emacs.el

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