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