From: Francois Fleuret Date: Sun, 28 Feb 2010 10:12:54 +0000 (+0100) Subject: Initial commit X-Git-Url: https://fleuret.org/cgi-bin/gitweb/gitweb.cgi?a=commitdiff_plain;h=87b171d58f0b3afc82d8842f2bd01cdc1c367360;p=elisp.git Initial commit --- diff --git a/emacs.el b/emacs.el new file mode 100644 index 0000000..23ca425 --- /dev/null +++ b/emacs.el @@ -0,0 +1,2580 @@ +;; -*-Emacs-Lisp-*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; This program is free software; you can redistribute it and/or ;; +;; modify it under the terms of the GNU General Public License as ;; +;; published by the Free Software Foundation; either version 3, or (at ;; +;; your option) any later version. ;; +;; ;; +;; This program is distributed in the hope that it will be useful, but ;; +;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; +;; General Public License for more details. ;; +;; ;; +;; You should have received a copy of the GNU General Public License ;; +;; along with this program. If not, see . ;; +;; ;; +;; Written by and Copyright (C) Francois Fleuret ;; +;; Contact for comments & bug reports ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; It's better to set the preferences in the .Xresources so that the +;; window is not first displayed with the wrong options + +;; Emacs.menuBar: off +;; Emacs.verticalScrollBars: off +;; Emacs.toolBar: off +;; Emacs.internalBorder: 1 +;; Emacs.FontBackend: xft +;; Xft.dpi: 96 +;; Xft.hinting: true +;; Xft.antialias: true +;; Xft.rgba: rgb + +;; Give the focus to the emacs window if we are under a windowing +;; system + +(when window-system + ;; (x-focus-frame nil) + (set-mouse-pixel-position (selected-frame) 4 4)) + +;; Where I keep my own scripts + +(add-to-list 'load-path "~/sources/gpl/elisp") +(add-to-list 'load-path "~/sources/elisp") + +;; No, I do not like menus +(menu-bar-mode -1) + +;; Nor fringes +(when (functionp 'fringe-mode) (fringe-mode '(0 . 0))) + +;; And I do not like scrollbar neither +(when (functionp 'scroll-bar-mode) (scroll-bar-mode -1)) + +;; Make all "yes or no" prompts be "y or n" instead +(fset 'yes-or-no-p 'y-or-n-p) + +;; Show the matching parenthesis and do it immediately, we are in a +;; hurry +(setq show-paren-delay 0) +(show-paren-mode t) + +;; use colorization for all modes +(global-font-lock-mode t) + +(setq font-lock-maximum-decoration 2 + ;;'((latex-mode . 2) (t . 2)) + ) + +;; Activate the dynamic completion of buffer names +(iswitchb-mode 1) + +;; Save the minibuffer history +(setq savehist-file "~/private/emacs/savehist") +(when (functionp 'savehist-mode) (savehist-mode 1)) + +;; I do not like tooltips +(when (functionp 'tooltip-mode) (tooltip-mode nil)) + +;; Activate the dynamic completion in the mini-buffer +(icomplete-mode 1) + +;; (setq highlight-current-line-globally t + ;; highlight-current-line-ignore-regexp "Faces\\|Colors\\| \\*Mini\\|\\*media\\|INBOX") + +;; (highlight-current-line-minor-mode 1) +;; (highlight-current-line-set-bg-color "gray75") + +(defun ff/compile-when-needed (name) + "Compiles the given file only if needed. Adds .el if required, and +uses `load-path' to find it." + (if (not (string-match "\.el$" name)) + (ff/compile-when-needed (concat name ".el")) + (mapc (lambda (dir) + (let* ((src (concat dir "/" name))) + (when (file-newer-than-file-p src (concat src "c")) + (if (let ((byte-compile-verbose nil)) + (condition-case nil + (byte-compile-file src) + (error nil))) + (message (format "Compiled %s" src )) + (message (format "Failed compilation of %s" src)))))) + load-path))) + +;; This is useful when using the same .emacs in many places + +(defun ff/load-or-alert (name &optional compile-when-needed) + "Tries to load the specified file and insert a warning message in a +load-warning buffer in case of failure." + + (when compile-when-needed (ff/compile-when-needed name)) + + (if (load name t nil) t + (let ((buf (get-buffer-create "*loading warnings*"))) + (display-buffer buf) + (set-buffer buf) + (insert (propertize "Warning:" 'face 'font-lock-warning-face) " could not load '" name "'\n") + (fit-window-to-buffer (get-buffer-window buf)) + (set-buffer-modified-p nil)) + nil)) + +;; This is the default in emacs 22.1 and later +;; (auto-compression-mode 1) + +;; make emacs use the clipboard so that copy/paste works for other +;; x-programs. I have no clue how all that clipboard thing works. +;; (setq x-select-enable-clipboard t) +;; (setq interprogram-paste-function 'x-cut-buffer-or-selection-value) + +(setq + + message-log-max 1000 + + ;; avoid GC as much as possible + gc-cons-threshold 2500000 + + ;; no startup message + inhibit-startup-screen t + + ;; no message in the scratch buffer + initial-scratch-message nil + + ;; do not fill my buffers, you fool + next-line-add-newlines nil + + ;; keep the window focused on the messages during compilation + compilation-scroll-output t + + ;; Keep the highlight on the compilation error + next-error-highlight t + + ;; blink the screen instead of beeping + ;; visible-bell t + + ;; take the CR when killing a line + kill-whole-line t + + ;; I prefer to move between lines as defined in the buffer, not + ;; visually + line-move-visual nil + + ;; I comment empty lines, too (does not seem to work, though) + comment-empty-lines t + + ;; We want long lines to be truncated instead of displayed on several lines + ;; truncate-lines t + ;; Show all lines, even if the window is not as large as the frame + ;; truncate-partial-width-windows nil + ;; truncate-partial-width-windows t + + ;; Do not keep tracks of the autosaved files + auto-save-list-file-prefix nil + + ;; Show me empty lines at the end of the buffer + default-indicate-empty-lines t + + ;; Show me the region until I do something on it + transient-mark-mode t + + ;; Do not color stuff which are clickable when hovering over it + mouse-highlight nil + + ;; Don't bother me with questions even if "unsafe" local variables + ;; are set + enable-local-variables :all + + ;; I have no problem with small windows + window-min-height 1 + + ;; I am not a fan of develock + develock-auto-enable nil + + ;; I do not like women to open windows + woman-use-own-frame nil + + ;; I am not that paranoid, contrary to what you think + epa-file-cache-passphrase-for-symmetric-encryption t + ;; And I like ascii files + epa-armor t + + ;; I have no problem with files having their own local variables + enable-local-eval t + + mail-from-style 'angles + browse-url-mozilla-program "firefox" + mc-encrypt-for-me t + mc-use-default-recipients t + + ;; browse-url-new-window-flag t + ) + +;; The backups + +(setq + temporary-file-directory "/tmp/" + vc-make-backup-files t + backup-directory-alist '((".*" . "~/misc/emacs.backups/")) + version-control t ;; Use backup files with numbers + kept-new-versions 10 + kept-old-versions 2 + delete-old-versions t + backup-by-copying-when-linked t + ) + +;; Stop this crazy blinking cursor +(blink-cursor-mode 0) + +;; (setq blink-cursor-delay 0.25 +;; blink-cursor-interval 0.25) + +;; (set-terminal-coding-system 'utf-8) + +;; (unless window-system +;; (xterm-mouse-mode 1) +;; (if (string= (getenv "TERM") "xterm-256color") +;; (ff/load-or-alert "xterm-256color" t)) +;; ) + +(setq-default + + ;; Show white spaces at the end of lines + show-trailing-whitespace t + + ;; Do not show the cursor in non-active window + cursor-in-non-selected-windows nil + + use-dialog-box nil + use-file-dialog nil + + ;; when on a TAB, the cursor has the TAB length + x-stretch-cursor t + + ;; This is the default coding system when toggle-input-method is + ;; invoked (C-\) + default-input-method "latin-1-prefix" + ;; do not put tabs when indenting + indent-tabs-mode nil + ;; And yes, we have a fast display / connection / whatever + baud-rate 524288 + ;; baud-rate 10 + + ;; To keep the cursor always visible when it moves (thanks + ;; snogglethrop!) + redisplay-dont-pause t + + ;; I want to see the keys I type instantaneously + echo-keystrokes 0.1 + ) + +;; Show the column number +(column-number-mode 1) + +;; What modes for what file extentions +(add-to-list 'auto-mode-alist '("\\.h\\'" . c++-mode)) + +(add-to-list 'auto-mode-alist '("\\.txt\\'" . (lambda() + (text-mode) + (orgtbl-mode) + (auto-fill-mode) + (flyspell-mode)))) + +(add-hook 'c++-mode-hook 'flyspell-prog-mode) +(add-hook 'log-edit-mode-hook 'flyspell-mode) + +;; I am a power-user + +(put 'narrow-to-region 'disabled nil) +(put 'upcase-region 'disabled nil) +(put 'downcase-region 'disabled nil) +;; (put 'scroll-left 'disabled nil) +;; (put 'scroll-right 'disabled nil) + +;; My selector is clearer than that +;; (when (load "ido" t) (ido-mode t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Makes buffer names more explicit then <2>, <3> etc. when there are +;; several identical filenames + +(when (load "uniquify" t) + (setq uniquify-buffer-name-style 'post-forward-angle-brackets)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Appearance +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when (boundp 'x-display-name) + + (setq-default + + ;; If the display is :0.0, we make the assumption that we are + ;; running the emacs locally, and we do not show the + ;; hostname. Otherwise, show @host. + + frame-title-format (concat "emacs" ;;invocation-name + (unless (string= x-display-name ":0.0") + (concat "@" system-name)) + " (%b)") + + ;; Use the same for the icone + + icon-title-format frame-title-format + )) + +;; "tool" bar? Are you kidding? +(when (boundp 'tool-bar-mode) (tool-bar-mode -1)) + +;; ;; If my own letter icon is here, use it and change its color +;; (when (file-exists-p "~/local/share/emacs/letter.xbm") + ;; (setq-default display-time-mail-icon + ;; (find-image + ;; '((:type xbm + ;; :file "~/local/share/emacs/letter.xbm" + ;; :ascent center))))) + +;; My funky setting of face colors. Basically, we switch to a sober +;; look and darken a bit the colors which need to (because of the +;; darker background) + +(defun ff/configure-faces (fl) + "Set face attributes and create faces when necessary" + (mapc (lambda (f) + (unless (boundp (car f)) (make-empty-face (car f))) + (eval `(set-face-attribute (car f) nil ,@(cdr f)))) + fl)) + +;; Not the same in xterm (which is gray in my case) and in +;; X-window + +(unless window-system + ;; (xterm-mouse-mode 1) + (ff/configure-faces + '((italic :underline nil) + (info-title-2 :foreground "green") + (cperl-array-face :background "gray90" :foreground "blue" :weight 'bold) + (cperl-hash-face :background "gray90" :foreground "purple" :weight 'bold) + (diff-added-face :foreground "blue" :weight 'bold) + (diff-changed-face :foreground "green" :weight 'bold) + (diff-removed-face :foreground "red" :weight 'bold) + (diff-file-header-face :background "white" :foreground "black" + :weight 'bold) + (diff-header-face :background "white" :foreground "black") + (diff-hunk-header-face :background "white" :foreground "black") + (diff-indicator-removed :foreground "red" :weight 'bold) + (diff-removed :foreground "red" :weight 'bold) + (diff-indicator-added :foreground "blue" :weight 'bold) + (diff-added :foreground "blue" :weight 'bold) + (font-lock-string-face :foreground "green") + (font-lock-variable-name-face :foreground "blue") + (font-lock-constant-face :foreground "blue") + (font-lock-function-name-face :foreground "blue") + (font-lock-preprocessor-face :foreground "green") + (font-lock-function-name-face :foreground "cyan") + (flyspell-incorrect-face :foreground "red2") + (flyspell-duplicate-face :foreground "OrangeRed2") + (sh-heredoc :foreground "blue") + (sh-heredoc-face :foreground "blue") + (font-lock-keyword-face :foreground "blue") + (highlight :background "darkseagreen3") + (isearch :background "orange" :foreground "black") + (isearch-lazy-highlight-face' :background "yellow" :foreground "black") + ;; (display-time-mail-face :background "white") + (show-paren-match-face :background "gold" :foreground "black") + (show-paren-mismatch-face :background "red" :foreground "black") + (trailing-whitespace :background "white") + (mode-line :background "cornflowerblue" :foreground "black" :box nil + :inverse-video nil) + (header-line :background "cornflowerblue" :foreground "black" :box nil + :inverse-video nil) + (mode-line-inactive :background "gray60" :foreground "black" :box nil + :inverse-video nil) + ;; (tex-verbatim :family nil) + (region :background "springgreen2") + (ff/date-info-face :foreground "white" :weight 'bold) + (ff/mail-alarm-face :foreground "red" :weight 'bold) + (gui-button-face :background "green" :foreground "white") + (enotes/information-face :foreground "cyan") + )) + ) + +;; (list-colors-display (mapcar 'car color-name-rgb-alist)) + +;; (ff/configure-faces '((default :background "black" :foreground "gray80"))) +;; (ff/configure-faces '((default :background "gray80" :foreground "black"))) + +(when window-system + (setq + display-time-use-mail-icon t) + + (ff/configure-faces + '( + (escape-glyph :foreground "gray70" :weight 'bold) + (default :background "gray90" :foreground "black") + (cperl-array-face :background "gray90" :foreground "blue" :weight 'bold) + (cperl-hash-face :background "gray90" :foreground "purple" :weight 'bold) + (message-cited-text :foreground "red4") + (diff-added :background "gray90" :foreground "green4" :weight 'bold) + (diff-removed :background "gray90" :foreground "red2" :weight 'bold) + (diff-changed :background "gray90" :foreground "blue") + (diff-file-header :background "white" :foreground "black" + :weight 'bold) + (diff-header :background "white" :foreground "black") + (diff-hunk-header :background "white" :foreground "black") + (font-lock-builtin-face :foreground "deeppink3") + (font-lock-string-face :foreground "dark olive green") + (font-lock-variable-name-face :foreground "sienna") + (font-lock-function-name-face :foreground "blue4" :weight 'bold) + ;; (font-lock-comment-face :foreground "") + (flyspell-incorrect-face :foreground "red2") + (flyspell-duplicate-face :foreground "OrangeRed2") + (header-line :background "gray65") + (sh-heredoc :foreground "darkorange3") + (sh-heredoc-face :foreground "darkorange3") + (highlight :background "turquoise") + (message-cited-text-face :foreground "firebrick") + (isearch :background "yellow" :foreground "black") + (isearch-lazy-highlight-face' :background "yellow3" :foreground "black") + (region :background "light sky blue" :foreground "black") + ;; (region :background "plum" :foreground "black") + (show-paren-match-face :background "gold" :foreground "black") + (show-paren-mismatch-face :background "red" :foreground "black") + (trailing-whitespace :background "gray65") + (cursor :inverse-video t) + (enotes/list-title-face :foreground "blue" :weight 'bold) + (mode-line :background "#9090f0" :foreground "black" :box nil + :inverse-video nil) + (header-line :background "cornflowerblue" :foreground "black" :box nil + :inverse-video nil) + (mode-line-inactive :background "#606080" :foreground "black" :box nil + :inverse-video nil) + ;; (fringe :background "black" :foreground "gray90") + (fringe :background "gray65") + (ff/date-info-face :foreground "white" :weight 'bold) + (ff/mail-alarm-face :foreground "white" :background "red2") + ;; (alarm-vc-face :foreground "black" :background "yellow" :weight 'normal) + )) + ) + +;; When we are root, put the modeline in red + +(when (string= (user-real-login-name) "root") + (ff/configure-faces + '((mode-line :background "red3" :foreground "black" :box nil + :inverse-video nil)) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Move the window on the buffer without moving the cursor +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/scroll-down () + "Scroll the buffer down one line and keep the cursor at the same location." + (interactive) + (condition-case nil + (scroll-down 1) + (error nil))) + +(defun ff/scroll-up () + "Scroll the buffer up one line and keep the cursor at the same location." + (interactive) + (condition-case nil + (scroll-up 1) + (error nil))) + +(defun ff/scroll-left () + "Scroll the buffer left one column and keep the cursor at the same location." + (interactive) + (condition-case nil + (scroll-left 2) + (error nil))) + +(defun ff/scroll-right () + "Scroll the buffer right one column and keep the cursor at the same location." + (interactive) + (condition-case nil + (scroll-right 2) + (error nil))) + +(define-key global-map [(meta up)] 'ff/scroll-down) +(define-key global-map [(meta down)] 'ff/scroll-up) +(define-key global-map [(meta p)] 'ff/scroll-down) +(define-key global-map [(meta n)] 'ff/scroll-up) +(define-key global-map [(meta right)] 'ff/scroll-left) +(define-key global-map [(meta left)] 'ff/scroll-right) + +(defun ff/delete-trailing-whitespaces-and-indent () + (interactive) + (delete-trailing-whitespace) + (indent-region (point-min) (point-max) nil)) + +(define-key global-map [(control c) (control q)] 'ff/delete-trailing-whitespaces-and-indent) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Playing sounds +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (defun ff/esd-sound (file) +;; "Plays a sound with the Enlighted sound daemon." +;; (interactive) +;; (process-kill-without-query (start-process-shell-command "esdplay" +;; nil +;; "esdplay" file))) + +(defun ff/alsa-sound (file) + "Plays a sound with ALSA." + (interactive) + (process-kill-without-query (start-process-shell-command "aplay" + nil + "aplay" "-q" file))) + +(if (and (boundp 'x-display-name) (string= x-display-name ":0.0")) + (defalias 'ff/play-sound-async 'ff/alsa-sound) + (defalias 'ff/play-sound-async 'ding)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; I comment stuff often, let's be efficient. shift + down comments +;; the current line and goes down, and shift + up uncomments the line +;; and goes up (they are not the dual of each other, but moving and +;; then uncommenting would be very counter-intuitive). +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/comment-and-go-down (arg) + "Comments and goes down ARG lines." + (interactive "p") + (condition-case nil + (comment-region (point-at-bol) (point-at-eol)) (error nil)) + (next-line 1) + (if (> arg 1) (ff/comment-and-go-down (1- arg)))) + +(defun ff/uncomment-and-go-up (arg) + "Uncomments and goes up ARG lines." + (interactive "p") + (condition-case nil + (uncomment-region (point-at-bol) (point-at-eol)) (error nil)) + (next-line -1) + (if (> arg 1) (ff/uncomment-and-go-up (1- arg)))) + +(define-key global-map [(shift down)] 'ff/comment-and-go-down) +(define-key global-map [(shift up)] 'ff/uncomment-and-go-up) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Counting various entities in text +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/count-char () + "Prints the number of characters between the first previous \"--\" +and the firt next \"--\"." + (interactive) + (let ((from (save-excursion (re-search-backward "^--$" nil t))) + (to (save-excursion (re-search-forward "^--$" nil t)))) + (if (and to from) (message "%d character(s)" (- to from 6)) + (error "Can not find the -- delimiters")))) + +(defun ff/count-words () + "Print number of words between the first previous \"--\" and the +firt next \"--\"." + (interactive) + (let ((from (save-excursion (re-search-backward "^--$" nil t))) + (to (save-excursion (re-search-forward "^--$" nil t)))) + (if (and to from) + (save-excursion + (goto-char from) + (let ((count 0)) + (while (< (point) to) + (re-search-forward "\\w+\\W+") + (setq count (1+ count))) + (message "%d word(s)" count))) + (error "Can not find the -- delimiters")))) + +(defun ff/word-occurences () + "Display in a new buffer the list of words sorted by number of +occurrences " + (interactive) + + (let ((buf (get-buffer-create "*word counting*")) + (map (make-sparse-keymap)) + (nb (make-hash-table)) + (st (make-hash-table)) + (result nil)) + + ;; Collects all words in a hash table + + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\\([\\-a-zA-Z\\\\]+\\)" nil t) + (let* ((s (downcase (match-string-no-properties 1))) + (k (sxhash s))) + (puthash k s st) + (puthash k (1+ (gethash k nb 0)) nb)))) + + ;; Creates the result buffer + + (define-key map "q" 'kill-this-buffer) + (display-buffer buf) + (set-buffer buf) + (setq show-trailing-whitespace nil) + (erase-buffer) + + ;; Builds a list from the hash table + + (maphash + (lambda (key value) + (setq result (cons (cons value (gethash key st)) result))) + nb) + + ;; Sort and display it + + (mapc (lambda (x) + (if (and (> (car x) 3) + ;; No leading backslash and at least four characters + (string-match "^[^\\]\\{4,\\}" (cdr x)) + ) + (insert (number-to-string (car x)) " " (cdr x) "\n"))) + (sort result (lambda (a b) (> (car a) (car b))))) + + ;; Adjust the window size and stuff + + (fit-window-to-buffer (get-buffer-window buf)) + (use-local-map map) + (set-buffer-modified-p nil)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Printing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'ps-print) + +(setq ps-print-color-p nil + ;; ps-paper-type 'letter + ps-paper-type 'a4 + ps-top-margin (* 1.75 56.692) + ps-left-margin 56.692 + ps-bottom-margin 56.692 + ps-right-margin 56.692 + + ;; Simple header. Remove that silly frame shadow. + ps-print-header nil + ps-print-header-frame nil + ps-header-line-pad 0.3 + ps-header-font-family 'Courier + ps-header-title-font-size '(8.5 . 10) + ps-header-font-size '(6 . 7) + ps-font-size '(7 . 8) + ) + +(ps-put 'ps-header-frame-alist 'back-color 1.0) +(ps-put 'ps-header-frame-alist 'shadow-color 1.0) +(ps-put 'ps-header-frame-alist 'border-color 0.0) +(ps-put 'ps-header-frame-alist 'border-width 0.0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/non-existing-filename (dir prefix suffix) + "Returns a filename of the form DIR/PREFIX[.n].SUFFIX whose file does +not exist" + (let ((n 0) + (f (concat prefix suffix))) + (while (file-exists-p (concat dir "/" f)) + (setq n (1+ n) + f (concat prefix "." (prin1-to-string n) suffix))) + f)) + +(defun ff/print-buffer-or-region-with-faces (&optional file) + + ;; I am fed up with spell checking highlights + (when (and flyspell-mode + ;; (or ispell-minor-mode flyspell-mode) + (not (y-or-n-p "The spell checking is on, still print ? "))) + (error "Printing cancelled, the spell-checking is on")) + + (unless + (condition-case nil + (ps-print-region-with-faces (region-beginning) (region-end) file) + (error nil)) + (ps-print-buffer-with-faces file))) + +(defun ff/print-to-file (file) + "Prints the region if selected or the whole buffer in postscript +into FILE." + (interactive + (list + (read-file-name + "PS file: " "/tmp/" nil nil + (ff/non-existing-filename + "/tmp" + (replace-regexp-in-string "[^a-zA-Z0-9_.-]" "_" (file-name-nondirectory + (buffer-name))) + ".ps")) + )) + (ff/print-buffer-or-region-with-faces file)) + +(defun ff/print-to-printer () + "Prints the region if selected or the whole buffer to a postscript +printer." + (interactive) + (message "Printing to '%s'" (getenv "PRINTER")) + (ff/print-buffer-or-region-with-faces)) + +;; Can you believe it? There is a "print" key on PC keyboards ... + +(define-key global-map [(print)] 'ff/print-to-file) +(define-key global-map [(shift print)] 'ff/print-to-printer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Dealing with the laptop battery +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defcustom ff/battery-file "/proc/acpi/battery/BAT0" + "*Where to gather the battery information") + +(defcustom ff/thermal-file "/proc/acpi/thermal_zone/THM1/" + "*Where to gather the thermal information") + +(defun ff/battery-info (path) + + (let ((state nil) + (full nil) + (charge nil) + (rate nil)) + + (with-temp-buffer + (insert-file-contents-literally (concat path "/state")) + (while (re-search-forward "^\\([a-z ]*\\): *\\(.*\\)$" nil t) + (let ((field (match-string 1)) + (value (match-string 2))) + + (cond ((string= field "charging state") + (cond ((string= value "charged") (setq state 'charged)) + ((string= value "charging") (setq state 'charging)) + ((string= value "discharging")(setq state 'discharging)) + (t (setq state 'unknown)))) + + ((string= field "remaining capacity") + (setq charge (string-to-number value))) + + ((string= field "present rate") + (setq rate (string-to-number value))))))) + + (with-temp-buffer + (insert-file-contents-literally (concat path "/info")) + (while (re-search-forward "^\\([a-z ]*\\): *\\(.*\\)$" nil t) + (let ((field (match-string 1)) + (value (match-string 2))) + + (cond ((string= field "last full capacity") + (setq full (string-to-number value))))))) + + (list state full charge rate))) + +(defun ff/thermal-info (path) + (let ((temperature nil)) + (with-temp-buffer + (insert-file-contents-literally (concat path "/temperature")) + (while (re-search-forward "^\\([a-z ]*\\): *\\(.*\\)$" nil t) + (let ((field (match-string 1)) + (value (match-string 2))) + + (cond ((string= field "temperature") + (setq temperature (string-to-number value))))))) + + (list temperature))) + +(defun ff/laptop-info-string () (interactive) + (condition-case nil + (let ((info (ff/battery-info ff/battery-file)) + (temperature (car (ff/thermal-info ff/thermal-file)))) + + (concat + + ;; The temperature + + (if (> temperature 50) + (concat + (let ((s (format "%dC" temperature))) + (if (> temperature 65) (propertize s 'face + 'font-lock-warning-face) + s)) + "/" + ) + ) + + ;; The battery + + (cond + + ((eq (nth 0 info) 'charged) "L") + + ((eq (nth 0 info) 'discharging) + (let* ((time (/ (* (nth 2 info) 60) (nth 3 info))) + (s (format "B%d:%02d" (/ time 60) (mod time 60)))) + (if (< time 15) + ;; Les than 15 minutes, let's write the remaining + ;; time in red + (propertize s 'face 'font-lock-warning-face) + s))) + + ((eq (nth 0 info) 'charging) + (format "L%2d%%" (/ (* 100 (nth 2 info)) (nth 1 info)))) + + (t (format "???")) + + ))) + + (error nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/system-info () (interactive) + + (let ((buf (get-buffer-create "*system info*")) + (map (make-sparse-keymap))) + + (define-key map "q" 'kill-this-buffer) + (display-buffer buf) + (set-buffer buf) + (setq show-trailing-whitespace nil) + (erase-buffer) + + (let ((highlight nil)) + + (mapc (lambda (x) + (insert + (if (setq highlight (not highlight)) + (propertize + (with-temp-buffer (apply 'call-process x) + (buffer-string)) + 'face 'highlight) + (with-temp-buffer (apply 'call-process x) + (buffer-string)) + )) + ) + + '( + ("hostname" nil t nil "-v") + ("acpi" nil t) + ("df" nil t nil "-h") + ;; ("mount" nil t) + ("ifconfig" nil t) + ("ssh-add" nil t nil "-l") + ))) + + (goto-char (point-min)) + (while (re-search-forward "^$" nil t) (backward-delete-char 1)) + + (fit-window-to-buffer (get-buffer-window buf)) + (use-local-map map) + (set-buffer-modified-p nil) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Make a sound when there is new mail +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; I do not like sounds anymore + +;; (setq ff/already-boinged-for-mail nil) + +;; (defun ff/boing-if-new-mail () +;; (if mail (when (not ff/already-boinged-for-mail) +;; ;; (ff/play-sound-async "~/local/sounds/boing1.wav") +;; ;; (ff/show-unspooled-mails) +;; (setq ff/already-boinged-for-mail t)) +;; (setq ff/already-boinged-for-mail nil)) +;; ) + +;; (add-hook 'display-time-hook 'ff/boing-if-new-mail) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Display time +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq + + display-time-interval 15 ;; Check every 15s + + display-time-string-forms `( + ;; (if mail + ;; (concat " " + ;; (propertize " mail " + ;; 'face 'ff/mail-alarm-face) + ;; " ") + ;; ) + + (propertize (concat 24-hours ":" minutes + " " + dayname " " + monthname " " + day) + 'face 'ff/date-info-face) + + load + + ,(if (ff/laptop-info-string) + '(concat " /" (ff/laptop-info-string) "/")) + + ) + + ;; display-time-format "%b %a %e %H:%M" + ;; display-time-mail-face nil + ) + +;; Show the time, mail and stuff +(display-time) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Moving through buffers +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/next-buffer () + "Switches to the next buffer in cyclic order." + (interactive) + (let ((buffer (current-buffer))) + (switch-to-buffer (other-buffer buffer)) + (bury-buffer buffer))) + +(defun ff/prev-buffer () + "Switches to the previous buffer in cyclic order." + (interactive) + (let ((list (nreverse (buffer-list))) + found) + (while (and (not found) list) + (let ((buffer (car list))) + (if (and (not (get-buffer-window buffer)) + (not (string-match "\\` " (buffer-name buffer)))) + (setq found buffer))) + (setq list (cdr list))) + (switch-to-buffer found))) + +(define-key global-map [?\C-x right] 'ff/next-buffer) +(define-key global-map [?\C-x left] 'ff/prev-buffer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; There is actually a decent terminal emulator in emacs! +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(load "term") + +(defun ff/kill-associated-buffer-and-delete-windows (process str) (interactive) + (let ((buffer (process-buffer process))) + (delete-windows-on buffer) + (kill-buffer buffer)) + (message "Process finished (%s)" (replace-regexp-in-string "\n$" "" str))) + +(defun ff/shell-new-buffer (buffername program &rest param) + "Start a terminal-emulator in a new buffer with the shell PROGRAM, +optionally invoked with the parameters PARAM. The process associated +to the shell can be killed without query." + + (interactive) + + (let ((n 1) + (bn buffername)) + + (while (get-buffer (concat "*" bn "*")) + (setq n (1+ n) + bn (format "%s<%d>" buffername n))) + + (set-buffer (apply 'make-term (append (list bn program nil) param))) + + (setq show-trailing-whitespace nil) + (term-char-mode) + (message "C-c C-k term-char-mode, C-c C-j term-line-mode. \ +In line mode: M-p previous line, M-n next line.") + + ;; A standard setup of the face above is not enough, I have to + ;; force them here. Since I have a gray90 background, I like + ;; darker colors. + + (when window-system + (ff/configure-faces + '((term-green :foreground "green3") + (term-cyan :foreground "cyan3") + (term-default-fg-inv :foreground "gray90" :background "black") + ))) + + (term-set-escape-char ?\C-x) + + ;; I like the shell buffer and windows to be deleted when the + ;; shell process terminates. It's a bit of a mess to acheive this. + + (let ((process (get-buffer-process (current-buffer)))) + (process-kill-without-query process) + (set-process-sentinel process + 'ff/kill-associated-buffer-and-delete-windows)) + + (switch-to-buffer-other-window (concat "*" bn "*")) + )) + +(defcustom ff/default-bash-commands '("ssh") + "*List of commands to be used for completion when invoking a new +bash shell with `ff/bash-new-buffer'.") + +(defun ff/bash-new-buffer (universal) + "Starts a bash in a new buffer. When invoked with a universal +argument, asks for a command to execute in that bash shell. The list +of commands in `ff/default-bash-commands' is used for auto-completion" + (interactive "P") + + (if universal + (let ((cmd (completing-read + "Command: " + (mapcar (lambda (x) (cons x t)) ff/default-bash-commands)))) + (ff/shell-new-buffer cmd "/bin/bash" "-c" cmd)) + + (ff/shell-new-buffer "bash" "/bin/bash"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; vc stuff for CVS +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq ;; Always follow links if the file is under version control + vc-follow-symlinks t + ) + +(when (require 'vc-git nil t) + (add-to-list 'vc-handled-backends 'GIT)) + +;; alarm-vc.el is one of my own scripts, check my web page + +(when (ff/load-or-alert "alarm-vc" t) + (setq alarm-vc-mode-exceptions "^VM")) + +(when (ff/load-or-alert "git") + (setq git-show-unknown nil) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Makes .sh and others files executable automagically +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Please consider the security-related consequences of using it + +(defun ff/make-shell-scripts-executable (&optional filename) + (setq filename (or filename (buffer-name))) + (when (and (string-match "\\.sh$\\|\\.pl$\\|\\.rb" filename) + (not (file-executable-p filename)) + ) + (set-file-modes filename 493) + (message "Made %s executable" filename))) + +(add-hook 'after-save-hook 'ff/make-shell-scripts-executable) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Cool stuff to navigate in emacs-lisp sources +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'find-func) + +(defun ff/goto-function-definition (&optional goback) + "Go directly to the definition of the function at point. With +goback argument, go back where we were." + (interactive "P") + (if goback + (if (not (and (boundp 'goto-function-history) goto-function-history)) + (error "We were nowhere, buddy") + (message "Come back") + (switch-to-buffer (car (car goto-function-history))) + (goto-char (cdr (car goto-function-history))) + (setq goto-function-history (cdr goto-function-history))) + + (let ((function (function-called-at-point))) + (when function + (let ((location (find-function-search-for-symbol + function nil + (symbol-file function)))) + (setq goto-function-history + (cons (cons (current-buffer) (point)) + (and (boundp 'goto-function-history) + goto-function-history))) + (pop-to-buffer (car location)) + (goto-char (cdr location))))))) + +(define-key global-map [(meta g)] 'ff/goto-function-definition) +(define-key global-map [(meta G)] (lambda () (interactive) + (ff/goto-function-definition t))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The big stuff (bbdb, mailcrypt, etc.) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Failsafe version if we can't load bbdb +(defun ff/explicit-name (email) email) + +(when (ff/load-or-alert "bbdb") + + (setq + ;; Stop asking (if not t or nil, will not ask) + bbdb-offer-save 'never + ;; I hate when bbdb decides to mess up my windows + bbdb-use-pop-up nil + ;; I have no problem with bbdb asking me if the sender email + ;; does not match exactly the address we have in the database + bbdb-quiet-about-name-mismatches 0 + ;; I have european friends, too + bbdb-north-american-phone-numbers-p nil + ;; To cycle through all possible addresses + bbdb-complete-name-allow-cycling t + ;; Cycle with full names only, not through all net-addresses alone too + bbdb-dwim-net-address-allow-redundancy t + ;; Do not add new addresses automatically + bbdb-always-add-addresses nil + ) + + (defface ff/known-address-face + '((t (:foreground "blue2"))) + "The face to display known mail identities.") + + (defface ff/unknown-address-face + '((t (:foreground "red3"))) + "The face to display unknown mail identities.") + + (defun ff/explicit-name (email) + "Returns a string identity for the first address in EMAIL. The +identity is taken from bbdb if possible or from the address itself +with mail-extract-address-components. The suffix \"& al.\" is added if +there are more than one address. + +If no bbdb record is found, the name is propertized with the face +ff/unknown-address-face. If a record is found and contains a note +'face, the associated face is used, otherwise +ff/known-address-face is used." + + (and email + (let* ((data (mail-extract-address-components email)) + (name (car data)) + (net (cadr data)) + (record (bbdb-search-simple nil net))) + + (concat + + (condition-case nil + (propertize (bbdb-record-name record) + 'face + (or (cdr (assoc 'face + (bbdb-record-raw-notes record))) + 'ff/known-address-face)) + (error + (propertize (or (and data (concat "<" email ">")) + "*undefined*") + 'face 'ff/unknown-address-face) + )) + (if (string-match "," (mail-strip-quoted-names email)) " & al.") + ))) + ) + + (ff/configure-faces '((ff/robot-address-face :foreground "green4") + (ff/important-address-face :foreground "blue2" + ;; :underline t + ;; :background "white" + ;; :foreground "green4" + :weight 'bold + ;; :slant 'italic + ))) + + + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; An encrypted file to put secure stuff (passwords, ...) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when (ff/load-or-alert "mailcrypt") + (mc-setversion "gpg") + ;; Keep the passphrase for 10min + (setq mc-passwd-timeout 600 + ff/secure-note-file "~/private/secure-notes.gpg") + ) + +(defface ff/secure-date + '((t (:background "gold" :weight bold))) + "The face to display the dates in the modeline.") + +(defun ff/secure-note-add () (interactive) + (find-file "~/private/secure-notes.gpg") + + ;; Adds a new entry (i.e. date and a bunch of empty lines) + + (goto-char (point-min)) + (insert "-- " + (format-time-string "%Y %b %d %H:%M:%S" (current-time)) + " ------------------------------------------------\n\n") + (previous-line 1) + + ;; Colorizes the dates + + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + "^-+ [0-9]+ [a-z]+ [0-9]+ [0-9]+:[0-9]+:[0-9]+.+$" + nil t) + (add-text-properties + (match-beginning 0) (match-end 0) '(face ff/secure-date)))) + + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Spelling +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq ;; For french, aspell is far better than ispell + ispell-program-name "aspell" + ;; To avoid ispell errors in figure filenames, labels, references. + ;; ispell-tex-skip-alists + ;; (list + ;; (append (car ispell-tex-skip-alists) + ;; '(("\\\\citep" ispell-tex-arg-end) ;; JMLR + ;; ("\\\\cite" ispell-tex-arg-end) + ;; ("\\\\nocite" ispell-tex-arg-end) + ;; ("\\\\includegraphics" ispell-tex-arg-end) + ;; ("\\\\author" ispell-tex-arg-end) + ;; ("\\\\ref" ispell-tex-arg-end) + ;; ("\\\\label" ispell-tex-arg-end) + ;; )) + ;; (cadr ispell-tex-skip-alists)) + + ;; So that reftex follows the text when moving in the summary + reftex-toc-follow-mode nil + ;; So that reftex visits files to follow + reftex-revisit-to-follow t + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Used in a \includegraphics runs xfig with the corresponding .fig +;; file or gimp with the corresponding bitmap picture +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/run-eps-edition (prefix rules &optional force) + (if rules + (let ((filename (concat prefix (car (car rules))))) + (if (or force (file-exists-p filename)) + (start-process "latex-eps-editor" nil (cdr (car rules)) filename) + (ff/run-eps-edition prefix (cdr rules) force))) + (message "No original file found for %seps" prefix))) + +(defcustom ff/xdvi-for-latex-options nil + "*Options to pass to xdvi when invoking `ff/run-viewer'") + +(defun ff/run-viewer (universal) + + "Starts an editor for the .eps at point (either xfig or gimp, +depending with the original file it can find), or starts xdvi for +the current .tex if no .eps is found at point. When run with a +universal argument starts xfig even if the .fig does not exist" + + (interactive "P") + + (if (and (save-excursion + (and (re-search-backward "{" (point-at-bol) t) + (or (re-search-forward "{\\([^{}]*.\\)eps}" (point-at-eol) t) + (re-search-forward "{\\([^{}]*.\\)pdf}" (point-at-eol) t) + (re-search-forward "{\\([^{}]*.\\)pdf_t}" (point-at-eol) t) + ))) + (and (<= (match-beginning 1) (point)) + (>= (match-end 1) (- (point) 2)))) + + (ff/run-eps-edition (match-string-no-properties 1) + '(("fig" . "xfig") + ("png" . "gimp") ("pgm" . "gimp") ("ppm" . "gimp") + ("jpg" . "xv")) + universal) + + (if (not (and (buffer-file-name) (string-match "\\(.*\\)\.tex$" + (buffer-file-name)))) + (message "Not a latex file!") + (condition-case nil (kill-process xdvi-process) (error nil)) + (let ((dvi-name (concat (match-string 1 (buffer-file-name)) ".dvi"))) + (if (not (file-exists-p dvi-name)) (error "Can not find %s !" dvi-name) + (message "Starting xdvi with %s" dvi-name) + (setq xdvi-process (apply 'start-process + (append '("xdvi-for-latex" nil "xdvi") + ff/xdvi-for-latex-options + (list dvi-name)))) + (process-kill-without-query xdvi-process)))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Tex mode + +;; When working on a tex file with other people, I can just change +;; ff/tex-command in the -*- part of the file so that I don't mess up +;; other's people configuration. + +(defadvice tex-file (around ff/set-my-own-tex-command () activate) + (let ((tex-command + (or (and (boundp 'ff/tex-command) + ff/tex-command) + tex-command))) + ad-do-it)) + +;; This is a bit hardcore, but really I can't bear the superscripts in +;; my emacs window and could not find another way to deactivate them. + +(load "tex-mode") +(defun tex-font-lock-suscript (pos) ()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Prevents many errors from beeping and makes the others play a nifty +;; sound +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/ring-bell () + (unless (memq this-command + '(isearch-abort + abort-recursive-edit + exit-minibuffer + keyboard-quit + backward-delete-char-untabify + delete-backward-char + minibuffer-complete-and-exit + previous-line next-line + backward-char forward-char + scroll-up scroll-down + enlarge-window-horizontally shrink-window-horizontally + enlarge-window shrink-window + minibuffer-complete + )) + ;; (message "command [%s]" (prin1-to-string this-command)) + ;; (ff/play-sound-async "~/local/sounds/short_la.wav") + )) + +(setq ring-bell-function 'ff/ring-bell) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Past the content of the url currently in the kill-ring with +;; shift-click 2 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/insert-url (&optional url) + "Downloads an URL with lynx and inserts it after the point." + (interactive "MUrl: ") + (when url + (message "Inserting %s" url) + (insert (concat "from: " url "\n\n")) + ;; (call-process "lynx" nil t nil "-nolist" "-dump" url)) + (call-process "w3m" nil t nil "-dump" url)) + ) + +(define-key global-map [(shift mouse-2)] + (lambda () (interactive) (ff/insert-url (current-kill 0)))) + +;; lookup-dict is one of my own scripts, check my web page + +(when (ff/load-or-alert "lookup-dict" t) + (define-key global-map [(control \?)] 'lookup-dict)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Automatization of things I do often +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/snip () (interactive) + (let ((start (condition-case nil (region-beginning) (error (point)))) + (end (condition-case nil (region-end) (error (point))))) + (goto-char end) + (insert "---------------------------- snip snip -------------------------------\n") + (goto-char start) + (insert "---------------------------- snip snip -------------------------------\n") + )) + +(defun ff/start-latex () + "Adds all that stuff to start a new LaTeX document." + (interactive) + (goto-char (point-min)) + (insert "%% -*- mode: latex; mode: reftex; mode: flyspell; coding: utf-8; tex-command: \"pdflatex.sh\" -*- + +\\documentclass[12pt]{article} +\\usepackage{epsfig} +\\usepackage{a4} +\\usepackage{amsmath} +\\usepackage{amssymb} +\\usepackage[utf8]{inputenc} +%% \\usepackage{eurosym} +%% \\usepackage{hyperref} +%% \\usepackage{harvard} + +%% Sans serif fonts +%% \\usepackage[T1]{fontenc} +%% \\usepackage[scaled]{helvet} +%% \\usepackage[cm]{sfmath} +%% \\renewcommand{\\ttdefault}{pcr} +%% \\renewcommand*\\familydefault{\\sfdefault} + +\\setlength{\\parindent}{0cm} +\\setlength{\\parskip}{12pt} + +%% \\renewcommand{\\baselinestretch}{1.3} + +\\begin{document} + +") + (save-excursion + (goto-char (point-max)) + (insert " + +\\end{document} +")) + (latex-mode)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/add-copyrights () + "Adds two lines for the (C) at the beginning of current buffer." + (interactive) + (let ((comment-style 'plain) + (gpl + (concat + + "\nSTART_IP_HEADER\n" + + (when (boundp 'user-full-name) + (concat "\nWritten by " user-full-name "\n")) + + (when (boundp 'user-mail-address) + (concat "Contact <" user-mail-address "> for comments & bug reports\n")) + + "\nEND_IP_HEADER\n" + + ))) + + (goto-char (point-min)) + + ;; If this is a script, put the gpl after the first line + + (when (re-search-forward "^#!" nil t) + (beginning-of-line) + (next-line 1)) + + (let ((start (point)) + (comment-style 'box)) + (insert gpl) + (comment-region start (point))) + + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/add-gpl () + "Adds the GPL statements at the beginning of current buffer." + (interactive) + (let ((comment-style 'box) + (gpl + (concat + + ;; " + ;; This program is free software; you can redistribute it and/or + ;; modify it under the terms of the GNU General Public License + ;; version 2 as published by the Free Software Foundation. + + ;; This program is distributed in the hope that it will be useful, but + ;; WITHOUT ANY WARRANTY\; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + ;; General Public License for more details. + ;; " + + " +START_IP_HEADER + +This program is free software: you can redistribute it and/or modify +it under the terms of the version 3 of the GNU General Public License +as published by the Free Software Foundation. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program. If not, see . + +" + (when (boundp 'user-full-name) + (concat "Written by and Copyright (C) " user-full-name "\n")) + + (when (boundp 'user-mail-address) + (concat "Contact <" user-mail-address "> for comments & bug reports\n")) + + " +END_IP_HEADER +" + + ))) + + (goto-char (point-min)) + + ;; If this is a script, put the gpl after the first line + (when (re-search-forward "^#!" nil t) + (beginning-of-line) + (next-line 1)) + + (let ((start (point))) + (insert gpl) + (comment-region start (point))) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/start-c++ () + "Adds the header to start a C++ program." + (interactive) + ;; (beginning-of-buffer) + (insert + " +#include +#include +#include +#include +#include + +using namespace std; + +int main(int argc, char **argv) { + +} +") + (previous-line 2) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/headerize () + "Adds the #define HEADER_H, etc." + (interactive) + (let ((flag-name (replace-regexp-in-string + "[\. \(\)]" "_" + (upcase (file-name-nondirectory (buffer-name)))))) + (goto-char (point-max)) + (insert "\n#endif\n") + (goto-char (point-min)) + (insert (concat "#ifndef " flag-name "\n")) + (insert (concat "#define " flag-name "\n")) + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/start-html () + "Adds all that stuff to start a new HTML file." + (interactive) + (goto-char (point-min)) + (insert " + + + + + + + + + + +") + (goto-char (point-max)) + (insert " + + + +") + (html-mode)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Insert a line showing all the variables written on the current line +;; and separated by commas + +(defun ff/cout-var (arg) + "Invoked on a line with a list of variables names, +it inserts a line which displays their values in cout +(or cerr if the function is invoked with a universal arg)" + (interactive "P") + (let ((line (if arg "cerr" "cout"))) + (goto-char (point-at-bol)) + ;; Regexp syntax sucks moose balls, honnest. To match '[', just + ;; put it as the first char in the [...] ... This leads to some + ;; obvious things like the following + (while (re-search-forward "\\([][a-zA-Z0-9_.:\(\)]+\\)" (point-at-eol) t) + (setq line + (concat line " << \" " + (match-string 1) " = \" << " (match-string 1)))) + (goto-char (point-at-bol)) + (kill-line) + (insert line " << endl\;\n") + (indent-region (point-at-bol 0) (point-at-eol 0) nil) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/clean-article () + "Cleans up an article by removing the leading blanks on each line +and refilling all the paragraphs." + (interactive) + (let ((fill-column 92)) + (goto-char (point-min)) + (while (re-search-forward "^\\ +" nil t) + (replace-match "" nil nil)) + (fill-individual-paragraphs (point-min) (point-max) t))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/start-slide () + (interactive) + (insert "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +\\begin{frame}{") + + (save-excursion (insert "}{} + +\\end{frame} + +")) + ) + +(add-hook 'latex-mode-hook (lambda () + (define-key latex-mode-map + [(meta S)] 'ff/start-slide) + (define-key latex-mode-map + [(control c) (control a)] 'align-current) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/start-test-code () + (interactive) + (let ((start (point))) + (insert " +{ // ******************************* START *************************** +#warning Test code added on " + (format-time-string "%04Y %b %02d %02H:%02M:%02S" (current-time)) + " + +} // ******************************** END **************************** + +") + (indent-region start (point) nil)) + (previous-line 3) + (c-indent-command)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/code-to-html () (interactive) + (save-restriction + (narrow-to-region (region-beginning) (region-end)) + (replace-string "\"" """ nil (point-min) (point-max)) + (replace-string " " " " nil (point-min) (point-max)) + (replace-string ">" ">" nil (point-min) (point-max)) + (replace-string "<" "<" nil (point-min) (point-max)) + (replace-string "\e" "^[" nil (point-min) (point-max)) + (replace-string "" "^?" nil (point-min) (point-max)) + (replace-string "" "^_" nil (point-min) (point-max)) + (replace-regexp "$" "
" nil (point-min) (point-max)) + ) + ) + +(defun ff/downcase-html-tags () (interactive) + (save-excursion + (beginning-of-buffer) + (while (re-search-forward "<\\([^>]+\\)>" nil t) + (downcase-region (match-beginning 1) (match-end 1))) + ) + ) + +;; If we enter html mode and there is no makefile around, create a +;; compilation command with tidy (this is cool stuff) + +(add-hook 'html-mode-hook + (lambda () + (unless (or (not (buffer-file-name)) + (file-exists-p "makefile") + (file-exists-p "Makefile")) + (set (make-local-variable 'compile-command) + (let ((fn (file-name-nondirectory buffer-file-name))) + (format "tidy -utf8 %s > /tmp/%s" fn fn)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/count-words-region (beginning end) + "Print number of words in the region. +Words are defined as at least one word-constituent character +followed by at least one character that is not a +word-constituent. The buffer's syntax table determines which +characters these are." + + (interactive "r") + (message "Counting words in region ... ") + (save-excursion + (goto-char beginning) + (let ((count 0)) + (while (< (point) end) + (re-search-forward "\\w+\\W+") + (setq count (1+ count))) + (cond ((zerop count) (message "The region does NOT have any word.")) + ((= 1 count) (message "The region has 1 word.")) + (t (message "The region has %d words." count)))))) + +;; (add-hook 'html-mode-hook 'flyspell-mode) + +(defun ff/tidy-html () + "Run tidy in on the content of the current buffer, put the result in +a file in /tmp" + (interactive) + (call-process-region (point-min) (point-max) + "/usr/bin/tidy" + nil + (list nil (make-temp-file "/tmp/tidy-html.")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Create the adequate embryo of a file if it does not exist + +(defun ff/start-file () (interactive) + (let ((filename (buffer-file-name))) + (when filename + + (when (string-match "\\.sh$" filename) + (sh-mode) + (insert "#!/bin/bash\n\nset -e\n\n") + (save-excursion + (ff/add-copyrights)) + ) + + (when (string-match "\\.html$" filename) + (html-mode) + (ff/start-html) + (previous-line 4) + ) + + (when (string-match "\\.h$" filename) + (c++-mode) + (ff/headerize) + (save-excursion + (ff/add-copyrights) + (newline)) + (newline) + (newline) + (previous-line 1) + ) + + (when (string-match "\\.cc$" filename) + (c++-mode) + (ff/add-copyrights) + (let ((headername (replace-regexp-in-string "\.cc" ".h" filename))) + (if (file-exists-p headername) + (insert (concat "\n#include \"" (file-name-nondirectory headername) "\"\n")) + (ff/start-c++)) + )) + + (when (string-match "\\.tex$" filename) + (latex-mode) + (ff/start-latex) + )) + ) + (set-buffer-modified-p nil) + ) + +(if (>= emacs-major-version 22) + (add-to-list 'find-file-not-found-functions 'ff/start-file) + (add-to-list 'find-file-not-found-hooks 'ff/start-file)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-key global-map [f8] 'ff-find-other-file) +(define-key global-map [(shift f8)] (lambda () (interactive) (ff-find-other-file t))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Antiword, htmlize and boxquote +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(autoload 'no-word "no-word") +(add-to-list 'auto-mode-alist '("\\.doc\\'" . no-word)) +;; (add-to-list 'auto-mode-alist '("\\.DOC\\'" . no-word)) + +(autoload 'htmlize-buffer "htmlize" nil t) + +(setq boxquote-top-and-tail "------------------") +(autoload 'boxquote-region "boxquote" nil t) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The compilation hacks +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; If we enter c++ mode and there is no makefile around, we create a +;; make command on the fly for the specific object file + +(add-hook 'c++-mode-hook + (lambda () + (unless (or (file-exists-p "makefile") (file-exists-p "Makefile")) + (set (make-local-variable 'compile-command) + (concat + "make -k " + (file-name-sans-extension + (file-name-nondirectory buffer-file-name))))))) + +;; runs the compilation according to the compile-command (and +;; thus does not ask any confirmation), shows the compilation buffer +;; during compilation and delete all windows showing the compilation +;; buffer if the compilation ends with no error + +;; asks for a compilation command and runs the compilation +;; but does not restore the window configuration (i.e. the compilation +;; buffer's window will still be visible, as usual) + +;; goes to the next compilation error (as C-x ` does on the +;; standard configuration) + +(defun ff/restore-windows-if-no-error (buffer msg) + "Delete the windows showing the compilation buffer if msg + matches \"^finished\"." + + (when (string-match "^finished" msg) + ;; (delete-windows-on buffer) + (if (boundp 'ff/window-configuration-before-compilation) + (set-window-configuration ff/window-configuration-before-compilation)) + ) + ) + +(setq compilation-finish-functions (cons 'ff/restore-windows-if-no-error compilation-finish-functions)) + +(defun ff/fast-compile () + "Compiles without asking anything." + (interactive) + (let ((compilation-read-command nil)) + (setq ff/window-configuration-before-compilation (current-window-configuration)) + (compile compile-command))) + +(setq compilation-read-command t + compile-command "make -j -k" + compile-history '("make clean" "make DEBUG=yes -j -k" "make -j -k") + ) + +(defun ff/universal-compile () (interactive) + (funcall (or (cdr (assoc major-mode + '( + (latex-mode . tex-file) + (html-mode . browse-url-of-buffer) + ;; Here you can add other mode -> compile command + ))) + 'ff/fast-compile ;; And this is the failsafe + ))) + +(define-key global-map [f1] 'ff/universal-compile) +(define-key global-map [(shift f1)] 'compile) +(define-key global-map [f2] 'next-error) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Related to mail +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (when (ff/load-or-alert "flyspell-timer" t) +;; (add-hook 'flyspell-mode-hook 'flyspell-timer-ensure-idle-timer)) + +(defun ff/pick-dictionnary () (interactive) + (when (and (boundp 'flyspell-mode) flyspell-mode) + (if (and current-input-method (string-match "latin" current-input-method)) + (ispell-change-dictionary "francais") + (ispell-change-dictionary "american")) + ;; (flyspell-buffer) + ) + ) + +(defadvice toggle-input-method (after ff/switch-dictionnary nil activate) + (ff/pick-dictionnary)) + +;; (add-hook 'message-mode-hook 'auto-fill-mode) +;; (add-hook 'message-mode-hook 'flyspell-mode) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Delete all windows which are in the same "column", which means +;; whose xmin and xmax are bounded by the xmin and xmax of the +;; currently selected column +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; This is from emacs23 ! better than my old ff/delete-other-windows-in-column + +(unless (fboundp 'delete-other-windows-vertically) + + (defun delete-other-windows-vertically (&optional window) + "Delete the windows in the same column with WINDOW, but not WINDOW itself. +This may be a useful alternative binding for \\[delete-other-windows] + if you often split windows horizontally." + (interactive) + (let* ((window (or window (selected-window))) + (edges (window-edges window)) + (w window) delenda) + (while (not (eq (setq w (next-window w 1)) window)) + (let ((e (window-edges w))) + (when (and (= (car e) (car edges)) + (= (caddr e) (caddr edges))) + (push w delenda)))) + (mapc 'delete-window delenda))) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Misc things +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Entropy is cool + +(defun ff/entropy (l) + (apply '+ + (mapcar + (lambda (x) + (if (= x 0.0) 0.0 + (* (- x) (/ (log x) (log 2))))) + l) + ) + ) + +;; Usefull to deal with results in latex files + +(defun ff/round-floats-in-region () (interactive) + (save-restriction + (condition-case nil + (narrow-to-region (region-beginning) (region-end)) + (error (thing-at-point 'word))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "[0-9\.]+" nil t) + (let ((value (string-to-number (buffer-substring (match-beginning 0) (match-end 0))))) + (delete-region (match-beginning 0) (match-end 0)) + (insert (format "%0.2f" value))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Keymaping +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'info nil t) + +(define-key global-map [(shift iso-lefttab)] 'ispell-complete-word) +;; shift-tab going backward is kind of standard +(define-key Info-mode-map [(shift iso-lefttab)] 'Info-prev-reference) + +;; (define-key global-map [(control x) (control a)] 'auto-fill-mode) + +;; Put back my keys, you thief! +(define-key global-map [(home)] 'beginning-of-buffer) +(define-key global-map [(end)] 'end-of-buffer) +;; (define-key global-map [(insertchar)] 'overwrite-mode) +(define-key global-map [(delete)] 'delete-char) + +;; Cool shortcuts to move to the end / beginning of block keen +(define-key global-map [(control right)] 'forward-sexp) +(define-key global-map [(control left)] 'backward-sexp) + +;; Wheel mouse moves up and down 2 lines (and DO NOT BEEP when we are +;; out of the buffer) + +(define-key global-map [mouse-4] + (lambda () (interactive) (condition-case nil (scroll-down 2) (error nil)))) +(define-key global-map [mouse-5] + (lambda () (interactive) (condition-case nil (scroll-up 2) (error nil)))) + +;; with shift it goes faster +(define-key global-map [(shift mouse-4)] + (lambda () (interactive) (condition-case nil (scroll-down 50) (error nil)))) +(define-key global-map [(shift mouse-5)] + (lambda () (interactive) (condition-case nil (scroll-up 50) (error nil)))) + +;; Meta-? shows the properties of the character at point +(define-key global-map [(meta ??)] + (lambda () (interactive) + (message (prin1-to-string (text-properties-at (point)))))) + +;; Compiles the latex file in the current buffer + +(setq tex-start-commands "\\input") +(define-key global-map [f3] 'tex-file) +(define-key global-map [(shift f3)] 'tex-bibtex-file) + +;; To run xdvi on the dvi associated to the .tex in the current +;; buffer, and to edit the .fig or bitmap image used to generate the +;; .eps at point + +(define-key global-map [f4] 'ff/run-viewer) + +;; Closes the current \begin{} + +(add-hook 'latex-mode-hook (lambda () (define-key latex-mode-map [(control end)] 'tex-close-latex-block))) + +(when (ff/load-or-alert "longlines") + + (setq longlines-show-hard-newlines t + longlines-auto-wrap t + longline-show-effect #(" -- |\n" 0 2 (face escape-glyph)) + ) + + ;; (defun ff/auto-longlines () + ;; (when (save-excursion + ;; (goto-char (point-min)) + ;; (re-search-forward "^.\\{81,\\}$" nil t)) + ;; (longlines-mode) + ;; (message "Switched on the lonlines mode automatically") + ;; )) + + ;; (add-hook 'latex-mode-hook 'ff/auto-longlines) + + ) + +(add-hook 'latex-mode-hook + (lambda () + (define-key latex-mode-map [(control tab)] + 'ispell-complete-word))) + +;; Meta-/ remaped (completion) + +(define-key global-map [(shift right)] 'dabbrev-expand) +(define-key global-map [(meta =)] 'dabbrev-expand) + +;; Change the current window. + +(defun ff/next-same-frame-window () (interactive) + (select-window (next-window (selected-window) + (> (minibuffer-depth) 0) + nil))) + +(defun ff/previous-same-frame-window () (interactive) + (select-window (previous-window (selected-window) + (> (minibuffer-depth) 0) + nil))) + +(define-key global-map [(shift prior)] 'ff/next-same-frame-window) +(define-key global-map [(shift next)] 'ff/previous-same-frame-window) + +(define-key global-map [(control })] 'enlarge-window-horizontally) +(define-key global-map [(control {)] 'shrink-window-horizontally) +(define-key global-map [(control \")] 'enlarge-window) +(define-key global-map [(control :)] 'shrink-window) + +;; (define-key global-map [(control shift prior)] 'next-multiframe-window) +;; (define-key global-map [(control shift next)] 'previous-multiframe-window) + +;; I have two screens sometime! + +(define-key global-map [(meta next)] 'other-frame) +(define-key global-map [(meta prior)] (lambda () (interactive) (other-frame -1))) + +(define-key global-map [(shift home)] 'delete-other-windows-vertically) + +;; (define-key global-map [(control +)] 'enlarge-window) +;; (define-key global-map [(control -)] 'shrink-window) + +;; Goes to next/previous buffer + +(define-key global-map [(control prior)] 'ff/next-buffer) +(define-key global-map [(control next)] 'ff/prev-buffer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; If M-. on a symbol, show where it is defined in another window +;; without giving focus, cycle if repeated. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(when (ff/load-or-alert "etags") + + (defun ff/find-tag-nofocus () (interactive) + "Show in another window the definition of the current tag" + (let ((tag (find-tag-default))) + (display-buffer (find-tag-noselect tag (string= tag last-tag))) + (message "Tag %s" tag) + ) + ) + + (define-key global-map [(meta .)] 'ff/find-tag-nofocus) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Destroys the current buffer and its window if it's not the only one +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defcustom ff/kill-this-buffer-and-delete-window-exceptions "" + "*Regexp matching the buffer names which have to be kept when using +`ff/kill-this-buffer-and-delete-window'.") + +(defun ff/kill-this-buffer-and-delete-window (universal) + "Unless its name matches +`ff/kill-this-buffer-and-delete-window-exceptions', kills the +current buffer and deletes the current window if it's not the +only one in the frame. If the buffer has to be kept, go to the +next one. With universal argument, kill all killable buffers." + (interactive "P") + (if universal + (let ((nb-killed 0)) + (mapc (lambda (x) + (unless (string-match ff/kill-this-buffer-and-delete-window-exceptions + (buffer-name x)) + (kill-buffer x) + (setq nb-killed (1+ nb-killed)) + )) + (buffer-list)) + (message "Killed %d buffer%s" nb-killed (if (> nb-killed 1) "s" ""))) + (if (string-match ff/kill-this-buffer-and-delete-window-exceptions (buffer-name)) + (ff/next-buffer) + (kill-this-buffer))) + ;; (unless (one-window-p t) (delete-window)) + ) + +(define-key global-map [(control backspace)] 'ff/kill-this-buffer-and-delete-window) +;; (define-key calc-mode-map [(control backspace)] 'calc-quit) + + +(setq ff/kill-this-buffer-and-delete-window-exceptions + "^ \\|\\*Messages\\*\\|\\*scratch\\*\\|\\*Group\\*\\|\\*-jabber-\\*\\|\\*-jabber-process-\\*\\|\\*media\\*") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Misc stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/elisp-debug-on () + "Switches `debug-on-error' and `debug-on-quit'." + (interactive) + (if debug-on-error + (setq debug-on-error nil + debug-on-quit nil) + (setq debug-on-error t + debug-on-quit t)) + (if debug-on-error + (message "elisp debug on") + (message "elisp debug off"))) + +(defun ff/create-dummy-buffer (&optional universal) (interactive "P") + (find-file (concat "/tmp/" (ff/non-existing-filename "/tmp/" "dummy" ""))) + (text-mode) + (if universal (ff/insert-url (current-kill 0))) + (message "New dummy text-mode buffer")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Recentf to keep a list of recently visited files. I use it +;; exclusively with my selector.el +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'recentf) + +(setq recentf-exclude + (append recentf-exclude + '("enotes$" "secure-notes$" "media-playlists$" + "bbdb$" + "svn-commit.tmp$" ".git/COMMIT_EDITMSG$" + "\.bbl$" "\.aux$" "\.toc$")) + recentf-max-saved-items 1000 + recentf-save-file "~/private/emacs/recentf" + ) + +(when (boundp 'recentf-keep) (add-to-list 'recentf-keep 'file-remote-p)) + +;; Removes the link if we add the file itself (I am fed up with +;; duplicates because of vc-follow-symlinks) + +(defadvice recentf-add-file (before ff/remove-links (filename) activate) + ;; If we are adding a filename corresponding to the last link we + ;; have added, remove the latter + (when (and recentf-list + (file-symlink-p (car recentf-list)) + (string= filename (file-chase-links filename))) + (setq recentf-list (cdr recentf-list)) + )) + +(recentf-mode 1) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; My front-end to mplayer +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (ff/compile-when-needed "media/mplayer") +;; (ff/compile-when-needed "media") + +(when (ff/load-or-alert "media") + + (unless window-system + (ff/configure-faces '( + (media/mode-string-face :foreground "blue4" :weight 'bold) + (media/current-tune-face :foreground "black" :background "yellow" :weight 'normal) + (media/instant-highlight-face :foreground "black" :background "orange" :weight 'normal) + )) + ) + + (define-key global-map [(meta \\)] 'media) + + (setq media/expert t + media/add-current-song-to-interrupted-when-killing t + media/duration-to-history 30 + media/history-size 1000 + media/playlist-file "~/private/emacs/media-playlists" + media/mplayer/args '( + "-framedrop" + "-zoom" + "-subfont-osd-scale" "3" + ;; "-osdlevel" "3" + ) + media/mplayer/timing-request-period 5.0 + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; A dynamic search +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; selector.el is one of my own scripts, check my web page + +(when (ff/load-or-alert "selector" t) + (define-key global-map [(shift return)] 'selector/quick-move-in-buffer) + (define-key global-map [(control x) (control b)] 'selector/switch-buffer) + + (defun ff/visit-debpkg-file (&optional regexp) + "This function lists all the files found with dpkg -S and +proposes to visit them." + (interactive "sPattern: ") + + (selector/select + + (mapcar + (lambda (s) + (cons (selector/filename-to-string s) s)) + (split-string + (shell-command-to-string (concat "dpkg -S " regexp " | awk '{print $2}'")))) + + 'selector/find-file + "*selector find-file*" + )) + ) + +(add-hook 'selector/mode-hook (lambda () (setq truncate-lines t))) + +(defun ff/selector-insert-record-callback (r) + (bbdb-display-records (list r)) + ;; Weird things will happen if you kill the buffer from which you + ;; invoked ff/selector-mail-from-bbdb + (insert (car (elt r 6))) + ) + +(defun ff/selector-compose-mail-callback (r) + (vm-compose-mail (car (elt r 6))) + ) + +(defun ff/selector-mail-from-bbdb () (interactive) + (selector/select + (mapcar + (lambda (r) (cons (concat (elt r 0) + " " + (elt r 1) + " (" + (car (elt r 6)) + ")") + r)) + (bbdb-records)) + (if (string= mode-name "Mail") + 'ff/selector-insert-record-callback + 'ff/selector-compose-mail-callback) + "*bbdb-search*" + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; A function to remove temporary alarm windows +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defcustom ff/annoying-windows-regexp + "\\*Messages\\*\\|\\*compilation\\*\\|\\*tex-shell\\*\\|\\*Help\\*\\|\\*info\\*\\|\\*Apropos\\*\\|\\*BBDB\\*\\|\\*.*-diff\\*" + "The regexp matching the windows to be deleted by `ff/delete-annoying-windows'" + ) + +(defun ff/delete-annoying-windows () + "Close all the windows showing buffers whose names match +`ff/annoying-windows-regexp'." + (interactive) + (when ff/annoying-windows-regexp + (mapc (lambda (w) + (when (and (not (one-window-p w)) + (string-match ff/annoying-windows-regexp + (buffer-name (window-buffer w)))) + (delete-window w))) + (window-list) + ) + (message "Removed annoying windows") + ) + ) + +(setq ff/annoying-windows-regexp + (concat ff/annoying-windows-regexp + "\\|\\*unspooled mails\\*\\|\\*enotes alarms\\*\\|\\*system info\\*")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Some handy functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun ff/twin-horizontal-current-buffer () (interactive) + (delete-other-windows) + (split-window-horizontally) + (balance-windows) + ) + +(defun ff/twin-vertical-current-buffer () (interactive) + (delete-other-windows) + (split-window-vertically) + (balance-windows) + ) + +(defun ff/flyspell-mode (arg) (interactive "p") + (flyspell-mode) + (when flyspell-mode (flyspell-buffer))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; My own keymap +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(setq ff/map (make-sparse-keymap)) +(define-key global-map [(control \`)] ff/map) +(define-key esc-map "`" ff/map) + +(defun ff/git-status (&optional dir) (interactive) + (if (buffer-file-name) + (git-status (file-name-directory (buffer-file-name))) + (error "No file attached to this buffer"))) + +(define-key ff/map [(control g)] 'ff/git-status) +(define-key ff/map [(control w)] 'server-edit) +(define-key ff/map [(control d)] 'ff/elisp-debug-on) +(define-key ff/map [(control \`)] 'ff/bash-new-buffer) +(define-key ff/map [(control n)] 'enotes/show-all-notes) +(define-key ff/map [(control s)] 'ff/secure-note-add) +(define-key ff/map [(control t)] 'ff/start-test-code) +(define-key ff/map [(control q)] 'ff/create-dummy-buffer) +(define-key ff/map [(control a)] 'auto-fill-mode) +(define-key ff/map [(control i)] 'ff/system-info) +(define-key ff/map "w" 'ff/word-occurences) +(define-key ff/map [(control c)] 'calendar) +;; (define-key ff/map [(control c)] (lambda () (interactive) (save-excursion (calendar)))) +(define-key ff/map [(control l)] 'goto-line) +(define-key ff/map [(control o)] 'selector/quick-pick-recent) +(define-key ff/map "s" 'selector/quick-move-in-buffer) +(define-key ff/map "S" 'selector/search-sentence) +(define-key ff/map "h" 'ff/tidy-html) +(define-key ff/map "c" 'ff/count-char) +(define-key ff/map [(control p)] 'ff/print-to-file) +(define-key ff/map "P" 'ff/print-to-printer) +(define-key ff/map [(control b)] 'bbdb) +(define-key ff/map "m" 'ff/selector-mail-from-bbdb) +(define-key ff/map [(control m)] 'woman) +(define-key ff/map "b" 'bookmark-jump) +(define-key ff/map [(control =)] 'calc) +(define-key ff/map [(control shift b)] + (lambda () (interactive) + (bookmark-set) + (bookmark-save))) +(define-key ff/map [(control f)] 'ff/flyspell-mode) + +(define-key ff/map [?\C-0] 'ff/delete-annoying-windows) +(define-key ff/map "1" 'delete-other-windows) +(define-key ff/map [?\C-1] 'delete-other-windows) +(define-key ff/map "2" 'ff/twin-vertical-current-buffer) +(define-key ff/map [?\C-2] 'ff/twin-vertical-current-buffer) +(define-key ff/map "3" 'ff/twin-horizontal-current-buffer) +(define-key ff/map [?\C-3] 'ff/twin-horizontal-current-buffer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Hacks so that all keys are functionnal in xterm and through ssh. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(unless window-system + + ;; One day I will understand these clipboard business. Until then, + ;; so that it works in xterm (yes), let's use xclip. This is a bit + ;; ugly. + + (defun ff/yank-with-xclip (&optional arg) + "Paste the content of the X clipboard with the xclip +command. Without ARG converts some of the '\\uxxxx' characters." + (interactive "P") + (with-temp-buffer + (shell-command "xclip -o" t) + (unless arg + (mapc (lambda (x) (replace-string (concat "\\u" (car x)) (cdr x) nil (point-min) (point-max))) + '(("fffd" . "??") + ("2013" . "-") + ("2014" . "--") + ("2018" . "`") + ("2019" . "'") + ("201c" . "``") + ("201d" . "''") + ("2022" . "*") + ("2026" . "...") + ("20ac" . "EUR") + ))) + (kill-ring-save (point-min) (point-max))) + + (yank)) + + (define-key global-map [(meta y)] 'ff/yank-with-xclip) + + ;; (set-terminal-coding-system 'iso-latin-1) + ;; (set-terminal-coding-system 'utf-8) + + ;; I have in my .Xressource + + ;; XTerm.VT100.translations: #override\n\ + ;; ,:scroll-back(2,line)\n\ + ;; ,:scroll-forw(2,line)\n\ + ;; Ctrl,Ctrl:scroll-back(1,page)\n\ + ;; Ctrl,Ctrl:scroll-forw(1,page)\n\ + ;; Shift,Shift:scroll-back(1,halfpage)\n\ + ;; Shift,Shift:scroll-forw(1,halfpage)\n\ + ;; Alt:insert-eight-bit()\n\ + ;; !ShiftBackSpace: string("")\n\ + ;; CtrlBackSpace: string("\eOZ")\n\ + ;; ShiftPrior: string("\e[5;2~")\n\ + ;; ShiftNext: string("\e[6;2~")\n\ + ;; Shift Ctrl]: string("\eO}")\n\ + ;; Shift Ctrl[: string("\eO{")\n\ + ;; Shift Ctrl/: string("\eO?")\n\ + ;; Ctrl/: string("\eO/")\n\ + ;; Shift Ctrl=: string("\eO+")\n\ + ;; Ctrl=: string("\eO=")\n\ + ;; Shift Ctrl;: string("\eO:")\n\ + ;; Ctrl;: string("\eO;")\n\ + ;; Shift Ctrl`: string("\eO~")\n\ + ;; Ctrl`: string("\eO`")\n\ + ;; Shift Ctrl': string("\eO\\\"")\n\ + ;; Ctrl': string("\eO'")\n\ + ;; Shift Ctrl.: string("\eO>")\n\ + ;; Ctrl.: string("\eO.")\n\ + ;; Shift Ctrl\\,: string("\eO<")\n\ + ;; Ctrl\\,: string("\eO,") + + (define-key function-key-map "\e[2~" [insert]) + + (define-key function-key-map "\e[Z" [S-iso-lefttab]) + + (define-key function-key-map "\e[1;2A" [S-up]) + (define-key function-key-map "\e[1;2B" [S-down]) + (define-key function-key-map "\e[1;2C" [S-right]) + (define-key function-key-map "\e[1;2D" [S-left]) + (define-key function-key-map "\e[1;2F" [S-end]) + (define-key function-key-map "\e[1;2H" [S-home]) + + (define-key function-key-map "\e[2;2~" [S-insert]) + (define-key function-key-map "\e[5;2~" [S-prior]) + (define-key function-key-map "\e[6;2~" [S-next]) + + (define-key function-key-map "\e[1;2P" [S-f1]) + (define-key function-key-map "\e[1;2Q" [S-f2]) + (define-key function-key-map "\e[1;2R" [S-f3]) + (define-key function-key-map "\e[1;2S" [S-f4]) + (define-key function-key-map "\e[15;2~" [S-f5]) + (define-key function-key-map "\e[17;2~" [S-f6]) + (define-key function-key-map "\e[18;2~" [S-f7]) + (define-key function-key-map "\e[19;2~" [S-f8]) + (define-key function-key-map "\e[20;2~" [S-f9]) + (define-key function-key-map "\e[21;2~" [S-f10]) + + (define-key function-key-map "\e[1;5A" [C-up]) + (define-key function-key-map "\e[1;5B" [C-down]) + (define-key function-key-map "\e[1;5C" [C-right]) + (define-key function-key-map "\e[1;5D" [C-left]) + (define-key function-key-map "\e[1;5F" [C-end]) + (define-key function-key-map "\e[1;5H" [C-home]) + + (define-key function-key-map "\e[2;5~" [C-insert]) + (define-key function-key-map "\e[5;5~" [C-prior]) + (define-key function-key-map "\e[6;5~" [C-next]) + + (define-key function-key-map "\e[1;9A" [M-up]) + (define-key function-key-map "\e[1;9B" [M-down]) + (define-key function-key-map "\e[1;9C" [M-right]) + (define-key function-key-map "\e[1;9D" [M-left]) + (define-key function-key-map "\e[1;9F" [M-end]) + (define-key function-key-map "\e[1;9H" [M-home]) + + (define-key function-key-map "\e[2;9~" [M-insert]) + (define-key function-key-map "\e[5;9~" [M-prior]) + (define-key function-key-map "\e[6;9~" [M-next]) + + ;; The following ones are not standard + + (define-key function-key-map "\eO}" (kbd "C-}")) + (define-key function-key-map "\eO{" (kbd "C-{")) + (define-key function-key-map "\eO?" (kbd "C-?")) + (define-key function-key-map "\eO/" (kbd "C-/")) + (define-key function-key-map "\eO:" (kbd "C-:")) + (define-key function-key-map "\eO;" (kbd "C-;")) + (define-key function-key-map "\eO~" (kbd "C-~")) + (define-key function-key-map "\eO`" (kbd "C-\`")) + (define-key function-key-map "\eO\"" (kbd "C-\"")) + (define-key function-key-map "\eO|" (kbd "C-|")) + (define-key function-key-map "\eO'" (kbd "C-'")) + (define-key function-key-map "\eO>" (kbd "C->")) + (define-key function-key-map "\eO." (kbd "C-.")) + (define-key function-key-map "\eO<" (kbd "C-<")) + (define-key function-key-map "\eO," (kbd "C-,")) + (define-key function-key-map "\eO-" (kbd "C--")) + (define-key function-key-map "\eO=" (kbd "C-=")) + (define-key function-key-map "\eO+" (kbd "C-+")) + + (define-key function-key-map "\eOZ" [C-backspace]) + + (define-key minibuffer-local-map "" 'previous-history-element) + (define-key minibuffer-local-map "" 'next-history-element) + + ;; (define-key global-map [(alt prior)] 'ff/prev-buffer) + ;; (define-key global-map [(alt next)] 'ff/next-buffer) + + ) + +;; I am fed up with Alt-Backspace in the minibuffer erasing the +;; content of the kill-ring + +(defun ff/backward-delete-word (arg) + "Delete characters forward until encountering the end of a word, but do not put them in the kill ring. +With argument ARG, do this that many times." + (interactive "p") + (delete-region (point) (progn (forward-word (- arg)) (point)))) + +(define-key minibuffer-local-map + [remap backward-kill-word] 'ff/backward-delete-word) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Privacy +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Where to save the bookmarks and where is bbdb + +(setq bookmark-default-file "~/private/emacs/bmk" + bbdb-file "~/private/bbdb" + custom-file "~/private/emacs/custom") + +;; enotes.el is one of my own scripts, check my web page + +(when (ff/load-or-alert "enotes" t) + (setq enotes/file "~/private/enotes" + enotes/show-help nil + enotes/full-display nil) + (enotes/init) + ;; (add-hook 'enotes/alarm-hook + ;; (lambda () (ff/play-sound-async "~/local/sounds/three_notes2.wav"))) + ) + +;; (when (ff/load-or-alert "goto-last-change.el") +;; (define-key global-map [(control x) (control a)] 'goto-last-change)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; My private stuff (email adresses, mail filters, etc.) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(ff/load-or-alert "~/private/emacs.perso.el" t) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; emacs server +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Runs in server mode, so that emacsclient works +(server-start) + +(defun ff/raise-frame-and-give-focus () + (when window-system + (raise-frame) + (x-focus-frame (selected-frame)) + (set-mouse-pixel-position (selected-frame) 4 4) + )) + +;; Raises the window when the server is invoked + +(add-hook 'server-switch-hook 'ff/raise-frame-and-give-focus)