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