emacs.el

   1 ;; -*- mode: Emacs-Lisp; mode: rainbow; -*-
   2
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4 ;; This program is free software; you can redistribute it and/or         ;;
   5 ;; modify it under the terms of the GNU General Public License as        ;;
   6 ;; published by the Free Software Foundation; either version 3, or (at   ;;
   7 ;; your option) any later version.                                       ;;
   8 ;;                                                                       ;;
   9 ;; This program is distributed in the hope that it will be useful, but   ;;
  10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
  12 ;; General Public License for more details.                              ;;
  13 ;;                                                                       ;;
  14 ;; You should have received a copy of the GNU General Public License     ;;
  15 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
  16 ;;                                                                       ;;
  17 ;; Written by and Copyright (C) Francois Fleuret                         ;;
  18 ;; Contact <francois@fleuret.org> for comments & bug reports             ;;
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20
  21 ;; It's better to set the preferences in the .Xresources so that the
  22 ;; window is not first displayed with the wrong options
  23
  24 ;; Emacs.menuBar:            off
  25 ;; Emacs.verticalScrollBars: off
  26 ;; Emacs.toolBar:            off
  27 ;; Emacs.internalBorder:     1
  28 ;; Emacs.FontBackend: xft
  29 ;; Xft.dpi: 96
  30 ;; Xft.hinting: true
  31 ;; Xft.antialias: true
  32 ;; Xft.rgba: rgb
  33
  34 ;; Give the focus to the emacs window if we are under a windowing
  35 ;; system
  36
  37 (when window-system
  38   ;; (x-focus-frame nil)
  39   (set-mouse-pixel-position (selected-frame) 4 4))
  40
  41 ;; Where I keep my own scripts
  42
  43 (add-to-list 'load-path "~/sources/gpl/elisp")
  44 (add-to-list 'load-path "~/sources/elisp")
  45 (add-to-list 'load-path "~/local/elisp")
  46
  47 ;; No, I do not like menus
  48 (menu-bar-mode -1)
  49
  50 ;; Nor fringes
  51 ;; (when (functionp 'fringe-mode) (fringe-mode '(0 . 0)))
  52 ;; (when (functionp 'fringe-mode) (fringe-mode '(0 . 1)))
  53 (when (functionp 'fringe-mode) (fringe-mode 10))
  54
  55 ;; And I do not like scrollbar neither
  56 (when (functionp 'scroll-bar-mode) (scroll-bar-mode -1))
  57
  58 ;; Make all "yes or no" prompts be "y or n" instead
  59 (fset 'yes-or-no-p 'y-or-n-p)
  60
  61 ;; Show the matching parenthesis and do it immediately, we are in a
  62 ;; hurry
  63 (setq show-paren-delay 0)
  64 (show-paren-mode t)
  65
  66 ;; use colorization for all modes
  67 (global-font-lock-mode t)
  68
  69 (setq font-lock-maximum-decoration 3
  70       ;;'((latex-mode . 2) (t . 2))
  71       )
  72
  73 ;; Activate the dynamic completion of buffer names
  74 (iswitchb-mode 1)
  75
  76 ;; Save the minibuffer history
  77 (setq savehist-file "~/private/emacs/savehist")
  78 (when (functionp 'savehist-mode) (savehist-mode 1))
  79
  80 ;; And allow minibuffer recursion
  81 (setq enable-recursive-minibuffers t)
  82 (minibuffer-depth-indicate-mode 1)
  83
  84 ;; I do not like tooltips
  85 (when (functionp 'tooltip-mode) (tooltip-mode nil))
  86
  87 ;; Activate the dynamic completion in the mini-buffer
  88 (icomplete-mode 1)
  89
  90 ;; (setq highlight-current-line-globally t
  91 ;; highlight-current-line-ignore-regexp "Faces\\|Colors\\| \\*Mini\\|\\*media\\|INBOX")
  92
  93 ;; (highlight-current-line-minor-mode 1)
  94 ;; (highlight-current-line-set-bg-color "gray75")
  95
  96 (defun ff/compile-when-needed (name)
  97   "Compiles the given file only if needed. Adds .el if required, and
  98 uses `load-path' to find it."
  99   (if (not (string-match "\.el$" name))
 100       (ff/compile-when-needed (concat name ".el"))
 101     (mapc (lambda (dir)
 102             (let* ((src (concat dir "/" name)))
 103               (when (file-newer-than-file-p src (concat src "c"))
 104                 (if (let ((byte-compile-verbose nil))
 105                       (condition-case nil
 106                           (byte-compile-file src)
 107                         (error nil)))
 108                     (message (format "Compiled %s" src ))
 109                   (message (format "Failed compilation of %s" src))))))
 110           load-path)))
 111
 112 ;; This is useful when using the same .emacs in many places
 113
 114 (defun ff/load-or-alert (name &optional compile-when-needed)
 115   "Tries to load the specified file and insert a warning message in a
 116 load-warning buffer in case of failure."
 117
 118   (when compile-when-needed (ff/compile-when-needed name))
 119
 120   (if (load name t nil) t
 121     (let ((buf (get-buffer-create "*loading warnings*")))
 122       (display-buffer buf)
 123       (set-buffer buf)
 124       (insert (propertize "Warning:" 'face 'font-lock-warning-face) " could not load '" name "'\n")
 125       (fit-window-to-buffer (get-buffer-window buf))
 126       (set-buffer-modified-p nil))
 127     nil))
 128
 129 ;; This is the default in emacs 22.1 and later
 130 ;; (auto-compression-mode 1)
 131
 132 ;; make emacs use the clipboard so that copy/paste works for other
 133 ;; x-programs. I have no clue how all that clipboard thing works.
 134
 135 ;; (setq x-select-enable-clipboard t)
 136 ;; (setq interprogram-paste-function 'x-cut-buffer-or-selection-value)
 137 ;; (setq x-select-enable-primary t)
 138 ;; (setq x-select-enable-clipboard t)
 139 ;; (global-set-key "\C-y" 'clipboard-yank)
 140
 141 (setq
 142
 143  message-log-max 1000
 144
 145  ;; avoid GC as much as possible
 146  gc-cons-threshold 2500000
 147
 148  ;; no startup message
 149  inhibit-startup-screen t
 150
 151  ;; no message in the scratch buffer
 152  initial-scratch-message nil
 153
 154  ;; do not fill my buffers, you fool
 155  next-line-add-newlines nil
 156
 157  ;; keep the window focused on the messages during compilation
 158  compilation-scroll-output t
 159
 160  ;; Keep the highlight on the compilation error
 161  next-error-highlight t
 162
 163  ;; blink the screen instead of beeping
 164  ;; visible-bell t
 165
 166  ;; take the CR when killing a line
 167  kill-whole-line t
 168
 169  ;; I prefer to move between lines as defined in the buffer, not
 170  ;; visually
 171  line-move-visual nil
 172
 173  ;; I comment empty lines, too (does not seem to work, though)
 174  comment-empty-lines t
 175
 176  ;; We want long lines to be truncated instead of displayed on several lines
 177  ;; truncate-lines t
 178  ;; Show all lines, even if the window is not as large as the frame
 179  ;; truncate-partial-width-windows nil
 180  ;; truncate-partial-width-windows t
 181
 182  ;; Do not keep tracks of the autosaved files
 183  auto-save-list-file-prefix nil
 184
 185  ;; Show me empty lines at the end of the buffer
 186  default-indicate-empty-lines t
 187
 188  ;; Show me the region until I do something on it
 189  transient-mark-mode t
 190
 191  ;; Do not color stuff which are clickable when hovering over it
 192  mouse-highlight nil
 193
 194  ;; Don't bother me with questions even if "unsafe" local variables
 195  ;; are set
 196  enable-local-variables :all
 197
 198  ;; I have no problem with small windows
 199  window-min-height 1
 200
 201  ;; I am not a fan of develock
 202  develock-auto-enable nil
 203
 204  ;; I do not like women to open windows
 205  woman-use-own-frame nil
 206
 207  ;; I am not that paranoid, contrary to what you think
 208  epa-file-cache-passphrase-for-symmetric-encryption t
 209  ;; And I like ascii files
 210  epa-armor t
 211
 212  ;; tramp-default-method "ssh"
 213  tramp-default-method "scp"
 214
 215  ;; I have no problem with files having their own local variables
 216  enable-local-eval t
 217
 218  mail-from-style 'angles
 219  browse-url-mozilla-program "firefox"
 220  mc-encrypt-for-me t
 221  mc-use-default-recipients t
 222
 223  ;; browse-url-new-window-flag t
 224
 225  ;; I do not like compilation to automatically split the active window
 226  ;; vertically, even when the said window is very wide
 227  split-height-threshold 0
 228  split-width-threshold nil
 229
 230  )
 231
 232 ;; The backups
 233
 234 (setq
 235  temporary-file-directory "/tmp/"
 236  vc-make-backup-files t
 237  backup-directory-alist '((".*" . "~/misc/emacs.backups/"))
 238  version-control t ;; Use backup files with numbers
 239  kept-new-versions 10
 240  kept-old-versions 2
 241  delete-old-versions t
 242  backup-by-copying-when-linked t
 243  )
 244
 245 (setq tramp-backup-directory-alist backup-directory-alist)
 246
 247 (setq user-emacs-directory "~/misc/emacs.d/")
 248
 249 (setq
 250  abbrev-file-name (concat user-emacs-directory "abbrev_defs")
 251  server-auth-dir (concat user-emacs-directory "server/")
 252  custom-theme-directory user-emacs-directory
 253  )
 254
 255 ;; Stop this crazy blinking cursor
 256 (blink-cursor-mode 0)
 257
 258 ;; (setq blink-cursor-delay 0.25
 259 ;; blink-cursor-interval 0.25)
 260
 261 ;; (set-terminal-coding-system 'utf-8)
 262
 263 ;; (unless window-system
 264 ;; (xterm-mouse-mode 1)
 265 ;;   (if (string= (getenv "TERM") "xterm-256color")
 266 ;;       (ff/load-or-alert "xterm-256color" t))
 267 ;; )
 268
 269 (setq-default
 270
 271  ;; Show white spaces at the end of lines
 272  show-trailing-whitespace t
 273
 274  ;; Do not show the cursor in non-active window
 275  cursor-in-non-selected-windows nil
 276
 277  use-dialog-box nil
 278  use-file-dialog nil
 279
 280  ;; when on a TAB, the cursor has the TAB length
 281  x-stretch-cursor t
 282
 283  ;; This is the default coding system when toggle-input-method is
 284  ;; invoked (C-\)
 285  default-input-method "latin-1-prefix"
 286  ;; do not put tabs when indenting
 287  indent-tabs-mode nil
 288  ;; And yes, we have a fast display / connection / whatever
 289  baud-rate 524288
 290  ;; baud-rate 10
 291
 292  ;; To keep the cursor always visible when it moves (thanks
 293  ;; snogglethrop!)
 294  redisplay-dont-pause t
 295
 296  ;; I want to see the keys I type instantaneously
 297  echo-keystrokes 0.1
 298  )
 299
 300 ;; Show the column number
 301 (column-number-mode 1)
 302
 303 ;; What modes for what file extentions
 304 (add-to-list 'auto-mode-alist '("\\.h\\'" . c++-mode))
 305
 306 (require 'org-table)
 307
 308 (add-to-list 'auto-mode-alist '("\\.txt\\'" . (lambda()
 309                                                 (text-mode)
 310                                                 (orgtbl-mode)
 311                                                 ;; (auto-fill-mode)
 312                                                 (flyspell-mode))))
 313
 314 (add-hook 'c++-mode-hook 'flyspell-prog-mode)
 315 (add-hook 'log-edit-mode-hook 'flyspell-mode)
 316
 317 ;; I am a power-user
 318
 319 (put 'narrow-to-region 'disabled nil)
 320 (put 'upcase-region 'disabled nil)
 321 (put 'downcase-region 'disabled nil)
 322 ;; (put 'scroll-left 'disabled nil)
 323 ;; (put 'scroll-right 'disabled nil)
 324
 325 ;; My selector is clearer than that
 326 ;; (when (load "ido" t) (ido-mode t))
 327
 328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 329
 330 ;; Makes buffer names more explicit then <2>, <3> etc. when there are
 331 ;; several identical filenames
 332
 333 (when (load "uniquify" t)
 334   (setq uniquify-buffer-name-style 'post-forward-angle-brackets))
 335
 336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 337 ;; Appearance
 338 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 339
 340 (when (boundp 'x-display-name)
 341
 342   (setq-default
 343
 344    ;; If the display is :0.0, we make the assumption that we are
 345    ;; running the emacs locally, and we do not show the
 346    ;; hostname. Otherwise, show @host.
 347
 348    frame-title-format (concat "emacs" ;;invocation-name
 349                               (unless (string= x-display-name ":0.0")
 350                                 (concat "@" system-name))
 351                               " (%b)")
 352
 353    ;; Use the same for the icone
 354
 355    icon-title-format frame-title-format
 356    ))
 357
 358 ;; "tool" bar? Are you kidding?
 359 (when (fboundp 'tool-bar-mode) (tool-bar-mode -1))
 360
 361 ;; ;; If my own letter icon is here, use it and change its color
 362 ;; (when (file-exists-p "~/local/share/emacs/letter.xbm")
 363 ;; (setq-default display-time-mail-icon
 364 ;; (find-image
 365 ;; '((:type xbm
 366 ;; :file "~/local/share/emacs/letter.xbm"
 367 ;; :ascent center)))))
 368
 369 ;; My funky setting of face colors. Basically, we switch to a sober
 370 ;; look and darken a bit the colors which need to (because of the
 371 ;; darker background)
 372
 373 (defun ff/configure-faces (fl)
 374   "Set face attributes and create faces when necessary"
 375   (mapc (lambda (f)
 376           (unless (boundp (car f)) (make-empty-face (car f)))
 377           (eval `(set-face-attribute (car f) nil ,@(cdr f))))
 378         fl))
 379
 380 ;; Not the same in xterm (which is gray in my case) and in
 381 ;; X-window
 382
 383 (unless window-system
 384   ;;     (xterm-mouse-mode 1)
 385   (ff/configure-faces
 386    '((italic :underline nil)
 387      (info-title-2 :foreground "green")
 388      (font-lock-comment-delimiter-face :foreground "black")
 389      (font-lock-comment-face :foreground "black")
 390      (cperl-array-face :background "gray90" :foreground "blue" :weight 'bold)
 391      (cperl-hash-face :background "gray90" :foreground "purple" :weight 'bold)
 392      (diff-added :background "gray90" :foreground "green4" :weight 'bold)
 393      (diff-removed :background "gray90" :foreground "red2" :weight 'bold)
 394      (diff-changed :background "gray90" :foreground "blue" :weight 'bold)
 395      (diff-file-header-face :background "white" :foreground "black"
 396                             :weight 'bold)
 397      (diff-header-face :background "white" :foreground "black")
 398      (diff-hunk-header-face :background "white" :foreground "black")
 399      (diff-indicator-removed :foreground "red" :weight 'bold)
 400      (diff-removed :foreground "red" :weight 'bold)
 401      (diff-indicator-added :foreground "blue" :weight 'bold)
 402      (diff-added :foreground "blue" :weight 'bold)
 403      (font-lock-string-face :foreground "green")
 404      (font-lock-variable-name-face :foreground "blue")
 405      (font-lock-constant-face :foreground "blue")
 406      (font-lock-preprocessor-face :foreground "green")
 407      (font-lock-function-name-face :foreground "cyan")
 408      (flyspell-incorrect :foreground "red2")
 409      (flyspell-duplicate :foreground "OrangeRed2")
 410      (hl-line :background "white")
 411      (sh-heredoc :foreground "black" :background "#fff0f0")
 412      (sh-heredoc-face :foreground "black" :background "#fff0f0")
 413      (font-lock-keyword-face :foreground "blue")
 414      (highlight :background "darkseagreen3")
 415      (isearch :background "orange" :foreground "black")
 416      (isearch-lazy-highlight-face' :background "yellow" :foreground "black")
 417      ;; (display-time-mail-face :background "white")
 418      (show-paren-match-face :background "gold" :foreground "black")
 419      (show-paren-mismatch-face :background "red" :foreground "black")
 420      (trailing-whitespace :background "white")
 421      (mode-line :background "cornflowerblue" :foreground "black" :box nil
 422                 :inverse-video nil)
 423      (header-line :background "cornflowerblue" :foreground "black" :box nil
 424                   :inverse-video nil)
 425      (mode-line-inactive :background "gray60" :foreground "black" :box nil
 426                          :inverse-video nil)
 427      (region :background "white")
 428      (ff/date-info-face :foreground "white" :weight 'bold)
 429      (ff/mail-alarm-face :foreground "red" :weight 'bold)
 430      (gui-button-face :background "green" :foreground "white")
 431      (enotes/information-face :foreground "cyan")
 432      ))
 433   )
 434
 435 ;; (list-colors-display (mapcar 'car color-name-rgb-alist))
 436
 437 ;; (ff/configure-faces '((default :background "black" :foreground "gray80")))
 438 ;; (ff/configure-faces '((default :background "gray80" :foreground "black")))
 439
 440 (when window-system
 441   ;; (setq
 442   ;; display-time-use-mail-icon t)
 443
 444   (ff/configure-faces
 445    '(
 446      ;; (escape-glyph :foreground "#c0c0c0" :weight 'bold)
 447
 448      (escape-glyph :foreground "green3" :weight 'bold)
 449      (default :background "gray90" :foreground "black")
 450      (cperl-array-face :background "gray90" :foreground "blue" :weight 'bold)
 451      (cperl-hash-face :background "gray90" :foreground "purple" :weight 'bold)
 452      (message-cited-text :foreground "red4")
 453      (diff-mode :background "gray90" :weight 'bold)
 454      (diff-added :background "gray90" :foreground "green4" :weight 'bold)
 455      (diff-removed :background "gray90" :foreground "red2" :weight 'bold)
 456      (diff-changed :background "gray90" :foreground "blue" :weight 'bold)
 457      (diff-file-header :background "white" :foreground "black"
 458                        :weight 'bold)
 459      (diff-header :background "white" :foreground "black")
 460      (diff-hunk-header :background "white" :foreground "black")
 461      (font-lock-builtin-face :foreground "deeppink3")
 462      (font-lock-string-face :foreground "dark olive green")
 463      (font-lock-variable-name-face :foreground "sienna")
 464      ;; (font-lock-function-name-face :foreground "blue" :weight 'bold)
 465      (font-lock-function-name-face :foreground "blue")
 466      ;; (font-lock-comment-delimiter-face :foreground "dark violet")
 467      ;; (font-lock-comment-face :foreground "dark violet")
 468      (flyspell-incorrect :background "#ff0000" :foreground "black")
 469      (flyspell-duplicate :background "#ff9000" :foreground "black")
 470      (hl-line :background "white")
 471      (sh-heredoc :foreground "black" :background "#fff0f0")
 472      (sh-heredoc-face :foreground "black" :background "#fff0f0")
 473      (header-line :background "gray65")
 474      (highlight :background "turquoise")
 475      (message-cited-text-face :foreground "firebrick")
 476      (isearch :background "yellow" :foreground "black")
 477      (isearch-lazy-highlight-face' :background "yellow3" :foreground "black")
 478      (region :background "#b8b8e0" :foreground "black")
 479      ;; (region :background "plum" :foreground "black")
 480      (show-paren-match-face :background "gold" :foreground "black")
 481      (show-paren-mismatch-face :background "red" :foreground "black")
 482      (trailing-whitespace :background "gray65")
 483      (cursor :inverse-video t)
 484      (enotes/list-title-face :foreground "blue" :weight 'bold)
 485      (mode-line :background "#b0b0ff" :foreground "black" :box nil
 486                 :inverse-video nil)
 487      (header-line :background "cornflowerblue" :foreground "black" :box nil
 488                   :inverse-video nil)
 489      (mode-line-inactive :background "gray80" :foreground "black" :box nil
 490                          :inverse-video nil)
 491      ;; (fringe :background "black" :foreground "gray90")
 492      (fringe :background "gray80")
 493      (ff/date-info-face :foreground "white" :weight 'bold)
 494      (ff/mail-alarm-face :foreground "white" :background "red2")
 495      ;; (alarm-vc-face :foreground "black" :background "yellow" :weight 'normal)
 496      (gui-button-face :background "green" :foreground "black")
 497     ))
 498   )
 499
 500 ;; When we are root, put the modeline in red
 501
 502 (when (string= (user-real-login-name) "root")
 503   (ff/configure-faces
 504    '((mode-line :background "red3" :foreground "black" :box nil
 505                 :inverse-video nil))
 506    ))
 507
 508 ;; Why should I have to do this?
 509 (add-hook 'sh-mode-hook
 510           (lambda ()
 511             (set-face-attribute 'sh-heredoc nil
 512                                 :foreground "#604000"
 513                                 :background "white"
 514                                 :italic t)
 515             (set-face-attribute 'sh-heredoc-face nil
 516                                 :foreground "#604000"
 517                                 :background "white"
 518                                 :italic t)
 519             ))
 520
 521 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 522 ;; Move the window on the buffer without moving the cursor
 523 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 524
 525 (defun ff/scroll-down ()
 526   "Scroll the buffer down one line and keep the cursor at the same location."
 527   (interactive)
 528   (condition-case nil
 529       (scroll-down 1)
 530     (error nil)))
 531
 532 (defun ff/scroll-up ()
 533   "Scroll the buffer up one line and keep the cursor at the same location."
 534   (interactive)
 535   (condition-case nil
 536       (scroll-up 1)
 537     (error nil)))
 538
 539 (defun ff/scroll-left ()
 540   "Scroll the buffer left one column and keep the cursor at the same location."
 541   (interactive)
 542   (condition-case nil
 543       (scroll-left 2)
 544     (error nil)))
 545
 546 (defun ff/scroll-right ()
 547   "Scroll the buffer right one column and keep the cursor at the same location."
 548   (interactive)
 549   (condition-case nil
 550       (scroll-right 2)
 551     (error nil)))
 552
 553 (define-key global-map [(meta up)] 'ff/scroll-down)
 554 (define-key global-map [(meta down)] 'ff/scroll-up)
 555 (define-key global-map [(meta p)] 'ff/scroll-down)
 556 (define-key global-map [(meta n)] 'ff/scroll-up)
 557 (define-key global-map [(meta right)] 'ff/scroll-left)
 558 (define-key global-map [(meta left)] 'ff/scroll-right)
 559
 560 (defun ff/delete-trailing-whitespaces-and-indent ()
 561   (interactive)
 562   (delete-trailing-whitespace)
 563   (indent-region (point-min) (point-max) nil))
 564
 565 (define-key global-map [(control c) (control q)] 'ff/delete-trailing-whitespaces-and-indent)
 566
 567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 568 ;; Playing sounds
 569 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 570
 571 ;; (defun ff/esd-sound (file)
 572 ;;   "Plays a sound with the Enlighted sound daemon."
 573 ;;   (interactive)
 574 ;;   (process-kill-without-query (start-process-shell-command "esdplay"
 575 ;;                                                            nil
 576 ;;                                                            "esdplay" file)))
 577
 578 (defun ff/alsa-sound (file)
 579   "Plays a sound with ALSA."
 580   (interactive)
 581   (process-kill-without-query (start-process-shell-command "aplay"
 582                                                            nil
 583                                                            "aplay" "-q" file)))
 584
 585 (if (and (boundp 'x-display-name) (string= x-display-name ":0.0"))
 586     (defalias 'ff/play-sound-async 'ff/alsa-sound)
 587   (defalias 'ff/play-sound-async 'ding))
 588
 589 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 590 ;; I comment stuff often, let's be efficient. shift + down comments
 591 ;; the current line and goes down, and shift + up uncomments the line
 592 ;; and goes up (they are not the dual of each other, but moving and
 593 ;; then uncommenting would be very counter-intuitive).
 594 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 595
 596 (defun ff/comment-and-go-down (arg)
 597   "Comments and goes down ARG lines."
 598   (interactive "p")
 599   (condition-case nil
 600       (comment-region (point-at-bol) (point-at-eol)) (error nil))
 601   (next-line 1)
 602   (if (> arg 1) (ff/comment-and-go-down (1- arg))))
 603
 604 (defun ff/uncomment-and-go-up (arg)
 605   "Uncomments and goes up ARG lines."
 606   (interactive "p")
 607   (condition-case nil
 608       (uncomment-region (point-at-bol) (point-at-eol)) (error nil))
 609   (next-line -1)
 610   (if (> arg 1) (ff/uncomment-and-go-up (1- arg))))
 611
 612 (define-key global-map [(shift down)] 'ff/comment-and-go-down)
 613 (define-key global-map [(shift up)] 'ff/uncomment-and-go-up)
 614
 615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 616 ;; Counting various entities in text
 617 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 618
 619 (defun ff/word-occurences ()
 620   "Display in a new buffer the list of words sorted by number of
 621 occurrences "
 622   (interactive)
 623
 624   (let ((buf (get-buffer-create "*word counting*"))
 625         (map (make-sparse-keymap))
 626         (nb (make-hash-table))
 627         (st (make-hash-table))
 628         (result nil))
 629
 630     ;; Collects all words in a hash table
 631
 632     (save-excursion
 633       (goto-char (point-min))
 634       (while (re-search-forward "\\([\\-a-zA-Z\\\\]+\\)" nil t)
 635         (let* ((s (downcase (match-string-no-properties 1)))
 636                (k (sxhash s)))
 637           (puthash k s st)
 638           (puthash k (1+ (gethash k nb 0)) nb))))
 639
 640     ;; Creates the result buffer
 641
 642     (define-key map "q" 'kill-this-buffer)
 643     (display-buffer buf)
 644     (set-buffer buf)
 645     (setq show-trailing-whitespace nil)
 646     (erase-buffer)
 647
 648     ;; Builds a list from the hash table
 649
 650     (maphash
 651      (lambda (key value)
 652        (setq result (cons (cons value (gethash key st)) result)))
 653      nb)
 654
 655     ;; Sort and display it
 656
 657     (mapc (lambda (x)
 658             (if (and (> (car x) 3)
 659                      ;; No leading backslash and at least four characters
 660                      (string-match "^[^\\]\\{4,\\}" (cdr x))
 661                      )
 662                 (insert (number-to-string (car x)) " " (cdr x) "\n")))
 663           (sort result (lambda (a b) (> (car a) (car b)))))
 664
 665     ;; Adjust the window size and stuff
 666
 667     (fit-window-to-buffer (get-buffer-window buf))
 668     (use-local-map map)
 669     (set-buffer-modified-p nil))
 670   )
 671
 672 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 673 ;; Printing
 674 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 675
 676 (load "ps-print")
 677
 678 (setq ps-print-color-p nil
 679       ps-paper-type 'letter
 680       ;; ps-paper-type 'a4
 681       ;; ps-top-margin (* 1.75 56.692)
 682       ;; ps-left-margin 56.692
 683       ;; ps-bottom-margin 56.692
 684       ;; ps-right-margin 56.692
 685
 686       ;; Simple header. Remove that silly frame shadow.
 687       ps-print-header nil
 688       ps-print-header-frame nil
 689       ps-header-line-pad 0.3
 690       ps-header-font-family 'Courier
 691       ps-header-title-font-size '(8.5 . 10)
 692       ps-header-font-size '(6 . 7)
 693       ps-font-size '(7 . 8)
 694       )
 695
 696 (ps-put 'ps-header-frame-alist 'back-color 1.0)
 697 (ps-put 'ps-header-frame-alist 'shadow-color 1.0)
 698 (ps-put 'ps-header-frame-alist 'border-color 0.0)
 699 (ps-put 'ps-header-frame-alist 'border-width 0.0)
 700
 701 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 702
 703 ;; http://blog.tuxicity.se/elisp/emacs/2010/03/26/rename-file-and-buffer-in-emacs.htm
 704
 705 (defun rename-file-and-buffer ()
 706   "Renames current buffer and file it is visiting."
 707   (interactive)
 708   (let ((name (buffer-name))
 709         (filename (buffer-file-name)))
 710     (if (not (and filename (file-exists-p filename)))
 711         (message "Buffer '%s' is not visiting a file!" name)
 712       (let ((new-name (read-file-name "New name: " filename)))
 713         (cond ((get-buffer new-name)
 714                (message "A buffer named '%s' already exists!" new-name))
 715               (t
 716                (rename-file name new-name 1)
 717                (rename-buffer new-name)
 718                (set-visited-file-name new-name)
 719                (set-buffer-modified-p nil)))))))
 720
 721 (global-set-key (kbd "C-c r") 'rename-file-and-buffer)
 722
 723 (defun ff/non-existing-filename (dir prefix suffix)
 724   "Returns a filename of the form DIR/PREFIX[.n].SUFFIX whose file does
 725 not exist"
 726   (let ((n 0)
 727         (f (concat prefix suffix)))
 728     (while (file-exists-p (concat dir "/" f))
 729       (setq n (1+ n)
 730             f (concat prefix "." (prin1-to-string n) suffix)))
 731     f))
 732
 733 (defun ff/print-buffer-or-region-with-faces (&optional file)
 734
 735   ;; I am fed up with spell checking highlights
 736   (when (and flyspell-mode
 737              ;; (or ispell-minor-mode flyspell-mode)
 738              (not (y-or-n-p "The spell checking is on, still print ? ")))
 739     (error "Printing cancelled, the spell-checking is on"))
 740
 741   (unless
 742       (condition-case nil
 743           (ps-print-region-with-faces (region-beginning) (region-end) file)
 744         (error nil))
 745     (ps-print-buffer-with-faces file)))
 746
 747 (defun ff/print-to-file (file)
 748   "Prints the region if selected or the whole buffer in postscript
 749 into FILE."
 750   (interactive
 751    (list
 752     (read-file-name
 753      "PS file: " "/tmp/" nil nil
 754      (ff/non-existing-filename
 755       "/tmp"
 756       (replace-regexp-in-string "[^a-zA-Z0-9_.-]" "_" (file-name-nondirectory
 757                                                        (buffer-name)))
 758       ".ps"))
 759     ))
 760   (ff/print-buffer-or-region-with-faces file))
 761
 762 (defun ff/print-to-printer ()
 763   "Prints the region if selected or the whole buffer to a postscript
 764 printer."
 765   (interactive)
 766   (message "Printing to '%s'" (getenv "PRINTER"))
 767   (ff/print-buffer-or-region-with-faces))
 768
 769 ;; Can you believe it? There is a "print" key on PC keyboards ...
 770
 771 (define-key global-map [(print)] 'ff/print-to-file)
 772 (define-key global-map [(shift print)] 'ff/print-to-printer)
 773
 774 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 775 ;; Dealing with the laptop battery
 776 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 777
 778 (defcustom ff/battery-dir "/sys/class/power_supply/BAT0"
 779   "*Where to gather the battery information")
 780
 781 (defcustom ff/temperature-file "/sys/class/thermal/thermal_zone0/temp"
 782   "*Where to gather the thermal information")
 783
 784 (defun ff/file-first-line (file)
 785   (with-temp-buffer
 786     (insert-file-contents-literally file)
 787     (buffer-substring (point-at-bol) (point-at-eol))))
 788
 789 (defun ff/battery-percent (prefix)
 790   (condition-case nil
 791       (/ (* 100 (string-to-number (ff/file-first-line (format "%s/%s_now" ff/battery-dir prefix))))
 792          (string-to-number (ff/file-first-line (format "%s/%s_full"  ff/battery-dir prefix))))
 793     (error -1))
 794   )
 795
 796 (defun ff/laptop-info-string () (interactive)
 797   (condition-case nil
 798       (concat
 799
 800        ;; The temperature
 801
 802        (let ((temp (/ (string-to-number (ff/file-first-line ff/temperature-file)) 1000)))
 803          (if (> temp 50)
 804              (concat
 805               (let ((s (format "%dC " temp)))
 806                 (if (> temp 70) (propertize s 'face
 807                                             'font-lock-warning-face)
 808                   s))
 809               )
 810            )
 811          )
 812
 813        ;; The battery
 814
 815        (let ((battery-status (ff/file-first-line (concat ff/battery-dir "/status"))))
 816
 817          (cond
 818           ((string= battery-status "Full") "L")
 819
 820           ((string= battery-status "Charging")
 821            (format "L%d%%" (max (ff/battery-percent "charge")
 822                                 (ff/battery-percent "energy"))))
 823
 824           ((string= battery-status "Discharging")
 825            (let* ((c (max (ff/battery-percent "charge")
 826                           (ff/battery-percent "energy")))
 827                   (s (format "B%d%%" c)))
 828              (if (>= c 20) s (propertize s 'face 'font-lock-warning-face))))
 829
 830           (t battery-status)
 831
 832           ))
 833
 834        )
 835
 836     (error nil))
 837   )
 838
 839 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 840
 841 (defun ff/system-info () (interactive)
 842
 843   (let ((buf (get-buffer-create "*system info*"))
 844         (map (make-sparse-keymap)))
 845
 846     (define-key map "q" 'kill-this-buffer)
 847     (display-buffer buf)
 848     (set-buffer buf)
 849     (setq show-trailing-whitespace nil)
 850     (erase-buffer)
 851
 852     (let ((highlight nil))
 853
 854       (mapc (lambda (x)
 855               (insert
 856                (if (setq highlight (not highlight))
 857                    (propertize
 858                     (with-temp-buffer (apply 'call-process x)
 859                                       (buffer-string))
 860                     'face '(:background "#c0c0ff"))
 861                  (with-temp-buffer (apply 'call-process x)
 862                                    (buffer-string))
 863                  ))
 864               )
 865
 866             '(
 867               ("hostname" nil t nil "-v")
 868               ("acpi" nil t)
 869               ("df" nil t nil "-h")
 870               ;; ("mount" nil t)
 871               ("ifconfig" nil t)
 872               ("ssh-add" nil t nil "-l")
 873               )))
 874
 875     (goto-char (point-min))
 876     (while (re-search-forward "^$" nil t) (backward-delete-char 1))
 877
 878     (fit-window-to-buffer (get-buffer-window buf))
 879     (use-local-map map)
 880     (set-buffer-modified-p nil)
 881     ))
 882
 883 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 884 ;; Make a sound when there is new mail
 885 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 886
 887 ;; I do not like sounds anymore
 888
 889 ;; (setq ff/already-boinged-for-mail nil)
 890
 891 ;; (defun ff/boing-if-new-mail ()
 892 ;; (if mail (when (not ff/already-boinged-for-mail)
 893 ;; ;; (ff/play-sound-async "~/local/sounds/boing1.wav")
 894 ;; ;; (ff/show-unspooled-mails)
 895 ;; (setq ff/already-boinged-for-mail t))
 896 ;; (setq ff/already-boinged-for-mail nil))
 897 ;; )
 898
 899 ;; (add-hook 'display-time-hook 'ff/boing-if-new-mail)
 900
 901 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 902 ;; Display time
 903 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 904
 905 (setq
 906
 907  display-time-interval 15 ;; Check every 15s
 908
 909  display-time-string-forms `(
 910
 911                              ;; (if mail
 912                              ;;     (concat " "
 913                              ;;             (propertize " mail "
 914                              ;;                         'face 'ff/mail-alarm-face)
 915                              ;;             " ")
 916                              ;;   )
 917
 918                              (propertize (concat 24-hours ":" minutes
 919                                                  " "
 920                                                  dayname " "
 921                                                  monthname " "
 922                                                  day)
 923                                          'face 'ff/date-info-face)
 924
 925                              load
 926
 927                              ,(if (ff/laptop-info-string)
 928                                   '(concat " " (ff/laptop-info-string)))
 929
 930                              )
 931
 932  ;; display-time-format "%b %a %e %H:%M"
 933  ;; display-time-mail-face nil
 934  )
 935
 936 ;; Show the time, mail and stuff
 937 (display-time)
 938
 939 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 940 ;; Moving through buffers
 941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 942
 943 (defun ff/next-buffer ()
 944   "Switches to the next buffer in cyclic order."
 945   (interactive)
 946   (let ((buffer (current-buffer)))
 947     (switch-to-buffer (other-buffer buffer))
 948     (bury-buffer buffer)))
 949
 950 (defun ff/prev-buffer ()
 951   "Switches to the previous buffer in cyclic order."
 952   (interactive)
 953   (let ((list (nreverse (buffer-list)))
 954         found)
 955     (while (and (not found) list)
 956       (let ((buffer (car list)))
 957         (if (and (not (get-buffer-window buffer))
 958                  (not (string-match "\\` " (buffer-name buffer))))
 959             (setq found buffer)))
 960       (setq list (cdr list)))
 961     (switch-to-buffer found)))
 962
 963 (define-key global-map [?\C-x right] 'ff/next-buffer)
 964 (define-key global-map [?\C-x left] 'ff/prev-buffer)
 965
 966 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 967 ;; There is actually a decent terminal emulator in emacs!
 968 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 969
 970 (load "term")
 971
 972 (defun ff/kill-associated-buffer (process str) (interactive)
 973   (let ((buffer (process-buffer process)))
 974     (kill-buffer buffer))
 975   (message "Process finished (%s)" (replace-regexp-in-string "\n$" "" str)))
 976
 977 (defun ff/kill-associated-buffer-and-delete-windows (process str) (interactive)
 978   (let ((buffer (process-buffer process)))
 979     (delete-windows-on buffer)
 980     (kill-buffer buffer))
 981   (message "Process finished (%s)" (replace-regexp-in-string "\n$" "" str)))
 982
 983 (defun ff/shell-new-buffer (buffername program &rest param)
 984   "Start a terminal-emulator in a new buffer with the shell PROGRAM,
 985 optionally invoked with the parameters PARAM. The process associated
 986 to the shell can be killed without query."
 987
 988   (interactive)
 989
 990   (let ((n 1)
 991         (bn buffername))
 992
 993     (while (get-buffer (concat "*" bn "*"))
 994       (setq n (1+ n)
 995             bn (format "%s<%d>" buffername n)))
 996
 997     (set-buffer (apply 'make-term (append (list bn program nil) param)))
 998
 999     (setq show-trailing-whitespace nil)
1000     (term-char-mode)
1001     (message "C-c C-k term-char-mode, C-c C-j term-line-mode. \
1002 In line mode: M-p previous line, M-n next line.")
1003
1004     ;; A standard setup of the face above is not enough, I have to
1005     ;; force them here. Since I have a gray90 background, I like
1006     ;; darker colors.
1007
1008     (when window-system
1009       (ff/configure-faces
1010        '((term-green :foreground "green3")
1011          (term-cyan :foreground "cyan3")
1012          (term-default-fg-inv :foreground "gray90" :background "black")
1013          )))
1014
1015     (term-set-escape-char ?\C-x)
1016
1017     ;; I like the shell buffer and windows to be deleted when the
1018     ;; shell process terminates. It's a bit of a mess to acheive this.
1019
1020     (let ((process (get-buffer-process (current-buffer))))
1021       (process-kill-without-query process)
1022       (set-process-sentinel process
1023                             ;; 'ff/kill-associated-buffer-and-delete-windows
1024                             'ff/kill-associated-buffer
1025                             ))
1026
1027     ;; (switch-to-buffer-other-window (concat "*" bn "*"))
1028     (switch-to-buffer (concat "*" bn "*"))
1029     ))
1030
1031 (defcustom ff/default-bash-commands '("ssh")
1032   "*List of commands to be used for completion when invoking a new
1033 bash shell with `ff/bash-new-buffer'.")
1034
1035 (defun ff/bash-new-buffer (universal)
1036   "Starts a bash in a new buffer. When invoked with a universal
1037 argument, asks for a command to execute in that bash shell. The list
1038 of commands in `ff/default-bash-commands' is used for auto-completion"
1039   (interactive "P")
1040
1041   (if universal
1042       (let ((cmd (completing-read
1043                   "Command: "
1044                   (mapcar (lambda (x) (cons x t)) ff/default-bash-commands))))
1045         (ff/shell-new-buffer cmd "/bin/bash" "-c" cmd))
1046
1047     (ff/shell-new-buffer "bash" "/bin/bash")))
1048
1049 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1050 ;; vc stuff for CVS
1051 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1052
1053 (setq ;; Always follow links if the file is under version control
1054  vc-follow-symlinks t
1055  )
1056
1057 (when (load "vc-git" nil t)
1058   (add-to-list 'vc-handled-backends 'GIT))
1059
1060 ;; alarm-vc.el is one of my own scripts, check my web page
1061
1062 (when (ff/load-or-alert "alarm-vc" t)
1063   (setq alarm-vc-mode-exceptions "^VM"))
1064
1065 (when (ff/load-or-alert "git")
1066   (setq git-show-unknown nil)
1067   )
1068
1069 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1070 ;; Makes .sh and others files executable automagically
1071 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1072
1073 ;; Please consider the security-related consequences of using it
1074
1075 ;; (defun ff/make-shell-scripts-executable (&optional filename)
1076 ;; (setq filename (or filename (buffer-name)))
1077 ;; (when (and (string-match "\\.sh$\\|\\.pl$\\|\\.rb" filename)
1078 ;; (not (file-executable-p filename))
1079 ;; )
1080 ;; (set-file-modes filename 493)
1081 ;; (message "Made %s executable" filename)))
1082
1083 ;; (add-hook 'after-save-hook 'ff/make-shell-scripts-executable)
1084
1085 (add-hook 'after-save-hook
1086           'executable-make-buffer-file-executable-if-script-p)
1087
1088 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1089 ;; Cool stuff to navigate in emacs-lisp sources
1090 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1091
1092 (load "find-func")
1093
1094 (defun ff/goto-function-definition (&optional goback)
1095   "Go directly to the definition of the function at point. With
1096 goback argument, go back where we were."
1097   (interactive "P")
1098   (if goback
1099       (if (not (and (boundp 'goto-function-history) goto-function-history))
1100           (error "We were nowhere, buddy")
1101         (message "Come back")
1102         (switch-to-buffer (car (car goto-function-history)))
1103         (goto-char (cdr (car goto-function-history)))
1104         (setq goto-function-history (cdr goto-function-history)))
1105
1106     (let ((function (function-called-at-point)))
1107       (when function
1108         (let ((location (find-function-search-for-symbol
1109                          function nil
1110                          (symbol-file function))))
1111           (setq goto-function-history
1112                 (cons (cons (current-buffer) (point))
1113                       (and (boundp 'goto-function-history)
1114                            goto-function-history)))
1115           (pop-to-buffer (car location))
1116           (goto-char (cdr location)))))))
1117
1118 (define-key global-map [(meta g)] 'ff/goto-function-definition)
1119 (define-key global-map [(meta G)] (lambda () (interactive)
1120                                     (ff/goto-function-definition t)))
1121
1122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1123 ;; The big stuff (bbdb, mailcrypt, etc.)
1124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1125
1126 ;; Failsafe version if we can't load bbdb
1127 (defun ff/explicit-name (email) email)
1128
1129 (load "vc-git")
1130
1131 (when (ff/load-or-alert "bbdb")
1132
1133   (setq
1134    ;; Stop asking (if not t or nil, will not ask)
1135    bbdb-offer-save 'never
1136    ;; I hate when bbdb decides to mess up my windows
1137    bbdb-use-pop-up nil
1138    ;; I have no problem with bbdb asking me if the sender email
1139    ;; does not match exactly the address we have in the database
1140    bbdb-quiet-about-name-mismatches 0
1141    ;; I have european friends, too
1142    bbdb-north-american-phone-numbers-p nil
1143    ;; To cycle through all possible addresses
1144    bbdb-complete-name-allow-cycling t
1145    ;; Cycle with full names only, not through all net-addresses alone too
1146    bbdb-dwim-net-address-allow-redundancy t
1147    ;; Do not add new addresses automatically
1148    bbdb-always-add-addresses nil
1149    )
1150
1151   (defface ff/known-address-face
1152     '((t (:foreground "blue2")))
1153     "The face to display known mail identities.")
1154
1155   (defface ff/unknown-address-face
1156     '((t (:foreground "gray50")))
1157     "The face to display unknown mail identities.")
1158
1159   (defun ff/explicit-name (email)
1160     "Returns a string identity for the first address in EMAIL. The
1161 identity is taken from bbdb if possible or from the address itself
1162 with mail-extract-address-components. The suffix \"& al.\" is added if
1163 there are more than one address.
1164
1165 If no bbdb record is found, the name is propertized with the face
1166 ff/unknown-address-face. If a record is found and contains a note
1167 'face, the associated face is used, otherwise
1168 ff/known-address-face is used."
1169
1170     (and email
1171          (let* ((data (mail-extract-address-components email))
1172                 (name (car data))
1173                 (net (cadr data))
1174                 (record (bbdb-search-simple nil net)))
1175
1176            (concat
1177
1178             (condition-case nil
1179                 (propertize (bbdb-record-name record)
1180                             'face
1181                             (or (cdr (assoc 'face
1182                                             (bbdb-record-raw-notes record)))
1183                                 'ff/known-address-face))
1184               (error
1185                (propertize (or (and data (concat "<" net ">"))
1186                                "*undefined*")
1187                            'face 'ff/unknown-address-face)
1188                ))
1189             (if (string-match "," (mail-strip-quoted-names email)) " & al.")
1190             )))
1191     )
1192
1193   (ff/configure-faces '((ff/robot-address-face :foreground "green4")
1194                         (ff/personal-address-face :foreground "blue2" :weight 'bold)
1195                         (ff/important-address-face :foreground "red3"
1196                                                    ;; :foreground "blue2"
1197                                                    ;; :underline t
1198                                                    ;; :background "white"
1199                                                    ;; :foreground "green4"
1200                                                    :weight 'bold
1201                                                    ;; :slant 'italic
1202                                                    )))
1203
1204   )
1205
1206 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1207 ;; An encrypted file to put secure stuff (passwords, ...)
1208 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1209
1210 (when (ff/load-or-alert "mailcrypt")
1211   (mc-setversion "gpg")
1212   ;; Keep the passphrase for 10min
1213   (setq mc-passwd-timeout 600
1214         ff/secure-note-file "~/private/secure-notes.gpg")
1215   )
1216
1217 (defface ff/secure-date
1218   '((t (:background "white" :weight bold)))
1219   "The face to display the dates in the modeline.")
1220
1221 (defun ff/secure-note-add () (interactive)
1222   (find-file ff/secure-note-file)
1223
1224   ;; Adds a new entry (i.e. date and a bunch of empty lines)
1225
1226   (goto-char (point-min))
1227   (insert "-- "
1228           (format-time-string "%Y %b %d %H:%M:%S" (current-time))
1229           " --\n\n")
1230   (previous-line 1)
1231
1232   ;; Colorizes the dates
1233
1234   (save-excursion
1235     (goto-char (point-min))
1236     (while (re-search-forward
1237             "^-- [0-9]+ [a-z]+ [0-9]+ [0-9]+:[0-9]+:[0-9]+ -+$"
1238             nil t)
1239       (add-text-properties
1240        (match-beginning 0) (1+ (match-end 0))
1241        '(face ff/secure-date rear-nonsticky t))))
1242
1243   (set-buffer-modified-p nil)
1244   (setq buffer-undo-list nil)
1245   )
1246
1247 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1248 ;; Spelling
1249 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1250
1251 (setq ;; For french, aspell is far better than ispell
1252  ispell-program-name "aspell"
1253  ;; To avoid ispell errors in figure filenames, labels, references.
1254  ;;       ispell-tex-skip-alists
1255  ;;       (list
1256  ;;        (append (car ispell-tex-skip-alists)
1257  ;;                '(("\\\\citep"           ispell-tex-arg-end) ;; JMLR
1258  ;;                  ("\\\\cite"            ispell-tex-arg-end)
1259  ;;                  ("\\\\nocite"          ispell-tex-arg-end)
1260  ;;                  ("\\\\includegraphics" ispell-tex-arg-end)
1261  ;;                  ("\\\\author"          ispell-tex-arg-end)
1262  ;;                  ("\\\\ref"             ispell-tex-arg-end)
1263  ;;                  ("\\\\label"           ispell-tex-arg-end)
1264  ;;                  ))
1265  ;;        (cadr ispell-tex-skip-alists))
1266
1267  ;; So that reftex follows the text when moving in the summary
1268  reftex-toc-follow-mode nil
1269  ;; So that reftex visits files to follow
1270  reftex-revisit-to-follow t
1271  )
1272
1273 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1274 ;; Used in a \includegraphics runs xfig with the corresponding .fig
1275 ;; file or gimp with the corresponding bitmap picture
1276 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1277
1278 (defun ff/run-eps-edition (prefix rules &optional force)
1279   (if rules
1280       (let ((filename (concat prefix (car (car rules)))))
1281         (if (or force (file-exists-p filename))
1282             (start-process "latex-eps-editor" nil (cdr (car rules)) filename)
1283           (ff/run-eps-edition prefix (cdr rules) force)))
1284     (message "No original file found for %seps" prefix)))
1285
1286 (defcustom ff/xdvi-for-latex-options nil
1287   "*Options to pass to xdvi when invoking `ff/run-viewer'")
1288
1289 (defun ff/run-viewer (universal)
1290
1291   "Starts an editor for the .eps at point (either xfig or gimp,
1292 depending with the original file it can find), or starts xdvi for
1293 the current .tex if no .eps is found at point. When run with a
1294 universal argument starts xfig even if the .fig does not exist"
1295
1296   (interactive "P")
1297
1298   (if (and (save-excursion
1299              (and (re-search-backward "{" (point-at-bol) t)
1300                   (or (re-search-forward "{\\([^{}]*.\\)eps}" (point-at-eol) t)
1301                       (re-search-forward "{\\([^{}]*.\\)pdf}" (point-at-eol) t)
1302                       (re-search-forward "{\\([^{}]*.\\)pdf_t}" (point-at-eol) t)
1303                       (re-search-forward "{\\([^{}]*.\\)png}" (point-at-eol) t)
1304                       (re-search-forward "{\\([^{}]*.\\)jpg}" (point-at-eol) t)
1305                       )))
1306            (and (<= (match-beginning 1) (point))
1307                 (>= (match-end 1) (- (point) 2))))
1308
1309       (ff/run-eps-edition (match-string-no-properties 1)
1310                           '(("fig" . "xfig")
1311                             ("jpg" . "gimp" )
1312                             ("png" . "gimp") ("pgm" . "gimp") ("ppm" . "gimp")
1313                             ("jpg" . "xv"))
1314                           universal)
1315
1316     (if (not (and (buffer-file-name) (string-match "\\(.*\\)\.tex$"
1317                                                    (buffer-file-name))))
1318         (message "Not a latex file!")
1319       (condition-case nil (kill-process xdvi-process) (error nil))
1320       (let ((dvi-name (concat (match-string 1 (buffer-file-name)) ".dvi")))
1321         (if (not (file-exists-p dvi-name)) (error "Can not find %s !" dvi-name)
1322           (message "Starting xdvi with %s" dvi-name)
1323           (setq xdvi-process (apply 'start-process
1324                                     (append '("xdvi-for-latex" nil "xdvi")
1325                                             ff/xdvi-for-latex-options
1326                                             (list dvi-name))))
1327           (process-kill-without-query xdvi-process))))
1328     ))
1329
1330 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1331 ;; Tex mode
1332
1333 ;; When working on a tex file with other people, I can just change
1334 ;; ff/tex-command in the -*- part of the file so that I don't mess up
1335 ;; other's people configuration.
1336
1337 (defadvice tex-file (around ff/set-my-own-tex-command () activate)
1338   (let ((tex-command
1339          (or (and (boundp 'ff/tex-command)
1340                   ff/tex-command)
1341              tex-command)))
1342     ad-do-it))
1343
1344 ;; This is a bit hardcore, but really I can't bear the superscripts in
1345 ;; my emacs window and could not find another way to deactivate them.
1346
1347 (load "tex-mode")
1348 (defun tex-font-lock-suscript (pos) ())
1349
1350 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1351 ;; Prevents many errors from beeping and makes the others play a nifty
1352 ;; sound
1353 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1354
1355 (defun ff/ring-bell ()
1356   (unless (memq this-command
1357                 '(isearch-abort
1358                   abort-recursive-edit
1359                   exit-minibuffer
1360                   keyboard-quit
1361                   backward-delete-char-untabify
1362                   delete-backward-char
1363                   minibuffer-complete-and-exit
1364                   previous-line next-line
1365                   backward-char forward-char
1366                   scroll-up scroll-down
1367                   enlarge-window-horizontally shrink-window-horizontally
1368                   enlarge-window shrink-window
1369                   minibuffer-complete
1370                   ))
1371     ;; (message "command [%s]" (prin1-to-string this-command))
1372     ;; (ff/play-sound-async "~/local/sounds/short_la.wav")
1373     ))
1374
1375 (setq ring-bell-function 'ff/ring-bell)
1376
1377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1378 ;; Past the content of the url currently in the kill-ring with
1379 ;; shift-click 2
1380 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1381
1382 (defun ff/insert-url (&optional url)
1383   "Downloads an URL with lynx and inserts it after the point."
1384   (interactive "MUrl: ")
1385   (when url
1386     (message "Inserting %s" url)
1387     (insert (concat "from: " url "\n\n"))
1388     ;; (call-process "lynx" nil t nil "-nolist" "-dump" url))
1389     (call-process "w3m" nil t nil "-dump" url))
1390   )
1391
1392 (define-key global-map [(shift mouse-2)]
1393   (lambda () (interactive) (ff/insert-url (current-kill 0))))
1394
1395 ;; lookup-dict is one of my own scripts, check my web page
1396
1397 (when (ff/load-or-alert "lookup-dict" t)
1398   (define-key global-map [(control \?)] 'lookup-dict))
1399
1400 ;; (defun ff/generate-password () (interactive)
1401 ;; (let ((c "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-"))
1402 ;; (nth (random (length c)) c))
1403
1404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1405 ;; Automatization of things I do often
1406 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1407
1408 (defun ff/snip () (interactive)
1409   (let ((start (condition-case nil (region-beginning) (error (point))))
1410         (end (condition-case nil (region-end) (error (point)))))
1411     (goto-char end)
1412     (insert "---------------------------- snip snip -------------------------------\n")
1413     (goto-char start)
1414     (insert "---------------------------- snip snip -------------------------------\n")
1415     ))
1416
1417 (defun ff/start-latex ()
1418   "Adds all that stuff to start a new LaTeX document."
1419   (interactive)
1420   (goto-char (point-min))
1421   (insert "%% -*- mode: latex; mode: reftex; mode: flyspell; coding: utf-8; tex-command: \"pdflatex.sh\" -*-
1422
1423 \\documentclass[12pt]{article}
1424 \\usepackage[a4paper,top=2.5cm,bottom=2cm,left=2.5cm,right=2.5cm]{geometry}
1425 \\usepackage[utf8]{inputenc}
1426 \\usepackage{amsmath}
1427 \\usepackage{amssymb}
1428 \\usepackage[pdftex]{graphicx}
1429 \\usepackage{microtype}
1430 \\usepackage[colorlinks=true,linkcolor=blue,urlcolor=blue,citecolor=blue]{hyperref}
1431
1432 \\setlength{\\parindent}{0cm}
1433 \\setlength{\\parskip}{12pt}
1434 \\renewcommand{\\baselinestretch}{1.3}
1435
1436 \\def\\argmax{\\operatornamewithlimits{argmax}}
1437 \\def\\argmin{\\operatornamewithlimits{argmin}}
1438
1439 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1440 %% Sans serif fonts
1441 %% \\usepackage[T1]{fontenc}
1442 %% \\usepackage[scaled]{helvet}
1443 %% \\usepackage[cm]{sfmath}
1444 %% \\renewcommand{\\ttdefault}{pcr}
1445 %% \\renewcommand*\\familydefault{\\sfdefault}
1446 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1447 %% The \\todo command
1448 \\newcounter{nbdrafts}
1449 \\setcounter{nbdrafts}{0}
1450 \\makeatletter
1451 \\newcommand{\\checknbdrafts}{
1452 \\ifnum \\thenbdrafts > 0
1453 \\@latex@warning@no@line{*WARNING* The document contains \\thenbdrafts \\space draft note(s)}
1454 \\fi}
1455 \\newcommand{\\todo}[1]{\\addtocounter{nbdrafts}{1}{\\color{red} #1}}
1456 \\makeatother
1457 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1458
1459 \\begin{document}
1460
1461 ")
1462   (save-excursion
1463     (goto-char (point-max))
1464     (insert "
1465
1466 \\end{document}
1467 "))
1468   (latex-mode))
1469
1470 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1471
1472 (defun ff/add-copyrights ()
1473   "Adds two lines for the (C) at the beginning of current buffer."
1474   (interactive)
1475
1476   (let ((comment-style 'plain))
1477
1478     (goto-char (point-min))
1479
1480     ;; If this is a script, put the copyrights after the first line
1481
1482     (when (re-search-forward "^#!" nil t)
1483       (beginning-of-line)
1484       (next-line 1))
1485
1486     (let ((start (point))
1487           (comment-style 'box))
1488       (insert
1489        (concat
1490
1491         "\nSTART_IP_HEADER\n"
1492
1493         (when (boundp 'user-full-name)
1494           (concat "\nWritten by " user-full-name "\n"))
1495
1496         (when (boundp 'user-mail-address)
1497           (concat "Contact <" user-mail-address "> for comments & bug reports\n"))
1498
1499         "\nEND_IP_HEADER\n"
1500         ))
1501
1502       (comment-region start (point)))
1503
1504     ))
1505
1506 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1507
1508 (defun ff/remove-ip-header () (interactive)
1509   (save-excursion
1510     (goto-char (point-min))
1511     (when (and (re-search-forward "START_IP_HEADER" nil t)
1512                (re-search-forward "END_IP_HEADER" nil t))
1513       (message "yep"))
1514     ))
1515
1516 (defun ff/add-gpl ()
1517   "Adds the GPL statements at the beginning of current buffer."
1518   (interactive)
1519   (let ((comment-style 'box)
1520         (gpl
1521          (concat
1522
1523           ;;           "
1524           ;; This program is free software; you can redistribute it and/or
1525           ;; modify it under the terms of the GNU General Public License
1526           ;; version 2 as published by the Free Software Foundation.
1527
1528           ;; This program is distributed in the hope that it will be useful, but
1529           ;; WITHOUT ANY WARRANTY\; without even the implied warranty of
1530           ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
1531           ;; General Public License for more details.
1532           ;; "
1533
1534           "
1535 START_IP_HEADER
1536
1537 This program is free software: you can redistribute it and/or modify
1538 it under the terms of the version 3 of the GNU General Public License
1539 as published by the Free Software Foundation.
1540
1541 This program is distributed in the hope that it will be useful, but
1542 WITHOUT ANY WARRANTY; without even the implied warranty of
1543 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1544 General Public License for more details.
1545
1546 You should have received a copy of the GNU General Public License
1547 along with this program. If not, see <http://www.gnu.org/licenses/>.
1548
1549 "
1550           (when (boundp 'user-full-name)
1551             (concat "Written by and Copyright (C) " user-full-name "\n"))
1552
1553           (when (boundp 'user-mail-address)
1554             (concat "Contact <" user-mail-address "> for comments & bug reports\n"))
1555
1556           "
1557 END_IP_HEADER
1558 "
1559
1560           )))
1561
1562     (goto-char (point-min))
1563
1564     ;; If this is a script, put the gpl after the first line
1565     (when (re-search-forward "^#!" nil t)
1566       (beginning-of-line)
1567       (next-line 1))
1568
1569     (let ((start (point)))
1570       (insert gpl)
1571       (comment-region start (point)))
1572     ))
1573
1574 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1575
1576 (defun ff/start-c ()
1577   "Adds the header to start a C program."
1578   (interactive)
1579   ;;   (beginning-of-buffer)
1580   (insert
1581    "
1582 #include <stdio.h>
1583 #include <stdlib.h>
1584
1585 int main(int argc, char **argv) {
1586   exit(EXIT_SUCCESS);
1587 }
1588 ")
1589   (previous-line 2)
1590   )
1591
1592 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1593
1594 (defun ff/start-c++ ()
1595   "Adds the header to start a C++ program."
1596   (interactive)
1597   ;;   (beginning-of-buffer)
1598   (insert
1599    "
1600 #include <iostream>
1601 #include <fstream>
1602 #include <cmath>
1603 #include <stdio.h>
1604 #include <stdlib.h>
1605
1606 using namespace std;
1607
1608 int main(int argc, char **argv) {
1609
1610 }
1611 ")
1612   (previous-line 2)
1613   )
1614
1615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1616
1617 (defun ff/headerize ()
1618   "Adds the #define HEADER_H, etc."
1619   (interactive)
1620   (let ((flag-name (replace-regexp-in-string
1621                     "[\. \(\)]" "_"
1622                     (upcase (file-name-nondirectory (buffer-file-name))))))
1623     (goto-char (point-max))
1624     (insert "\n#endif\n")
1625     (goto-char (point-min))
1626     (insert (concat "#ifndef " flag-name "\n"))
1627     (insert (concat "#define " flag-name "\n"))
1628     )
1629   )
1630
1631 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1632
1633 (defun ff/start-html ()
1634   "Adds all that stuff to start a new HTML file."
1635   (interactive)
1636   (goto-char (point-min))
1637   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
1638 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
1639
1640 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
1641
1642 <head>
1643 <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />
1644 <title></title>
1645 <style>
1646 p {
1647  color:#009900;
1648 }
1649 </style>
1650 </head>
1651
1652 <body>
1653 ")
1654   (goto-char (point-max))
1655   (insert "
1656 </body>
1657
1658 </html>
1659 ")
1660   (html-mode))
1661
1662 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1663
1664 ;; Insert a line showing all the variables written on the current line
1665 ;; and separated by commas
1666
1667 (defun ff/cout-var (arg)
1668   "Invoked on a line with a list of variables names,
1669 it inserts a line which displays their values in cout, or cerr if
1670 the function is invoked with a universal arg"
1671   (interactive "P")
1672   (let ((line (if arg "cerr" "cout")))
1673     (goto-char (point-at-bol))
1674     ;; Regexp syntax sucks moose balls, honnest. To match '[', just
1675     ;; put it as the first char in the [...] ... This leads to some
1676     ;; obvious things like the following
1677     (while (re-search-forward "\\([][a-zA-Z0-9_.:\(\)]+\\)" (point-at-eol) t)
1678       (setq line
1679             (concat line " << \" "
1680                     (match-string 1) " = \" << " (match-string 1))))
1681     (goto-char (point-at-bol))
1682     (kill-line)
1683     (insert line " << endl\;\n")
1684     (indent-region (point-at-bol 0) (point-at-eol 0) nil)
1685     ))
1686
1687 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1688
1689 (defun ff/clean-article ()
1690   "Cleans up an article by removing the leading blanks on each line
1691 and refilling all the paragraphs."
1692   (interactive)
1693   (let ((fill-column 92))
1694     (goto-char (point-min))
1695     (while (re-search-forward "^\\ +" nil t)
1696       (replace-match "" nil nil))
1697     (fill-individual-paragraphs (point-min) (point-max) t)))
1698
1699 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1700
1701 (defun ff/start-slide ()
1702   (interactive)
1703   (insert "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1704
1705 \\begin{frame}{")
1706
1707   (save-excursion (insert "}{}
1708
1709 \\end{frame}
1710
1711 "))
1712   )
1713
1714 (add-hook
1715  'latex-mode-hook
1716  (lambda ()
1717    (define-key latex-mode-map [(meta S)] 'ff/start-slide)
1718    (define-key latex-mode-map [(control c) (control a)] 'align-current)
1719    (define-key latex-mode-map [(control end)] 'tex-close-latex-block)
1720    (define-key latex-mode-map [(control tab)] 'ispell-complete-word)
1721    (copy-face 'default 'tex-verbatim)
1722    ;; (ff/configure-faces '((tex-verbatim :background "gray95")))
1723    ))
1724
1725 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1726
1727 (defun ff/start-test-code ()
1728   (interactive)
1729   (let ((start (point)))
1730     (insert "
1731 { // ******************************* START ***************************
1732 #warning Test code added on "
1733             (format-time-string "%04Y %b %02d %02H:%02M:%02S" (current-time))
1734             "
1735
1736 } // ******************************** END ****************************
1737
1738 ")
1739     (indent-region start (point) nil))
1740   (previous-line 3)
1741   (c-indent-command))
1742
1743 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1744
1745 (defun ff/code-to-html () (interactive)
1746   (save-restriction
1747     (narrow-to-region (region-beginning) (region-end))
1748     (replace-string "\"" "&quot;" nil (point-min) (point-max))
1749     (replace-string " " "&nbsp;" nil (point-min) (point-max))
1750     (replace-string ">" "&gt;" nil (point-min) (point-max))
1751     (replace-string "<" "&lt;" nil (point-min) (point-max))
1752     (replace-string "\e" "^[" nil (point-min) (point-max))
1753     (replace-string "\7f" "^?" nil (point-min) (point-max))
1754     (replace-string "\1f" "^_" nil (point-min) (point-max))
1755     (replace-regexp "$" "<br />" nil (point-min) (point-max))
1756     )
1757   )
1758
1759 (defun ff/downcase-html-tags () (interactive)
1760   (save-excursion
1761     (beginning-of-buffer)
1762     (while (re-search-forward "<\\([^>]+\\)>" nil t)
1763       (downcase-region (match-beginning 1) (match-end 1)))
1764     )
1765   )
1766
1767 ;; If we enter html mode and there is no makefile around, create a
1768 ;; compilation command with tidy (this is cool stuff)
1769
1770 (add-hook 'html-mode-hook
1771           (lambda ()
1772             (unless (or (not (buffer-file-name))
1773                         (file-exists-p "makefile")
1774                         (file-exists-p "Makefile"))
1775               (set (make-local-variable 'compile-command)
1776                    (let ((fn (file-name-nondirectory buffer-file-name)))
1777                      (format "tidy -utf8 %s > /tmp/%s" fn fn))))))
1778
1779 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1780
1781 (defun ff/count-words-region (beginning end)
1782   "Print number of words in the region.
1783 Words are defined as at least one word-constituent character
1784 followed by at least one character that is not a
1785 word-constituent.  The buffer's syntax table determines which
1786 characters these are."
1787
1788   (interactive "r")
1789   (message "Counting words in region ... ")
1790   (save-excursion
1791     (goto-char beginning)
1792     (let ((count 0))
1793       (while (< (point) end)
1794         (re-search-forward "\\w+\\W+")
1795         (setq count (1+ count)))
1796       (cond ((zerop count) (message "The region does NOT have any word."))
1797             ((= 1 count) (message "The region has 1 word."))
1798             (t (message "The region has %d words." count))))))
1799
1800 ;; (add-hook 'html-mode-hook 'flyspell-mode)
1801
1802 (defun ff/tidy-html ()
1803   "Run tidy in on the content of the current buffer, put the result in
1804 a file in /tmp"
1805   (interactive)
1806   (call-process-region (point-min) (point-max)
1807                        "/usr/bin/tidy"
1808                        nil
1809                        (list nil (make-temp-file "/tmp/tidy-html."))))
1810
1811 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1812
1813 ;; Create the adequate embryo of a file if it does not exist
1814
1815 (defun ff/start-file () (interactive)
1816   (let ((filename (buffer-file-name)))
1817     (when filename
1818
1819       (when (string-match "\\.sh$" filename)
1820         (sh-mode)
1821         (insert "#!/bin/bash\n\nset -e\nset -o pipefail\n\n")
1822         (save-excursion
1823           (ff/add-copyrights))
1824         )
1825
1826       (when (string-match "\\.html$" filename)
1827         (html-mode)
1828         (ff/start-html)
1829         (previous-line 4)
1830         )
1831
1832       (when (string-match "\\.h$" filename)
1833         (c++-mode)
1834         (ff/headerize)
1835         (save-excursion
1836           (ff/add-copyrights)
1837           (newline))
1838         (newline)
1839         (newline)
1840         (previous-line 1)
1841         )
1842
1843       (when (string-match "\\.c$" filename)
1844         (c-mode)
1845         (ff/add-copyrights)
1846         (ff/start-c))
1847
1848       (when (string-match "\.\\(cc\\|cpp\\)$" filename)
1849         (c++-mode)
1850         (ff/add-copyrights)
1851         (let ((headername  (replace-regexp-in-string "\\.\\(cc\\|cpp\\)$" ".h"
1852                                                      filename)))
1853           (if (file-exists-p headername)
1854               (insert (concat "\n#include \"" (file-name-nondirectory headername) "\"\n"))
1855             (ff/start-c++))
1856           ))
1857
1858       (when (string-match "\\.tex$" filename)
1859         (latex-mode)
1860         (ff/start-latex)
1861         ))
1862     )
1863   (set-buffer-modified-p nil)
1864   )
1865
1866 (if (>= emacs-major-version 22)
1867     (add-to-list 'find-file-not-found-functions 'ff/start-file)
1868   (add-to-list 'find-file-not-found-hooks 'ff/start-file))
1869
1870 (when (>= emacs-major-version 24)
1871   (define-obsolete-function-alias 'make-local-hook 'ignore "21.1")
1872   (setq send-mail-function 'sendmail-send-it) ;; emacs 24.x stuff
1873
1874   (custom-set-faces
1875    '(diff-added ((default (:background "gray90" :foreground "green4" :weight bold))))
1876    '(diff-removed ((default (:background "gray90" :foreground "red2" :weight bold))))
1877    '(diff-changed ((default (:background "gray90" :foreground "blue" :weight bold))))
1878    )
1879   )
1880
1881 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1882
1883 (define-key global-map [f8] 'ff-find-other-file)
1884 (define-key global-map [(shift f8)] (lambda () (interactive) (ff-find-other-file t)))
1885
1886 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1887 ;; Antiword, htmlize and boxquote
1888 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1889
1890 (autoload 'no-word "no-word")
1891 (add-to-list 'auto-mode-alist '("\\.doc\\'" . no-word))
1892 ;; (add-to-list 'auto-mode-alist '("\\.DOC\\'" . no-word))
1893
1894 (autoload 'htmlize-buffer "htmlize" nil t)
1895
1896 (setq boxquote-top-and-tail "------------------")
1897 (autoload 'boxquote-region "boxquote" nil t)
1898
1899 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1900 ;; The compilation hacks
1901 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1902
1903 ;; If we enter c++ mode and there is no makefile around, we create a
1904 ;; make command on the fly for the specific object file
1905
1906 (add-hook 'c++-mode-hook
1907           (lambda ()
1908             (unless (or (file-exists-p "makefile") (file-exists-p "Makefile"))
1909               (set (make-local-variable 'compile-command)
1910                    (concat
1911                     "make -k "
1912                     (file-name-sans-extension
1913                      (file-name-nondirectory buffer-file-name)))))))
1914
1915 ;; <f1> runs the compilation according to the compile-command (and
1916 ;; thus does not ask any confirmation), shows the compilation buffer
1917 ;; during compilation and delete all windows showing the compilation
1918 ;; buffer if the compilation ends with no error
1919
1920 ;; <shift-f1> asks for a compilation command and runs the compilation
1921 ;; but does not restore the window configuration (i.e. the compilation
1922 ;; buffer's window will still be visible, as usual)
1923
1924 ;; <f2> goes to the next compilation error (as C-x ` does on the
1925 ;; standard configuration)
1926
1927 (defun ff/restore-windows-if-no-error (buffer msg)
1928   "Delete the windows showing the compilation buffer if msg
1929   matches \"^finished\"."
1930
1931   (when (string-match "^finished" msg)
1932     ;;     (delete-windows-on buffer)
1933     (if (boundp 'ff/window-configuration-before-compilation)
1934         (set-window-configuration ff/window-configuration-before-compilation))
1935     )
1936   )
1937
1938 (add-to-list 'compilation-finish-functions 'ff/restore-windows-if-no-error)
1939
1940 (defun ff/fast-compile ()
1941   "Compiles without asking anything."
1942   (interactive)
1943   (let ((compilation-read-command nil))
1944     (setq ff/window-configuration-before-compilation (current-window-configuration))
1945     (compile compile-command)))
1946
1947 (setq compilation-read-command t
1948       compile-command "make -j -k"
1949       compile-history '("make clean" "make DEBUG=yes -j -k" "make -j -k")
1950       )
1951
1952 (defun ff/universal-compile () (interactive)
1953   (funcall (or (cdr (assoc major-mode
1954                            '(
1955                              (latex-mode . tex-file)
1956                              (html-mode . browse-url-of-buffer)
1957                              ;; Here you can add other mode -> compile command
1958                              )))
1959                'ff/fast-compile         ;; And this is the failsafe
1960                )))
1961
1962 (define-key global-map [f1] 'ff/universal-compile)
1963 (define-key global-map [(shift f1)] 'compile)
1964 (define-key global-map [f2] 'next-error)
1965
1966 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1967 ;; Related to mail
1968 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1969
1970 ;; (when (ff/load-or-alert "flyspell-timer" t)
1971 ;;   (add-hook 'flyspell-mode-hook 'flyspell-timer-ensure-idle-timer))
1972
1973 (defun ff/start-flyspell () (interactive)
1974   (ff/configure-faces
1975    '(
1976      ;; (flyspell-incorrect :background "#ff0000" :foreground "black")
1977      ;; (flyspell-duplicate :background "#ff9000" :foreground "black")
1978      (flyspell-incorrect :foreground "#ff0000" :weight 'bold)
1979      (flyspell-duplicate :foreground "#ff9000" :weight 'bold)
1980      ))
1981   ;; (flyspell-buffer)
1982   )
1983
1984 (add-hook 'flyspell-mode-hook 'ff/start-flyspell)
1985
1986 (defun ff/pick-dictionnary () (interactive)
1987   (when (and (boundp 'flyspell-mode) flyspell-mode)
1988     (if (and current-input-method (string-match "latin" current-input-method))
1989         (ispell-change-dictionary "francais")
1990       (ispell-change-dictionary "american"))
1991     ;;     (flyspell-buffer)
1992     )
1993   )
1994
1995 (defadvice toggle-input-method (after ff/switch-dictionnary nil activate)
1996   (ff/pick-dictionnary))
1997
1998 ;; (add-hook 'message-mode-hook 'auto-fill-mode)
1999 ;; (add-hook 'message-mode-hook 'flyspell-mode)
2000
2001 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2002 ;; Delete all windows which are in the same "column", which means
2003 ;; whose xmin and xmax are bounded by the xmin and xmax of the
2004 ;; currently selected column
2005 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2006
2007 ;; This is from emacs23 ! better than my old ff/delete-other-windows-in-column
2008
2009 (unless (fboundp 'delete-other-windows-vertically)
2010
2011   (defun delete-other-windows-vertically (&optional window)
2012     "Delete the windows in the same column with WINDOW, but not WINDOW itself.
2013 This may be a useful alternative binding for \\[delete-other-windows]
2014  if you often split windows horizontally."
2015     (interactive)
2016     (let* ((window (or window (selected-window)))
2017            (edges (window-edges window))
2018            (w window) delenda)
2019       (while (not (eq (setq w (next-window w 1)) window))
2020         (let ((e (window-edges w)))
2021           (when (and (= (car e) (car edges))
2022                      (= (caddr e) (caddr edges)))
2023             (push w delenda))))
2024       (mapc 'delete-window delenda)))
2025   )
2026
2027 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2028 ;; Misc things
2029 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2030
2031 ;; Entropy is cool
2032
2033 (defun ff/entropy (l)
2034   (apply '+
2035          (mapcar
2036           (lambda (x)
2037             (if (= x 0.0) 0.0
2038               (* (- x) (/ (log x) (log 2)))))
2039           l)
2040          )
2041   )
2042
2043 ;; Usefull to deal with results in latex files
2044
2045 (defun ff/round-floats-in-region () (interactive)
2046   (save-restriction
2047     (condition-case nil
2048         (narrow-to-region (region-beginning) (region-end))
2049       (error (thing-at-point 'word)))
2050     (save-excursion
2051       (goto-char (point-min))
2052       (while (re-search-forward "[0-9\.]+" nil t)
2053         (let ((value (string-to-number (buffer-substring (match-beginning 0) (match-end 0)))))
2054           (delete-region (match-beginning 0) (match-end 0))
2055           (insert (format "%0.2f" value)))))))
2056
2057 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2058 ;; Keymaping
2059 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2060
2061 (load "info" nil t)
2062
2063 (define-key global-map [(shift iso-lefttab)] 'ispell-complete-word)
2064 ;; shift-tab going backward is kind of standard
2065 (define-key Info-mode-map [(shift iso-lefttab)] 'Info-prev-reference)
2066
2067 ;; (define-key global-map [(control x) (control a)] 'auto-fill-mode)
2068
2069 ;; Put back my keys, you thief!
2070 (define-key global-map [(home)] 'beginning-of-buffer)
2071 (define-key global-map [(end)] 'end-of-buffer)
2072 ;; (define-key global-map [(insertchar)] 'overwrite-mode)
2073 (define-key global-map [(delete)] 'delete-char)
2074
2075 ;; Cool shortcuts to move to the end / beginning of block keen
2076 (define-key global-map [(control right)] 'forward-sexp)
2077 (define-key global-map [(control left)] 'backward-sexp)
2078
2079 ;; Wheel mouse moves up and down 2 lines (and DO NOT BEEP when we are
2080 ;; out of the buffer)
2081
2082 (define-key global-map [mouse-4]
2083   (lambda () (interactive) (condition-case nil (scroll-down 2) (error nil))))
2084 (define-key global-map [mouse-5]
2085   (lambda () (interactive) (condition-case nil (scroll-up 2) (error nil))))
2086
2087 ;; with shift it goes faster
2088 (define-key global-map [(shift mouse-4)]
2089   (lambda () (interactive) (condition-case nil (scroll-down 50) (error nil))))
2090 (define-key global-map [(shift mouse-5)]
2091   (lambda () (interactive) (condition-case nil (scroll-up 50) (error nil))))
2092
2093 ;; Meta-? shows the properties of the character at point
2094 (define-key global-map [(meta ??)]
2095   (lambda () (interactive)
2096     (message (prin1-to-string (text-properties-at (point))))))
2097
2098 ;; Compiles the latex file in the current buffer
2099
2100 (setq tex-start-commands "\\input")
2101 (define-key global-map [f3] 'tex-file)
2102 (define-key global-map [(shift f3)] 'tex-bibtex-file)
2103
2104 ;; To run xdvi on the dvi associated to the .tex in the current
2105 ;; buffer, and to edit the .fig or bitmap image used to generate the
2106 ;; .eps at point
2107
2108 (define-key global-map [f4] 'ff/run-viewer)
2109
2110 ;; Closes the current \begin{}
2111
2112 (when (ff/load-or-alert "longlines")
2113
2114   (setq longlines-show-hard-newlines t
2115         longlines-auto-wrap t
2116         ;; longlines-show-effect #("|\n" 0 2 (face escape-glyph))
2117         ;; longlines-show-effect #("∴\n" 0 2 (face escape-glyph))
2118         longlines-show-effect #("•\n" 0 2 (face escape-glyph))
2119         ;; longlines-show-effect #("↵\n" 0 2 (face escape-glyph))
2120         )
2121
2122   ;; (defun ff/auto-longlines ()
2123   ;; (when (save-excursion
2124   ;; (goto-char (point-min))
2125   ;; (re-search-forward "^.\\{81,\\}$" nil t))
2126   ;; (longlines-mode)
2127   ;; (message "Switched on the lonlines mode automatically")
2128   ;; ))
2129
2130   ;; (add-hook 'latex-mode-hook 'ff/auto-longlines)
2131
2132   )
2133
2134 ;; Meta-/ remaped (completion)
2135
2136 (define-key global-map [(shift right)] 'dabbrev-expand)
2137 (define-key global-map [(meta =)] 'dabbrev-expand)
2138
2139 ;; Change the current window.
2140
2141 (defun ff/next-same-frame-window () (interactive)
2142   (select-window (next-window (selected-window)
2143                               (> (minibuffer-depth) 0)
2144                               nil)))
2145
2146 (defun ff/previous-same-frame-window () (interactive)
2147   (select-window (previous-window (selected-window)
2148                                   (> (minibuffer-depth) 0)
2149                                   nil)))
2150
2151 (define-key global-map [(shift prior)] 'ff/next-same-frame-window)
2152 (define-key global-map [(shift next)] 'ff/previous-same-frame-window)
2153
2154 (define-key global-map [(control })] 'enlarge-window-horizontally)
2155 (define-key global-map [(control {)] 'shrink-window-horizontally)
2156 (define-key global-map [(control \")] 'enlarge-window)
2157 (define-key global-map [(control :)] 'shrink-window)
2158
2159 ;; (define-key global-map [(control shift prior)] 'next-multiframe-window)
2160 ;; (define-key global-map [(control shift next)] 'previous-multiframe-window)
2161
2162 ;; I have two screens sometime!
2163
2164 (define-key global-map [(meta next)] 'other-frame)
2165 (define-key global-map [(meta prior)] (lambda () (interactive) (other-frame -1)))
2166
2167 (define-key global-map [(shift home)] 'delete-other-windows-vertically)
2168
2169 ;; (define-key global-map [(control +)] 'enlarge-window)
2170 ;; (define-key global-map [(control -)] 'shrink-window)
2171
2172 ;; Goes to next/previous buffer
2173
2174 (define-key global-map [(control prior)] 'ff/next-buffer)
2175 (define-key global-map [(control next)] 'ff/prev-buffer)
2176
2177 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2178 ;; If M-. on a symbol, show where it is defined in another window
2179 ;; without giving focus, cycle if repeated.
2180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2181
2182 (when (ff/load-or-alert "etags")
2183
2184   (defun ff/find-tag-nofocus () (interactive)
2185     "Show in another window the definition of the current tag"
2186     (let ((tag (find-tag-default)))
2187       (display-buffer (find-tag-noselect tag (string= tag last-tag)))
2188       (message "Tag %s" tag)
2189       )
2190     )
2191
2192   (define-key global-map [(meta .)] 'ff/find-tag-nofocus)
2193   )
2194
2195 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2196 ;; Destroys the current buffer and its window if it's not the only one
2197 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2198
2199 (defcustom ff/kill-this-buffer-and-delete-window-exceptions ""
2200   "*Regexp matching the buffer names which have to be kept when using
2201 `ff/kill-this-buffer-and-delete-window'.")
2202
2203 (defun ff/kill-this-buffer-and-delete-window (universal)
2204   "Unless its name matches
2205 `ff/kill-this-buffer-and-delete-window-exceptions', kills the
2206 current buffer and deletes the current window if it's not the
2207 only one in the frame. If the buffer has to be kept, go to the
2208 next one. With universal argument, kill all killable buffers."
2209   (interactive "P")
2210   (if universal
2211       (let ((nb-killed 0))
2212         (mapc (lambda (x)
2213                 (unless (string-match ff/kill-this-buffer-and-delete-window-exceptions
2214                                       (buffer-name x))
2215                   (kill-buffer x)
2216                   (setq nb-killed (1+ nb-killed))
2217                   ))
2218               (buffer-list))
2219         (message "Killed %d buffer%s" nb-killed (if (> nb-killed 1) "s" "")))
2220     (if (string-match ff/kill-this-buffer-and-delete-window-exceptions (buffer-name))
2221         (ff/next-buffer)
2222       (kill-this-buffer)))
2223   ;; (unless (one-window-p t) (delete-window))
2224   )
2225
2226 (define-key global-map [(control backspace)] 'ff/kill-this-buffer-and-delete-window)
2227 ;; (define-key calc-mode-map [(control backspace)] 'calc-quit)
2228
2229
2230 (setq ff/kill-this-buffer-and-delete-window-exceptions
2231       "^ \\|\\*Messages\\*\\|\\*scratch\\*\\|\\*Group\\*\\|\\*-jabber-\\*\\|\\*-jabber-process-\\*\\|\\*media\\*")
2232
2233 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2234 ;; Misc stuff
2235 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2236
2237 (defun ff/elisp-debug-on ()
2238   "Switches `debug-on-error' and `debug-on-quit'."
2239   (interactive)
2240   (if debug-on-error
2241       (setq debug-on-error nil
2242             debug-on-quit nil)
2243     (setq debug-on-error t
2244           debug-on-quit t))
2245   (if debug-on-error
2246       (message "elisp debug on")
2247     (message "elisp debug off")))
2248
2249 (defun ff/create-dummy-buffer (&optional universal) (interactive "P")
2250   (find-file (concat "/tmp/" (ff/non-existing-filename "/tmp/" "dummy" "")))
2251   (text-mode)
2252   (if universal (ff/insert-url (current-kill 0)))
2253   (message "New dummy text-mode buffer"))
2254
2255 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2256 ;; Recentf to keep a list of recently visited files. I use it
2257 ;; exclusively with my selector.el
2258 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2259
2260 (load "recentf")
2261
2262 ;; If we just check for file-symlink-p, everytime we start emacs it
2263 ;; will check all the remote files listed in recentf-list, so we check
2264 ;; that they are not remote first
2265 (defun ff/file-not-remote-but-symlink (filename)
2266   (and (not (file-remote-p filename)) (file-symlink-p filename)))
2267
2268 (setq recentf-exclude (append recentf-exclude
2269                               '(
2270                                 ff/file-not-remote-but-symlink
2271                                 "enotes$" "secure-notes$" "media-playlists$"
2272                                 "bbdb$"
2273                                 "svn-commit.tmp$" ".git/COMMIT_EDITMSG$"
2274                                 "\.bbl$" "\.aux$" "\.toc$"
2275                                 ))
2276       recentf-max-saved-items 1000
2277       recentf-save-file "~/private/emacs/recentf"
2278       )
2279
2280 (when (boundp 'recentf-keep) (add-to-list 'recentf-keep 'file-remote-p))
2281
2282 (recentf-mode 1)
2283
2284 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2285 ;; My front-end to mplayer
2286 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2287
2288 ;; (ff/compile-when-needed "media/mplayer")
2289 ;; (ff/compile-when-needed "media")
2290
2291 (when (ff/load-or-alert "media")
2292
2293   (unless window-system
2294     (ff/configure-faces
2295      '(
2296        (media/mode-string-face
2297         :foreground "blue4" :weight 'bold)
2298
2299        (media/current-tune-face
2300         :foreground "black" :background "yellow" :weight 'normal)
2301
2302        (media/instant-highlight-face
2303         :foreground "black" :background "orange" :weight 'normal)
2304        ))
2305     )
2306
2307   (define-key global-map [(meta \\)] 'media)
2308
2309   (setq media/expert t
2310         media/add-current-song-to-interrupted-when-killing t
2311         media/duration-to-history 30
2312         media/history-size 1000
2313         media/playlist-file "~/private/emacs/media-playlists"
2314         media/mplayer/args '(
2315                              "-framedrop"
2316                              "-zoom"
2317                              "-cache" "512"
2318                              "-subfont-osd-scale" "3"
2319                              ;; "-stop-xscreensaver"
2320                              ;; "-osdlevel" "3"
2321                              )
2322         media/mplayer/timing-request-period 1.0
2323         )
2324   )
2325
2326 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2327 ;; A dynamic search
2328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2329
2330 ;; selector.el is one of my own scripts, check my web page
2331
2332 (when (ff/load-or-alert "selector" t)
2333   ;; (define-key global-map [(shift return)] 'selector/quick-move-in-buffer)
2334   (define-key global-map [(control x) (control b)] 'selector/switch-buffer)
2335
2336   (defun ff/visit-debpkg-file (&optional regexp)
2337     "This function lists all the files found with dpkg -S and
2338 proposes to visit them."
2339     (interactive "sPattern: ")
2340
2341     (selector/select
2342
2343      (mapcar
2344       (lambda (s)
2345         (cons (selector/filename-to-string s) s))
2346       (split-string
2347        (shell-command-to-string (concat "dpkg -S " regexp " | awk '{print $2}'"))))
2348
2349      'selector/find-file
2350      "*selector find-file*"
2351      ))
2352   )
2353
2354 (add-hook 'selector/mode-hook (lambda () (setq truncate-lines t)))
2355
2356 (defun ff/selector-insert-record-callback (r)
2357   (bbdb-display-records (list r))
2358   ;; Weird things will happen if you kill the buffer from which you
2359   ;; invoked ff/selector-mail-from-bbdb
2360   (insert (car (elt r 6)))
2361   )
2362
2363 (defun ff/selector-compose-mail-callback (r)
2364   (vm-compose-mail (car (elt r 6)))
2365   )
2366
2367 (defun ff/selector-mail-from-bbdb () (interactive)
2368   (selector/select
2369    (mapcar
2370     (lambda (r) (cons (concat (elt r 0)
2371                               " "
2372                               (elt r 1)
2373                               " ("
2374                               (car (elt r 6))
2375                               ")")
2376                       r))
2377     (bbdb-records))
2378    (if (string= mode-name "Mail")
2379        'ff/selector-insert-record-callback
2380      'ff/selector-compose-mail-callback)
2381    "*bbdb-search*"
2382    )
2383   )
2384
2385 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2386 ;; My script to automatically count the number of words and characters
2387 ;; between two markers
2388
2389 (ff/load-or-alert "text-counters.el")
2390
2391 ;; Display them in the modeline when in text-mode
2392
2393 (add-hook 'text-mode-hook 'tc/add-text-counters-in-modeline)
2394
2395 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2396 ;; A function to remove temporary alarm windows
2397 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2398
2399 (defcustom ff/annoying-windows-regexp
2400   "\\*Messages\\*\\|\\*compilation\\*\\|\\*tex-shell\\*\\|\\*Help\\*\\|\\*info\\*\\|\\*Apropos\\*\\|\\*BBDB\\*\\|\\*.*-diff\\*"
2401   "The regexp matching the windows to be deleted by `ff/delete-annoying-windows'"
2402   )
2403
2404 (defun ff/delete-annoying-windows ()
2405   "Close all the windows showing buffers whose names match
2406 `ff/annoying-windows-regexp'."
2407   (interactive)
2408   (when ff/annoying-windows-regexp
2409     (mapc (lambda (w)
2410             (when (and (not (one-window-p w))
2411                        (string-match ff/annoying-windows-regexp
2412                                      (buffer-name (window-buffer w))))
2413               (delete-window w)))
2414           (window-list)
2415           )
2416     (message "Removed annoying windows")
2417     )
2418   )
2419
2420 (setq ff/annoying-windows-regexp
2421       (concat ff/annoying-windows-regexp
2422               "\\|\\*unspooled mails\\*\\|\\*enotes alarms\\*\\|\\*system info\\*"))
2423
2424 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2425 ;; Some handy functions
2426 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2427
2428 (defun ff/twin-horizontal-current-buffer () (interactive)
2429   (delete-other-windows)
2430   (split-window-horizontally)
2431   (balance-windows)
2432   )
2433
2434 (defun ff/twin-vertical-current-buffer () (interactive)
2435   (delete-other-windows)
2436   (split-window-vertically)
2437   (balance-windows)
2438   )
2439
2440 (defun ff/flyspell-mode (arg) (interactive "p")
2441   (if flyspell-mode (flyspell-mode -1)
2442     (flyspell-mode 1)
2443     (flyspell-buffer))
2444 )
2445
2446 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2447 ;; The fridge!
2448 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2449
2450 (defun ff/move-region-to-fridge () (interactive)
2451   "Cut the current region, paste it in a file called ./fridge
2452 with a time tag, and save this file"
2453   (unless (use-region-p) (error "No region selected"))
2454   (let ((bn (file-name-nondirectory (buffer-file-name))))
2455     (kill-region (region-beginning) (region-end))
2456     (with-current-buffer (find-file-noselect "fridge")
2457       (goto-char (point-max))
2458       (insert "\n")
2459       (insert "######################################################################\n")
2460       (insert "\n"
2461               (format-time-string "%Y %b %d %H:%M:%S" (current-time))
2462               " (from "
2463               bn
2464               ")\n\n")
2465       (yank)
2466       (save-buffer)
2467       (message "Region moved to fridge")
2468       )
2469     )
2470   )
2471
2472 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2473 ;; Let's be zen. Remove the modeline and fringes.
2474 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2475
2476 (setq ff/zen-original-setting nil)
2477
2478 (defun ff/zen () (interactive)
2479   (if ff/zen-original-setting
2480       (setq mode-line-format (car ff/zen-original-setting)
2481             fringe-mode (cdr ff/zen-original-setting)
2482             ff/zen-original-setting nil)
2483     (setq ff/zen-original-setting (cons mode-line-format fringe-mode)
2484           mode-line-format nil
2485           fringe-mode '(0 . 0))
2486     (delete-other-windows)
2487     )
2488   (fringe-mode fringe-mode)
2489   (if ff/zen-original-setting
2490       (message "Zen mode")
2491     (message "Cluttered mode"))
2492   )
2493
2494 ;; (define-key global-map [(control x) (x)] 'ff/zen)
2495
2496 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2497 ;; My own keymap
2498 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2499
2500 (setq ff/map (make-sparse-keymap))
2501 (define-key global-map [(control \`)] ff/map)
2502
2503 (unless window-system
2504   ;; (define-key global-map [(control @)] ff/map)
2505   (define-key global-map [(meta O) \`] ff/map)
2506 )
2507
2508 (define-key esc-map "`" ff/map)
2509
2510 (defun ff/git-status (&optional dir) (interactive)
2511   (if (buffer-file-name)
2512       (git-status (file-name-directory (buffer-file-name)))
2513     (error "No file attached to this buffer")))
2514
2515 (defun ff/insert-date () (interactive)
2516   (insert (format-time-string "\n * %Y %b %d %H:%M:%S\n\n" (current-time)))
2517   )
2518
2519 (define-key ff/map [(control g)] 'ff/git-status)
2520 (define-key ff/map [(control w)] 'server-edit)
2521 (define-key ff/map [(control d)] 'ff/elisp-debug-on)
2522 ;; (define-key ff/map "d" 'diary)
2523 (define-key ff/map "d" 'ff/insert-date)
2524 (define-key ff/map [(control \`)] 'ff/bash-new-buffer)
2525 (define-key ff/map [(control n)] 'enotes/show-all-notes)
2526 (define-key ff/map [(control s)] 'ff/secure-note-add)
2527 (define-key ff/map [(control t)] 'ff/start-test-code)
2528 (define-key ff/map [(control q)] 'ff/create-dummy-buffer)
2529 (define-key ff/map [(control a)] 'auto-fill-mode)
2530 (define-key ff/map [(control i)] 'ff/system-info)
2531 (define-key ff/map "w" 'ff/word-occurences)
2532 (define-key ff/map [(control c)] 'calendar)
2533 ;; (define-key ff/map [(control c)] (lambda () (interactive) (save-excursion (calendar))))
2534 (define-key ff/map [(control l)] 'goto-line)
2535 (define-key ff/map "l" 'longlines-mode)
2536 (define-key ff/map [(control o)] 'selector/quick-pick-recent)
2537 (define-key ff/map "s" 'selector/quick-move-in-buffer)
2538 (define-key ff/map "S" 'selector/search-sentence)
2539 (define-key ff/map "t" (lambda () (interactive) (find-file "~/private/TODO.txt")))
2540 (define-key ff/map "h" 'ff/tidy-html)
2541 (define-key ff/map "c" 'ff/count-char)
2542 (define-key ff/map [(control p)] 'ff/print-to-file)
2543 (define-key ff/map "P" 'ff/print-to-printer)
2544 (define-key ff/map [(control b)] 'bbdb)
2545 (define-key ff/map "m" 'ff/selector-mail-from-bbdb)
2546 (define-key ff/map [(control m)] 'woman)
2547 (define-key ff/map "b" 'bookmark-jump)
2548 (define-key ff/map [(control =)] 'calc)
2549 (define-key ff/map [(control shift b)]
2550   (lambda () (interactive)
2551     (bookmark-set)
2552     (bookmark-save)))
2553 (define-key ff/map "f" 'ff/move-region-to-fridge)
2554 (define-key ff/map [(control f)] 'ff/flyspell-mode)
2555
2556 (define-key ff/map [?\C-0] 'ff/delete-annoying-windows)
2557 (define-key ff/map "1" 'delete-other-windows)
2558 (define-key ff/map [?\C-1] 'delete-other-windows)
2559 (define-key ff/map "2" 'ff/twin-vertical-current-buffer)
2560 (define-key ff/map [?\C-2] 'ff/twin-vertical-current-buffer)
2561 (define-key ff/map "3" 'ff/twin-horizontal-current-buffer)
2562 (define-key ff/map [?\C-3] 'ff/twin-horizontal-current-buffer)
2563
2564 (define-key ff/map " " 'delete-trailing-whitespace)
2565 (define-key ff/map [(control x)] 'ff/zen)
2566
2567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2568 ;; Hacks so that all keys are functionnal in xterm and through ssh.
2569 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2570
2571 (unless window-system
2572
2573   ;; One day I will understand these clipboard business. Until then,
2574   ;; so that it works in xterm (yes), let's use xclip. This is a bit
2575   ;; ugly.
2576
2577   ;; (defun ff/yank-with-xclip (&optional arg)
2578   ;; "Paste the content of the X clipboard with the xclip
2579   ;; command. Without ARG converts some of the '\\uxxxx' characters."
2580   ;; (interactive "P")
2581   ;; (with-temp-buffer
2582   ;; (shell-command "xclip -o" t)
2583   ;; (unless arg
2584   ;; (mapc (lambda (x) (replace-string (concat "\\u" (car x)) (cdr x) nil (point-min) (point-max)))
2585   ;; '(("fffd" . "??")
2586   ;; ("2013" . "-")
2587   ;; ("2014" . "--")
2588   ;; ("2018" . "`")
2589   ;; ("2019" . "'")
2590   ;; ("201c" . "``")
2591   ;; ("201d" . "''")
2592   ;; ("2022" . "*")
2593   ;; ("2026" . "...")
2594   ;; ("20ac" . "EUR")
2595   ;; )))
2596   ;; (kill-ring-save (point-min) (point-max)))
2597
2598   ;; (yank))
2599
2600   ;; (define-key global-map [(meta y)] 'ff/yank-with-xclip)
2601
2602   ;;   (set-terminal-coding-system 'iso-latin-1)
2603   ;; (set-terminal-coding-system 'utf-8)
2604
2605   ;; I have in my .Xressource
2606
2607   ;; XTerm.VT100.translations: #override\n\
2608   ;;   <Btn4Down>,<Btn4Up>:scroll-back(2,line)\n\
2609   ;;   <Btn5Down>,<Btn5Up>:scroll-forw(2,line)\n\
2610   ;;   Ctrl<Btn4Down>,Ctrl<Btn4Up>:scroll-back(1,page)\n\
2611   ;;   Ctrl<Btn5Down>,Ctrl<Btn5Up>:scroll-forw(1,page)\n\
2612   ;;   Shift<Btn4Down>,Shift<Btn4Up>:scroll-back(1,halfpage)\n\
2613   ;;   Shift<Btn5Down>,Shift<Btn5Up>:scroll-forw(1,halfpage)\n\
2614   ;;   Alt<KeyPress>:insert-eight-bit()\n\
2615   ;;   !Shift<Key>BackSpace: string("\7f")\n\
2616   ;;   Ctrl<Key>BackSpace: string("\eOZ")\n\
2617   ;;   Shift<Key>Prior: string("\e[5;2~")\n\
2618   ;;   Shift<Key>Next: string("\e[6;2~")\n\
2619   ;;   Shift Ctrl<Key>]: string("\eO}")\n\
2620   ;;   Shift Ctrl<Key>[: string("\eO{")\n\
2621   ;;   Shift Ctrl<Key>/: string("\eO?")\n\
2622   ;;   Ctrl<Key>/: string("\eO/")\n\
2623   ;;   Shift Ctrl<Key>=: string("\eO+")\n\
2624   ;;   Ctrl<Key>=: string("\eO=")\n\
2625   ;;   Shift Ctrl<Key>;: string("\eO:")\n\
2626   ;;   Ctrl<Key>;: string("\eO;")\n\
2627   ;;   Shift Ctrl<Key>`: string("\eO~")\n\
2628   ;;   Ctrl<Key>`: string("\eO`")\n\
2629   ;;   Shift Ctrl<Key>': string("\eO\\\"")\n\
2630   ;;   Ctrl<Key>': string("\eO'")\n\
2631   ;;   Shift Ctrl<Key>.: string("\eO>")\n\
2632   ;;   Ctrl<Key>.: string("\eO.")\n\
2633   ;;   Shift Ctrl<Key>\\,: string("\eO<")\n\
2634   ;;   Ctrl<Key>\\,: string("\eO,")
2635
2636   (define-key function-key-map "\e[2~" [insert])
2637
2638   (define-key function-key-map "\e[Z" [S-iso-lefttab])
2639
2640   (define-key function-key-map "\e[1;2A" [S-up])
2641   (define-key function-key-map "\e[1;2B" [S-down])
2642   (define-key function-key-map "\e[1;2C" [S-right])
2643   (define-key function-key-map "\e[1;2D" [S-left])
2644   (define-key function-key-map "\e[1;2F" [S-end])
2645   (define-key function-key-map "\e[1;2H" [S-home])
2646
2647   (define-key function-key-map "\e[2;2~" [S-insert])
2648   (define-key function-key-map "\e[5;2~" [S-prior])
2649   (define-key function-key-map "\e[6;2~" [S-next])
2650
2651   (define-key function-key-map "\e[1;2P" [S-f1])
2652   (define-key function-key-map "\e[1;2Q" [S-f2])
2653   (define-key function-key-map "\e[1;2R" [S-f3])
2654   (define-key function-key-map "\e[1;2S" [S-f4])
2655   (define-key function-key-map "\e[15;2~" [S-f5])
2656   (define-key function-key-map "\e[17;2~" [S-f6])
2657   (define-key function-key-map "\e[18;2~" [S-f7])
2658   (define-key function-key-map "\e[19;2~" [S-f8])
2659   (define-key function-key-map "\e[20;2~" [S-f9])
2660   (define-key function-key-map "\e[21;2~" [S-f10])
2661
2662   (define-key function-key-map "\e[1;5A" [C-up])
2663   (define-key function-key-map "\e[1;5B" [C-down])
2664   (define-key function-key-map "\e[1;5C" [C-right])
2665   (define-key function-key-map "\e[1;5D" [C-left])
2666   (define-key function-key-map "\e[1;5F" [C-end])
2667   (define-key function-key-map "\e[1;5H" [C-home])
2668
2669   (define-key function-key-map "\e[2;5~" [C-insert])
2670   (define-key function-key-map "\e[5;5~" [C-prior])
2671   (define-key function-key-map "\e[6;5~" [C-next])
2672
2673   (define-key function-key-map "\e[1;9A" [M-up])
2674   (define-key function-key-map "\e[1;9B" [M-down])
2675   (define-key function-key-map "\e[1;9C" [M-right])
2676   (define-key function-key-map "\e[1;9D" [M-left])
2677   (define-key function-key-map "\e[1;9F" [M-end])
2678   (define-key function-key-map "\e[1;9H" [M-home])
2679
2680   (define-key function-key-map "\e[2;9~" [M-insert])
2681   (define-key function-key-map "\e[5;9~" [M-prior])
2682   (define-key function-key-map "\e[6;9~" [M-next])
2683
2684   ;; The following ones are not standard
2685
2686   (define-key function-key-map "\eO}" (kbd "C-}"))
2687   (define-key function-key-map "\eO{" (kbd "C-{"))
2688   (define-key function-key-map "\eO?" (kbd "C-?"))
2689   (define-key function-key-map "\eO/" (kbd "C-/"))
2690   (define-key function-key-map "\eO:" (kbd "C-:"))
2691   (define-key function-key-map "\eO;" (kbd "C-;"))
2692   (define-key function-key-map "\eO~" (kbd "C-~"))
2693   (define-key function-key-map "\eO`" (kbd "C-\`"))
2694   (define-key function-key-map "\eO\"" (kbd "C-\""))
2695   (define-key function-key-map "\eO|" (kbd "C-|"))
2696   (define-key function-key-map "\eO'" (kbd "C-'"))
2697   (define-key function-key-map "\eO>" (kbd "C->"))
2698   (define-key function-key-map "\eO." (kbd "C-."))
2699   (define-key function-key-map "\eO<" (kbd "C-<"))
2700   (define-key function-key-map "\eO," (kbd "C-,"))
2701   (define-key function-key-map "\eO-" (kbd "C--"))
2702   (define-key function-key-map "\eO=" (kbd "C-="))
2703   (define-key function-key-map "\eO+" (kbd "C-+"))
2704
2705   (define-key function-key-map "\eOZ" [C-backspace])
2706
2707   (define-key minibuffer-local-map "\10" 'previous-history-element)
2708   (define-key minibuffer-local-map "\ e" 'next-history-element)
2709
2710   ;; (define-key global-map [(alt prior)] 'ff/prev-buffer)
2711   ;; (define-key global-map [(alt next)] 'ff/next-buffer)
2712
2713   )
2714
2715 ;; I am fed up with Alt-Backspace in the minibuffer erasing the
2716 ;; content of the kill-ring
2717
2718 (defun ff/backward-delete-word (arg)
2719   "Delete characters forward until encountering the end of a word, but do not put them in the kill ring.
2720 With argument ARG, do this that many times."
2721   (interactive "p")
2722   (delete-region (point) (progn (forward-word (- arg)) (point))))
2723
2724 (define-key minibuffer-local-map
2725   [remap backward-kill-word] 'ff/backward-delete-word)
2726
2727 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2728 ;; Privacy
2729 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2730
2731 ;; Where to save the bookmarks and where is bbdb
2732
2733 (setq bookmark-default-file "~/private/emacs/bmk"
2734       bbdb-file "~/private/bbdb"
2735       custom-file "~/private/emacs/custom")
2736
2737 ;; enotes.el is one of my own scripts, check my web page
2738
2739 (when (ff/load-or-alert "enotes" t)
2740   (setq enotes/file "~/private/enotes"
2741         enotes/show-help nil
2742         enotes/full-display nil
2743         enotes/default-time-fields "9:30")
2744
2745   (enotes/init)
2746   ;; (add-hook 'enotes/alarm-hook
2747   ;;  (lambda () (ff/play-sound-async "~/local/sounds/three_notes2.wav")))
2748   )
2749
2750 ;; (when (ff/load-or-alert "goto-last-change.el")
2751 ;; (define-key global-map [(control x) (control a)] 'goto-last-change))
2752
2753 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2754 ;; My private stuff (email adresses, mail filters, etc.)
2755 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2756
2757 (ff/load-or-alert "~/private/emacs.perso.el" t)
2758
2759 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2760 ;; emacs server
2761 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2762
2763 ;; Runs in server mode, so that emacsclient works
2764 (server-start)
2765
2766 (defun ff/raise-frame-and-give-focus ()
2767   (when window-system
2768     (raise-frame)
2769     (x-focus-frame (selected-frame))
2770     (set-mouse-pixel-position (selected-frame) 4 4)
2771     ))
2772
2773 ;; Raises the window when the server is invoked
2774
2775 (add-hook 'server-switch-hook 'ff/raise-frame-and-give-focus)