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