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 "~/src/gpl/elisp")
  67 (add-to-list 'load-path "~/src/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 %\\usepackage{showframe}
1623
1624 \\setlength{\\parindent}{0cm}
1625 \\setlength{\\parskip}{12pt}
1626 %\\renewcommand{\\baselinestretch}{1.3}
1627 %\\setlength{\\tabcolsep}{0pt}
1628 %\\renewcommand{\\arraystretch}{1.0}
1629
1630 \\def\\argmax{\\operatornamewithlimits{argmax}}
1631 \\def\\argmin{\\operatornamewithlimits{argmin}}
1632 \\def\\expect{\\mathds{E}}
1633
1634 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1635 %% The \\todo command
1636 \\newcounter{nbdrafts}
1637 \\setcounter{nbdrafts}{0}
1638 \\makeatletter
1639 \\newcommand{\\checknbdrafts}{
1640 \\ifnum \\thenbdrafts > 0
1641 \\@latex@warning@no@line{*WARNING* The document contains \\thenbdrafts \\space draft note(s)}
1642 \\fi}
1643 \\newcommand{\\todo}[1]{\\addtocounter{nbdrafts}{1}{\\color{red} #1}}
1644 \\makeatother
1645 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1646
1647 \\begin{document}
1648
1649 ")
1650   (save-excursion
1651     (goto-char (point-max))
1652     (insert "
1653
1654 \\bibliographystyle{abbrvnat}
1655
1656 \\bibliography{dlc}
1657
1658 \\checknbdrafts
1659
1660 \\end{document}
1661 "))
1662   (latex-mode))
1663
1664 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1665
1666 (defun ff/add-copyrights ()
1667   "Adds two lines for the (C) at the beginning of current buffer."
1668   (interactive)
1669
1670   (let ((comment-style 'plain))
1671
1672     (goto-char (point-min))
1673
1674     ;; If this is a script, put the copyrights after the first line
1675
1676     (when (re-search-forward "^#!" nil t)
1677       (beginning-of-line)
1678       (next-line 1))
1679
1680     (let ((start (point))
1681           (comment-style 'box))
1682       (insert
1683        (concat
1684
1685         "\nSTART_IP_HEADER\n"
1686
1687         (when (boundp 'user-full-name)
1688           (concat "\nWritten by " user-full-name "\n"))
1689
1690         (when (boundp 'user-mail-address)
1691           (concat "Contact <" user-mail-address "> for comments & bug reports\n"))
1692
1693         "\nEND_IP_HEADER\n"
1694         ))
1695
1696       (comment-region start (point)))
1697
1698     ))
1699
1700 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1701
1702 (defun ff/remove-ip-header () (interactive)
1703        (save-excursion
1704          (goto-char (point-min))
1705          (when (and (re-search-forward "START_IP_HEADER" nil t)
1706                     (re-search-forward "END_IP_HEADER" nil t))
1707            (message "yep"))
1708          ))
1709
1710 (defun ff/add-gpl ()
1711   "Adds the GPL statements at the beginning of current buffer."
1712   (interactive)
1713   (let ((comment-style 'box)
1714         (gpl
1715          (concat
1716
1717           ;;           "
1718           ;; This program is free software; you can redistribute it and/or
1719           ;; modify it under the terms of the GNU General Public License
1720           ;; version 2 as published by the Free Software Foundation.
1721
1722           ;; This program is distributed in the hope that it will be useful, but
1723           ;; WITHOUT ANY WARRANTY\; without even the implied warranty of
1724           ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
1725           ;; General Public License for more details.
1726           ;; "
1727
1728           "
1729 START_IP_HEADER
1730
1731 This program is free software: you can redistribute it and/or modify
1732 it under the terms of the version 3 of the GNU General Public License
1733 as published by the Free Software Foundation.
1734
1735 This program is distributed in the hope that it will be useful, but
1736 WITHOUT ANY WARRANTY; without even the implied warranty of
1737 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1738 General Public License for more details.
1739
1740 You should have received a copy of the GNU General Public License
1741 along with this program. If not, see <http://www.gnu.org/licenses/>.
1742
1743 "
1744           (when (boundp 'user-full-name)
1745             (concat "Written by and Copyright (C) " user-full-name "\n"))
1746
1747           (when (boundp 'user-mail-address)
1748             (concat "Contact <" user-mail-address "> for comments & bug reports\n"))
1749
1750           "
1751 END_IP_HEADER
1752 "
1753
1754           )))
1755
1756     (goto-char (point-min))
1757
1758     ;; If this is a script, put the gpl after the first line
1759     (when (re-search-forward "^#!" nil t)
1760       (beginning-of-line)
1761       (next-line 1))
1762
1763     (let ((start (point)))
1764       (insert gpl)
1765       (comment-region start (point)))
1766     ))
1767
1768 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1769
1770 (defun ff/start-c ()
1771   "Adds the header to start a C program."
1772   (interactive)
1773   ;;   (beginning-of-buffer)
1774   (insert
1775    "
1776 #include <stdio.h>
1777 #include <stdlib.h>
1778
1779 int main(int argc, char **argv) {
1780   exit(EXIT_SUCCESS);
1781 }
1782 ")
1783   (previous-line 2)
1784   )
1785
1786 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1787
1788 (defun ff/start-c++ ()
1789   "Adds the header to start a C++ program."
1790   (interactive)
1791   ;;   (beginning-of-buffer)
1792   (insert
1793    "
1794 #include <iostream>
1795 #include <fstream>
1796 #include <cmath>
1797 #include <stdio.h>
1798 #include <stdlib.h>
1799
1800 using namespace std;
1801
1802 int main(int argc, char **argv) {
1803
1804 }
1805 ")
1806   (previous-line 2)
1807   )
1808
1809 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1810
1811 (defun ff/headerize ()
1812   "Adds the #define HEADER_H, etc."
1813   (interactive)
1814   (let ((flag-name (replace-regexp-in-string
1815                     "[\. \(\)]" "_"
1816                     (upcase (file-name-nondirectory (buffer-file-name))))))
1817     (goto-char (point-max))
1818     (insert "\n#endif\n")
1819     (goto-char (point-min))
1820     (insert (concat "#ifndef " flag-name "\n"))
1821     (insert (concat "#define " flag-name "\n"))
1822     )
1823   )
1824
1825 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1826
1827 (defun ff/start-lua ()
1828   "Adds all the stuff to start a new lua file"
1829   (interactive)
1830   (goto-char (point-min))
1831   (insert "#!/usr/bin/env luajit
1832
1833 require 'torch'
1834 require 'nn'
1835 require 'image'
1836 require 'optim'
1837
1838 ")
1839   (lua-mode)
1840   )
1841
1842 (defun ff/start-python ()
1843   "Adds all the stuff to start a new python file"
1844   (interactive)
1845   (goto-char (point-min))
1846   (insert "#!/usr/bin/env python
1847
1848 import math
1849
1850 import torch, torchvision
1851
1852 from torch import nn
1853 from torch.nn import functional as F
1854
1855 ")
1856   (python-mode)
1857   )
1858
1859
1860 (defun ff/start-html ()
1861   "Adds all that stuff to start a new HTML file."
1862   (interactive)
1863   (goto-char (point-min))
1864   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
1865 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
1866
1867 <html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
1868
1869 <head>
1870 <meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />
1871 <title></title>
1872 <style type=\"text/css\">
1873 p {
1874  color:#009900;
1875 }
1876 </style>
1877 </head>
1878
1879 <body>
1880 ")
1881   (goto-char (point-max))
1882   (insert "
1883 </body>
1884
1885 </html>
1886 ")
1887   (html-mode))
1888
1889 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1890
1891 ;; Insert a line showing all the variables written on the current line
1892 ;; and separated by commas
1893
1894 (defun ff/cout-var (arg)
1895   "Invoked on a line with a list of variables names,
1896 it inserts a line which displays their values in cout, or cerr if
1897 the function is invoked with a universal arg"
1898   (interactive "P")
1899   (let ((line (if arg "cerr" "cout")))
1900     (goto-char (point-at-bol))
1901     ;; To match '[', put it as the first char in the [...]
1902     (while (re-search-forward "\\([][a-zA-Z0-9_.:\(\)]+\\)" (point-at-eol) t)
1903       (setq line
1904             (concat line " << \" "
1905                     (match-string 1) " = \" << " (match-string 1))))
1906     (goto-char (point-at-bol))
1907     (kill-line)
1908     (insert line " << endl\;\n")
1909     (indent-region (point-at-bol 0) (point-at-eol 0) nil)
1910     ))
1911
1912 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1913
1914 (defun ff/clean-article ()
1915   "Cleans up an article by removing the leading blanks on each line
1916 and refilling all the paragraphs."
1917   (interactive)
1918   (let ((fill-column 92))
1919     (goto-char (point-min))
1920     (while (re-search-forward "^\\ +" nil t)
1921       (replace-match "" nil nil))
1922     (fill-individual-paragraphs (point-min) (point-max) t)))
1923
1924 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1925
1926 (defun ff/start-slide (universal)
1927   (interactive "P")
1928
1929   (if universal
1930       (progn
1931         (insert "\\end{frame}
1932
1933 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1934
1935 \\begin{frame}[fragile]{")
1936         (save-excursion (insert "}{}
1937
1938 "))
1939         )
1940
1941     (insert "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1942
1943 \\begin{frame}[fragile]{")
1944
1945     (save-excursion (insert "}{}
1946
1947 \\end{frame}
1948
1949 "))
1950     )
1951   )
1952
1953 (add-hook
1954  'latex-mode-hook
1955  (lambda ()
1956    (define-key latex-mode-map [(meta S)] 'ff/start-slide)
1957    (define-key latex-mode-map [(control c) (control a)] 'align-current)
1958    (define-key latex-mode-map [(control end)] 'tex-close-latex-block)
1959    (define-key latex-mode-map [(control tab)] 'ispell-complete-word)
1960    (copy-face 'default 'tex-verbatim)
1961    ;; (ff/configure-faces '((tex-verbatim :background "gray95")))
1962    ))
1963
1964 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1965
1966 (defun ff/start-test-code ()
1967   (interactive)
1968   (let ((start (point)))
1969     (insert "
1970 { // ******************************* START ***************************
1971 #warning Test code added on "
1972             (format-time-string "%04Y %b %02d %02H:%02M:%02S" (current-time))
1973             "
1974
1975 } // ******************************** END ****************************
1976
1977 ")
1978     (indent-region start (point) nil))
1979   (previous-line 3)
1980   (c-indent-command))
1981
1982 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1983
1984 (defun ff/code-to-html () (interactive)
1985        (save-restriction
1986          (narrow-to-region (region-beginning) (region-end))
1987          (replace-string "\"" "&quot;" nil (point-min) (point-max))
1988          (replace-string " " "&nbsp;" nil (point-min) (point-max))
1989          (replace-string ">" "&gt;" nil (point-min) (point-max))
1990          (replace-string "<" "&lt;" nil (point-min) (point-max))
1991          (replace-string "\e" "^[" nil (point-min) (point-max))
1992          (replace-string "\7f" "^?" nil (point-min) (point-max))
1993          (replace-string "\1f" "^_" nil (point-min) (point-max))
1994          (replace-regexp "$" "<br />" nil (point-min) (point-max))
1995          )
1996        )
1997
1998 (defun ff/downcase-html-tags () (interactive)
1999        (save-excursion
2000          (beginning-of-buffer)
2001          (while (re-search-forward "<\\([^>]+\\)>" nil t)
2002            (downcase-region (match-beginning 1) (match-end 1)))
2003          )
2004        )
2005
2006 ;; If we enter html mode and there is no makefile around, create a
2007 ;; compilation command with tidy (this is cool stuff)
2008
2009 (add-hook 'html-mode-hook
2010           (lambda ()
2011             (unless (or (not (buffer-file-name))
2012                         (file-exists-p "makefile")
2013                         (file-exists-p "Makefile"))
2014               (set (make-local-variable 'compile-command)
2015                    (let ((fn (file-name-nondirectory buffer-file-name)))
2016                      (format "tidy -utf8 %s > /tmp/%s" fn fn))))))
2017
2018 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2019
2020 (defun ff/count-words-region (beginning end)
2021   "Print number of words in the region.
2022 Words are defined as at least one word-constituent character
2023 followed by at least one character that is not a
2024 word-constituent.  The buffer's syntax table determines which
2025 characters these are."
2026
2027   (interactive "r")
2028   (message "Counting words in region ... ")
2029   (save-excursion
2030     (goto-char beginning)
2031     (let ((count 0))
2032       (while (< (point) end)
2033         (re-search-forward "\\w+\\W+")
2034         (setq count (1+ count)))
2035       (cond ((zerop count) (message "The region does NOT have any word."))
2036             ((= 1 count) (message "The region has 1 word."))
2037             (t (message "The region has %d words." count))))))
2038
2039 ;; (add-hook 'html-mode-hook 'flyspell-mode)
2040
2041 (defun ff/tidy-html ()
2042   "Run tidy in on the content of the current buffer, put the result in
2043 a file in /tmp"
2044   (interactive)
2045   (call-process-region (point-min) (point-max)
2046                        "/usr/bin/tidy"
2047                        nil
2048                        (list nil (make-temp-file "/tmp/tidy-html."))))
2049
2050 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2051
2052 ;; Create the adequate embryo of a file if it does not exist
2053
2054 (defun ff/start-file () (interactive)
2055        (let ((filename (buffer-file-name)))
2056          (when filename
2057
2058            (when (string-match "\\.sh$" filename)
2059              (sh-mode)
2060              (insert "#!/bin/bash\n\nset -e\nset -o pipefail\n\n")
2061              (save-excursion
2062                (ff/add-copyrights))
2063              )
2064
2065            (when (string-match "\\.lua$" filename)
2066              (lua-mode)
2067              (ff/start-lua)
2068              )
2069
2070            (when (string-match "\\.py$" filename)
2071              (python-mode)
2072              (ff/start-python)
2073              )
2074
2075            (when (string-match "\\.html$" filename)
2076              (html-mode)
2077              (ff/start-html)
2078              (previous-line 4)
2079              )
2080
2081            (when (string-match "\\.h$" filename)
2082              (c++-mode)
2083              (ff/headerize)
2084              (save-excursion
2085                (ff/add-copyrights)
2086                (newline))
2087              (newline)
2088              (newline)
2089              (previous-line 1)
2090              )
2091
2092            (when (string-match "\\.c$" filename)
2093              (c-mode)
2094              (ff/add-copyrights)
2095              (ff/start-c))
2096
2097            (when (string-match "\.\\(cc\\|cpp\\)$" filename)
2098              (c++-mode)
2099              (ff/add-copyrights)
2100              (let ((headername  (replace-regexp-in-string "\\.\\(cc\\|cpp\\)$" ".h"
2101                                                           filename)))
2102                (if (file-exists-p headername)
2103                    (insert (concat "\n#include \"" (file-name-nondirectory headername) "\"\n"))
2104                  (ff/start-c++))
2105                ))
2106
2107            (when (string-match "\\.tex$" filename)
2108              (latex-mode)
2109              (ff/start-latex)
2110              ))
2111          )
2112        (set-buffer-modified-p nil)
2113        )
2114
2115 (if (>= emacs-major-version 22)
2116     (add-to-list 'find-file-not-found-functions 'ff/start-file)
2117   (add-to-list 'find-file-not-found-hooks 'ff/start-file))
2118
2119 (when (>= emacs-major-version 24)
2120   (define-obsolete-function-alias 'make-local-hook 'ignore "21.1")
2121   (setq send-mail-function 'sendmail-send-it) ;; emacs 24.x stuff
2122
2123   (custom-set-faces
2124    '(diff-added ((default (:background "gray90" :foreground "green4" :weight bold))))
2125    '(diff-removed ((default (:background "gray90" :foreground "red2" :weight bold))))
2126    '(diff-changed ((default (:background "gray90" :foreground "blue" :weight bold))))
2127    )
2128   )
2129
2130 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2131
2132 (define-key global-map [f8] 'ff-find-other-file)
2133 (define-key global-map [(shift f8)] (lambda () (interactive) (ff-find-other-file t)))
2134
2135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2136 ;; The compilation hacks
2137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2138
2139 ;; If we enter c++ mode and there is no makefile around, we create a
2140 ;; make command on the fly for the specific object file
2141
2142 (add-hook 'c++-mode-hook
2143           (lambda ()
2144             (unless (or (file-exists-p "makefile") (file-exists-p "Makefile"))
2145               (set (make-local-variable 'compile-command)
2146                    (concat
2147                     "make -k "
2148                     (file-name-sans-extension
2149                      (file-name-nondirectory buffer-file-name)))))))
2150
2151 ;; <f1> runs the compilation according to the compile-command (and
2152 ;; thus does not ask any confirmation), shows the compilation buffer
2153 ;; during compilation and delete all windows showing the compilation
2154 ;; buffer if the compilation ends with no error
2155
2156 ;; <shift-f1> asks for a compilation command and runs the compilation
2157 ;; but does not restore the window configuration (i.e. the compilation
2158 ;; buffer's window will still be visible, as usual)
2159
2160 ;; <f2> goes to the next compilation error (as C-x ` does on the
2161 ;; standard configuration)
2162
2163 (defun ff/restore-windows-if-no-error (buffer msg)
2164   "Delete the windows showing the compilation buffer if msg
2165   matches \"^finished\"."
2166
2167   (when (string-match "^finished" msg)
2168     ;;     (delete-windows-on buffer)
2169     (if (boundp 'ff/window-configuration-before-compilation)
2170         (set-window-configuration ff/window-configuration-before-compilation))
2171     )
2172   )
2173
2174 (add-to-list 'compilation-finish-functions 'ff/restore-windows-if-no-error)
2175
2176 (defun ff/fast-compile ()
2177   "Compiles without asking anything."
2178   (interactive)
2179   (let ((compilation-read-command nil))
2180     (setq ff/window-configuration-before-compilation (current-window-configuration))
2181     (compile compile-command)))
2182
2183 (setq compilation-read-command t
2184       compile-command "make -j -k"
2185       ;; compile-history '("make clean" "make DEBUG=yes -j -k" "make -j -k")
2186       )
2187
2188 (defun ff/universal-compile (universal) (interactive "P")
2189        (funcall (or (cdr (assoc major-mode
2190                                 '(
2191                                   (latex-mode . tex-file)
2192                                   (html-mode . browse-url-of-buffer)
2193                                   ;; Here you can add other mode -> compile command
2194                                   )))
2195                     'ff/fast-compile         ;; And this is the failsafe
2196                     )))
2197
2198 (define-key global-map [f1] 'ff/universal-compile)
2199 (define-key global-map [(shift f1)] 'compile)
2200 (define-key global-map [f2] 'next-error)
2201
2202 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2203 ;; Horrible hack
2204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2205
2206 (defun dont-delay-compile-warnings (fun type &rest args)
2207   (if (eq type 'bytecomp)
2208       (let ((after-init-time t))
2209         (apply fun type args))
2210     (apply fun type args)))
2211 (advice-add 'display-warning :around #'dont-delay-compile-warnings)
2212
2213 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2214 ;; Related to mail
2215 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2216
2217 ;; (when (ff/load-or-alert "flyspell-timer" t)
2218 ;;   (add-hook 'flyspell-mode-hook 'flyspell-timer-ensure-idle-timer))
2219
2220 (defun ff/start-flyspell () (interactive)
2221        (ff/configure-faces
2222         '(
2223           ;; (flyspell-incorrect :background "#ff0000" :foreground "black")
2224           ;; (flyspell-duplicate :background "#ff9000" :foreground "black")
2225           (flyspell-incorrect :foreground "#ff0000" :weight 'bold)
2226           (flyspell-duplicate :foreground "#ff9000" :weight 'bold)
2227           ))
2228        ;; (flyspell-buffer)
2229        )
2230
2231 (add-hook 'flyspell-mode-hook 'ff/start-flyspell)
2232
2233 (defun ff/pick-dictionnary () (interactive)
2234        (when (and (boundp 'flyspell-mode) flyspell-mode)
2235          (if (and current-input-method (string-match "latin" current-input-method))
2236              (ispell-change-dictionary "francais")
2237            (ispell-change-dictionary "american"))
2238          ;;     (flyspell-buffer)
2239          )
2240        )
2241
2242 (defadvice toggle-input-method (after ff/switch-dictionnary nil activate)
2243   (ff/pick-dictionnary))
2244
2245 ;; (add-hook 'message-mode-hook 'auto-fill-mode)
2246 ;; (add-hook 'message-mode-hook 'flyspell-mode)
2247
2248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2249 ;; Delete all windows which are in the same "column", which means
2250 ;; whose xmin and xmax are bounded by the xmin and xmax of the
2251 ;; currently selected column
2252 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2253
2254 ;; This is from emacs23 ! better than my old ff/delete-other-windows-in-column
2255
2256 (unless (fboundp 'delete-other-windows-vertically)
2257
2258   (defun delete-other-windows-vertically (&optional window)
2259     "Delete the windows in the same column with WINDOW, but not WINDOW itself.
2260 This may be a useful alternative binding for \\[delete-other-windows]
2261  if you often split windows horizontally."
2262     (interactive)
2263     (let* ((window (or window (selected-window)))
2264            (edges (window-edges window))
2265            (w window) delenda)
2266       (while (not (eq (setq w (next-window w 1)) window))
2267         (let ((e (window-edges w)))
2268           (when (and (= (car e) (car edges))
2269                      (= (caddr e) (caddr edges)))
2270             (push w delenda))))
2271       (mapc 'delete-window delenda)))
2272   )
2273
2274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2275 ;; Misc things
2276 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2277
2278 ;; Entropy is cool
2279
2280 (defun ff/entropy (l)
2281   (apply '+
2282          (mapcar
2283           (lambda (x)
2284             (if (= x 0.0) 0.0
2285               (* (- x) (/ (log x) (log 2)))))
2286           l)
2287          )
2288   )
2289
2290 ;; Usefull to deal with results in latex files
2291
2292 (defun ff/round-floats-in-region () (interactive)
2293        (save-restriction
2294          (condition-case nil
2295              (narrow-to-region (region-beginning) (region-end))
2296            (error (thing-at-point 'word)))
2297          (save-excursion
2298            (goto-char (point-min))
2299            (while (re-search-forward "[0-9\.]+" nil t)
2300              (let ((value (string-to-number (buffer-substring (match-beginning 0) (match-end 0)))))
2301                (delete-region (match-beginning 0) (match-end 0))
2302                (insert (format "%0.1e" value)))))))
2303
2304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2305 ;; Keymaping
2306 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2307
2308 (load "info" nil t)
2309
2310 (define-key global-map [(shift iso-lefttab)] 'ispell-complete-word)
2311 ;; shift-tab going backward is kind of standard
2312 (define-key Info-mode-map [(shift iso-lefttab)] 'Info-prev-reference)
2313
2314 ;; (define-key global-map [(control x) (control a)] 'auto-fill-mode)
2315
2316 ;; Put back my keys, you thief!
2317 (define-key global-map [(home)] 'beginning-of-buffer)
2318 (define-key global-map [(end)] 'end-of-buffer)
2319 ;; (define-key global-map [(insertchar)] 'overwrite-mode)
2320 (define-key global-map [(delete)] 'delete-char)
2321
2322 ;; Cool shortcuts to move to the end / beginning of block keen
2323 (define-key global-map [(control right)] 'forward-sexp)
2324 (define-key global-map [(control left)] 'backward-sexp)
2325
2326 ;; Wheel mouse moves up and down 2 lines (and DO NOT BEEP when we are
2327 ;; out of the buffer)
2328
2329 (define-key global-map [mouse-4]
2330   (lambda () (interactive) (condition-case nil (scroll-down 2) (error nil))))
2331 (define-key global-map [mouse-5]
2332   (lambda () (interactive) (condition-case nil (scroll-up 2) (error nil))))
2333
2334 ;; with shift it goes faster
2335 (define-key global-map [(shift mouse-4)]
2336   (lambda () (interactive) (condition-case nil (scroll-down 50) (error nil))))
2337 (define-key global-map [(shift mouse-5)]
2338   (lambda () (interactive) (condition-case nil (scroll-up 50) (error nil))))
2339
2340 ;; Meta-? shows the properties of the character at point
2341 (define-key global-map [(meta ??)]
2342   (lambda () (interactive)
2343     (message (prin1-to-string (text-properties-at (point))))))
2344
2345 ;; Compiles the latex file in the current buffer
2346
2347
2348
2349 (setq tex-start-commands "\\input")
2350 (define-key global-map [f3] 'tex-file)
2351 (define-key global-map [(shift f3)] 'tex-bibtex-file)
2352
2353 ;; To run xdvi on the dvi associated to the .tex in the current
2354 ;; buffer, and to edit the .fig or bitmap image used to generate the
2355 ;; .eps at point
2356
2357 (define-key global-map [f4] 'ff/run-viewer)
2358
2359 ;; Closes the current \begin{}
2360
2361 ;; Meta-/ remaped (completion)
2362
2363 (define-key global-map [(shift right)] 'dabbrev-expand)
2364 (define-key global-map [(meta =)] 'dabbrev-expand)
2365
2366 ;; Change the current window.
2367
2368 (defun ff/next-same-frame-window () (interactive)
2369        (select-window (next-window (selected-window)
2370                                    (> (minibuffer-depth) 0)
2371                                    nil)))
2372
2373 (defun ff/previous-same-frame-window () (interactive)
2374        (select-window (previous-window (selected-window)
2375                                        (> (minibuffer-depth) 0)
2376                                        nil)))
2377
2378 (define-key global-map [(shift prior)] 'ff/next-same-frame-window)
2379 (define-key global-map [(shift next)] 'ff/previous-same-frame-window)
2380
2381 (define-key global-map [(control })] 'enlarge-window-horizontally)
2382 (define-key global-map [(control {)] 'shrink-window-horizontally)
2383 (define-key global-map [(control \")] 'enlarge-window)
2384 (define-key global-map [(control :)] 'shrink-window)
2385
2386 ;; (define-key global-map [(control shift prior)] 'next-multiframe-window)
2387 ;; (define-key global-map [(control shift next)] 'previous-multiframe-window)
2388
2389 ;; I have two screens sometime!
2390 ;; (define-key global-map [(meta next)] 'other-frame)
2391 ;; (define-key global-map [(meta prior)] (lambda () (interactive) (other-frame -1)))
2392
2393 ;; (load "winner")
2394 (winner-mode 1)
2395 ;; (define-key global-map [(shift backspace)] 'winner-undo)
2396
2397 ;; (define-key global-map [(shift home)] 'delete-other-windows-vertically)
2398 ;; (define-key global-map [(control +)] 'enlarge-window)
2399 ;; (define-key global-map [(control -)] 'shrink-window)
2400 ;; Goes to next/previous buffer
2401 ;; (define-key global-map [(control prior)] 'ff/next-buffer)
2402 ;; (define-key global-map [(control next)] 'ff/prev-buffer)
2403
2404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2405 ;; If M-. on a symbol, show where it is defined in another window
2406 ;; without giving focus, cycle if repeated.
2407 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2408
2409 (when (ff/load-or-alert "etags")
2410
2411   (defun ff/find-tag-nofocus () (interactive)
2412          "Show in another window the definition of the current tag"
2413          (let ((tag (find-tag-default)))
2414            (display-buffer (find-tag-noselect tag (string= tag last-tag)))
2415            (message "Tag %s" tag)
2416            )
2417          )
2418
2419   (define-key global-map [(meta .)] 'ff/find-tag-nofocus)
2420   )
2421
2422 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2423 ;; Destroys the current buffer and its window if it's not the only one
2424 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2425
2426 (defcustom ff/kill-this-buffer-and-delete-window-exceptions ""
2427   "*Regexp matching the buffer names which have to be kept when using
2428 `ff/kill-this-buffer-and-delete-window'.")
2429
2430 (defun ff/kill-this-buffer-and-delete-window (universal)
2431   "Unless its name matches
2432 `ff/kill-this-buffer-and-delete-window-exceptions', kills the
2433 current buffer and deletes the current window if it's not the
2434 only one in the frame. If the buffer has to be kept, go to the
2435 next one. With universal argument, kill all killable buffers."
2436   (interactive "P")
2437   (if universal
2438       (let ((nb-killed 0))
2439         (mapc (lambda (x)
2440                 (unless (string-match ff/kill-this-buffer-and-delete-window-exceptions
2441                                       (buffer-name x))
2442                   (kill-buffer x)
2443                   (setq nb-killed (1+ nb-killed))
2444                   ))
2445               (buffer-list))
2446         (message "Killed %d buffer%s" nb-killed (if (> nb-killed 1) "s" "")))
2447     (if (string-match ff/kill-this-buffer-and-delete-window-exceptions (buffer-name))
2448         (ff/next-buffer)
2449       (kill-this-buffer)))
2450   (unless (one-window-p t) (delete-window))
2451   )
2452
2453 (define-key global-map [(control backspace)] 'ff/kill-this-buffer-and-delete-window)
2454 ;; (define-key calc-mode-map [(control backspace)] 'calc-quit)
2455
2456
2457 (setq ff/kill-this-buffer-and-delete-window-exceptions
2458       "^ \\|\\*Messages\\*\\|\\*scratch\\*\\|\\*Group\\*\\|\\*-jabber-\\*\\|\\*-jabber-process-\\*\\|\\*media\\*")
2459
2460 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2461 ;; Misc stuff
2462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2463
2464 (defun ff/elisp-debug-on ()
2465   "Switches `debug-on-error' and `debug-on-quit'."
2466   (interactive)
2467   (if debug-on-error
2468       (setq debug-on-error nil
2469             debug-on-quit nil)
2470     (setq debug-on-error t
2471           debug-on-quit t))
2472   (if debug-on-error
2473       (message "elisp debug on")
2474     (message "elisp debug off")))
2475
2476 (defun ff/create-dummy-buffer (&optional universal) (interactive "P")
2477        (find-file (concat "/tmp/" (ff/non-existing-filename "/tmp/" "dummy" "")))
2478        (text-mode)
2479        (if universal (ff/insert-url (current-kill 0)))
2480        (message "New dummy text-mode buffer"))
2481
2482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2483 ;; Recentf to keep a list of recently visited files. I use it
2484 ;; exclusively with my selector.el
2485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2486
2487 (load "recentf")
2488
2489 ;; If we just check for file-symlink-p, everytime we start emacs it
2490 ;; will check all the remote files listed in recentf-list, so we check
2491 ;; that they are not remote first
2492 (defun ff/file-not-remote-but-symlink (filename)
2493   (and (not (file-remote-p filename)) (file-symlink-p filename)))
2494
2495 (setq recentf-exclude (append recentf-exclude
2496                               '(
2497                                 ff/file-not-remote-but-symlink
2498                                 "enotes$" "secure-notes$" "media-playlists$"
2499                                 "bbdb$"
2500                                 "svn-commit.tmp$" ".git/COMMIT_EDITMSG$"
2501                                 "\.bbl$" "\.aux$" "\.toc$"
2502                                 ))
2503       recentf-max-saved-items 10000
2504       recentf-save-file (concat ff/emacs-dir "/recentf")
2505       )
2506
2507 (when (boundp 'recentf-keep) (add-to-list 'recentf-keep 'file-remote-p))
2508
2509 (recentf-mode 1)
2510
2511 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2512 ;; My front-end to mplayer
2513 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2514
2515 ;; (ff/compile-when-needed "media/mplayer")
2516 ;; (ff/compile-when-needed "media")
2517
2518 (when (ff/load-or-alert "media")
2519
2520   (unless window-system
2521     (ff/configure-faces
2522      '(
2523        (media/mode-string-face
2524         :foreground "blue4" :weight 'bold)
2525
2526        (media/current-tune-face
2527         :foreground "black" :background "yellow" :weight 'normal)
2528
2529        (media/instant-highlight-face
2530         :foreground "black" :background "orange" :weight 'normal)
2531        ))
2532     )
2533
2534   (define-key global-map [(meta \\)] 'media)
2535
2536   (setq media/expert t
2537         media/add-current-song-to-interrupted-when-killing t
2538         media/duration-to-history 30
2539         media/history-size 1000
2540         media/playlist-file (concat ff/emacs-dir "/media-playlists")
2541         media/continue-mode-hint (if window-system "⤸" "*")
2542         media/mplayer/args '(
2543                              "-framedrop"
2544                              "-zoom"
2545                              "-cache" "512"
2546                              "-subfont-osd-scale" "3"
2547                              ;; "-stop-xscreensaver"
2548                              ;; "-osdlevel" "3"
2549                              )
2550         media/mplayer/timing-request-period 1.0
2551         )
2552
2553   )
2554
2555 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2556 ;; A dynamic search
2557 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2558
2559 ;; selector.el is one of my own scripts, check my web page
2560
2561 (when (ff/load-or-alert "selector" t)
2562   ;; (define-key global-map [(shift return)] 'selector/quick-move-in-buffer)
2563   (define-key global-map [(control x) (control b)] 'selector/switch-buffer)
2564
2565   (defun ff/visit-debpkg-file (&optional regexp)
2566     "This function lists all the files found with dpkg -S and
2567 proposes to visit them."
2568     (interactive "sPattern: ")
2569
2570     (selector/select
2571
2572      (mapcar
2573       (lambda (s)
2574         (cons (selector/filename-to-string s) s))
2575       (split-string
2576        (shell-command-to-string (concat "dpkg -S " regexp " | awk '{print $2}'"))))
2577
2578      'selector/find-file
2579      "*selector find-file*"
2580      ))
2581   )
2582
2583 (add-hook 'selector/mode-hook (lambda () (setq truncate-lines t)))
2584
2585 (defun ff/selector-insert-record-callback (r)
2586   (bbdb-display-records (list r))
2587   ;; Weird things will happen if you kill the buffer from which you
2588   ;; invoked ff/selector-mail-from-bbdb
2589   (insert (car (elt r 6)))
2590   )
2591
2592 (defun ff/selector-compose-mail-callback (r)
2593   (vm-compose-mail (car (elt r 6)))
2594   )
2595
2596 (defun ff/selector-mail-from-bbdb () (interactive)
2597        (selector/select
2598         (mapcar
2599          (lambda (r) (cons (concat (elt r 0)
2600                                    " "
2601                                    (elt r 1)
2602                                    " ("
2603                                    (car (elt r 6))
2604                                    ")")
2605                            r))
2606          (bbdb-records))
2607         (if (string= mode-name "Mail")
2608             'ff/selector-insert-record-callback
2609           'ff/selector-compose-mail-callback)
2610         "*bbdb-search*"
2611         )
2612        )
2613
2614 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2615 ;; My script to automatically count the number of words and characters
2616 ;; between two markers
2617
2618 (ff/load-or-alert "text-counters.el")
2619
2620 ;; Display them in the modeline when in text-mode
2621
2622 (add-hook 'text-mode-hook 'tc/add-text-counters-in-modeline)
2623
2624 ;; (add-hook 'text-mode-hook
2625 ;; (lambda ()
2626 ;; (setq comment-start " > ")))
2627
2628 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2629 ;; A function to remove temporary alarm windows
2630 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2631
2632 (defcustom ff/annoying-windows-regexp
2633   "\\*Messages\\*\\|\\*compilation\\*\\|\\*tex-shell\\*\\|\\*Help\\*\\|\\*info\\*\\|\\*Apropos\\*\\|\\*BBDB\\*\\|\\*.*-diff\\*"
2634   "The regexp matching the windows to be deleted by `ff/delete-annoying-windows'"
2635   )
2636
2637 (defun ff/delete-annoying-windows ()
2638   "Close all the windows showing buffers whose names match
2639 `ff/annoying-windows-regexp'."
2640   (interactive)
2641   (when ff/annoying-windows-regexp
2642     (mapc (lambda (w)
2643             (when (and (not (one-window-p w))
2644                        (string-match ff/annoying-windows-regexp
2645                                      (buffer-name (window-buffer w))))
2646               (delete-window w)))
2647           (window-list)
2648           )
2649     (message "Removed annoying windows")
2650     )
2651   )
2652
2653 (setq ff/annoying-windows-regexp
2654       (concat ff/annoying-windows-regexp
2655               "\\|\\*unspooled mails\\*\\|\\*enotes alarms\\*\\|\\*system info\\*"))
2656
2657 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2658 ;; Some handy functions
2659 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2660
2661 (defun ff/twin-horizontal-current-buffer () (interactive)
2662        (delete-other-windows)
2663        (split-window-horizontally)
2664        (balance-windows)
2665        )
2666
2667 (defun ff/twin-vertical-current-buffer () (interactive)
2668        (delete-other-windows)
2669        (split-window-vertically)
2670        (balance-windows)
2671        )
2672
2673 (defun ff/flyspell-mode (arg) (interactive "p")
2674        (if flyspell-mode (flyspell-mode -1)
2675          (flyspell-mode 1)
2676          (flyspell-buffer))
2677        )
2678
2679 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2680 ;; The fridge!
2681 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2682
2683 (defun ff/move-region-to-fridge (&optional universal) (interactive "P")
2684        "Cut the current region, paste it in a file called ./fridge
2685 with a time tag, and save this file"
2686        (unless (use-region-p) (error "No region selected"))
2687        (let ((bn (file-name-nondirectory (buffer-file-name))))
2688          (if universal
2689              (copy-region-as-kill (region-beginning) (region-end))
2690            (kill-region (region-beginning) (region-end))
2691            )
2692          (with-current-buffer (find-file-noselect "fridge")
2693            (goto-char (point-max))
2694            (insert "\n")
2695            (insert "######################################################################\n")
2696            (insert "\n"
2697                    (format-time-string "%Y %b %d %H:%M:%S" (current-time))
2698                    " (from "
2699                    bn
2700                    ")\n\n")
2701            (yank)
2702            (save-buffer)
2703            (message "Region moved to fridge")
2704            )
2705          )
2706        )
2707
2708 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2709 ;; My own keymap mapped to C-`
2710 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2711
2712 (setq ff/map (make-sparse-keymap))
2713 (define-key global-map [(control \`)] ff/map)
2714
2715 ;; (defun ff/start-stop-macro-recording () (interactive)
2716   ;; (if (or defining-kbd-macro executing-kbd-macro)
2717       ;; (kmacro-end-macro)
2718     ;; (kmacro-start-macro))
2719   ;; )
2720
2721 ;; (define-key global-map [(shift return)] 'ff/start-stop-macro-recording)
2722
2723 (unless window-system
2724   ;; (define-key global-map [(control @)] ff/map)
2725   (define-key global-map [(meta O) \`] ff/map)
2726   )
2727
2728 (define-key esc-map "`" ff/map)
2729
2730 (defun ff/kill-downto-signature () (interactive)
2731        (let ((s (point)))
2732          (when (re-search-forward "^-- $")
2733            (kill-region s (match-beginning 0))
2734            (goto-char s))))
2735
2736 (defun ff/git-status (&optional dir) (interactive)
2737        (if (buffer-file-name)
2738            (git-status (file-name-directory (buffer-file-name)))
2739          (error "No file attached to this buffer")))
2740
2741 (defun ff/insert-date (&optional universal) (interactive "P")
2742        (insert (format-time-string "\n * %H:%M:%S %A %B %d, %Y\n\n" (current-time)))
2743        ;; ;; (insert (format-time-string "%Y %b %d %H:%M:%S" (current-time)))
2744        ;; ;; (insert (format-time-string "%d.%m.%y" (current-time)))
2745        ;; (if universal
2746            ;; (insert (format-time-string "%d.%m.%Y %H:%M:%S" (current-time)))
2747          ;; (insert (format-time-string "%d.%m.%Y" (current-time))))
2748        )
2749
2750 (define-key ff/map [(control g)] 'magit)
2751 ;;(define-key ff/map [(control g)] 'ff/git-status)
2752 ;; (define-key ff/map [(control w)] 'server-edit)
2753 (define-key ff/map [(control d)] 'ff/elisp-debug-on)
2754 ;; (define-key ff/map "d" 'diary)
2755 (define-key ff/map "d" 'ff/insert-date)
2756 (define-key ff/map [(control \`)] 'ff/bash-new-buffer)
2757 (define-key ff/map [(control n)] 'enotes/show-all-notes)
2758 (define-key ff/map [(control s)] 'ff/secure-note-add)
2759 (define-key ff/map [(control t)] 'ff/start-test-code)
2760 (define-key ff/map [(control q)] 'ff/create-dummy-buffer)
2761 (define-key ff/map [(control a)] 'auto-fill-mode)
2762 (define-key ff/map [(control i)] 'ff/system-info)
2763 (define-key ff/map "w" 'ff/word-occurences)
2764 ;; (define-key ff/map [(control c)] 'calendar)
2765 (define-key ff/map [(control c)] 'ff/show-compilation-buffer-split-window)
2766 ;; (define-key ff/map [(control c)] (lambda () (interactive) (save-excursion (calendar))))
2767 (define-key ff/map [(control l)] 'goto-line)
2768 (define-key ff/map "l" 'longlines-mode)
2769 (define-key ff/map [(control o)] 'selector/quick-pick-recent)
2770 (define-key ff/map "s" 'selector/quick-move-in-buffer)
2771 (define-key ff/map "S" 'selector/search-sentence)
2772 (define-key ff/map "t" (lambda () (interactive) (find-file "~/private/TODO.txt")))
2773 (define-key ff/map "h" 'ff/tidy-html)
2774 (define-key ff/map "c" 'ff/count-char)
2775 (define-key ff/map [(control p)] 'ff/print-to-file)
2776 (define-key ff/map "P" 'ff/print-to-printer)
2777 (define-key ff/map [(control b)] 'bbdb)
2778 (define-key ff/map "m" 'ff/selector-mail-from-bbdb)
2779 (define-key ff/map [(control m)] 'woman)
2780 (define-key ff/map "b" 'bookmark-jump)
2781 (define-key ff/map [(control =)] 'calc)
2782 (define-key ff/map "=" 'ff/number-beamer-frames)
2783 (define-key ff/map [(control shift b)]
2784   (lambda () (interactive)
2785     (bookmark-set)
2786     (bookmark-save)))
2787 (define-key ff/map "f" 'ff/move-region-to-fridge)
2788 (define-key ff/map [(control f)] 'ff/flyspell-mode)
2789 (define-key ff/map [(control k)] 'ff/kill-downto-signature)
2790
2791 (define-key ff/map [?\C-0] 'ff/delete-annoying-windows)
2792 (define-key ff/map "1" 'delete-other-windows)
2793 (define-key ff/map [?\C-1] 'delete-other-windows)
2794 (define-key ff/map "2" 'ff/twin-vertical-current-buffer)
2795 (define-key ff/map [?\C-2] 'ff/twin-vertical-current-buffer)
2796 (define-key ff/map "3" 'ff/twin-horizontal-current-buffer)
2797 (define-key ff/map [?\C-3] 'ff/twin-horizontal-current-buffer)
2798
2799 (define-key ff/map " " 'delete-trailing-whitespace)
2800
2801 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2802 ;; Hacks so that all keys are functionnal in xterm and through ssh.
2803 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2804
2805 (unless window-system
2806
2807   ;; One day I will understand these clipboard business. Until then,
2808   ;; so that it works in xterm (yes), let's use xclip. This is a bit
2809   ;; ugly.
2810
2811   ;; (defun ff/yank-with-xclip (&optional arg)
2812   ;; "Paste the content of the X clipboard with the xclip
2813   ;; command. Without ARG converts some of the '\\uxxxx' characters."
2814   ;; (interactive "P")
2815   ;; (with-temp-buffer
2816   ;; (shell-command "xclip -o" t)
2817   ;; (unless arg
2818   ;; (mapc (lambda (x) (replace-string (concat "\\u" (car x)) (cdr x) nil (point-min) (point-max)))
2819   ;; '(("fffd" . "??")
2820   ;; ("2013" . "-")
2821   ;; ("2014" . "--")
2822   ;; ("2018" . "`")
2823   ;; ("2019" . "'")
2824   ;; ("201c" . "``")
2825   ;; ("201d" . "''")
2826   ;; ("2022" . "*")
2827   ;; ("2026" . "...")
2828   ;; ("20ac" . "EUR")
2829   ;; )))
2830   ;; (kill-ring-save (point-min) (point-max)))
2831
2832   ;; (yank))
2833
2834   ;; (define-key global-map [(meta y)] 'ff/yank-with-xclip)
2835
2836   ;;   (set-terminal-coding-system 'iso-latin-1)
2837   ;; (set-terminal-coding-system 'utf-8)
2838
2839   ;; I have in my .Xressource
2840
2841   ;; XTerm.VT100.translations: #override\n\
2842   ;;   <Btn4Down>,<Btn4Up>:scroll-back(2,line)\n\
2843   ;;   <Btn5Down>,<Btn5Up>:scroll-forw(2,line)\n\
2844   ;;   Ctrl<Btn4Down>,Ctrl<Btn4Up>:scroll-back(1,page)\n\
2845   ;;   Ctrl<Btn5Down>,Ctrl<Btn5Up>:scroll-forw(1,page)\n\
2846   ;;   Shift<Btn4Down>,Shift<Btn4Up>:scroll-back(1,halfpage)\n\
2847   ;;   Shift<Btn5Down>,Shift<Btn5Up>:scroll-forw(1,halfpage)\n\
2848   ;;   Alt<KeyPress>:insert-eight-bit()\n\
2849   ;;   !Shift<Key>BackSpace: string("\7f")\n\
2850   ;;   Ctrl<Key>BackSpace: string("\eOZ")\n\
2851   ;;   Shift<Key>Prior: string("\e[5;2~")\n\
2852   ;;   Shift<Key>Next: string("\e[6;2~")\n\
2853   ;;   Shift Ctrl<Key>]: string("\eO}")\n\
2854   ;;   Shift 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.")\n\
2867   ;;   Shift Ctrl<Key>\\,: string("\eO<")\n\
2868   ;;   Ctrl<Key>\\,: string("\eO,")
2869
2870   (define-key function-key-map "\e[2~" [insert])
2871
2872   (define-key function-key-map "\e[Z" [S-iso-lefttab])
2873
2874   (define-key function-key-map "\e[1;2A" [S-up])
2875   (define-key function-key-map "\e[1;2B" [S-down])
2876   (define-key function-key-map "\e[1;2C" [S-right])
2877   (define-key function-key-map "\e[1;2D" [S-left])
2878   (define-key function-key-map "\e[1;2F" [S-end])
2879   (define-key function-key-map "\e[1;2H" [S-home])
2880
2881   (define-key function-key-map "\e[2;2~" [S-insert])
2882   (define-key function-key-map "\e[5;2~" [S-prior])
2883   (define-key function-key-map "\e[6;2~" [S-next])
2884
2885   (define-key function-key-map "\e[1;2P" [S-f1])
2886   (define-key function-key-map "\e[1;2Q" [S-f2])
2887   (define-key function-key-map "\e[1;2R" [S-f3])
2888   (define-key function-key-map "\e[1;2S" [S-f4])
2889   (define-key function-key-map "\e[15;2~" [S-f5])
2890   (define-key function-key-map "\e[17;2~" [S-f6])
2891   (define-key function-key-map "\e[18;2~" [S-f7])
2892   (define-key function-key-map "\e[19;2~" [S-f8])
2893   (define-key function-key-map "\e[20;2~" [S-f9])
2894   (define-key function-key-map "\e[21;2~" [S-f10])
2895
2896   (define-key function-key-map "\e[1;5A" [C-up])
2897   (define-key function-key-map "\e[1;5B" [C-down])
2898   (define-key function-key-map "\e[1;5C" [C-right])
2899   (define-key function-key-map "\e[1;5D" [C-left])
2900   (define-key function-key-map "\e[1;5F" [C-end])
2901   (define-key function-key-map "\e[1;5H" [C-home])
2902
2903   (define-key function-key-map "\e[2;5~" [C-insert])
2904   (define-key function-key-map "\e[5;5~" [C-prior])
2905   (define-key function-key-map "\e[6;5~" [C-next])
2906
2907   (define-key function-key-map "\e[1;9A" [M-up])
2908   (define-key function-key-map "\e[1;9B" [M-down])
2909   (define-key function-key-map "\e[1;9C" [M-right])
2910   (define-key function-key-map "\e[1;9D" [M-left])
2911   (define-key function-key-map "\e[1;9F" [M-end])
2912   (define-key function-key-map "\e[1;9H" [M-home])
2913
2914   (define-key function-key-map "\e[2;9~" [M-insert])
2915   (define-key function-key-map "\e[5;9~" [M-prior])
2916   (define-key function-key-map "\e[6;9~" [M-next])
2917
2918   ;; The following ones are not standard
2919
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   (define-key function-key-map "\eO=" (kbd "C-="))
2937   (define-key function-key-map "\eO+" (kbd "C-+"))
2938
2939   (define-key function-key-map "\eOZ" [C-backspace])
2940
2941   (define-key minibuffer-local-map "\10" 'previous-history-element)
2942   (define-key minibuffer-local-map "\ e" 'next-history-element)
2943
2944   ;; (define-key global-map [(alt prior)] 'ff/prev-buffer)
2945   ;; (define-key global-map [(alt next)] 'ff/next-buffer)
2946
2947   )
2948
2949 ;; I am fed up with Alt-Backspace in the minibuffer erasing the
2950 ;; content of the kill-ring
2951
2952 (defun ff/backward-delete-word (arg)
2953   "Delete characters forward until encountering the end of a word, but do not put them in the kill ring.
2954 With argument ARG, do this that many times."
2955   (interactive "p")
2956   (delete-region (point) (progn (forward-word (- arg)) (point))))
2957
2958 (define-key minibuffer-local-map
2959   [remap backward-kill-word] 'ff/backward-delete-word)
2960
2961 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2962 ;; Privacy
2963 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2964
2965 ;; Where to save the bookmarks
2966
2967 (setq bookmark-default-file (concat ff/emacs-dir "/bmk")
2968       custom-file (concat ff/emacs-dir "/custom"))
2969
2970 ;; enotes.el is one of my own scripts, check my web page
2971
2972 ;; ** ;; (when (ff/load-or-alert "enotes" t)
2973 ;; ** ;;   (setq enotes/file "~/private/enotes"
2974 ;; ** ;;         enotes/show-help nil
2975 ;; ** ;;         enotes/full-display nil
2976 ;; ** ;;         enotes/default-time-fields "9:30")
2977 ;; ** ;;
2978 ;; ** ;;   (enotes/init)
2979 ;; ** ;;   )
2980
2981 (when (ff/load-or-alert "goto-last-change.el")
2982   (define-key global-map [(control -)] 'goto-last-change)
2983   )
2984
2985 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2986 ;; My private stuff (email adresses, mail filters, etc.)
2987 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2988
2989 (ff/load-or-alert "~/private/emacs.perso.el" t)
2990
2991 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2992 ;; emacs server
2993 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2994
2995 ;; Runs in server mode, so that emacsclient works
2996 ;; ;;(server-start)
2997
2998 ;; (defun ff/raise-frame-and-give-focus ()
2999   ;; (when window-system
3000     ;; (raise-frame)
3001     ;; (x-focus-frame (selected-frame))
3002     ;; (set-mouse-pixel-position (selected-frame) 4 4)
3003     ;; ))
3004
3005 ;; ;; Raises the window when the server is invoked
3006
3007 ;; (add-hook 'server-switch-hook 'ff/raise-frame-and-give-focus)