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