emacs.el

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