emacs.el

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