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