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