emacs.el

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