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 (load "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
 789        (let ((temp (/ (string-to-number (ff/file-first-line ff/temperature-file)) 1000)))
 790          (if (> temp 50)
 791              (concat
 792               (let ((s (format "%dC " temp)))
 793                 (if (> temp 65) (propertize s 'face
 794                                             'font-lock-warning-face)
 795                   s))
 796               )
 797            )
 798          )
 799
 800        ;; The battery
 801
 802        (let ((battery-status (ff/file-first-line (concat ff/battery-dir "/status"))))
 803
 804          (cond
 805           ((string= battery-status "Full") "L")
 806
 807           ((string= battery-status "Charging")
 808            (format "L%d%%" (max (ff/battery-percent "charge")
 809                                 (ff/battery-percent "energy"))))
 810
 811           ((string= battery-status "Discharging")
 812            (format "B%d%%"  (max (ff/battery-percent "charge")
 813                                  (ff/battery-percent "energy"))))
 814
 815           (t battery-status)
 816
 817           ))
 818
 819        )
 820
 821     (error nil))
 822   )
 823
 824 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 825
 826 (defun ff/system-info () (interactive)
 827
 828   (let ((buf (get-buffer-create "*system info*"))
 829         (map (make-sparse-keymap)))
 830
 831     (define-key map "q" 'kill-this-buffer)
 832     (display-buffer buf)
 833     (set-buffer buf)
 834     (setq show-trailing-whitespace nil)
 835     (erase-buffer)
 836
 837     (let ((highlight nil))
 838
 839       (mapc (lambda (x)
 840               (insert
 841                (if (setq highlight (not highlight))
 842                    (propertize
 843                     (with-temp-buffer (apply 'call-process x)
 844                                       (buffer-string))
 845                     'face '(:background "#c0c0ff"))
 846                  (with-temp-buffer (apply 'call-process x)
 847                                    (buffer-string))
 848                  ))
 849               )
 850
 851             '(
 852               ("hostname" nil t nil "-v")
 853               ("acpi" nil t)
 854               ("df" nil t nil "-h")
 855               ;; ("mount" nil t)
 856               ("ifconfig" nil t)
 857               ("ssh-add" nil t nil "-l")
 858               )))
 859
 860     (goto-char (point-min))
 861     (while (re-search-forward "^$" nil t) (backward-delete-char 1))
 862
 863     (fit-window-to-buffer (get-buffer-window buf))
 864     (use-local-map map)
 865     (set-buffer-modified-p nil)
 866     ))
 867
 868 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 869 ;; Make a sound when there is new mail
 870 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 871
 872 ;; I do not like sounds anymore
 873
 874 ;; (setq ff/already-boinged-for-mail nil)
 875
 876 ;; (defun ff/boing-if-new-mail ()
 877 ;; (if mail (when (not ff/already-boinged-for-mail)
 878 ;; ;; (ff/play-sound-async "~/local/sounds/boing1.wav")
 879 ;; ;; (ff/show-unspooled-mails)
 880 ;; (setq ff/already-boinged-for-mail t))
 881 ;; (setq ff/already-boinged-for-mail nil))
 882 ;; )
 883
 884 ;; (add-hook 'display-time-hook 'ff/boing-if-new-mail)
 885
 886 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 887 ;; Display time
 888 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 889
 890 (setq
 891
 892  display-time-interval 15 ;; Check every 15s
 893
 894  display-time-string-forms `(
 895
 896                              ;; (if mail
 897                              ;;     (concat " "
 898                              ;;             (propertize " mail "
 899                              ;;                         'face 'ff/mail-alarm-face)
 900                              ;;             " ")
 901                              ;;   )
 902
 903                              (propertize (concat 24-hours ":" minutes
 904                                                  " "
 905                                                  dayname " "
 906                                                  monthname " "
 907                                                  day)
 908                                          'face 'ff/date-info-face)
 909
 910                              load
 911
 912                              ,(if (ff/laptop-info-string)
 913                                   '(concat " /" (ff/laptop-info-string) "/"))
 914
 915                              )
 916
 917  ;; display-time-format "%b %a %e %H:%M"
 918  ;; display-time-mail-face nil
 919  )
 920
 921 ;; Show the time, mail and stuff
 922 (display-time)
 923
 924 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 925 ;; Moving through buffers
 926 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 927
 928 (defun ff/next-buffer ()
 929   "Switches to the next buffer in cyclic order."
 930   (interactive)
 931   (let ((buffer (current-buffer)))
 932     (switch-to-buffer (other-buffer buffer))
 933     (bury-buffer buffer)))
 934
 935 (defun ff/prev-buffer ()
 936   "Switches to the previous buffer in cyclic order."
 937   (interactive)
 938   (let ((list (nreverse (buffer-list)))
 939         found)
 940     (while (and (not found) list)
 941       (let ((buffer (car list)))
 942         (if (and (not (get-buffer-window buffer))
 943                  (not (string-match "\\` " (buffer-name buffer))))
 944             (setq found buffer)))
 945       (setq list (cdr list)))
 946     (switch-to-buffer found)))
 947
 948 (define-key global-map [?\C-x right] 'ff/next-buffer)
 949 (define-key global-map [?\C-x left] 'ff/prev-buffer)
 950
 951 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 952 ;; There is actually a decent terminal emulator in emacs!
 953 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 954
 955 (load "term")
 956
 957 (defun ff/kill-associated-buffer (process str) (interactive)
 958   (let ((buffer (process-buffer process)))
 959     (kill-buffer buffer))
 960   (message "Process finished (%s)" (replace-regexp-in-string "\n$" "" str)))
 961
 962 (defun ff/kill-associated-buffer-and-delete-windows (process str) (interactive)
 963   (let ((buffer (process-buffer process)))
 964     (delete-windows-on buffer)
 965     (kill-buffer buffer))
 966   (message "Process finished (%s)" (replace-regexp-in-string "\n$" "" str)))
 967
 968 (defun ff/shell-new-buffer (buffername program &rest param)
 969   "Start a terminal-emulator in a new buffer with the shell PROGRAM,
 970 optionally invoked with the parameters PARAM. The process associated
 971 to the shell can be killed without query."
 972
 973   (interactive)
 974
 975   (let ((n 1)
 976         (bn buffername))
 977
 978     (while (get-buffer (concat "*" bn "*"))
 979       (setq n (1+ n)
 980             bn (format "%s<%d>" buffername n)))
 981
 982     (set-buffer (apply 'make-term (append (list bn program nil) param)))
 983
 984     (setq show-trailing-whitespace nil)
 985     (term-char-mode)
 986     (message "C-c C-k term-char-mode, C-c C-j term-line-mode. \
 987 In line mode: M-p previous line, M-n next line.")
 988
 989     ;; A standard setup of the face above is not enough, I have to
 990     ;; force them here. Since I have a gray90 background, I like
 991     ;; darker colors.
 992
 993     (when window-system
 994       (ff/configure-faces
 995        '((term-green :foreground "green3")
 996          (term-cyan :foreground "cyan3")
 997          (term-default-fg-inv :foreground "gray90" :background "black")
 998          )))
 999
1000     (term-set-escape-char ?\C-x)
1001
1002     ;; I like the shell buffer and windows to be deleted when the
1003     ;; shell process terminates. It's a bit of a mess to acheive this.
1004
1005     (let ((process (get-buffer-process (current-buffer))))
1006       (process-kill-without-query process)
1007       (set-process-sentinel process
1008                             ;; 'ff/kill-associated-buffer-and-delete-windows
1009                             'ff/kill-associated-buffer
1010                             ))
1011
1012     ;; (switch-to-buffer-other-window (concat "*" bn "*"))
1013     (switch-to-buffer (concat "*" bn "*"))
1014     ))
1015
1016 (defcustom ff/default-bash-commands '("ssh")
1017   "*List of commands to be used for completion when invoking a new
1018 bash shell with `ff/bash-new-buffer'.")
1019
1020 (defun ff/bash-new-buffer (universal)
1021   "Starts a bash in a new buffer. When invoked with a universal
1022 argument, asks for a command to execute in that bash shell. The list
1023 of commands in `ff/default-bash-commands' is used for auto-completion"
1024   (interactive "P")
1025
1026   (if universal
1027       (let ((cmd (completing-read
1028                   "Command: "
1029                   (mapcar (lambda (x) (cons x t)) ff/default-bash-commands))))
1030         (ff/shell-new-buffer cmd "/bin/bash" "-c" cmd))
1031
1032     (ff/shell-new-buffer "bash" "/bin/bash")))
1033
1034 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1035 ;; vc stuff for CVS
1036 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1037
1038 (setq ;; Always follow links if the file is under version control
1039  vc-follow-symlinks t
1040  )
1041
1042 (when (load "vc-git" nil t)
1043   (add-to-list 'vc-handled-backends 'GIT))
1044
1045 ;; alarm-vc.el is one of my own scripts, check my web page
1046
1047 (when (ff/load-or-alert "alarm-vc" t)
1048   (setq alarm-vc-mode-exceptions "^VM"))
1049
1050 (when (ff/load-or-alert "git")
1051   (setq git-show-unknown nil)
1052   )
1053
1054 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1055 ;; Makes .sh and others files executable automagically
1056 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1057
1058 ;; Please consider the security-related consequences of using it
1059
1060 ;; (defun ff/make-shell-scripts-executable (&optional filename)
1061 ;; (setq filename (or filename (buffer-name)))
1062 ;; (when (and (string-match "\\.sh$\\|\\.pl$\\|\\.rb" filename)
1063 ;; (not (file-executable-p filename))
1064 ;; )
1065 ;; (set-file-modes filename 493)
1066 ;; (message "Made %s executable" filename)))
1067
1068 ;; (add-hook 'after-save-hook 'ff/make-shell-scripts-executable)
1069
1070 (add-hook 'after-save-hook
1071           'executable-make-buffer-file-executable-if-script-p)
1072
1073 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1074 ;; Cool stuff to navigate in emacs-lisp sources
1075 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1076
1077 (load "find-func")
1078
1079 (defun ff/goto-function-definition (&optional goback)
1080   "Go directly to the definition of the function at point. With
1081 goback argument, go back where we were."
1082   (interactive "P")
1083   (if goback
1084       (if (not (and (boundp 'goto-function-history) goto-function-history))
1085           (error "We were nowhere, buddy")
1086         (message "Come back")
1087         (switch-to-buffer (car (car goto-function-history)))
1088         (goto-char (cdr (car goto-function-history)))
1089         (setq goto-function-history (cdr goto-function-history)))
1090
1091     (let ((function (function-called-at-point)))
1092       (when function
1093         (let ((location (find-function-search-for-symbol
1094                          function nil
1095                          (symbol-file function))))
1096           (setq goto-function-history
1097                 (cons (cons (current-buffer) (point))
1098                       (and (boundp 'goto-function-history)
1099                            goto-function-history)))
1100           (pop-to-buffer (car location))
1101           (goto-char (cdr location)))))))
1102
1103 (define-key global-map [(meta g)] 'ff/goto-function-definition)
1104 (define-key global-map [(meta G)] (lambda () (interactive)
1105                                     (ff/goto-function-definition t)))
1106
1107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1108 ;; The big stuff (bbdb, mailcrypt, etc.)
1109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1110
1111 ;; Failsafe version if we can't load bbdb
1112 (defun ff/explicit-name (email) email)
1113
1114 (when (ff/load-or-alert "bbdb")
1115
1116   (setq
1117    ;; Stop asking (if not t or nil, will not ask)
1118    bbdb-offer-save 'never
1119    ;; I hate when bbdb decides to mess up my windows
1120    bbdb-use-pop-up nil
1121    ;; I have no problem with bbdb asking me if the sender email
1122    ;; does not match exactly the address we have in the database
1123    bbdb-quiet-about-name-mismatches 0
1124    ;; I have european friends, too
1125    bbdb-north-american-phone-numbers-p nil
1126    ;; To cycle through all possible addresses
1127    bbdb-complete-name-allow-cycling t
1128    ;; Cycle with full names only, not through all net-addresses alone too
1129    bbdb-dwim-net-address-allow-redundancy t
1130    ;; Do not add new addresses automatically
1131    bbdb-always-add-addresses nil
1132    )
1133
1134   (defface ff/known-address-face
1135     '((t (:foreground "blue2")))
1136     "The face to display known mail identities.")
1137
1138   (defface ff/unknown-address-face
1139     '((t (:foreground "red4")))
1140     "The face to display unknown mail identities.")
1141
1142   (defun ff/explicit-name (email)
1143     "Returns a string identity for the first address in EMAIL. The
1144 identity is taken from bbdb if possible or from the address itself
1145 with mail-extract-address-components. The suffix \"& al.\" is added if
1146 there are more than one address.
1147
1148 If no bbdb record is found, the name is propertized with the face
1149 ff/unknown-address-face. If a record is found and contains a note
1150 'face, the associated face is used, otherwise
1151 ff/known-address-face is used."
1152
1153     (and email
1154          (let* ((data (mail-extract-address-components email))
1155                 (name (car data))
1156                 (net (cadr data))
1157                 (record (bbdb-search-simple nil net)))
1158
1159            (concat
1160
1161             (condition-case nil
1162                 (propertize (bbdb-record-name record)
1163                             'face
1164                             (or (cdr (assoc 'face
1165                                             (bbdb-record-raw-notes record)))
1166                                 'ff/known-address-face))
1167               (error
1168                (propertize (or (and data (concat "<" net ">"))
1169                                "*undefined*")
1170                            'face 'ff/unknown-address-face)
1171                ))
1172             (if (string-match "," (mail-strip-quoted-names email)) " & al.")
1173             )))
1174     )
1175
1176   (ff/configure-faces '((ff/robot-address-face :foreground "green4")
1177                         (ff/important-address-face :foreground "blue2"
1178                                                    ;; :underline t
1179                                                    ;; :background "white"
1180                                                    ;; :foreground "green4"
1181                                                    :weight 'bold
1182                                                    ;; :slant 'italic
1183                                                    )))
1184
1185
1186   )
1187
1188 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1189 ;; An encrypted file to put secure stuff (passwords, ...)
1190 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1191
1192 (when (ff/load-or-alert "mailcrypt")
1193   (mc-setversion "gpg")
1194   ;; Keep the passphrase for 10min
1195   (setq mc-passwd-timeout 600
1196         ff/secure-note-file "~/private/secure-notes.gpg")
1197   )
1198
1199 (defface ff/secure-date
1200   '((t (:background "gold" :weight bold)))
1201   "The face to display the dates in the modeline.")
1202
1203 (defun ff/secure-note-add () (interactive)
1204   (find-file "~/private/secure-notes.gpg")
1205
1206   ;; Adds a new entry (i.e. date and a bunch of empty lines)
1207
1208   (goto-char (point-min))
1209   (insert "-- "
1210           (format-time-string "%Y %b %d %H:%M:%S" (current-time))
1211           " ------------------------------------------------\n\n")
1212   (previous-line 1)
1213
1214   ;; Colorizes the dates
1215
1216   (save-excursion
1217     (goto-char (point-min))
1218     (while (re-search-forward
1219             "^-+ [0-9]+ [a-z]+ [0-9]+ [0-9]+:[0-9]+:[0-9]+.+$"
1220             nil t)
1221       (add-text-properties
1222        (match-beginning 0) (match-end 0) '(face ff/secure-date))))
1223
1224   (set-buffer-modified-p nil)
1225   (setq buffer-undo-list nil)
1226   )
1227
1228 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1229 ;; Spelling
1230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1231
1232 (setq ;; For french, aspell is far better than ispell
1233  ispell-program-name "aspell"
1234  ;; To avoid ispell errors in figure filenames, labels, references.
1235  ;;       ispell-tex-skip-alists
1236  ;;       (list
1237  ;;        (append (car ispell-tex-skip-alists)
1238  ;;                '(("\\\\citep"           ispell-tex-arg-end) ;; JMLR
1239  ;;                  ("\\\\cite"            ispell-tex-arg-end)
1240  ;;                  ("\\\\nocite"          ispell-tex-arg-end)
1241  ;;                  ("\\\\includegraphics" ispell-tex-arg-end)
1242  ;;                  ("\\\\author"          ispell-tex-arg-end)
1243  ;;                  ("\\\\ref"             ispell-tex-arg-end)
1244  ;;                  ("\\\\label"           ispell-tex-arg-end)
1245  ;;                  ))
1246  ;;        (cadr ispell-tex-skip-alists))
1247
1248  ;; So that reftex follows the text when moving in the summary
1249  reftex-toc-follow-mode nil
1250  ;; So that reftex visits files to follow
1251  reftex-revisit-to-follow t
1252  )
1253
1254 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1255 ;; Used in a \includegraphics runs xfig with the corresponding .fig
1256 ;; file or gimp with the corresponding bitmap picture
1257 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1258
1259 (defun ff/run-eps-edition (prefix rules &optional force)
1260   (if rules
1261       (let ((filename (concat prefix (car (car rules)))))
1262         (if (or force (file-exists-p filename))
1263             (start-process "latex-eps-editor" nil (cdr (car rules)) filename)
1264           (ff/run-eps-edition prefix (cdr rules) force)))
1265     (message "No original file found for %seps" prefix)))
1266
1267 (defcustom ff/xdvi-for-latex-options nil
1268   "*Options to pass to xdvi when invoking `ff/run-viewer'")
1269
1270 (defun ff/run-viewer (universal)
1271
1272   "Starts an editor for the .eps at point (either xfig or gimp,
1273 depending with the original file it can find), or starts xdvi for
1274 the current .tex if no .eps is found at point. When run with a
1275 universal argument starts xfig even if the .fig does not exist"
1276
1277   (interactive "P")
1278
1279   (if (and (save-excursion
1280              (and (re-search-backward "{" (point-at-bol) t)
1281                   (or (re-search-forward "{\\([^{}]*.\\)eps}" (point-at-eol) t)
1282                       (re-search-forward "{\\([^{}]*.\\)pdf}" (point-at-eol) t)
1283                       (re-search-forward "{\\([^{}]*.\\)pdf_t}" (point-at-eol) t)
1284                       (re-search-forward "{\\([^{}]*.\\)png}" (point-at-eol) t)
1285                       (re-search-forward "{\\([^{}]*.\\)jpg}" (point-at-eol) t)
1286                       )))
1287            (and (<= (match-beginning 1) (point))
1288                 (>= (match-end 1) (- (point) 2))))
1289
1290       (ff/run-eps-edition (match-string-no-properties 1)
1291                           '(("fig" . "xfig")
1292                             ("jpg" . "gimp" )
1293                             ("png" . "gimp") ("pgm" . "gimp") ("ppm" . "gimp")
1294                             ("jpg" . "xv"))
1295                           universal)
1296
1297     (if (not (and (buffer-file-name) (string-match "\\(.*\\)\.tex$"
1298                                                    (buffer-file-name))))
1299         (message "Not a latex file!")
1300       (condition-case nil (kill-process xdvi-process) (error nil))
1301       (let ((dvi-name (concat (match-string 1 (buffer-file-name)) ".dvi")))
1302         (if (not (file-exists-p dvi-name)) (error "Can not find %s !" dvi-name)
1303           (message "Starting xdvi with %s" dvi-name)
1304           (setq xdvi-process (apply 'start-process
1305                                     (append '("xdvi-for-latex" nil "xdvi")
1306                                             ff/xdvi-for-latex-options
1307                                             (list dvi-name))))
1308           (process-kill-without-query xdvi-process))))
1309     ))
1310
1311 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1312 ;; Tex mode
1313
1314 ;; When working on a tex file with other people, I can just change
1315 ;; ff/tex-command in the -*- part of the file so that I don't mess up
1316 ;; other's people configuration.
1317
1318 (defadvice tex-file (around ff/set-my-own-tex-command () activate)
1319   (let ((tex-command
1320          (or (and (boundp 'ff/tex-command)
1321                   ff/tex-command)
1322              tex-command)))
1323     ad-do-it))
1324
1325 ;; This is a bit hardcore, but really I can't bear the superscripts in
1326 ;; my emacs window and could not find another way to deactivate them.
1327
1328 (load "tex-mode")
1329 (defun tex-font-lock-suscript (pos) ())
1330
1331 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1332 ;; Prevents many errors from beeping and makes the others play a nifty
1333 ;; sound
1334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1335
1336 (defun ff/ring-bell ()
1337   (unless (memq this-command
1338                 '(isearch-abort
1339                   abort-recursive-edit
1340                   exit-minibuffer
1341                   keyboard-quit
1342                   backward-delete-char-untabify
1343                   delete-backward-char
1344                   minibuffer-complete-and-exit
1345                   previous-line next-line
1346                   backward-char forward-char
1347                   scroll-up scroll-down
1348                   enlarge-window-horizontally shrink-window-horizontally
1349                   enlarge-window shrink-window
1350                   minibuffer-complete
1351                   ))
1352     ;; (message "command [%s]" (prin1-to-string this-command))
1353     ;; (ff/play-sound-async "~/local/sounds/short_la.wav")
1354     ))
1355
1356 (setq ring-bell-function 'ff/ring-bell)
1357
1358 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1359 ;; Past the content of the url currently in the kill-ring with
1360 ;; shift-click 2
1361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1362
1363 (defun ff/insert-url (&optional url)
1364   "Downloads an URL with lynx and inserts it after the point."
1365   (interactive "MUrl: ")
1366   (when url
1367     (message "Inserting %s" url)
1368     (insert (concat "from: " url "\n\n"))
1369     ;; (call-process "lynx" nil t nil "-nolist" "-dump" url))
1370     (call-process "w3m" nil t nil "-dump" url))
1371   )
1372
1373 (define-key global-map [(shift mouse-2)]
1374   (lambda () (interactive) (ff/insert-url (current-kill 0))))
1375
1376 ;; lookup-dict is one of my own scripts, check my web page
1377
1378 (when (ff/load-or-alert "lookup-dict" t)
1379   (define-key global-map [(control \?)] 'lookup-dict))
1380
1381 ;; (defun ff/generate-password () (interactive)
1382 ;; (let ((c "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-"))
1383 ;; (nth (random (length c)) c))
1384
1385 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1386 ;; Automatization of things I do often
1387 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1388
1389 (defun ff/snip () (interactive)
1390   (let ((start (condition-case nil (region-beginning) (error (point))))
1391         (end (condition-case nil (region-end) (error (point)))))
1392     (goto-char end)
1393     (insert "---------------------------- snip snip -------------------------------\n")
1394     (goto-char start)
1395     (insert "---------------------------- snip snip -------------------------------\n")
1396     ))
1397
1398 (defun ff/start-latex ()
1399   "Adds all that stuff to start a new LaTeX document."
1400   (interactive)
1401   (goto-char (point-min))
1402   (insert "%% -*- mode: latex; mode: reftex; mode: flyspell; coding: utf-8; tex-command: \"pdflatex.sh\" -*-
1403
1404 \\documentclass[12pt]{article}
1405 \\usepackage[a4paper,top=2.5cm,bottom=2cm,left=1.5cm,right=1.5cm]{geometry}
1406 \\usepackage[utf8]{inputenc}
1407 \\usepackage{amsmath}
1408 \\usepackage{amssymb}
1409 \\usepackage{hyperref}
1410
1411 %% \\usepackage[pdftex]{graphicx}
1412 %% \\usepackage{eurosym}
1413
1414 \\hypersetup{
1415   colorlinks=true,
1416   linkcolor=blue,
1417   urlcolor=blue,
1418   citecolor=blue
1419 }
1420
1421 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1422 %% Sans serif fonts
1423 %% \\usepackage[T1]{fontenc}
1424 %% \\usepackage[scaled]{helvet}
1425 %% \\usepackage[cm]{sfmath}
1426 %% \\renewcommand{\\ttdefault}{pcr}
1427 %% \\renewcommand*\\familydefault{\\sfdefault}
1428 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1429 %% \\def\\argmax{\\operatornamewithlimits{argmax}}
1430 %% \\def\\argmin{\\operatornamewithlimits{argmin}}
1431 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1432 %% \\setlength{\\parindent}{0cm}
1433 %% \\setlength{\\parskip}{12pt}
1434 %% \\renewcommand{\\baselinestretch}{1.3}
1435 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1436
1437 \\begin{document}
1438
1439 ")
1440   (save-excursion
1441     (goto-char (point-max))
1442     (insert "
1443
1444 \\end{document}
1445 "))
1446   (latex-mode))
1447
1448 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1449
1450 (defun ff/add-copyrights ()
1451   "Adds two lines for the (C) at the beginning of current buffer."
1452   (interactive)
1453
1454   (let ((comment-style 'plain))
1455
1456     (goto-char (point-min))
1457
1458     ;; If this is a script, put the copyrights after the first line
1459
1460     (when (re-search-forward "^#!" nil t)
1461       (beginning-of-line)
1462       (next-line 1))
1463
1464     (let ((start (point))
1465           (comment-style 'box))
1466       (insert
1467        (concat
1468
1469         "\nSTART_IP_HEADER\n"
1470
1471         (when (boundp 'user-full-name)
1472           (concat "\nWritten by " user-full-name "\n"))
1473
1474         (when (boundp 'user-mail-address)
1475           (concat "Contact <" user-mail-address "> for comments & bug reports\n"))
1476
1477         "\nEND_IP_HEADER\n"
1478         ))
1479
1480       (comment-region start (point)))
1481
1482     ))
1483
1484 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1485
1486 (defun ff/remove-ip-header () (interactive)
1487   (save-excursion
1488     (goto-char (point-min))
1489     (when (and (re-search-forward "START_IP_HEADER" nil t)
1490                (re-search-forward "END_IP_HEADER" nil t))
1491       (message "yep"))
1492     ))
1493
1494 (defun ff/add-gpl ()
1495   "Adds the GPL statements at the beginning of current buffer."
1496   (interactive)
1497   (let ((comment-style 'box)
1498         (gpl
1499          (concat
1500
1501           ;;           "
1502           ;; This program is free software; you can redistribute it and/or
1503           ;; modify it under the terms of the GNU General Public License
1504           ;; version 2 as published by the Free Software Foundation.
1505
1506           ;; This program is distributed in the hope that it will be useful, but
1507           ;; WITHOUT ANY WARRANTY\; without even the implied warranty of
1508           ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
1509           ;; General Public License for more details.
1510           ;; "
1511
1512           "
1513 START_IP_HEADER
1514
1515 This program is free software: you can redistribute it and/or modify
1516 it under the terms of the version 3 of the GNU General Public License
1517 as published by the Free Software Foundation.
1518
1519 This program is distributed in the hope that it will be useful, but
1520 WITHOUT ANY WARRANTY; without even the implied warranty of
1521 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1522 General Public License for more details.
1523
1524 You should have received a copy of the GNU General Public License
1525 along with this program. If not, see <http://www.gnu.org/licenses/>.
1526
1527 "
1528           (when (boundp 'user-full-name)
1529             (concat "Written by and Copyright (C) " user-full-name "\n"))
1530
1531           (when (boundp 'user-mail-address)
1532             (concat "Contact <" user-mail-address "> for comments & bug reports\n"))
1533
1534           "
1535 END_IP_HEADER
1536 "
1537
1538           )))
1539
1540     (goto-char (point-min))
1541
1542     ;; If this is a script, put the gpl after the first line
1543     (when (re-search-forward "^#!" nil t)
1544       (beginning-of-line)
1545       (next-line 1))
1546
1547     (let ((start (point)))
1548       (insert gpl)
1549       (comment-region start (point)))
1550     ))
1551
1552 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1553
1554 (defun ff/start-c ()
1555   "Adds the header to start a C program."
1556   (interactive)
1557   ;;   (beginning-of-buffer)
1558   (insert
1559    "
1560 #include <stdio.h>
1561 #include <stdlib.h>
1562
1563 int main(int argc, char **argv) {
1564   exit(EXIT_SUCCESS);
1565 }
1566 ")
1567   (previous-line 2)
1568   )
1569
1570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1571
1572 (defun ff/start-c++ ()
1573   "Adds the header to start a C++ program."
1574   (interactive)
1575   ;;   (beginning-of-buffer)
1576   (insert
1577    "
1578 #include <iostream>
1579 #include <fstream>
1580 #include <cmath>
1581 #include <stdio.h>
1582 #include <stdlib.h>
1583
1584 using namespace std;
1585
1586 int main(int argc, char **argv) {
1587
1588 }
1589 ")
1590   (previous-line 2)
1591   )
1592
1593 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1594
1595 (defun ff/headerize ()
1596   "Adds the #define HEADER_H, etc."
1597   (interactive)
1598   (let ((flag-name (replace-regexp-in-string
1599                     "[\. \(\)]" "_"
1600                     (upcase (file-name-nondirectory (buffer-file-name))))))
1601     (goto-char (point-max))
1602     (insert "\n#endif\n")
1603     (goto-char (point-min))
1604     (insert (concat "#ifndef " flag-name "\n"))
1605     (insert (concat "#define " flag-name "\n"))
1606     )
1607   )
1608
1609 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1610
1611 (defun ff/start-html ()
1612   "Adds all that stuff to start a new HTML file."
1613   (interactive)
1614   (goto-char (point-min))
1615   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
1616 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
1617
1618 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
1619
1620 <head>
1621 <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />
1622 <title></title>
1623 </head>
1624
1625 <body>
1626 ")
1627   (goto-char (point-max))
1628   (insert "
1629 </body>
1630
1631 </html>
1632 ")
1633   (html-mode))
1634
1635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1636
1637 ;; Insert a line showing all the variables written on the current line
1638 ;; and separated by commas
1639
1640 (defun ff/cout-var (arg)
1641   "Invoked on a line with a list of variables names,
1642 it inserts a line which displays their values in cout, or cerr if
1643 the function is invoked with a universal arg"
1644   (interactive "P")
1645   (let ((line (if arg "cerr" "cout")))
1646     (goto-char (point-at-bol))
1647     ;; Regexp syntax sucks moose balls, honnest. To match '[', just
1648     ;; put it as the first char in the [...] ... This leads to some
1649     ;; obvious things like the following
1650     (while (re-search-forward "\\([][a-zA-Z0-9_.:\(\)]+\\)" (point-at-eol) t)
1651       (setq line
1652             (concat line " << \" "
1653                     (match-string 1) " = \" << " (match-string 1))))
1654     (goto-char (point-at-bol))
1655     (kill-line)
1656     (insert line " << endl\;\n")
1657     (indent-region (point-at-bol 0) (point-at-eol 0) nil)
1658     ))
1659
1660 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1661
1662 (defun ff/clean-article ()
1663   "Cleans up an article by removing the leading blanks on each line
1664 and refilling all the paragraphs."
1665   (interactive)
1666   (let ((fill-column 92))
1667     (goto-char (point-min))
1668     (while (re-search-forward "^\\ +" nil t)
1669       (replace-match "" nil nil))
1670     (fill-individual-paragraphs (point-min) (point-max) t)))
1671
1672 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1673
1674 (defun ff/start-slide ()
1675   (interactive)
1676   (insert "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1677
1678 \\begin{frame}{")
1679
1680   (save-excursion (insert "}{}
1681
1682 \\end{frame}
1683
1684 "))
1685   )
1686
1687 (add-hook
1688  'latex-mode-hook
1689  (lambda ()
1690    (define-key latex-mode-map [(meta S)] 'ff/start-slide)
1691    (define-key latex-mode-map [(control c) (control a)] 'align-current)
1692    (define-key latex-mode-map [(control end)] 'tex-close-latex-block)
1693    (define-key latex-mode-map [(control tab)] 'ispell-complete-word)
1694    ;; Strange that I have to specify that
1695    ;; (setq paragraph-separate "[%      \f]*$")
1696    ;; (setq paragraph-separate
1697          ;; (concat "[%]*\\|[\f%]\\|[ \t]*\\($\\|"
1698                  ;; "\\\\[][]\\|"
1699                  ;; "\\\\" (regexp-opt (append
1700                                      ;; (mapcar 'car latex-section-alist)
1701                                      ;; '("begin" "label" "end" )) t)
1702                  ;; "\\>\\|\\\\\\(" (regexp-opt '("item" "bibitem" "newline"
1703                                                ;; "noindent" "newpage" "footnote"
1704                                                ;; "marginpar" "parbox" "caption"))
1705                  ;; "\\|\\$\\$\\|[a-z]*\\(space\\|skip\\|page[a-z]*\\)"
1706                  ;; "\\>\\)[ \t]*\\($\\|%\\)\\)"))
1707    ;; (flyspell-mode 1)
1708    ;; (reftex-mode 1)
1709    ))
1710
1711 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1712
1713 (defun ff/start-test-code ()
1714   (interactive)
1715   (let ((start (point)))
1716     (insert "
1717 { // ******************************* START ***************************
1718 #warning Test code added on "
1719             (format-time-string "%04Y %b %02d %02H:%02M:%02S" (current-time))
1720             "
1721
1722 } // ******************************** END ****************************
1723
1724 ")
1725     (indent-region start (point) nil))
1726   (previous-line 3)
1727   (c-indent-command))
1728
1729 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1730
1731 (defun ff/code-to-html () (interactive)
1732   (save-restriction
1733     (narrow-to-region (region-beginning) (region-end))
1734     (replace-string "\"" "&quot;" nil (point-min) (point-max))
1735     (replace-string " " "&nbsp;" nil (point-min) (point-max))
1736     (replace-string ">" "&gt;" nil (point-min) (point-max))
1737     (replace-string "<" "&lt;" nil (point-min) (point-max))
1738     (replace-string "\e" "^[" nil (point-min) (point-max))
1739     (replace-string "\7f" "^?" nil (point-min) (point-max))
1740     (replace-string "\1f" "^_" nil (point-min) (point-max))
1741     (replace-regexp "$" "<br />" nil (point-min) (point-max))
1742     )
1743   )
1744
1745 (defun ff/downcase-html-tags () (interactive)
1746   (save-excursion
1747     (beginning-of-buffer)
1748     (while (re-search-forward "<\\([^>]+\\)>" nil t)
1749       (downcase-region (match-beginning 1) (match-end 1)))
1750     )
1751   )
1752
1753 ;; If we enter html mode and there is no makefile around, create a
1754 ;; compilation command with tidy (this is cool stuff)
1755
1756 (add-hook 'html-mode-hook
1757           (lambda ()
1758             (unless (or (not (buffer-file-name))
1759                         (file-exists-p "makefile")
1760                         (file-exists-p "Makefile"))
1761               (set (make-local-variable 'compile-command)
1762                    (let ((fn (file-name-nondirectory buffer-file-name)))
1763                      (format "tidy -utf8 %s > /tmp/%s" fn fn))))))
1764
1765 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1766
1767 (defun ff/count-words-region (beginning end)
1768   "Print number of words in the region.
1769 Words are defined as at least one word-constituent character
1770 followed by at least one character that is not a
1771 word-constituent.  The buffer's syntax table determines which
1772 characters these are."
1773
1774   (interactive "r")
1775   (message "Counting words in region ... ")
1776   (save-excursion
1777     (goto-char beginning)
1778     (let ((count 0))
1779       (while (< (point) end)
1780         (re-search-forward "\\w+\\W+")
1781         (setq count (1+ count)))
1782       (cond ((zerop count) (message "The region does NOT have any word."))
1783             ((= 1 count) (message "The region has 1 word."))
1784             (t (message "The region has %d words." count))))))
1785
1786 ;; (add-hook 'html-mode-hook 'flyspell-mode)
1787
1788 (defun ff/tidy-html ()
1789   "Run tidy in on the content of the current buffer, put the result in
1790 a file in /tmp"
1791   (interactive)
1792   (call-process-region (point-min) (point-max)
1793                        "/usr/bin/tidy"
1794                        nil
1795                        (list nil (make-temp-file "/tmp/tidy-html."))))
1796
1797 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1798
1799 ;; Create the adequate embryo of a file if it does not exist
1800
1801 (defun ff/start-file () (interactive)
1802   (let ((filename (buffer-file-name)))
1803     (when filename
1804
1805       (when (string-match "\\.sh$" filename)
1806         (sh-mode)
1807         (insert "#!/bin/bash\n\nset -e\n\n")
1808         (save-excursion
1809           (ff/add-copyrights))
1810         )
1811
1812       (when (string-match "\\.html$" filename)
1813         (html-mode)
1814         (ff/start-html)
1815         (previous-line 4)
1816         )
1817
1818       (when (string-match "\\.h$" filename)
1819         (c++-mode)
1820         (ff/headerize)
1821         (save-excursion
1822           (ff/add-copyrights)
1823           (newline))
1824         (newline)
1825         (newline)
1826         (previous-line 1)
1827         )
1828
1829       (when (string-match "\\.c$" filename)
1830         (c-mode)
1831         (ff/add-copyrights)
1832         (ff/start-c))
1833
1834       (when (string-match "\.\\(cc\\|cpp\\)$" filename)
1835         (c++-mode)
1836         (ff/add-copyrights)
1837         (let ((headername  (replace-regexp-in-string "\\.\\(cc\\|cpp\\)$" ".h"
1838                                                      filename)))
1839           (if (file-exists-p headername)
1840               (insert (concat "\n#include \"" (file-name-nondirectory headername) "\"\n"))
1841             (ff/start-c++))
1842           ))
1843
1844       (when (string-match "\\.tex$" filename)
1845         (latex-mode)
1846         (ff/start-latex)
1847         ))
1848     )
1849   (set-buffer-modified-p nil)
1850   )
1851
1852 (if (>= emacs-major-version 22)
1853     (add-to-list 'find-file-not-found-functions 'ff/start-file)
1854   (add-to-list 'find-file-not-found-hooks 'ff/start-file))
1855
1856 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1857
1858 (define-key global-map [f8] 'ff-find-other-file)
1859 (define-key global-map [(shift f8)] (lambda () (interactive) (ff-find-other-file t)))
1860
1861 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1862 ;; Antiword, htmlize and boxquote
1863 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1864
1865 (autoload 'no-word "no-word")
1866 (add-to-list 'auto-mode-alist '("\\.doc\\'" . no-word))
1867 ;; (add-to-list 'auto-mode-alist '("\\.DOC\\'" . no-word))
1868
1869 (autoload 'htmlize-buffer "htmlize" nil t)
1870
1871 (setq boxquote-top-and-tail "------------------")
1872 (autoload 'boxquote-region "boxquote" nil t)
1873
1874 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1875 ;; The compilation hacks
1876 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1877
1878 ;; If we enter c++ mode and there is no makefile around, we create a
1879 ;; make command on the fly for the specific object file
1880
1881 (add-hook 'c++-mode-hook
1882           (lambda ()
1883             (unless (or (file-exists-p "makefile") (file-exists-p "Makefile"))
1884               (set (make-local-variable 'compile-command)
1885                    (concat
1886                     "make -k "
1887                     (file-name-sans-extension
1888                      (file-name-nondirectory buffer-file-name)))))))
1889
1890 ;; <f1> runs the compilation according to the compile-command (and
1891 ;; thus does not ask any confirmation), shows the compilation buffer
1892 ;; during compilation and delete all windows showing the compilation
1893 ;; buffer if the compilation ends with no error
1894
1895 ;; <shift-f1> asks for a compilation command and runs the compilation
1896 ;; but does not restore the window configuration (i.e. the compilation
1897 ;; buffer's window will still be visible, as usual)
1898
1899 ;; <f2> goes to the next compilation error (as C-x ` does on the
1900 ;; standard configuration)
1901
1902 (defun ff/restore-windows-if-no-error (buffer msg)
1903   "Delete the windows showing the compilation buffer if msg
1904   matches \"^finished\"."
1905
1906   (when (string-match "^finished" msg)
1907     ;;     (delete-windows-on buffer)
1908     (if (boundp 'ff/window-configuration-before-compilation)
1909         (set-window-configuration ff/window-configuration-before-compilation))
1910     )
1911   )
1912
1913 (add-to-list 'compilation-finish-functions 'ff/restore-windows-if-no-error)
1914
1915 (defun ff/fast-compile ()
1916   "Compiles without asking anything."
1917   (interactive)
1918   (let ((compilation-read-command nil))
1919     (setq ff/window-configuration-before-compilation (current-window-configuration))
1920     (compile compile-command)))
1921
1922 (setq compilation-read-command t
1923       compile-command "make -j -k"
1924       compile-history '("make clean" "make DEBUG=yes -j -k" "make -j -k")
1925       )
1926
1927 (defun ff/universal-compile () (interactive)
1928   (funcall (or (cdr (assoc major-mode
1929                            '(
1930                              (latex-mode . tex-file)
1931                              (html-mode . browse-url-of-buffer)
1932                              ;; Here you can add other mode -> compile command
1933                              )))
1934                'ff/fast-compile         ;; And this is the failsafe
1935                )))
1936
1937 (define-key global-map [f1] 'ff/universal-compile)
1938 (define-key global-map [(shift f1)] 'compile)
1939 (define-key global-map [f2] 'next-error)
1940
1941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1942 ;; Related to mail
1943 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1944
1945 ;; (when (ff/load-or-alert "flyspell-timer" t)
1946 ;;   (add-hook 'flyspell-mode-hook 'flyspell-timer-ensure-idle-timer))
1947
1948 (defun ff/pick-dictionnary () (interactive)
1949   (when (and (boundp 'flyspell-mode) flyspell-mode)
1950     (if (and current-input-method (string-match "latin" current-input-method))
1951         (ispell-change-dictionary "francais")
1952       (ispell-change-dictionary "american"))
1953     ;;     (flyspell-buffer)
1954     )
1955   )
1956
1957 (defadvice toggle-input-method (after ff/switch-dictionnary nil activate)
1958   (ff/pick-dictionnary))
1959
1960 ;; (add-hook 'message-mode-hook 'auto-fill-mode)
1961 ;; (add-hook 'message-mode-hook 'flyspell-mode)
1962
1963 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1964 ;; Delete all windows which are in the same "column", which means
1965 ;; whose xmin and xmax are bounded by the xmin and xmax of the
1966 ;; currently selected column
1967 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1968
1969 ;; This is from emacs23 ! better than my old ff/delete-other-windows-in-column
1970
1971 (unless (fboundp 'delete-other-windows-vertically)
1972
1973   (defun delete-other-windows-vertically (&optional window)
1974     "Delete the windows in the same column with WINDOW, but not WINDOW itself.
1975 This may be a useful alternative binding for \\[delete-other-windows]
1976  if you often split windows horizontally."
1977     (interactive)
1978     (let* ((window (or window (selected-window)))
1979            (edges (window-edges window))
1980            (w window) delenda)
1981       (while (not (eq (setq w (next-window w 1)) window))
1982         (let ((e (window-edges w)))
1983           (when (and (= (car e) (car edges))
1984                      (= (caddr e) (caddr edges)))
1985             (push w delenda))))
1986       (mapc 'delete-window delenda)))
1987   )
1988
1989 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1990 ;; Misc things
1991 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1992
1993 ;; Entropy is cool
1994
1995 (defun ff/entropy (l)
1996   (apply '+
1997          (mapcar
1998           (lambda (x)
1999             (if (= x 0.0) 0.0
2000               (* (- x) (/ (log x) (log 2)))))
2001           l)
2002          )
2003   )
2004
2005 ;; Usefull to deal with results in latex files
2006
2007 (defun ff/round-floats-in-region () (interactive)
2008   (save-restriction
2009     (condition-case nil
2010         (narrow-to-region (region-beginning) (region-end))
2011       (error (thing-at-point 'word)))
2012     (save-excursion
2013       (goto-char (point-min))
2014       (while (re-search-forward "[0-9\.]+" nil t)
2015         (let ((value (string-to-number (buffer-substring (match-beginning 0) (match-end 0)))))
2016           (delete-region (match-beginning 0) (match-end 0))
2017           (insert (format "%0.2f" value)))))))
2018
2019 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2020 ;; Keymaping
2021 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2022
2023 (load "info" nil t)
2024
2025 (define-key global-map [(shift iso-lefttab)] 'ispell-complete-word)
2026 ;; shift-tab going backward is kind of standard
2027 (define-key Info-mode-map [(shift iso-lefttab)] 'Info-prev-reference)
2028
2029 ;; (define-key global-map [(control x) (control a)] 'auto-fill-mode)
2030
2031 ;; Put back my keys, you thief!
2032 (define-key global-map [(home)] 'beginning-of-buffer)
2033 (define-key global-map [(end)] 'end-of-buffer)
2034 ;; (define-key global-map [(insertchar)] 'overwrite-mode)
2035 (define-key global-map [(delete)] 'delete-char)
2036
2037 ;; Cool shortcuts to move to the end / beginning of block keen
2038 (define-key global-map [(control right)] 'forward-sexp)
2039 (define-key global-map [(control left)] 'backward-sexp)
2040
2041 ;; Wheel mouse moves up and down 2 lines (and DO NOT BEEP when we are
2042 ;; out of the buffer)
2043
2044 (define-key global-map [mouse-4]
2045   (lambda () (interactive) (condition-case nil (scroll-down 2) (error nil))))
2046 (define-key global-map [mouse-5]
2047   (lambda () (interactive) (condition-case nil (scroll-up 2) (error nil))))
2048
2049 ;; with shift it goes faster
2050 (define-key global-map [(shift mouse-4)]
2051   (lambda () (interactive) (condition-case nil (scroll-down 50) (error nil))))
2052 (define-key global-map [(shift mouse-5)]
2053   (lambda () (interactive) (condition-case nil (scroll-up 50) (error nil))))
2054
2055 ;; Meta-? shows the properties of the character at point
2056 (define-key global-map [(meta ??)]
2057   (lambda () (interactive)
2058     (message (prin1-to-string (text-properties-at (point))))))
2059
2060 ;; Compiles the latex file in the current buffer
2061
2062 (setq tex-start-commands "\\input")
2063 (define-key global-map [f3] 'tex-file)
2064 (define-key global-map [(shift f3)] 'tex-bibtex-file)
2065
2066 ;; To run xdvi on the dvi associated to the .tex in the current
2067 ;; buffer, and to edit the .fig or bitmap image used to generate the
2068 ;; .eps at point
2069
2070 (define-key global-map [f4] 'ff/run-viewer)
2071
2072 ;; Closes the current \begin{}
2073
2074 (when (ff/load-or-alert "longlines")
2075
2076   (setq longlines-show-hard-newlines t
2077         longlines-auto-wrap t
2078         ;; longlines-show-effect #("|\n" 0 2 (face escape-glyph))
2079         )
2080
2081   ;; (defun ff/auto-longlines ()
2082   ;; (when (save-excursion
2083   ;; (goto-char (point-min))
2084   ;; (re-search-forward "^.\\{81,\\}$" nil t))
2085   ;; (longlines-mode)
2086   ;; (message "Switched on the lonlines mode automatically")
2087   ;; ))
2088
2089   ;; (add-hook 'latex-mode-hook 'ff/auto-longlines)
2090
2091   )
2092
2093 ;; Meta-/ remaped (completion)
2094
2095 (define-key global-map [(shift right)] 'dabbrev-expand)
2096 (define-key global-map [(meta =)] 'dabbrev-expand)
2097
2098 ;; Change the current window.
2099
2100 (defun ff/next-same-frame-window () (interactive)
2101   (select-window (next-window (selected-window)
2102                               (> (minibuffer-depth) 0)
2103                               nil)))
2104
2105 (defun ff/previous-same-frame-window () (interactive)
2106   (select-window (previous-window (selected-window)
2107                                   (> (minibuffer-depth) 0)
2108                                   nil)))
2109
2110 (define-key global-map [(shift prior)] 'ff/next-same-frame-window)
2111 (define-key global-map [(shift next)] 'ff/previous-same-frame-window)
2112
2113 (define-key global-map [(control })] 'enlarge-window-horizontally)
2114 (define-key global-map [(control {)] 'shrink-window-horizontally)
2115 (define-key global-map [(control \")] 'enlarge-window)
2116 (define-key global-map [(control :)] 'shrink-window)
2117
2118 ;; (define-key global-map [(control shift prior)] 'next-multiframe-window)
2119 ;; (define-key global-map [(control shift next)] 'previous-multiframe-window)
2120
2121 ;; I have two screens sometime!
2122
2123 (define-key global-map [(meta next)] 'other-frame)
2124 (define-key global-map [(meta prior)] (lambda () (interactive) (other-frame -1)))
2125
2126 (define-key global-map [(shift home)] 'delete-other-windows-vertically)
2127
2128 ;; (define-key global-map [(control +)] 'enlarge-window)
2129 ;; (define-key global-map [(control -)] 'shrink-window)
2130
2131 ;; Goes to next/previous buffer
2132
2133 (define-key global-map [(control prior)] 'ff/next-buffer)
2134 (define-key global-map [(control next)] 'ff/prev-buffer)
2135
2136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2137 ;; If M-. on a symbol, show where it is defined in another window
2138 ;; without giving focus, cycle if repeated.
2139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2140
2141 (when (ff/load-or-alert "etags")
2142
2143   (defun ff/find-tag-nofocus () (interactive)
2144     "Show in another window the definition of the current tag"
2145     (let ((tag (find-tag-default)))
2146       (display-buffer (find-tag-noselect tag (string= tag last-tag)))
2147       (message "Tag %s" tag)
2148       )
2149     )
2150
2151   (define-key global-map [(meta .)] 'ff/find-tag-nofocus)
2152   )
2153
2154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2155 ;; Destroys the current buffer and its window if it's not the only one
2156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2157
2158 (defcustom ff/kill-this-buffer-and-delete-window-exceptions ""
2159   "*Regexp matching the buffer names which have to be kept when using
2160 `ff/kill-this-buffer-and-delete-window'.")
2161
2162 (defun ff/kill-this-buffer-and-delete-window (universal)
2163   "Unless its name matches
2164 `ff/kill-this-buffer-and-delete-window-exceptions', kills the
2165 current buffer and deletes the current window if it's not the
2166 only one in the frame. If the buffer has to be kept, go to the
2167 next one. With universal argument, kill all killable buffers."
2168   (interactive "P")
2169   (if universal
2170       (let ((nb-killed 0))
2171         (mapc (lambda (x)
2172                 (unless (string-match ff/kill-this-buffer-and-delete-window-exceptions
2173                                       (buffer-name x))
2174                   (kill-buffer x)
2175                   (setq nb-killed (1+ nb-killed))
2176                   ))
2177               (buffer-list))
2178         (message "Killed %d buffer%s" nb-killed (if (> nb-killed 1) "s" "")))
2179     (if (string-match ff/kill-this-buffer-and-delete-window-exceptions (buffer-name))
2180         (ff/next-buffer)
2181       (kill-this-buffer)))
2182   ;; (unless (one-window-p t) (delete-window))
2183   )
2184
2185 (define-key global-map [(control backspace)] 'ff/kill-this-buffer-and-delete-window)
2186 ;; (define-key calc-mode-map [(control backspace)] 'calc-quit)
2187
2188
2189 (setq ff/kill-this-buffer-and-delete-window-exceptions
2190       "^ \\|\\*Messages\\*\\|\\*scratch\\*\\|\\*Group\\*\\|\\*-jabber-\\*\\|\\*-jabber-process-\\*\\|\\*media\\*")
2191
2192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2193 ;; Misc stuff
2194 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2195
2196 (defun ff/elisp-debug-on ()
2197   "Switches `debug-on-error' and `debug-on-quit'."
2198   (interactive)
2199   (if debug-on-error
2200       (setq debug-on-error nil
2201             debug-on-quit nil)
2202     (setq debug-on-error t
2203           debug-on-quit t))
2204   (if debug-on-error
2205       (message "elisp debug on")
2206     (message "elisp debug off")))
2207
2208 (defun ff/create-dummy-buffer (&optional universal) (interactive "P")
2209   (find-file (concat "/tmp/" (ff/non-existing-filename "/tmp/" "dummy" "")))
2210   (text-mode)
2211   (if universal (ff/insert-url (current-kill 0)))
2212   (message "New dummy text-mode buffer"))
2213
2214 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2215 ;; Recentf to keep a list of recently visited files. I use it
2216 ;; exclusively with my selector.el
2217 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2218
2219 (load "recentf")
2220
2221 (setq recentf-exclude
2222       (append recentf-exclude
2223               '("enotes$" "secure-notes$" "media-playlists$"
2224                 "bbdb$"
2225                 "svn-commit.tmp$" ".git/COMMIT_EDITMSG$"
2226                 "\.bbl$" "\.aux$" "\.toc$"))
2227       recentf-max-saved-items 1000
2228       recentf-save-file "~/private/emacs/recentf"
2229       )
2230
2231 (when (boundp 'recentf-keep) (add-to-list 'recentf-keep 'file-remote-p))
2232
2233 ;; Removes the link if we add the file itself (I am fed up with
2234 ;; duplicates because of vc-follow-symlinks)
2235
2236 (defadvice recentf-add-file (before ff/remove-links (filename) activate)
2237   ;; If we are adding a filename corresponding to the last link we
2238   ;; have added, remove the latter
2239   (when (and recentf-list
2240              (file-symlink-p (car recentf-list))
2241              (string= filename (file-chase-links filename)))
2242     (setq recentf-list (cdr recentf-list))
2243     ))
2244
2245 (recentf-mode 1)
2246
2247 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2248 ;; My front-end to mplayer
2249 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2250
2251 ;; (ff/compile-when-needed "media/mplayer")
2252 ;; (ff/compile-when-needed "media")
2253
2254 (when (ff/load-or-alert "media")
2255
2256   (unless window-system
2257     (ff/configure-faces
2258      '(
2259        (media/mode-string-face
2260         :foreground "blue4" :weight 'bold)
2261
2262        (media/current-tune-face
2263         :foreground "black" :background "yellow" :weight 'normal)
2264
2265        (media/instant-highlight-face
2266         :foreground "black" :background "orange" :weight 'normal)
2267        ))
2268     )
2269
2270   (define-key global-map [(meta \\)] 'media)
2271
2272   (setq media/expert t
2273         media/add-current-song-to-interrupted-when-killing t
2274         media/duration-to-history 30
2275         media/history-size 1000
2276         media/playlist-file "~/private/emacs/media-playlists"
2277         media/mplayer/args '(
2278                              "-framedrop"
2279                              "-zoom"
2280                              "-subfont-osd-scale" "3"
2281                              ;; "-stop-xscreensaver"
2282                              ;; "-osdlevel" "3"
2283                              )
2284         media/mplayer/timing-request-period 5.0
2285         )
2286   )
2287
2288 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2289 ;; A dynamic search
2290 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2291
2292 ;; selector.el is one of my own scripts, check my web page
2293
2294 (when (ff/load-or-alert "selector" t)
2295   ;; (define-key global-map [(shift return)] 'selector/quick-move-in-buffer)
2296   (define-key global-map [(control x) (control b)] 'selector/switch-buffer)
2297
2298   (defun ff/visit-debpkg-file (&optional regexp)
2299     "This function lists all the files found with dpkg -S and
2300 proposes to visit them."
2301     (interactive "sPattern: ")
2302
2303     (selector/select
2304
2305      (mapcar
2306       (lambda (s)
2307         (cons (selector/filename-to-string s) s))
2308       (split-string
2309        (shell-command-to-string (concat "dpkg -S " regexp " | awk '{print $2}'"))))
2310
2311      'selector/find-file
2312      "*selector find-file*"
2313      ))
2314   )
2315
2316 (add-hook 'selector/mode-hook (lambda () (setq truncate-lines t)))
2317
2318 (defun ff/selector-insert-record-callback (r)
2319   (bbdb-display-records (list r))
2320   ;; Weird things will happen if you kill the buffer from which you
2321   ;; invoked ff/selector-mail-from-bbdb
2322   (insert (car (elt r 6)))
2323   )
2324
2325 (defun ff/selector-compose-mail-callback (r)
2326   (vm-compose-mail (car (elt r 6)))
2327   )
2328
2329 (defun ff/selector-mail-from-bbdb () (interactive)
2330   (selector/select
2331    (mapcar
2332     (lambda (r) (cons (concat (elt r 0)
2333                               " "
2334                               (elt r 1)
2335                               " ("
2336                               (car (elt r 6))
2337                               ")")
2338                       r))
2339     (bbdb-records))
2340    (if (string= mode-name "Mail")
2341        'ff/selector-insert-record-callback
2342      'ff/selector-compose-mail-callback)
2343    "*bbdb-search*"
2344    )
2345   )
2346
2347 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2348 ;; A function to remove temporary alarm windows
2349 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2350
2351 (defcustom ff/annoying-windows-regexp
2352   "\\*Messages\\*\\|\\*compilation\\*\\|\\*tex-shell\\*\\|\\*Help\\*\\|\\*info\\*\\|\\*Apropos\\*\\|\\*BBDB\\*\\|\\*.*-diff\\*"
2353   "The regexp matching the windows to be deleted by `ff/delete-annoying-windows'"
2354   )
2355
2356 (defun ff/delete-annoying-windows ()
2357   "Close all the windows showing buffers whose names match
2358 `ff/annoying-windows-regexp'."
2359   (interactive)
2360   (when ff/annoying-windows-regexp
2361     (mapc (lambda (w)
2362             (when (and (not (one-window-p w))
2363                        (string-match ff/annoying-windows-regexp
2364                                      (buffer-name (window-buffer w))))
2365               (delete-window w)))
2366           (window-list)
2367           )
2368     (message "Removed annoying windows")
2369     )
2370   )
2371
2372 (setq ff/annoying-windows-regexp
2373       (concat ff/annoying-windows-regexp
2374               "\\|\\*unspooled mails\\*\\|\\*enotes alarms\\*\\|\\*system info\\*"))
2375
2376 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2377 ;; Some handy functions
2378 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2379
2380 (defun ff/twin-horizontal-current-buffer () (interactive)
2381   (delete-other-windows)
2382   (split-window-horizontally)
2383   (balance-windows)
2384   )
2385
2386 (defun ff/twin-vertical-current-buffer () (interactive)
2387   (delete-other-windows)
2388   (split-window-vertically)
2389   (balance-windows)
2390   )
2391
2392 (defun ff/flyspell-mode (arg) (interactive "p")
2393   (flyspell-mode)
2394   (when flyspell-mode (flyspell-buffer)))
2395
2396 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2397 ;; The fridge!
2398 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2399
2400 (defun ff/move-region-to-fridge () (interactive)
2401   "Cut the current region, paste it in a file called ./fridge
2402 with a time tag, and save this file"
2403   (unless (use-region-p) (error "No region selected"))
2404   (let ((bn (file-name-nondirectory (buffer-file-name))))
2405     (kill-region (region-beginning) (region-end))
2406     (with-current-buffer (find-file-noselect "fridge")
2407       (goto-char (point-max))
2408       (insert "\n")
2409       (insert "######################################################################\n")
2410       (insert "\n"
2411               (format-time-string "%Y %b %d %H:%M:%S" (current-time))
2412               " (from "
2413               bn
2414               ")\n\n")
2415       (yank)
2416       (save-buffer)
2417       (message "Region moved to fridge")
2418       )
2419     )
2420   )
2421
2422 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2423 ;; My own keymap
2424 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2425
2426 (setq ff/map (make-sparse-keymap))
2427 (define-key global-map [(control \`)] ff/map)
2428 (define-key esc-map "`" ff/map)
2429
2430 (defun ff/git-status (&optional dir) (interactive)
2431   (if (buffer-file-name)
2432       (git-status (file-name-directory (buffer-file-name)))
2433     (error "No file attached to this buffer")))
2434
2435 (defun ff/insert-date () (interactive)
2436   (insert (format-time-string "\n * %Y %b %d %H:%M:%S\n\n" (current-time)))
2437   )
2438
2439 (define-key ff/map [(control g)] 'ff/git-status)
2440 (define-key ff/map [(control w)] 'server-edit)
2441 (define-key ff/map [(control d)] 'ff/elisp-debug-on)
2442 ;; (define-key ff/map "d" 'diary)
2443 (define-key ff/map "d" 'ff/insert-date)
2444 (define-key ff/map [(control \`)] 'ff/bash-new-buffer)
2445 (define-key ff/map [(control n)] 'enotes/show-all-notes)
2446 (define-key ff/map [(control s)] 'ff/secure-note-add)
2447 (define-key ff/map [(control t)] 'ff/start-test-code)
2448 (define-key ff/map [(control q)] 'ff/create-dummy-buffer)
2449 (define-key ff/map [(control a)] 'auto-fill-mode)
2450 (define-key ff/map [(control i)] 'ff/system-info)
2451 (define-key ff/map "w" 'ff/word-occurences)
2452 (define-key ff/map [(control c)] 'calendar)
2453 ;; (define-key ff/map [(control c)] (lambda () (interactive) (save-excursion (calendar))))
2454 (define-key ff/map [(control l)] 'goto-line)
2455 (define-key ff/map "l" 'longlines-mode)
2456 (define-key ff/map [(control o)] 'selector/quick-pick-recent)
2457 (define-key ff/map "s" 'selector/quick-move-in-buffer)
2458 (define-key ff/map "S" 'selector/search-sentence)
2459 (define-key ff/map "h" 'ff/tidy-html)
2460 (define-key ff/map "c" 'ff/count-char)
2461 (define-key ff/map [(control p)] 'ff/print-to-file)
2462 (define-key ff/map "P" 'ff/print-to-printer)
2463 (define-key ff/map [(control b)] 'bbdb)
2464 (define-key ff/map "m" 'ff/selector-mail-from-bbdb)
2465 (define-key ff/map [(control m)] 'woman)
2466 (define-key ff/map "b" 'bookmark-jump)
2467 (define-key ff/map [(control =)] 'calc)
2468 (define-key ff/map [(control shift b)]
2469   (lambda () (interactive)
2470     (bookmark-set)
2471     (bookmark-save)))
2472 (define-key ff/map "f" 'ff/move-region-to-fridge)
2473 (define-key ff/map [(control f)] 'ff/flyspell-mode)
2474
2475 (define-key ff/map [?\C-0] 'ff/delete-annoying-windows)
2476 (define-key ff/map "1" 'delete-other-windows)
2477 (define-key ff/map [?\C-1] 'delete-other-windows)
2478 (define-key ff/map "2" 'ff/twin-vertical-current-buffer)
2479 (define-key ff/map [?\C-2] 'ff/twin-vertical-current-buffer)
2480 (define-key ff/map "3" 'ff/twin-horizontal-current-buffer)
2481 (define-key ff/map [?\C-3] 'ff/twin-horizontal-current-buffer)
2482
2483 (define-key ff/map " " 'delete-trailing-whitespace)
2484
2485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2486 ;; Hacks so that all keys are functionnal in xterm and through ssh.
2487 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2488
2489 (unless window-system
2490
2491   ;; One day I will understand these clipboard business. Until then,
2492   ;; so that it works in xterm (yes), let's use xclip. This is a bit
2493   ;; ugly.
2494
2495   ;; (defun ff/yank-with-xclip (&optional arg)
2496     ;; "Paste the content of the X clipboard with the xclip
2497 ;; command. Without ARG converts some of the '\\uxxxx' characters."
2498     ;; (interactive "P")
2499     ;; (with-temp-buffer
2500       ;; (shell-command "xclip -o" t)
2501       ;; (unless arg
2502         ;; (mapc (lambda (x) (replace-string (concat "\\u" (car x)) (cdr x) nil (point-min) (point-max)))
2503               ;; '(("fffd" . "??")
2504                 ;; ("2013" . "-")
2505                 ;; ("2014" . "--")
2506                 ;; ("2018" . "`")
2507                 ;; ("2019" . "'")
2508                 ;; ("201c" . "``")
2509                 ;; ("201d" . "''")
2510                 ;; ("2022" . "*")
2511                 ;; ("2026" . "...")
2512                 ;; ("20ac" . "EUR")
2513                 ;; )))
2514       ;; (kill-ring-save (point-min) (point-max)))
2515
2516     ;; (yank))
2517
2518   ;; (define-key global-map [(meta y)] 'ff/yank-with-xclip)
2519
2520   ;;   (set-terminal-coding-system 'iso-latin-1)
2521   ;; (set-terminal-coding-system 'utf-8)
2522
2523   ;; I have in my .Xressource
2524
2525   ;; XTerm.VT100.translations: #override\n\
2526   ;;   <Btn4Down>,<Btn4Up>:scroll-back(2,line)\n\
2527   ;;   <Btn5Down>,<Btn5Up>:scroll-forw(2,line)\n\
2528   ;;   Ctrl<Btn4Down>,Ctrl<Btn4Up>:scroll-back(1,page)\n\
2529   ;;   Ctrl<Btn5Down>,Ctrl<Btn5Up>:scroll-forw(1,page)\n\
2530   ;;   Shift<Btn4Down>,Shift<Btn4Up>:scroll-back(1,halfpage)\n\
2531   ;;   Shift<Btn5Down>,Shift<Btn5Up>:scroll-forw(1,halfpage)\n\
2532   ;;   Alt<KeyPress>:insert-eight-bit()\n\
2533   ;;   !Shift<Key>BackSpace: string("\7f")\n\
2534   ;;   Ctrl<Key>BackSpace: string("\eOZ")\n\
2535   ;;   Shift<Key>Prior: string("\e[5;2~")\n\
2536   ;;   Shift<Key>Next: string("\e[6;2~")\n\
2537   ;;   Shift Ctrl<Key>]: string("\eO}")\n\
2538   ;;   Shift 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=")\n\
2543   ;;   Shift Ctrl<Key>;: string("\eO:")\n\
2544   ;;   Ctrl<Key>;: string("\eO;")\n\
2545   ;;   Shift Ctrl<Key>`: string("\eO~")\n\
2546   ;;   Ctrl<Key>`: string("\eO`")\n\
2547   ;;   Shift Ctrl<Key>': string("\eO\\\"")\n\
2548   ;;   Ctrl<Key>': string("\eO'")\n\
2549   ;;   Shift Ctrl<Key>.: string("\eO>")\n\
2550   ;;   Ctrl<Key>.: string("\eO.")\n\
2551   ;;   Shift Ctrl<Key>\\,: string("\eO<")\n\
2552   ;;   Ctrl<Key>\\,: string("\eO,")
2553
2554   (define-key function-key-map "\e[2~" [insert])
2555
2556   (define-key function-key-map "\e[Z" [S-iso-lefttab])
2557
2558   (define-key function-key-map "\e[1;2A" [S-up])
2559   (define-key function-key-map "\e[1;2B" [S-down])
2560   (define-key function-key-map "\e[1;2C" [S-right])
2561   (define-key function-key-map "\e[1;2D" [S-left])
2562   (define-key function-key-map "\e[1;2F" [S-end])
2563   (define-key function-key-map "\e[1;2H" [S-home])
2564
2565   (define-key function-key-map "\e[2;2~" [S-insert])
2566   (define-key function-key-map "\e[5;2~" [S-prior])
2567   (define-key function-key-map "\e[6;2~" [S-next])
2568
2569   (define-key function-key-map "\e[1;2P" [S-f1])
2570   (define-key function-key-map "\e[1;2Q" [S-f2])
2571   (define-key function-key-map "\e[1;2R" [S-f3])
2572   (define-key function-key-map "\e[1;2S" [S-f4])
2573   (define-key function-key-map "\e[15;2~" [S-f5])
2574   (define-key function-key-map "\e[17;2~" [S-f6])
2575   (define-key function-key-map "\e[18;2~" [S-f7])
2576   (define-key function-key-map "\e[19;2~" [S-f8])
2577   (define-key function-key-map "\e[20;2~" [S-f9])
2578   (define-key function-key-map "\e[21;2~" [S-f10])
2579
2580   (define-key function-key-map "\e[1;5A" [C-up])
2581   (define-key function-key-map "\e[1;5B" [C-down])
2582   (define-key function-key-map "\e[1;5C" [C-right])
2583   (define-key function-key-map "\e[1;5D" [C-left])
2584   (define-key function-key-map "\e[1;5F" [C-end])
2585   (define-key function-key-map "\e[1;5H" [C-home])
2586
2587   (define-key function-key-map "\e[2;5~" [C-insert])
2588   (define-key function-key-map "\e[5;5~" [C-prior])
2589   (define-key function-key-map "\e[6;5~" [C-next])
2590
2591   (define-key function-key-map "\e[1;9A" [M-up])
2592   (define-key function-key-map "\e[1;9B" [M-down])
2593   (define-key function-key-map "\e[1;9C" [M-right])
2594   (define-key function-key-map "\e[1;9D" [M-left])
2595   (define-key function-key-map "\e[1;9F" [M-end])
2596   (define-key function-key-map "\e[1;9H" [M-home])
2597
2598   (define-key function-key-map "\e[2;9~" [M-insert])
2599   (define-key function-key-map "\e[5;9~" [M-prior])
2600   (define-key function-key-map "\e[6;9~" [M-next])
2601
2602   ;; The following ones are not standard
2603
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   (define-key function-key-map "\eO\"" (kbd "C-\""))
2613   (define-key function-key-map "\eO|" (kbd "C-|"))
2614   (define-key function-key-map "\eO'" (kbd "C-'"))
2615   (define-key function-key-map "\eO>" (kbd "C->"))
2616   (define-key function-key-map "\eO." (kbd "C-."))
2617   (define-key function-key-map "\eO<" (kbd "C-<"))
2618   (define-key function-key-map "\eO," (kbd "C-,"))
2619   (define-key function-key-map "\eO-" (kbd "C--"))
2620   (define-key function-key-map "\eO=" (kbd "C-="))
2621   (define-key function-key-map "\eO+" (kbd "C-+"))
2622
2623   (define-key function-key-map "\eOZ" [C-backspace])
2624
2625   (define-key minibuffer-local-map "\10" 'previous-history-element)
2626   (define-key minibuffer-local-map "\ e" 'next-history-element)
2627
2628   ;; (define-key global-map [(alt prior)] 'ff/prev-buffer)
2629   ;; (define-key global-map [(alt next)] 'ff/next-buffer)
2630
2631   )
2632
2633 ;; I am fed up with Alt-Backspace in the minibuffer erasing the
2634 ;; content of the kill-ring
2635
2636 (defun ff/backward-delete-word (arg)
2637   "Delete characters forward until encountering the end of a word, but do not put them in the kill ring.
2638 With argument ARG, do this that many times."
2639   (interactive "p")
2640   (delete-region (point) (progn (forward-word (- arg)) (point))))
2641
2642 (define-key minibuffer-local-map
2643   [remap backward-kill-word] 'ff/backward-delete-word)
2644
2645 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2646 ;; Privacy
2647 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2648
2649 ;; Where to save the bookmarks and where is bbdb
2650
2651 (setq bookmark-default-file "~/private/emacs/bmk"
2652       bbdb-file "~/private/bbdb"
2653       custom-file "~/private/emacs/custom")
2654
2655 ;; enotes.el is one of my own scripts, check my web page
2656
2657 (when (ff/load-or-alert "enotes" t)
2658   (setq enotes/file "~/private/enotes"
2659         enotes/show-help nil
2660         enotes/full-display nil
2661         enotes/default-time-fields "9:30")
2662
2663   (enotes/init)
2664   ;; (add-hook 'enotes/alarm-hook
2665   ;;  (lambda () (ff/play-sound-async "~/local/sounds/three_notes2.wav")))
2666   )
2667
2668 ;; (when (ff/load-or-alert "goto-last-change.el")
2669 ;; (define-key global-map [(control x) (control a)] 'goto-last-change))
2670
2671 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2672 ;; My private stuff (email adresses, mail filters, etc.)
2673 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2674
2675 (ff/load-or-alert "~/private/emacs.perso.el" t)
2676
2677 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2678 ;; emacs server
2679 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2680
2681 ;; Runs in server mode, so that emacsclient works
2682 (server-start)
2683
2684 (defun ff/raise-frame-and-give-focus ()
2685   (when window-system
2686     (raise-frame)
2687     (x-focus-frame (selected-frame))
2688     (set-mouse-pixel-position (selected-frame) 4 4)
2689     ))
2690
2691 ;; Raises the window when the server is invoked
2692
2693 (add-hook 'server-switch-hook 'ff/raise-frame-and-give-focus)