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