more. always more
authorJoerg Jaspert <joerg@debian.org>
Wed, 1 May 2013 22:06:45 +0000 (00:06 +0200)
committerJoerg Jaspert <joerg@debian.org>
Wed, 1 May 2013 22:06:45 +0000 (00:06 +0200)
.emacs.d/config/emacs.org
.emacs.d/elisp/local/color-theme.el [new file with mode: 0755]
.emacs.d/elisp/local/diminish.el [new file with mode: 0644]
.emacs.d/elisp/local/filladapt.el [new file with mode: 0644]
.emacs.d/elisp/local/ganneff.el
.emacs.d/elisp/local/region-bindings-mode.el [new file with mode: 0644]

index eb91076..94c9c96 100644 (file)
@@ -173,26 +173,26 @@ them first.
 safe-load does not break emacs initialization, should a file be
 unreadable while emacs boots up.
 #+BEGIN_SRC emacs-lisp
-  (defvar safe-load-error-list ""
-          "*List of files that reported errors when loaded via safe-load")
-
-  (defun safe-load (file &optional noerror nomessage nosuffix)
-    "Load a file.  If error on load, report back, wait for
-     a key stroke then continue on"
-    (interactive "f")
-    (condition-case nil (load file noerror nomessage nosuffix)
-      (error
-        (progn
-         (setq safe-load-error-list  (concat safe-load-error-list  " " file))
-         (message "****** [Return to continue] Error loading %s" safe-load-error-list )
-          (sleep-for 1)
-         nil))))
-
-  (defun safe-load-check ()
  "Check for any previous safe-load loading errors.  (safe-load.el)"
-    (interactive)
-    (if (string-equal safe-load-error-list "") ()
-                 (message (concat "****** error loading: " safe-load-error-list))))
+(defvar safe-load-error-list ""
+        "*List of files that reported errors when loaded via safe-load")
+
+(defun safe-load (file &optional noerror nomessage nosuffix)
+  "Load a file.  If error on load, report back, wait for
+   a key stroke then continue on"
+  (interactive "f")
+  (condition-case nil (load file noerror nomessage nosuffix)
+    (error
+      (progn
+       (setq safe-load-error-list  (concat safe-load-error-list  " " file))
+       (message "****** [Return to continue] Error loading %s" safe-load-error-list )
+        (sleep-for 1)
+       nil))))
+
+(defun safe-load-check ()
+ "Check for any previous safe-load loading errors.  (safe-load.el)"
+  (interactive)
+  (if (string-equal safe-load-error-list "") ()
+               (message (concat "****** error loading: " safe-load-error-list))))
 #+END_SRC
 
 match-paren will either jump to the "other" paren or simply insert %
@@ -286,10 +286,9 @@ I dislike the startup message
 
 Usually I want the lines to break at 72 characters.
 #+BEGIN_SRC emacs-lisp
-  (if (> emacs-major-version 22
-         )
-      (setq fill-column 72)
-    (setq default-fill-column 72))
+(if (> emacs-major-version 22)
+    (setq fill-column 72)
+  (setq default-fill-column 72))
 #+END_SRC
 
 And it is nice to have a final newline in files.
@@ -377,22 +376,12 @@ Make the fringe (gutter) smaller, the argument is a width in pixels (the default
 #+END_SRC
 
 *** Menu, Tool and Scrollbar
-I don't want to see the menu-bar, …
-#+BEGIN_SRC emacs-lisp
-  (when window-system
-      (menu-bar-mode -1))
-#+END_SRC
-
-… and I dislike the tool-bar, …
+I don't want to see the menu-bar, tool-bar or scrollbar.
 #+BEGIN_SRC emacs-lisp
-  (when window-system
-      (tool-bar-mode -1))
-#+END_SRC
-
-… and don't you start with a scrollbar.
-#+BEGIN_SRC emacs-lisp
-(if (fboundp 'scroll-bar-mode)
-    (scroll-bar-mode nil))
+(when window-system
+  (menu-bar-mode -1)
+  (tool-bar-mode -1)
+  (set-scroll-bar-mode nil))
 #+END_SRC
 **** When using emacs in daemon mode
 Emacs has a very nice mode where it detaches itself and runs as daemon -
@@ -435,21 +424,21 @@ And modeline-posn is great. It will hilight the column number in the
 modeline in red as soon as you are over the defined limit.
 
 #+BEGIN_SRC emacs-lisp
-  (line-number-mode 1)
-  (column-number-mode 1)
-  (size-indication-mode 1)
-  (display-time-mode 1)
-  (setq display-time-day-and-date nil)
-  (setq display-time-24hr-format t)
-  (setq modelinepos-column-limit 72)
+(line-number-mode 1)
+(column-number-mode 1)
+(size-indication-mode 1)
+(display-time-mode 1)
+(setq display-time-day-and-date nil)
+(setq display-time-24hr-format t)
+(setq modelinepos-column-limit 72)
 
-  (require 'modeline-posn)
-  (set-face-foreground 'mode-line "grey20")
-  (set-face-background 'mode-line "grey70")
-  (set-face-foreground 'modeline-inactive "grey20")
-  (set-face-background 'modeline-inactive "grey40")
-  (set-face-foreground 'modelinepos-column-warning "grey20")
-  (set-face-background 'modelinepos-column-warning "red")
+(require 'modeline-posn)
+(set-face-foreground 'mode-line "grey20")
+(set-face-background 'mode-line "grey70")
+(set-face-foreground 'modeline-inactive "grey20")
+(set-face-background 'modeline-inactive "grey40")
+(set-face-foreground 'modelinepos-column-warning "grey20")
+(set-face-background 'modelinepos-column-warning "red")
 #+END_SRC
 **** diminish
 [2013-04-22 Mon 11:27]
@@ -459,40 +448,40 @@ to get entirely rid of some modes, the other is a function taken from
 "Mastering Emacs" which replaces the modes text with an own (set of)
 character(s).
 #+BEGIN_SRC emacs-lisp
-    (require 'diminish)
-    (diminish 'auto-fill-function)
-    (eval-after-load "filladapt" '(diminish 'filladapt-mode))
-    (defvar mode-line-cleaner-alist
-      `((auto-complete-mode . " α")
-        (yas/minor-mode . " υ")
-        (paredit-mode . " π")
-        (eldoc-mode . "")
-        (abbrev-mode . "")
-        ;; Major modes
-        (lisp-interaction-mode . "λ")
-        (hi-lock-mode . "")
-        (python-mode . "Py")
-        (emacs-lisp-mode . "EL")
-        (org-mode . "Ω")
-        (org-indent-mode . "")
-        (sh-mode . " Σ")
-        (nxhtml-mode . "nx"))
-      "Alist for `clean-mode-line'.
-
-    When you add a new element to the alist, keep in mind that you
-    must pass the correct minor/major mode symbol and a string you
-    want to use in the modeline *in lieu of* the original.
-
-    Want some symbols? Go:
-
-    ;ςερτζθιοπασδφγηξκλυχψωβνμ
-    :ΣΕΡΤΖΘΙΟΠΑΣΔΦΓΗΞΚΛΥΧΨΩΒΝΜ
-    @ł€¶ŧ←↓→øþ¨~æſðđŋħ̣ĸł˝^`|»«¢„“”µ·…
-    ☃⌕☥
+  (require 'diminish)
+  (diminish 'auto-fill-function)
+  (defvar mode-line-cleaner-alist
+    `((auto-complete-mode . " α")
+      (yas-minor-mode . " y")
+      (paredit-mode . " π")
+      (eldoc-mode . "")
+      (abbrev-mode . "")
+      ;; Major modes
+      (lisp-interaction-mode . "λ")
+      (hi-lock-mode . "")
+      (python-mode . "Py")
+      (emacs-lisp-mode . "EL")
+      (org-mode . "Ω")
+      (org-indent-mode . "")
+      (sh-mode . " Σ")
+      (nxhtml-mode . "nx"))
+    
+    "Alist for `clean-mode-line'.
+  
+  When you add a new element to the alist, keep in mind that you
+  must pass the correct minor/major mode symbol and a string you
+  want to use in the modeline *in lieu of* the original.
+  
+  Want some symbols? Go:
+  
+  ;ςερτζθιοπασδφγηξκλυχψωβνμ
+  :ΣΕΡΤΖΘΙΟΠΑΣΔΦΓΗΞΚΛΥΧΨΩΒΝΜ
+  @ł€¶ŧ←↓→øþ¨~æſðđŋħ̣ĸł˝^`|»«¢„“”µ·…
+  ☃⌕☥
   ")
-
-    (add-hook 'after-change-major-mode-hook 'clean-mode-line)
-
+  
+  (add-hook 'after-change-major-mode-hook 'clean-mode-line)
+  
 #+END_SRC
 Unfortunately icicles breaks this with the way it adds/removes itself,
 so take it our for now...
@@ -513,19 +502,18 @@ read in emacs.
 [2013-04-23 Tue 16:43]
 Shell. zsh in my case.
 #+BEGIN_SRC emacs-lisp
-  (setq shell-file-name "zsh")
-  (setq shell-command-switch "-c")
-  (setq explicit-shell-file-name shell-file-name)
-  (setenv "SHELL" shell-file-name)
-  (setq explicit-sh-args '("-login" "-i"))
-  (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
-  (setq comint-scroll-to-bottom-on-input t)  ; always insert at the bottom
-  (setq comint-scroll-to-bottom-on-output t) ; always add output at the bottom
-  (setq comint-scroll-show-maximum-output t) ; scroll to show max possible output
-  (setq comint-completion-autolist t)        ; show completion list when ambiguous
-  (setq comint-input-ignoredups t)           ; no duplicates in command history
-  (setq comint-completion-addsuffix t)       ; insert space/slash after file completion
-
+(setq shell-file-name "zsh")
+(setq shell-command-switch "-c")
+(setq explicit-shell-file-name shell-file-name)
+(setenv "SHELL" shell-file-name)
+(setq explicit-sh-args '("-login" "-i"))
+(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
+(setq comint-scroll-to-bottom-on-input t)  ; always insert at the bottom
+(setq comint-scroll-to-bottom-on-output t) ; always add output at the bottom
+(setq comint-scroll-show-maximum-output t) ; scroll to show max possible output
+(setq comint-completion-autolist t)        ; show completion list when ambiguous
+(setq comint-input-ignoredups t)           ; no duplicates in command history
+(setq comint-completion-addsuffix t)       ; insert space/slash after file completion
 #+END_SRC
 
 *** Emacs shell
@@ -618,9 +606,8 @@ hilighting them makes it obvious where they are.
 While many editors allow you to close "all the other files, not the one
 you are in", emacs doesn't have this... Except, now it will.
 #+BEGIN_SRC emacs-lisp
-(require 'dash)
-(global-set-key (kbd "C-c k") 'prelude-kill-other-buffers)
-
+  
+  (global-set-key (kbd "C-c k") 'prelude-kill-other-buffers)
 #+END_SRC
 *** Scrolling
 Default scrolling behaviour in emacs is a bit annoying, who wants to
@@ -639,9 +626,6 @@ The default how emacs handles cutting/pasting with the primary selection
 changed in emacs24. I am used to the old way, so get it back.
 #+BEGIN_SRC emacs-lisp
 (setq x-select-enable-primary t)
-#+END_SRC
-
-#+BEGIN_SRC emacs-lisp
 (setq x-select-enable-clipboard t        ;; copy-paste should work ...
   interprogram-paste-function            ;; ...with...
   'x-cut-buffer-or-selection-value)      ;; ...other X clients
@@ -723,7 +707,7 @@ Regexes are too useful, so use the regex search by default.
 
 Rgrep is infinitely useful in multi-file projects.
 #+begin_src emacs-lisp
-  (define-key global-map "\C-x\C-g" 'rgrep)
+(define-key global-map "\C-x\C-g" 'rgrep)
 #+end_src
 
 Easy way to move a line up - or down. Simpler than dealing with C-x C-t
@@ -743,7 +727,7 @@ AKA transpose lines.
 
 When I press Enter I almost always want to go to the right indentation on the next line.
 #+BEGIN_SRC emacs-lisp
-  (global-set-key (kbd "RET") 'newline-and-indent)
+(global-set-key (kbd "RET") 'newline-and-indent)
 #+END_SRC
 
 Easier undo, and i don't need suspend-frame
@@ -760,7 +744,7 @@ Window switching, go backwards. (C-x o goes to the next window)
 
 Edit file as root
 #+BEGIN_SRC emacs-lisp
-  (global-set-key (kbd "C-x C-r") 'prelude-sudo-edit)
+(global-set-key (kbd "C-x C-r") 'prelude-sudo-edit)
 #+END_SRC
 
 M-space is bound to just-one-space, which is great for programming. What
@@ -775,12 +759,12 @@ not, bad Emacs.
 **** ace-jump-mode
 [2013-04-28 So 11:26]
 #+BEGIN_SRC emacs-lisp
-  (autoload 'ace-jump-mode "ace-jump-mode" "Emacs quick move minor mode" t)
-  (define-key global-map (kbd "C-c SPC") 'ace-jump-mode)
-  ;; enable a more powerful jump back function from ace jump mode
-  (autoload 'ace-jump-mode-pop-mark "ace-jump-mode" "Ace jump back :-)" t)
-  (eval-after-load "ace-jump-mode" '(ace-jump-mode-enable-mark-sync))
-  (define-key global-map (kbd "C-c C-SPC") 'ace-jump-mode-pop-mark)
+(autoload 'ace-jump-mode "ace-jump-mode" "Emacs quick move minor mode" t)
+(define-key global-map (kbd "H-SPC") 'ace-jump-mode)
+;; enable a more powerful jump back function from ace jump mode
+(autoload 'ace-jump-mode-pop-mark "ace-jump-mode" "Ace jump back :-)" t)
+(eval-after-load "ace-jump-mode" '(ace-jump-mode-enable-mark-sync))
+(define-key global-map (kbd "H-c SPC") 'ace-jump-mode-pop-mark)
 #+END_SRC
 **** Overwrite mode
 Usually you can press the *Ins*ert key, to get into overwrite mode. I
@@ -884,19 +868,6 @@ From https://raw.github.com/qdot/conf_emacs/master/emacs_conf.org
 (add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p)
 #+END_SRC
 
-*** Registers
-One can use registers for a whole shitload of things, from storing
-strings, numbers, rectangles, pathes, configurations and markers. So one
-can use them for easy access for stuff, like a file you want to open
-lotsa times, things you type often, whatever.
-
-See [[http://www.emacswiki.org/emacs/Registers][EmacsWiki: Registers]] and/or [[http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html][Registers - GNU Emacs Manual]]
-
-#+BEGIN_SRC emacs-lisp
-;;**** C-x r j e opens .emacs
-(set-register ?e '(file . "~/dotfiles/.emacs"))
-#+END_SRC
-
 *** Emacs Server
 #+BEGIN_SRC emacs-lisp
 (server-start)
@@ -942,6 +913,15 @@ configuration.
 (add-to-list 'interpreter-mode-alist '("python" . python-mode))
 #+END_SRC
 
+** Region bindings mode
+[2013-05-01 Wed 22:51]
+This mode allows to have keybindings that are only alive when the
+region is active. Helpful for things that only do any useful action
+then, like for example the [[*multiple%20cursors][multiple cursors]] mode I load later.
+#+BEGIN_SRC emacs-lisp
+(require 'region-bindings-mode)
+(region-bindings-mode-enable)
+#+END_SRC
 ** tramp
 Transparent Remote (file) Access, Multiple Protocol, remote file editing.
 #+BEGIN_SRC emacs-lisp
@@ -1003,11 +983,11 @@ We want some extra key bindings loaded. In case we haven't loaded dired
 yet, there won't be a keymap to add to, so add our setup function to the
 load hook only. Otherwise just bind the keys.
 #+BEGIN_SRC emacs-lisp
-  (if (boundp 'dired-mode-map)
-      ;; we're good to go; just add our bindings
-      (my-dired-init)
-    ;; it's not loaded yet, so add our bindings to the load-hook
-    (add-hook 'dired-load-hook 'my-dired-init))
+(if (boundp 'dired-mode-map)
+    ;; we're good to go; just add our bindings
+    (my-dired-init)
+  ;; it's not loaded yet, so add our bindings to the load-hook
+  (add-hook 'dired-load-hook 'my-dired-init))
 #+END_SRC
 
 A few settings
@@ -1023,10 +1003,16 @@ wdired
 #+BEGIN_SRC emacs-lisp
 (setq wdired-allow-to-change-permissions t)
 #+END_SRC
+** filladapt
+[2013-05-02 Thu 00:04]
+#+BEGIN_SRC emacs-lisp
+(require 'filladapt)
+(eval-after-load "filladapt" '(diminish 'filladapt-mode))
+(setq-default filladapt-mode t)
+#+END_SRC
 ** icicles
 [[http://article.gmane.org/gmane.emacs.orgmode/4574/match%3Dicicles][“In case you never heard of it, Icicles is to ‘TAB’ completion what
 ‘TAB’ completion is to typing things manually every time.”]]
-
 #+BEGIN_SRC emacs-lisp
 (require 'icicles)
 (icy-mode 1)
@@ -1074,7 +1060,6 @@ By default, Emacs can update the time stamp for the following two
 formats if one exists in the first 8 lines of the file.
 - Time-stamp: <>
 - Time-stamp: " "
-
 #+BEGIN_SRC emacs-lisp
 (require 'time-stamp)
 (setq time-stamp-active t)
@@ -2144,11 +2129,14 @@ like it move it into my own space. My elpa subdir stays empty.
 Use multiple cursors mode. See [[http://emacsrocks.com/e13.html][Emacs Rocks! multiple cursors]] and
 [[https://github.com/emacsmirror/multiple-cursors][emacsmirror/multiple-cursors · GitHub]]
 #+BEGIN_SRC emacs-lisp
-(use-package multiple-cursors
-  :bind
-   (("C->" . mc/mark-next-like-this)
-    ("C-<" . mc/mark-previous-like-this)
-    ("C-*" . mc/mark-all-like-this)))
+  (require 'multiple-cursors)
+  (define-key region-bindings-mode-map "a" 'mc/mark-all-like-this)
+  
+  (define-key region-bindings-mode-map "p" 'mc/mark-previous-like-this)
+  (define-key region-bindings-mode-map "n" 'mc/mark-next-like-this)
+  (define-key region-bindings-mode-map "l" 'mc/edit-lines)
+  (define-key region-bindings-mode-map "m" 'mc/mark-more-like-this-extended)
+  (setq mc/list-file (expand-file-name "mc-cache.el" jj-cache-dir))
 #+END_SRC
 ** rainbow-delimiters
 [2013-04-09 Di 23:38]
diff --git a/.emacs.d/elisp/local/color-theme.el b/.emacs.d/elisp/local/color-theme.el
new file mode 100755 (executable)
index 0000000..36baf67
--- /dev/null
@@ -0,0 +1,1671 @@
+;;; color-theme.el --- install color themes
+
+;; Copyright (C) 1999, 2000  Jonadab the Unsightly One <jonadab@bright.net>
+;; Copyright (C) 2000, 2001, 2002, 2003  Alex Schroeder <alex@gnu.org>
+;; Copyright (C) 2003, 2004, 2005, 2006  Xavier Maillard <zedek@gnu.org>
+
+;; Version: 6.6.0
+;; Keywords: faces
+;; Author: Jonadab the Unsightly One <jonadab@bright.net>
+;; Maintainer: Xavier Maillard <zedek@gnu.org>
+;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ColorTheme
+
+;; This file is not (YET) part of GNU Emacs.
+
+;; This 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 2, or (at your option) any later
+;; version.
+;;
+;; This 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Please read README and BUGS files for any relevant help.
+;; Contributors (not themers) should also read HACKING file.
+
+;;; Thanks
+
+;; Deepak Goel  <deego@glue.umd.edu>
+;; S. Pokrovsky <pok@nbsp.nsk.su> for ideas and discussion.
+;; Gordon Messmer <gordon@dragonsdawn.net> for ideas and discussion.
+;; Sriram Karra <karra@cs.utah.edu> for the color-theme-submit stuff.
+;; Olgierd `Kingsajz' Ziolko <kingsajz@rpg.pl> for the spec-filter idea.
+;; Brian Palmer for color-theme-library ideas and code
+;; All the users that contributed their color themes.
+
+\f
+
+;;; Code:
+(eval-when-compile
+  (require 'easymenu)
+  (require 'reporter)
+  (require 'sendmail))
+
+(require 'cl); set-difference is a function...
+
+;; for custom-face-attributes-get or face-custom-attributes-get
+(require 'cus-face)
+(require 'wid-edit); for widget-apply stuff in cus-face.el
+
+(defconst color-theme-maintainer-address "zedek@gnu.org"
+  "Address used by `submit-color-theme'.")
+
+;; Emacs / XEmacs compatibility and workaround layer
+
+(cond ((and (facep 'tool-bar)
+           (not (facep 'toolbar)))
+       (put 'toolbar 'face-alias 'tool-bar))
+      ((and (facep 'toolbar)
+           (not (facep 'tool-bar)))
+       (put 'tool-bar 'face-alias 'toolbar)))
+
+(defvar color-theme-xemacs-p (and (featurep 'xemacs) 
+                                  (string-match "XEmacs" emacs-version))
+  "Non-nil if running XEmacs.")
+
+;; Add this since it appears to miss in emacs-2x
+(if (fboundp 'replace-in-string)
+    (defalias 'color-theme-replace-in-string 'replace-in-string)
+  (defsubst color-theme-replace-in-string (target old new &optional literal)
+    (replace-regexp-in-string old new target nil literal)))
+
+;; face-attr-construct has a problem in Emacs 20.7 and older when
+;; dealing with inverse-video faces.  Here is a short test to check
+;; wether you are affected.
+
+;; (set-background-color "wheat")
+;; (set-foreground-color "black")
+;; (setq a (make-face 'a-face))
+;; (face-spec-set a '((t (:background "white" :foreground "black" :inverse-video t))))
+;; (face-attr-construct a)
+;;     => (:background "black" :inverse-video t)
+
+;; The expected response is the original specification:
+;;     => (:background "white" :foreground "black" :inverse-video t)
+
+;; That's why we depend on cus-face.el functionality.
+
+(cond ((fboundp 'custom-face-attributes-get)
+       (defun color-theme-face-attr-construct (face frame)
+         (if (atom face)
+             (custom-face-attributes-get face frame)
+             (if (and (consp face) (eq (car face) 'quote))
+                 (custom-face-attributes-get (cadr face) frame)
+                 (custom-face-attributes-get (car face) frame)))))
+      ((fboundp 'face-custom-attributes-get)
+       (defalias 'color-theme-face-attr-construct
+        'face-custom-attributes-get))
+      (t
+       (defun color-theme-face-attr-construct (&rest ignore)
+        (error "Unable to construct face attributes"))))
+
+(defun color-theme-alist (plist)
+  "Transform PLIST into an alist if it is a plist and return it.
+If the first element of PLIST is a cons cell, we just return PLIST,
+assuming PLIST to be an alist.  If the first element of plist is not a
+symbol, this is an error: We cannot distinguish a plist from an ordinary
+list, but a list that doesn't start with a symbol is certainly no plist
+and no alist.
+
+This is used to make sure `default-frame-alist' really is an alist and not
+a plist.  In XEmacs, the alist is deprecated; a plist is used instead."
+  (cond ((consp (car plist))
+        plist)
+       ((not (symbolp (car plist)))
+        (error "Wrong type argument: plist, %S" plist))
+       ((featurep 'xemacs)
+        (plist-to-alist plist)))); XEmacs only
+
+;; Customization
+
+(defgroup color-theme nil
+  "Color Themes for Emacs.
+A color theme consists of frame parameter settings, variable settings,
+and face definitions."
+  :version "20.6"
+  :group 'faces)
+
+(defcustom color-theme-legal-frame-parameters "\\(color\\|mode\\)$"
+  "Regexp that matches frame parameter names.
+Only frame parameter names that match this regexp can be changed as part
+of a color theme."
+  :type '(choice (const :tag "Colors only" "\\(color\\|mode\\)$")
+                (const :tag "Colors, fonts, and size"
+                       "\\(color\\|mode\\|font\\|height\\|width\\)$")
+                (regexp :tag "Custom regexp"))
+  :group 'color-theme
+  :link '(info-link "(elisp)Window Frame Parameters"))
+
+(defcustom color-theme-legal-variables "\\(color\\|face\\)$"
+  "Regexp that matches variable names.
+Only variables that match this regexp can be changed as part of a color
+theme.  In addition to matching this name, the variables have to be user
+variables (see function `user-variable-p')."
+  :type 'regexp
+  :group 'color-theme)
+
+(defcustom color-theme-illegal-faces "^w3-"
+  "Regexp that matches face names forbidden in themes.
+The default setting \"^w3-\" excludes w3 faces since these
+are created dynamically."
+  :type 'regexp
+  :group 'color-theme
+  :link '(info-link "(elisp)Faces for Font Lock")
+  :link '(info-link "(elisp)Standard Faces"))
+
+(defcustom color-theme-illegal-default-attributes '(:family :height :width)
+  "A list of face properties to be ignored when installing faces.
+This prevents Emacs from doing terrible things to your display just because
+a theme author likes weird fonts."
+  :type '(repeat symbol)
+  :group 'color-theme)
+
+(defcustom color-theme-is-global t
+  "*Determines wether a color theme is installed on all frames or not.
+If non-nil, color themes will be installed for all frames.
+If nil, color themes will be installed for the selected frame only.
+
+A possible use for this variable is dynamic binding. Here is a larger
+example to put in your ~/.emacs; it will make the Blue Sea color theme
+the default used for the first frame, and it will create two additional
+frames with different color themes.
+
+setup:
+    \(require 'color-theme)
+    ;; set default color theme
+    \(color-theme-blue-sea)
+    ;; create some frames with different color themes
+    \(let ((color-theme-is-global nil))
+      \(select-frame (make-frame))
+      \(color-theme-gnome2)
+      \(select-frame (make-frame))
+      \(color-theme-standard))
+
+Please note that using XEmacs and and a nil value for
+color-theme-is-global will ignore any variable settings for the color
+theme, since XEmacs doesn't have frame-local variable bindings.
+
+Also note that using Emacs and a non-nil value for color-theme-is-global
+will install a new color theme for all frames.  Using XEmacs and a
+non-nil value for color-theme-is-global will install a new color theme
+only on those frames that are not using a local color theme."
+  :type 'boolean
+  :group 'color-theme)
+
+(defcustom color-theme-is-cumulative t
+  "*Determines wether new color themes are installed on top of each other.
+If non-nil, installing a color theme will undo all settings made by
+previous color themes."
+  :type 'boolean
+  :group 'color-theme)
+
+(defcustom color-theme-directory nil
+  "Directory where we can find additionnal themes (personnal).
+Note that there is at least one directory shipped with the official
+color-theme distribution where all contributed themes are located.
+This official selection can't be changed with that variable. 
+However, you still can decide to turn it on or off and thus,
+not be shown with all themes but yours."
+  :type '(repeat string)
+  :group 'color-theme)
+
+(defcustom color-theme-libraries (directory-files 
+                                  (file-name-as-directory 
+                                  (expand-file-name 
+                                    "themes" 
+                                    (file-name-directory (locate-library "color-theme")))) 
+                                  t "^color-theme")
+  "A list of files, which will be loaded in color-theme-initialize depending
+on `color-theme-load-all-themes' value. 
+This allows a user to prune the default color-themes (which can take a while
+to load)."
+  :type '(repeat string)
+  :group 'color-theme)
+
+(defcustom color-theme-load-all-themes t
+  "When t, load all color-theme theme files
+as presented by `color-theme-libraries'. Else
+do not load any of this themes."
+  :type 'boolean
+  :group 'color-theme)
+
+(defcustom color-theme-mode-hook nil
+  "Hook for color-theme-mode."
+  :type 'hook
+  :group 'color-theme)
+
+(defvar color-theme-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "RET") 'color-theme-install-at-point)
+    (define-key map (kbd "c") 'list-colors-display)
+    (define-key map (kbd "d") 'color-theme-describe)
+    (define-key map (kbd "f") 'list-faces-display)
+    (define-key map (kbd "i") 'color-theme-install-at-point)
+    (define-key map (kbd "l") 'color-theme-install-at-point-for-current-frame)
+    (define-key map (kbd "p") 'color-theme-print)
+    (define-key map (kbd "q") 'bury-buffer)
+    (define-key map (kbd "?") 'color-theme-describe)
+    (if color-theme-xemacs-p
+       (define-key map (kbd "<button2>") 'color-theme-install-at-mouse)
+      (define-key map (kbd "<mouse-2>") 'color-theme-install-at-mouse))
+    map)
+  "Mode map used for the buffer created by `color-theme-select'.")
+
+(defvar color-theme-initialized nil
+  "Internal variable determining whether color-theme-initialize has been invoked yet")
+
+(defvar color-theme-buffer-name "*Color Theme Selection*"
+  "Name of the color theme selection buffer.")
+
+(defvar color-theme-original-frame-alist nil
+  "nil until one of the color themes has been installed.")
+
+(defvar color-theme-history nil
+  "List of color-themes called, in reverse order")
+
+(defcustom color-theme-history-max-length nil
+  "Max length of history to maintain.
+Two other values are acceptable: t means no limit, and
+nil means that no history is maintained."
+  :type '(choice (const :tag "No history" nil)
+                (const :tag "Unlimited length" t)
+                integer)
+  :group 'color-theme)
+
+(defvar color-theme-counter 0
+  "Counter for every addition to `color-theme-history'.
+This counts how many themes were installed, regardless
+of `color-theme-history-max-length'.")
+
+(defvar color-theme-entry-path (cond
+                                ;; Emacs 22.x and later
+                                ((lookup-key global-map [menu-bar tools])
+                                 '("tools"))
+                                ;; XEmacs
+                                ((featurep 'xemacs)
+                                 (setq tool-entry '("Tools")))
+                                ;; Emacs < 22
+                                (t
+                                 '("Tools")))
+  "Menu tool entry path.")
+
+(defun color-theme-add-to-history (name)
+  "Add color-theme NAME to `color-theme-history'."
+  (setq color-theme-history
+       (cons (list name color-theme-is-cumulative)
+             color-theme-history)
+       color-theme-counter (+ 1 color-theme-counter))
+  ;; Truncate the list if necessary.
+  (when (and (integerp color-theme-history-max-length)
+            (>= (length color-theme-history)
+                color-theme-history-max-length))
+    (setcdr (nthcdr (1- color-theme-history-max-length)
+                   color-theme-history)
+           nil)))
+
+;; (let ((l '(1 2 3 4 5)))
+;;   (setcdr (nthcdr 2 l) nil)
+;;   l)
+
+\f
+
+;; List of color themes used to create the *Color Theme Selection*
+;; buffer.
+
+(defvar color-themes
+  '((color-theme-aalto-dark "Aalto Dark" "Jari Aalto <jari.aalto@poboxes.com>")
+    (color-theme-aalto-light "Aalto Light" "Jari Aalto <jari.aalto@poboxes.com>")
+    (color-theme-aliceblue "Alice Blue" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-andreas "Andreas" "Andreas Busch <Andreas.Busch@politics.ox.ac.uk>")
+    (color-theme-arjen "Arjen" "Arjen Wiersma <arjen@wiersma.org>")
+    (color-theme-beige-diff "Beige Diff" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-bharadwaj "Bharadwaj" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-bharadwaj-slate "Bharadwaj Slate" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-billw "Billw" "Bill White <billw@wolfram.com>")
+    (color-theme-black-on-gray "BlackOnGray" "Sudhir Bhojwani <sbhojwani@altoweb.com>")
+    (color-theme-blippblopp "Blipp Blopp" "Thomas Sicheritz-Ponten<thomas@biopython.org>")
+    (color-theme-simple-1 "Black" "Jonadab <jonadab@bright.net>")
+    (color-theme-blue-erc "Blue ERC" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-blue-gnus "Blue Gnus" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-blue-mood "Blue Mood" "Nelson Loyola <nloyola@yahoo.com>")
+    (color-theme-blue-sea "Blue Sea" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-calm-forest "Calm Forest" "Artur Hefczyc <kobit@plusnet.pl>")
+    (color-theme-charcoal-black "Charcoal Black" "Lars Chr. Hausmann <jazz@zqz.dk>")
+    (color-theme-goldenrod "Cheap Goldenrod" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-clarity "Clarity and Beauty" "Richard Wellum <rwellum@cisco.com>")
+    (color-theme-classic "Classic" "Frederic Giroud <postcard@worldonline.fr>")
+    (color-theme-comidia "Comidia" "Marcelo Dias de Toledo <mtole@ig.com.br>")
+    (color-theme-jsc-dark "Cooper Dark" "John S Cooper <John.Cooper@eu.citrix.com>")
+    (color-theme-jsc-light "Cooper Light" "John S Cooper <John.Cooper@eu.citrix.com>")
+    (color-theme-jsc-light2 "Cooper Light 2" "John S Cooper <John.Cooper@eu.citrix.com>")
+    (color-theme-dark-blue "Dark Blue" "Chris McMahan <cmcmahan@one.net>")
+    (color-theme-dark-blue2 "Dark Blue 2" "Chris McMahan <cmcmahan@one.net>")
+    (color-theme-dark-green "Dark Green" "eddy_woody@hotmail.com")
+    (color-theme-dark-laptop "Dark Laptop" "Laurent Michel <ldm@cs.brown.edu>")
+    (color-theme-deep-blue "Deep Blue" "Tomas Cerha <cerha@brailcom.org>")
+    (color-theme-digital-ofs1 "Digital OFS1" "Gareth Owen <gowen@gwowen.freeserve.co.uk>")
+    (color-theme-euphoria "Euphoria" "oGLOWo@oGLOWo.cjb.net")
+    (color-theme-feng-shui "Feng Shui" "Walter Higgins <walterh@rocketmail.com>")
+    (color-theme-fischmeister "Fischmeister"
+                             "Sebastian Fischmeister <sfischme@nexus.lzk.tuwien.ac.at>")
+    (color-theme-gnome "Gnome" "Jonadab <jonadab@bright.net>")
+    (color-theme-gnome2 "Gnome 2" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-gray1 "Gray1" "Paul Pulli <P.Pulli@motorola.com>")
+    (color-theme-gray30 "Gray30" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-kingsajz "Green Kingsajz" "Olgierd `Kingsajz' Ziolko <kingsajz@rpg.pl>")
+    (color-theme-greiner "Greiner" "Kevin Greiner <kgreiner@mapquest.com>")
+    (color-theme-gtk-ide "GTK IDE" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-high-contrast "High Contrast" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-hober "Hober" "Edward O'Connor <ted@oconnor.cx>")
+    (color-theme-infodoc "Infodoc" "Frederic Giroud <postcard@worldonline.fr>")
+    (color-theme-jb-simple "JB Simple" "jeff@dvns.com")
+    (color-theme-jedit-grey "Jedit Grey" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-jonadabian "Jonadab" "Jonadab <jonadab@bright.net>")
+    (color-theme-jonadabian-slate "Jonadabian Slate" "Jonadab <jonadab@bright.net>")
+    (color-theme-katester "Katester" "Higgins_Walter@emc.com")
+    (color-theme-late-night "Late Night" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-lawrence "Lawrence" "lawrence mitchell <wence@gmx.li>")
+    (color-theme-lethe "Lethe" "Ivica Loncar <ivica.loncar@srk.fer.hr>")
+    (color-theme-ld-dark "Linh Dang Dark" "Linh Dang <linhd@nortelnetworks.com>")
+    (color-theme-marine "Marine" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-matrix "Matrix" "Walter Higgins <walterh@rocketmail.com>")
+    (color-theme-marquardt "Marquardt" "Colin Marquardt <colin@marquardt-home.de>")
+    (color-theme-midnight "Midnight" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-mistyday "Misty Day" "Hari Kumar <Hari.Kumar@mtm.kuleuven.ac.be>")
+    (color-theme-montz "Montz" "Brady Montz <bradym@becomm.com>")
+    (color-theme-oswald "Oswald" "Tom Oswald <toswald@sharplabs.com>")
+    (color-theme-parus "Parus" "Jon K Hellan <hellan@acm.org>")
+    (color-theme-pierson "Pierson" "Dan L. Pierson <dan@sol.control.com>")
+    (color-theme-ramangalahy "Ramangalahy" "Solofo Ramangalahy <solofo@irisa.fr>")
+    (color-theme-raspopovic "Raspopovic" "Pedja Raspopovic <pedja@lsil.com>")
+    (color-theme-renegade "Renegade" "Dave Benjamin <ramen@ramenfest.com>")
+    (color-theme-resolve "Resolve" "Damien Elmes <resolve@repose.cx>")
+    (color-theme-retro-green "Retro Green" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-retro-orange "Retro Orange" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-robin-hood "Robin Hood" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-rotor "Rotor" "Jinwei Shen <shenjw@wam.umd.edu>")
+    (color-theme-ryerson "Ryerson" "Luis Fernandes <elf@ee.ryerson.ca>")
+    (color-theme-salmon-diff "Salmon Diff" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-salmon-font-lock "Salmon Font-Lock" "Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-scintilla "Scintilla" "Gordon Messmer <gordon@dragonsdawn.net>")
+    (color-theme-shaman "Shaman" "shaman@interdon.net")
+    (color-theme-sitaramv-nt "Sitaram NT"
+                            "Sitaram Venkatraman <sitaramv@loc251.tandem.com>")
+    (color-theme-sitaramv-solaris "Sitaram Solaris"
+                                 "Sitaram Venkatraman <sitaramv@loc251.tandem.com>")
+    (color-theme-snow "Snow" "Nicolas Rist <Nicolas.Rist@alcatel.de>")
+    (color-theme-snowish "Snowish" "Girish Bharadwaj <girishb@gbvsoft.com>")
+    (color-theme-standard-ediff "Standard Ediff" "Emacs Team, added by Alex Schroeder <alex@gnu.org>" t)
+    (color-theme-standard "Standard Emacs 20" "Emacs Team, added by Alex Schroeder <alex@gnu.org>")
+    (color-theme-emacs-21 "Standard Emacs 21" "Emacs Team, added by Alex Schroeder <alex@gnu.org>")
+    (color-theme-emacs-nw "Standard Emacs 21 No Window" "Emacs Team, added by D. Goel <deego@gnufans.org>")
+    (color-theme-xemacs "Standard XEmacs" "XEmacs Team, added by Alex Schroeder <alex@gnu.org>")
+    (color-theme-subtle-blue "Subtle Blue" "Chris McMahan <cmcmahan@one.net>")
+    (color-theme-subtle-hacker "Subtle Hacker" "Colin Walters <levanti@verbum.org>")
+    (color-theme-taming-mr-arneson "Taming Mr Arneson" "Erik Arneson <erik@aarg.net>")
+    (color-theme-taylor "Taylor" "Art Taylor <reeses@hemisphere.org>")
+    (color-theme-tty-dark "TTY Dark" "O Polite <m2@plusseven.com>")
+    (color-theme-vim-colors "Vim Colors" "Michael Soulier <msoulier@biryani.nssg.mitel.com>")
+    (color-theme-whateveryouwant "Whateveryouwant" "Fabien Penso <penso@linuxfr.org>, color by Scott Jaderholm <scott@jaderholm.com>")
+    (color-theme-wheat "Wheat" "Alex Schroeder <alex@gnu.org>")
+    (color-theme-pok-wob "White On Black" "S. Pokrovsky <pok@nbsp.nsk.su>")
+    (color-theme-pok-wog "White On Grey" "S. Pokrovsky <pok@nbsp.nsk.su>")
+    (color-theme-word-perfect "WordPerfect" "Thomas Gehrlein <Thomas.Gehrlein@t-online.de>")
+    (color-theme-xp "XP" "Girish Bharadwaj <girishb@gbvsoft.com>"))
+  "List of color themes.
+
+Each THEME is itself a three element list (FUNC NAME MAINTAINER &optional LIBRARY).
+
+FUNC is a color theme function which does the setup.  The function
+FUNC may call `color-theme-install'.  The color theme function may be
+interactive.
+
+NAME is the name of the theme and MAINTAINER is the name and/or email of
+the maintainer of the theme.
+
+If LIBRARY is non-nil, the color theme will be considered a library and
+may not be shown in the default menu.
+
+If you defined your own color theme and want to add it to this list,
+use something like this:
+
+  (add-to-list 'color-themes '(color-theme-gnome2 \"Gnome2\" \"Alex\"))")
+
+;;; Functions
+
+(defun color-theme-backup-original-values ()
+  "Back up the original `default-frame-alist'.
+The values are stored in `color-theme-original-frame-alist' on
+startup."
+  (if (null color-theme-original-frame-alist)
+      (setq color-theme-original-frame-alist
+           (color-theme-filter (frame-parameters (selected-frame))
+                               color-theme-legal-frame-parameters))))
+(add-hook 'after-init-hook 'color-theme-backup-original-values)
+
+;;;###autoload
+(defun color-theme-select (&optional arg)
+  "Displays a special buffer for selecting and installing a color theme.
+With optional prefix ARG, this buffer will include color theme libraries
+as well.  A color theme library is in itself not complete, it must be
+used as part of another color theme to be useful.  Thus, color theme
+libraries are mainly useful for color theme authors."
+  (interactive "P")
+  (unless color-theme-initialized (color-theme-initialize))
+  (switch-to-buffer (get-buffer-create color-theme-buffer-name))
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  ;; recreate the snapshot if necessary
+  (when (or (not (assq 'color-theme-snapshot color-themes))
+           (not (commandp 'color-theme-snapshot)))
+    (fset 'color-theme-snapshot (color-theme-make-snapshot))
+    (setq color-themes (delq (assq 'color-theme-snapshot color-themes)
+                            color-themes)
+         color-themes (delq (assq 'bury-buffer color-themes)
+                            color-themes)
+         color-themes (append '((color-theme-snapshot
+                                 "[Reset]" "Undo changes, if possible.")
+                                (bury-buffer
+                                 "[Quit]" "Bury this buffer."))
+                            color-themes)))
+  (dolist (theme color-themes)
+    (let ((func (nth 0 theme))
+         (name (nth 1 theme))
+         (author (nth 2 theme))
+         (library (nth 3 theme))
+         (desc))
+      (when (or (not library) arg)
+       (setq desc (format "%-23s %s" 
+                          (if library (concat name " [lib]") name)
+                          author))
+       (put-text-property 0 (length desc) 'color-theme func desc)
+       (put-text-property 0 (length name) 'face 'bold desc)
+       (put-text-property 0 (length name) 'mouse-face 'highlight desc)
+       (insert desc)
+       (newline))))
+  (goto-char (point-min))
+  (setq buffer-read-only t)
+  (set-buffer-modified-p nil)
+  (color-theme-mode))
+
+(when (require 'easymenu)
+  (easy-menu-add-item nil color-theme-entry-path "--")
+  (easy-menu-add-item  nil color-theme-entry-path
+                       ["Color Themes" color-theme-select t]))
+
+(defun color-theme-mode ()
+  "Major mode to select and install color themes.
+
+Use \\[color-theme-install-at-point] to install a color theme on all frames.
+Use \\[color-theme-install-at-point-for-current-frame] to install a color theme for the current frame only.
+
+The changes are applied on top of your current setup.  This is a
+feature.
+
+Some of the themes should be considered extensions to the standard color
+theme: they modify only a limited number of faces and variables.  To
+verify the final look of a color theme, install the standard color
+theme, then install the other color theme.  This is a feature. It allows
+you to mix several color themes.
+
+Use \\[color-theme-describe] to read more about the color theme function at point.
+If you want to install the color theme permanently, put the call to the
+color theme function into your ~/.emacs:
+
+    \(require 'color-theme)
+    \(color-theme-gnome2)
+
+If you worry about the size of color-theme.el: You are right.  Use
+\\[color-theme-print] to print the current color theme and save the resulting buffer
+as ~/.emacs-color-theme.  Now you can install only this specific color
+theme in your .emacs:
+
+    \(load-file \"~/.emacs-color-theme\")
+    \(my-color-theme)
+
+The Emacs menu is not affected by color themes within Emacs.  Depending
+on the toolkit you used to compile Emacs, you might have to set specific
+X ressources.  See the info manual for more information.  Here is an
+example ~/.Xdefaults fragment:
+
+    emacs*Background: DarkSlateGray
+    emacs*Foreground: wheat
+
+\\{color-theme-mode-map}
+
+The color themes are listed in `color-themes', which see."
+  (kill-all-local-variables)
+  (setq major-mode 'color-theme-mode)
+  (setq mode-name "Color Themes")
+  (use-local-map color-theme-mode-map)
+  (when (functionp 'goto-address); Emacs
+    (goto-address))
+  (run-hooks 'color-theme-mode-hook))
+
+;;; Commands in Color Theme Selection mode
+
+;;;###autoload
+(defun color-theme-describe ()
+  "Describe color theme listed at point.
+This shows the documentation of the value of text-property color-theme
+at point.  The text-property color-theme should be a color theme
+function.  See `color-themes'."
+  (interactive)
+  (describe-function (get-text-property (point) 'color-theme)))
+
+;;;###autoload
+(defun color-theme-install-at-mouse (event)
+  "Install color theme clicked upon using the mouse.
+First argument EVENT is used to set point.  Then
+`color-theme-install-at-point' is called."
+  (interactive "e")
+  (save-excursion
+    (mouse-set-point event)
+    (color-theme-install-at-point)))
+
+;;;autoload
+(defun color-theme-install-at-point ()
+  "Install color theme at point.
+This calls the value of the text-property `color-theme' at point.
+The text-property `color-theme' should be a color theme function.
+See `color-themes'."
+  (interactive)
+  (let ((func (get-text-property (point) 'color-theme)))
+    ;; install theme
+    (if func
+       (funcall func))
+    ;; If goto-address is being used, remove all overlays in the current
+    ;; buffer and run it again.  The face used for the mail addresses in
+    ;; the the color theme selection buffer is based on the variable
+    ;; goto-address-mail-face.  Changes in that variable will not affect
+    ;; existing overlays, however, thereby confusing users.
+    (when (functionp 'goto-address); Emacs
+      (dolist (o (overlays-in (point-min) (point-max)))
+       (delete-overlay o))
+      (goto-address))))
+
+;;;###autoload
+(defun color-theme-install-at-point-for-current-frame ()
+  "Install color theme at point for current frame only.
+Binds `color-theme-is-global' to nil and calls
+`color-theme-install-at-point'."
+  (interactive)
+  (let ((color-theme-is-global nil))
+    (color-theme-install-at-point)))
+
+\f
+
+;; Taking a snapshot of the current color theme and pretty printing it.
+
+(defun color-theme-filter (old-list regexp &optional exclude)
+  "Filter OLD-LIST.
+The resulting list will be newly allocated and contains only elements
+with names matching REGEXP.  OLD-LIST may be a list or an alist.  If you
+want to filter a plist, use `color-theme-alist' to convert your plist to
+an alist, first.
+
+If the optional argument EXCLUDE is non-nil, then the sense is
+reversed: only non-matching elements will be retained."
+  (let (elem new-list)
+    (dolist (elem old-list)
+      (setq name (symbol-name (if (listp elem) (car elem) elem)))
+      (when (or (and (not exclude)
+                    (string-match regexp name))
+               (and exclude
+                    (not (string-match regexp name))))
+       ;; Now make sure that if elem is a cons cell, and the cdr of
+       ;; that cons cell is a string, then we need a *new* string in
+       ;; the new list.  Having a new cons cell is of no use because
+       ;; modify-frame-parameters will modify this string, thus
+       ;; modifying our color theme functions!
+       (when (and (consp elem)
+                  (stringp (cdr elem)))
+         (setq elem (cons (car elem)
+                          (copy-sequence (cdr elem)))))
+       ;; Now store elem
+       (setq new-list (cons elem new-list))))
+    new-list))
+
+(defun color-theme-spec-filter (spec)
+  "Filter the attributes in SPEC.
+This makes sure that SPEC has the form ((t (PLIST ...))).
+Only properties not in `color-theme-illegal-default-attributes'
+are included in the SPEC returned."
+  (let ((props (cadar spec))
+       result prop val)
+    (while props
+      (setq prop (nth 0 props)
+           val (nth 1 props)
+           props (nthcdr 2 props))
+      (unless (memq prop color-theme-illegal-default-attributes)
+       (setq result (cons val (cons prop result)))))
+    `((t ,(nreverse result)))))
+
+;; (color-theme-spec-filter '((t (:background "blue3"))))
+;; (color-theme-spec-filter '((t (:stipple nil :background "Black" :foreground "SteelBlue" :inverse-video nil :box nil :strike-through nil :overline nil :underline nil :slant normal :weight normal :width semi-condensed :family "misc-fixed"))))
+
+(defun color-theme-plist-delete (plist prop)
+  "Delete property PROP from property list PLIST by side effect.
+This modifies PLIST."
+  ;; deal with prop at the start
+  (while (eq (car plist) prop)
+    (setq plist (cddr plist)))
+  ;; deal with empty plist
+  (when plist
+    (let ((lastcell (cdr plist))
+         (l (cddr plist)))
+      (while l
+       (if (eq (car l) prop)
+           (progn
+             (setq l (cddr l))
+             (setcdr lastcell l))
+         (setq lastcell (cdr l)
+               l (cddr l))))))
+  plist)
+
+;; (color-theme-plist-delete '(a b c d e f g h) 'a)
+;; (color-theme-plist-delete '(a b c d e f g h) 'b)
+;; (color-theme-plist-delete '(a b c d e f g h) 'c)
+;; (color-theme-plist-delete '(a b c d e f g h) 'g)
+;; (color-theme-plist-delete '(a b c d c d e f g h) 'c)
+;; (color-theme-plist-delete '(a b c d e f c d g h) 'c)
+
+(if (or (featurep 'xemacs)
+       (< emacs-major-version 21))
+    (defalias 'color-theme-spec-compat 'identity)
+  (defun color-theme-spec-compat (spec)
+    "Filter the attributes in SPEC such that is is never invalid.
+Example: Eventhough :bold works in Emacs, it is not recognized by
+`customize-face' -- and then the face is uncustomizable.  This
+function replaces a :bold attribute with the corresponding :weight
+attribute, if there is no :weight, or deletes it.  This undoes the
+doings of `color-theme-spec-canonical-font', more or less."
+    (let ((props (cadar spec)))
+      (when (plist-member props :bold)
+       (setq props (color-theme-plist-delete props :bold))
+       (unless (plist-member props :weight)
+         (setq props (plist-put props :weight 'bold))))
+      (when (plist-member props :italic)
+       (setq props (color-theme-plist-delete props :italic))
+       (unless (plist-member props :slant)
+         (setq props (plist-put props :slant 'italic))))
+      `((t ,props)))))
+
+;; (color-theme-spec-compat '((t (:foreground "blue" :bold t))))
+;; (color-theme-spec-compat '((t (:bold t :foreground "blue" :weight extra-bold))))
+;; (color-theme-spec-compat '((t (:italic t :foreground "blue"))))
+;; (color-theme-spec-compat '((t (:slant oblique :italic t :foreground "blue"))))
+
+(defun color-theme-spec-canonical-font (atts)
+  "Add :bold and :italic attributes if necessary."
+  ;; add these to the front of atts -- this will keept the old value for
+  ;; customize-face in Emacs 21.
+  (when (and (memq (plist-get atts :weight)
+                  '(ultra-bold extra-bold bold semi-bold))
+            (not (plist-get atts :bold)))
+    (setq atts (cons :bold (cons t atts))))
+  (when (and (not (memq (plist-get atts :slant)
+                       '(normal nil)))
+            (not (plist-get atts :italic)))
+    (setq atts (cons :italic (cons t atts))))
+  atts)
+;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'bold (selected-frame)))
+;; (defface foo '((t (:weight extra-bold))) "foo")
+;; (color-theme-spec-canonical-font (color-theme-face-attr-construct 'foo (selected-frame)))
+;; (face-spec-set 'foo '((t (:weight extra-bold))) nil)
+;; (face-spec-set 'foo '((t (:bold t))) nil)
+;; (face-spec-set 'foo '((t (:bold t :weight extra-bold))) nil)
+
+;; Handle :height according to NEWS file for Emacs 21
+(defun color-theme-spec-resolve-height (old new)
+  "Return the new height given OLD and NEW height.
+OLD is the current setting, NEW is the setting inherited from."
+  (cond ((not old)
+        new)
+       ((integerp old)
+        old)
+       ((and (floatp old)
+             (integerp new))
+        (round (* old new)))
+       ((and (floatp old)
+             (floatp new))
+        (* old new))
+       ((and (functionp old)
+             (integerp new))
+        (round (funcall old new)))
+       ((and (functionp old)
+             (float new))
+        `(lambda (f) (* (funcall ,old f) ,new)))
+       ((and (functionp old)
+             (functionp new))
+        `(lambda (f) (* (funcall ,old (funcall ,new f)))))
+       (t
+        (error "Illegal :height attributes: %S or %S" old new))))
+;; (color-theme-spec-resolve-height 12 1.2)
+;; (color-theme-spec-resolve-height 1.2 1.2)
+;; (color-theme-spec-resolve-height 1.2 12)
+;; (color-theme-spec-resolve-height 1.2 'foo)
+;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 5)
+;; (color-theme-spec-resolve-height (lambda (f) (* 2 f)) 2.0)
+;; the following lambda is the result from the above calculation
+;; (color-theme-spec-resolve-height (lambda (f) (* (funcall (lambda (f) (* 2 f)) f) 2.0)) 5)
+
+(defun color-theme-spec-resolve-inheritance (atts)
+  "Resolve all occurences of the :inherit attribute."
+  (let ((face (plist-get atts :inherit)))
+    ;; From the Emacs 21 NEWS file: "Attributes from inherited faces are
+    ;; merged into the face like an underlying face would be." --
+    ;; therefore properties of the inherited face only add missing
+    ;; attributes.
+    (when face
+      ;; remove :inherit face from atts -- this assumes only one
+      ;; :inherit attribute.
+      (setq atts (delq ':inherit (delq face atts)))
+      (let ((more-atts (color-theme-spec-resolve-inheritance
+                       (color-theme-face-attr-construct
+                        face (selected-frame))))
+           att val)
+       (while more-atts
+         (setq att (car more-atts)
+               val (cadr more-atts)
+               more-atts (cddr more-atts))
+         ;; Color-theme assumes that no value is ever 'unspecified.
+         (cond ((eq att ':height); cumulative effect!
+                (setq atts (plist-put atts 
+                                      ':height 
+                                      (color-theme-spec-resolve-height
+                                       (plist-get atts att) 
+                                       val))))
+               ;; Default: Only put if it has not been specified before.
+               ((not (plist-get atts att))
+                (setq atts (cons att (cons val atts))))
+                 
+))))
+    atts))
+;; (color-theme-spec-resolve-inheritance '(:bold t))
+;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "blue"))
+;; (color-theme-face-attr-construct 'font-lock-comment-face (selected-frame))
+;; (color-theme-spec-resolve-inheritance '(:bold t :inherit font-lock-comment-face))
+;; (color-theme-spec-resolve-inheritance '(:bold t :foreground "red" :inherit font-lock-comment-face))
+;; (color-theme-face-attr-construct 'Info-title-2-face (selected-frame))
+;; (color-theme-face-attr-construct 'Info-title-3-face (selected-frame))
+;; (color-theme-face-attr-construct 'Info-title-4-face (selected-frame))
+;; (color-theme-spec-resolve-inheritance '(:inherit Info-title-2-face))
+
+;; The :inverse-video attribute causes Emacs to swap foreground and
+;; background colors, XEmacs does not.  Therefore, if anybody chooses
+;; the inverse-video attribute, we 1. swap the colors ourselves in Emacs
+;; and 2. we remove the inverse-video attribute in Emacs and XEmacs.
+;; Inverse-video is only useful on a monochrome tty.
+(defun color-theme-spec-maybe-invert (atts)
+  "Remove the :inverse-video attribute from ATTS.
+If ATTS contains :inverse-video t, remove it and swap foreground and
+background color.  Return ATTS."
+  (let ((inv (plist-get atts ':inverse-video)))
+    (if inv
+       (let (result att)
+         (while atts
+           (setq att (car atts)
+                 atts (cdr atts))
+           (cond ((and (eq att :foreground) (not color-theme-xemacs-p))
+                  (setq result (cons :background result)))
+                 ((and (eq att :background) (not color-theme-xemacs-p))
+                  (setq result (cons :foreground result)))
+                 ((eq att :inverse-video)
+                  (setq atts (cdr atts))); this prevents using dolist
+                 (t
+                  (setq result (cons att result)))))
+         (nreverse result))
+      ;; else
+      atts)))
+;; (color-theme-spec-maybe-invert '(:bold t))
+;; (color-theme-spec-maybe-invert '(:foreground "blue"))
+;; (color-theme-spec-maybe-invert '(:background "red"))
+;; (color-theme-spec-maybe-invert '(:inverse-video t))
+;; (color-theme-spec-maybe-invert '(:inverse-video t :foreground "red"))
+;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red"))
+;; (color-theme-spec-maybe-invert '(:inverse-video t :background "red" :foreground "blue" :bold t))
+;; (color-theme-spec-maybe-invert '(:inverse-video nil :background "red" :foreground "blue" :bold t))
+
+(defun color-theme-spec (face)
+  "Return a list for FACE which has the form (FACE SPEC).
+See `defface' for the format of SPEC.  In this case we use only one
+DISPLAY, t, and determine ATTS using `color-theme-face-attr-construct'.
+If ATTS is nil, (nil) is used  instead.
+
+If ATTS contains :inverse-video t, we remove it and swap foreground and
+background color using `color-theme-spec-maybe-invert'.  We do this
+because :inverse-video is handled differently in Emacs and XEmacs.  We
+will loose on a tty without colors, because in that situation,
+:inverse-video means something."
+  (let ((atts
+        (color-theme-spec-canonical-font
+         (color-theme-spec-maybe-invert
+          (color-theme-spec-resolve-inheritance
+           (color-theme-face-attr-construct face (selected-frame)))))))
+    (if atts
+       `(,face ((t ,atts)))
+      `(,face ((t (nil)))))))
+
+(defun color-theme-get-params ()
+  "Return a list of frame parameter settings usable in a color theme.
+Such an alist may be installed by `color-theme-install-frame-params'.  The
+frame parameters returned must match `color-theme-legal-frame-parameters'."
+  (let ((params (color-theme-filter (frame-parameters (selected-frame))
+                                   color-theme-legal-frame-parameters)))
+    (sort params (lambda (a b) (string< (symbol-name (car a))
+                                       (symbol-name (car b)))))))
+
+(defun color-theme-get-vars ()
+  "Return a list of variable settings usable in a color theme.
+Such an alist may be installed by `color-theme-install-variables'.
+The variable names must match `color-theme-legal-variables', and the
+variable must be a user variable according to `user-variable-p'."
+  (let ((vars)
+       (val))
+    (mapatoms (lambda (v)
+               (and (boundp v)
+                    (user-variable-p v)
+                    (string-match color-theme-legal-variables
+                                  (symbol-name v))
+                    (setq val (eval v))
+                    (add-to-list 'vars (cons v val)))))
+    (sort vars (lambda (a b) (string< (car a) (car b))))))
+
+(defun color-theme-print-alist (alist)
+  "Print ALIST."
+  (insert "\n     " (if alist "(" "nil"))
+  (dolist (elem alist)
+    (when (= (preceding-char) ?\))
+      (insert "\n      "))
+    (prin1 elem (current-buffer)))
+  (when (= (preceding-char) ?\)) (insert ")")))
+
+(defun color-theme-get-faces ()
+  "Return a list of faces usable in a color theme.
+Such an alist may be installed by `color-theme-install-faces'.  The
+faces returned must not match `color-theme-illegal-faces'."
+  (let ((faces (color-theme-filter (face-list) color-theme-illegal-faces t)))
+    ;; default face must come first according to comments in
+    ;; custom-save-faces, the rest is to be sorted by name
+    (cons 'default (sort (delq 'default faces) 'string-lessp))))
+
+(defun color-theme-get-face-definitions ()
+  "Return face settings usable in a color-theme."
+  (let ((faces (color-theme-get-faces)))
+    (mapcar 'color-theme-spec faces)))
+
+(defun color-theme-print-faces (faces)
+  "Print face settings for all faces returned by `color-theme-get-faces'."
+  (when faces
+    (insert "\n     "))
+  (dolist (face faces)
+    (when (= (preceding-char) ?\))
+      (insert "\n     "))
+    (prin1 face (current-buffer))))
+
+(defun color-theme-reset-faces ()
+  "Reset face settings for all faces returned by `color-theme-get-faces'."
+  (let ((faces (color-theme-get-faces))
+       (face) (spec) (entry)
+       (frame (if color-theme-is-global nil (selected-frame))))
+    (while faces
+      (setq entry (color-theme-spec (car faces)))
+      (setq face (nth 0 entry))
+      (setq spec '((t (nil))))
+      (setq faces (cdr faces))
+      (if (functionp 'face-spec-reset-face)
+         (face-spec-reset-face face frame)
+       (face-spec-set face spec frame)
+       (if color-theme-is-global
+           (put face 'face-defface-spec spec))))))
+
+(defun color-theme-print-theme (func doc params vars faces)
+  "Print a theme into the current buffer.
+FUNC is the function name, DOC the doc string, PARAMS the
+frame parameters, VARS the variable bindings, and FACES
+the list of faces and their specs."
+  (insert "(defun " (symbol-name func) " ()\n"
+         "  \"" doc "\"\n"
+         "  (interactive)\n"
+         "  (color-theme-install\n"
+         "   '(" (symbol-name func))
+  ;; alist of frame parameters
+  (color-theme-print-alist params)
+  ;; alist of variables
+  (color-theme-print-alist vars)
+  ;; remaining elements of snapshot: face specs
+  (color-theme-print-faces faces)
+  (insert ")))\n")
+  (insert "(add-to-list 'color-themes '(" (symbol-name func) " "
+          " \"THEME NAME\" \"YOUR NAME\"))")
+  (goto-char (point-min)))
+
+;;;###autoload
+(defun color-theme-print (&optional buf)
+  "Print the current color theme function.
+
+You can contribute this function to <URL:news:gnu.emacs.sources> or
+paste it into your .emacs file and call it.  That should recreate all
+the settings necessary for your color theme.
+
+Example:
+
+    \(require 'color-theme)
+    \(defun my-color-theme ()
+      \"Color theme by Alex Schroeder, created 2000-05-17.\"
+      \(interactive)
+      \(color-theme-install
+       '(...
+        ...
+        ...)))
+    \(my-color-theme)
+
+If you want to use a specific color theme function, you can call the
+color theme function in your .emacs directly.
+
+Example:
+
+    \(require 'color-theme)
+    \(color-theme-gnome2)"
+  (interactive)
+  (message "Pretty printing current color theme function...")
+  (switch-to-buffer (if buf
+                       buf
+                     (get-buffer-create "*Color Theme*")))
+  (unless buf
+    (setq buffer-read-only nil)
+    (erase-buffer))
+  ;; insert defun
+  (insert "(eval-when-compile"
+          "    (require 'color-theme))\n")
+  (color-theme-print-theme 'my-color-theme
+                          (concat "Color theme by "
+                                  (if (string= "" user-full-name)
+                                      (user-login-name)
+                                    user-full-name)
+                                  ", created " (format-time-string "%Y-%m-%d") ".")
+                          (color-theme-get-params)
+                          (color-theme-get-vars)
+                          (mapcar 'color-theme-spec (color-theme-get-faces)))
+  (unless buf
+    (emacs-lisp-mode))
+  (goto-char (point-min))
+  (message "Pretty printing current color theme function... done"))
+
+(defun color-theme-analyze-find-theme (code)
+  "Find the sexpr that calls `color-theme-install'."
+  (let (theme)
+    (while (and (not theme) code)
+      (when (eq (car code) 'color-theme-install)
+       (setq theme code))
+      (when (listp (car code))
+       (setq theme (color-theme-analyze-find-theme (car code))))
+      (setq code (cdr code)))
+    theme))
+
+;; (equal (color-theme-analyze-find-theme
+;;     '(defun color-theme-blue-eshell ()
+;;        "Color theme for eshell faces only."
+;;        (color-theme-install
+;;         '(color-theme-blue-eshell
+;;           nil
+;;           (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed"))))
+;;           (eshell-ls-backup-face ((t (:foreground "Grey"))))))))
+;;        '(color-theme-install
+;;      (quote
+;;       (color-theme-blue-eshell
+;;        nil
+;;        (eshell-ls-archive-face ((t (:bold t :foreground "IndianRed"))))
+;;        (eshell-ls-backup-face ((t (:foreground "Grey")))))))))
+
+(defun color-theme-analyze-add-face (a b regexp faces)
+  "If only one of A or B are in FACES, the other is added, and FACES is returned.
+If REGEXP is given, this is only done if faces contains a match for regexps."
+  (when (or (not regexp)
+           (catch 'found
+             (dolist (face faces)
+               (when (string-match regexp (symbol-name (car face)))
+                 (throw 'found t)))))
+    (let ((face-a (assoc a faces))
+         (face-b (assoc b faces)))
+      (if (and face-a (not face-b))
+         (setq faces (cons (list b (nth 1 face-a))
+                           faces))
+       (if (and (not face-a) face-b)
+           (setq faces (cons (list a (nth 1 face-b))
+                             faces))))))
+  faces)
+
+;; (equal (color-theme-analyze-add-face
+;;     'blue 'violet nil
+;;     '((blue ((t (:foreground "blue"))))
+;;       (bold ((t (:bold t))))))
+;;        '((violet ((t (:foreground "blue"))))
+;;      (blue ((t (:foreground "blue"))))
+;;      (bold ((t (:bold t))))))
+;; (equal (color-theme-analyze-add-face
+;;     'violet 'blue nil
+;;     '((blue ((t (:foreground "blue"))))
+;;       (bold ((t (:bold t))))))
+;;        '((violet ((t (:foreground "blue"))))
+;;      (blue ((t (:foreground "blue"))))
+;;      (bold ((t (:bold t))))))
+;; (equal (color-theme-analyze-add-face
+;;     'violet 'blue "foo"
+;;     '((blue ((t (:foreground "blue"))))
+;;       (bold ((t (:bold t))))))
+;;        '((blue ((t (:foreground "blue"))))
+;;      (bold ((t (:bold t))))))
+;; (equal (color-theme-analyze-add-face
+;;     'violet 'blue "blue"
+;;     '((blue ((t (:foreground "blue"))))
+;;       (bold ((t (:bold t))))))
+;;        '((violet ((t (:foreground "blue"))))
+;;      (blue ((t (:foreground "blue"))))
+;;      (bold ((t (:bold t))))))
+
+(defun color-theme-analyze-add-faces (faces)
+  "Add missing faces to FACES and return it."
+  ;; The most important thing is to add missing faces for the other
+  ;; editor.  These are the most important faces to check.  The
+  ;; following rules list two faces, A and B.  If either of the two is
+  ;; part of the theme, the other must be, too.  The optional third
+  ;; argument specifies a regexp.  Only if an existing face name
+  ;; matches this regexp, is the rule applied.
+  (let ((rules '((font-lock-builtin-face font-lock-reference-face)
+                (font-lock-doc-face font-lock-doc-string-face)
+                (font-lock-constant-face font-lock-preprocessor-face)
+                ;; In Emacs 21 `modeline' is just an alias for
+                ;; `mode-line'.  I recommend the use of
+                ;; `modeline' until further notice.
+                (modeline mode-line)
+                (modeline modeline-buffer-id)
+                (modeline modeline-mousable)
+                (modeline modeline-mousable-minor-mode)
+                (region primary-selection)
+                (region zmacs-region)
+                (font-lock-string-face dired-face-boring "^dired")
+                (font-lock-function-name-face dired-face-directory "^dired")
+                (default dired-face-executable "^dired")
+                (font-lock-warning-face dired-face-flagged "^dired")
+                (font-lock-warning-face dired-face-marked "^dired")
+                (default dired-face-permissions "^dired")
+                (default dired-face-setuid "^dired")
+                (default dired-face-socket "^dired")
+                (font-lock-keyword-face dired-face-symlink "^dired")
+                (tool-bar menu))))
+    (dolist (rule rules)
+      (setq faces (color-theme-analyze-add-face
+                  (nth 0 rule) (nth 1 rule) (nth 2 rule) faces))))
+  ;; The `fringe' face defines what the left and right borders of the
+  ;; frame look like in Emacs 21.  To give them default fore- and
+  ;; background colors, use (fringe ((t (nil)))) in your color theme.
+  ;; Usually it makes more sense to choose a color slightly lighter or
+  ;; darker from the default background.
+  (unless (assoc 'fringe faces)
+    (setq faces (cons '(fringe ((t (nil)))) faces)))
+  ;; The tool-bar should not be part of the frame-parameters, since it
+  ;; should not appear or disappear depending on the color theme.  The
+  ;; apppearance of the toolbar, however, can be changed by the color
+  ;; theme.  For Emacs 21, use the `tool-bar' face.  The easiest way
+  ;; to do this is to give it the default fore- and background colors.
+  ;; This can be achieved using (tool-bar ((t (nil)))) in the theme.
+  ;; Usually it makes more sense, however, to provide the same colors
+  ;; as used in the `menu' face, and to specify a :box attribute.  In
+  ;; order to alleviate potential Emacs/XEmacs incompatibilities,
+  ;; `toolbar' will be defined as an alias for `tool-bar' if it does
+  ;; not exist, and vice-versa.  This is done eventhough the face
+  ;; `toolbar' seems to have no effect on XEmacs.  If you look at
+  ;; XEmacs lisp/faces.el, however, you will find that it is in fact
+  ;; referenced for XPM stuff.
+  (unless (assoc 'tool-bar faces)
+    (setq faces (cons '(tool-bar ((t (nil)))) faces)))
+  ;; Move the default face back to the front, and sort the rest.
+  (unless (eq (caar faces) 'default)
+    (let ((face (assoc 'default faces)))
+      (setq faces (cons face
+                       (sort (delete face faces)
+                             (lambda (a b)
+                               (string-lessp (car a) (car b))))))))
+  faces)
+
+(defun color-theme-analyze-remove-heights (faces)
+  "Remove :height property where it is an integer and return FACES."
+  ;; I don't recommend making font sizes part of a color theme.  Most
+  ;; users would be surprised to see their font sizes change when they
+  ;; install a color-theme.  Therefore, remove all :height attributes
+  ;; if the value is an integer.  If the value is a float, this is ok
+  ;; -- the value is relative to the default height.  One notable
+  ;; exceptions is for a color-theme created for visually impaired
+  ;; people.  These *must* use a larger font in order to be usable.
+  (let (result)
+    (dolist (face faces)
+      (let ((props (cadar (nth 1 face))))
+       (if (and (plist-member props :height)
+                (integerp (plist-get props :height)))
+           (setq props (color-theme-plist-delete props :height)
+                 result (cons (list (car face) `((t ,props)))
+                              result))
+         (setq result (cons face result)))))
+    (nreverse result)))
+
+;; (equal (color-theme-analyze-remove-heights
+;;     '((blue ((t (:foreground "blue" :height 2))))
+;;       (bold ((t (:bold t :height 1.0))))))
+;;        '((blue ((t (:foreground "blue"))))
+;;      (bold ((t (:bold t :height 1.0))))))
+
+;;;###autoload
+(defun color-theme-analyze-defun ()
+  "Once you have a color-theme printed, check for missing faces.
+This is used by maintainers who receive a color-theme submission
+and want to make sure it follows the guidelines by the color-theme
+author."
+  ;; The support for :foreground and :background attributes works for
+  ;; Emacs 20 and 21 as well as for XEmacs.  :inverse-video is taken
+  ;; care of while printing color themes.
+  (interactive)
+  ;; Parse the stuff and find the call to color-theme-install
+  (save-excursion
+    (save-restriction
+      (narrow-to-defun)
+      ;; define the function
+      (eval-defun nil)
+      (goto-char (point-min))
+      (let* ((code (read (current-buffer)))
+            (theme (color-theme-canonic
+                    (eval
+                     (cadr
+                      (color-theme-analyze-find-theme
+                       code)))))
+            (func (color-theme-function theme))
+            (doc (documentation func t))
+            (variables (color-theme-variables theme))
+            (faces (color-theme-faces theme))
+            (params (color-theme-frame-params theme)))
+       (setq faces (color-theme-analyze-remove-heights
+                    (color-theme-analyze-add-faces faces)))
+       ;; Remove any variable bindings of faces that point to their
+       ;; symbol?  Perhaps not, because another theme might want to
+       ;; change this, so it is important to be able to reset them.
+       ;;      (let (result)
+       ;;        (dolist (var variables)
+       ;;          (unless (eq (car var) (cdr var))
+       ;;            (setq result (cons var result))))
+       ;;        (setq variables (nreverse result)))
+       ;; Now modify the theme directly.
+       (setq theme (color-theme-analyze-find-theme code))
+       (setcdr (cadadr theme) (list params variables faces))
+       (message "Pretty printing analysed color theme function...")
+       (with-current-buffer (get-buffer-create "*Color Theme*")
+         (setq buffer-read-only nil)
+         (erase-buffer)
+         ;; insert defun
+         (color-theme-print-theme func doc params variables faces)
+         (emacs-lisp-mode))
+       (message "Pretty printing analysed color theme function... done")
+       (ediff-buffers (current-buffer)
+                      (get-buffer "*Color Theme*"))))))
+
+;;; Creating a snapshot of the current color theme
+
+(defun color-theme-snapshot nil)
+
+;;;###autoload
+(defun color-theme-make-snapshot ()
+  "Return the definition of the current color-theme.
+The function returned will recreate the color-theme in use at the moment."
+  (eval `(lambda ()
+          "The color theme in use when the selection buffer was created.
+\\[color-theme-select] creates the color theme selection buffer.  At the
+same time, this snapshot is created as a very simple undo mechanism.
+The snapshot is created via `color-theme-snapshot'."
+          (interactive)
+          (color-theme-install
+           '(color-theme-snapshot
+             ;; alist of frame parameters
+             ,(color-theme-get-params)
+             ;; alist of variables
+             ,(color-theme-get-vars)
+             ;; remaining elements of snapshot: face specs
+             ,@(color-theme-get-face-definitions))))))
+
+\f
+
+;;; Handling the various parts of a color theme install
+
+(defvar color-theme-frame-param-frobbing-rules
+  '((foreground-color default foreground)
+    (background-color default background))
+  "List of rules to use when frobbing faces based on frame parameters.
+This is only necessary for XEmacs, because in Emacs 21 changing the
+frame paramters automatically affects the relevant faces.")
+
+;; fixme: silent the bytecompiler with set-face-property
+(defun color-theme-frob-faces (params)
+  "Change certain faces according to PARAMS.
+This uses `color-theme-frame-param-frobbing-rules'."
+  (dolist (rule color-theme-frame-param-frobbing-rules)
+    (let* ((param (nth 0 rule))
+          (face (nth 1 rule))
+          (prop (nth 2 rule))
+          (val (cdr (assq param params)))
+          (frame (if color-theme-is-global nil (selected-frame))))
+      (when val
+       (set-face-property face prop val frame)))))
+
+(defun color-theme-alist-reduce (old-list)
+  "Reduce OLD-LIST.
+The resulting list will be newly allocated and will not contain any elements
+with duplicate cars.  This will speed the installation of new themes by
+only installing unique attributes."
+  (let (new-list)
+    (dolist (elem old-list)
+      (when (not (assq (car elem) new-list))
+       (setq new-list (cons elem new-list))))
+    new-list))
+
+(defun color-theme-install-frame-params (params)
+  "Change frame parameters using alist PARAMETERS.
+
+If `color-theme-is-global' is non-nil, all frames are modified using
+`modify-frame-parameters' and the PARAMETERS are prepended to
+`default-frame-alist'.  The value of `initial-frame-alist' is not
+modified.  If `color-theme-is-global' is nil, only the selected frame is
+modified.  If `color-theme-is-cumulative' is nil, the frame parameters
+are restored from `color-theme-original-frame-alist'.
+
+If the current frame parameters have a parameter `minibuffer' with
+value `only', then the frame parameters are not installed, since this
+indicates a dedicated minibuffer frame.
+
+Called from `color-theme-install'."
+  (setq params (color-theme-filter
+               params color-theme-legal-frame-parameters))
+  ;; We have a new list in params now, therefore we may use
+  ;; destructive nconc.
+  (if color-theme-is-global
+      (let ((frames (frame-list)))
+       (if (or color-theme-is-cumulative
+               (null color-theme-original-frame-alist))
+           (setq default-frame-alist
+                 (append params (color-theme-alist default-frame-alist))
+                 minibuffer-frame-alist
+                 (append params (color-theme-alist minibuffer-frame-alist)))
+         (setq default-frame-alist
+               (append params color-theme-original-frame-alist)
+               minibuffer-frame-alist
+               (append params (color-theme-alist minibuffer-frame-alist))))
+       (setq default-frame-alist
+             (color-theme-alist-reduce default-frame-alist)
+             minibuffer-frame-alist
+             (color-theme-alist-reduce minibuffer-frame-alist))
+       (dolist (frame frames)
+         (let ((params (if (eq 'only (cdr (assq 'minibuffer (frame-parameters frame))))
+                           minibuffer-frame-alist
+                         default-frame-alist)))
+           (condition-case var
+               (modify-frame-parameters frame params)
+             (error (message "Error using params %S: %S" params var))))))
+    (condition-case var
+       (modify-frame-parameters (selected-frame) params)
+      (error (message "Error using params %S: %S" params var))))
+  (when color-theme-xemacs-p
+    (color-theme-frob-faces params)))
+
+;; (setq default-frame-alist (cons '(height . 30) default-frame-alist))
+
+(defun color-theme-install-variables (vars)
+  "Change variables using alist VARS.
+All variables matching `color-theme-legal-variables' are set.
+
+If `color-theme-is-global' and `color-theme-xemacs-p' are nil, variables
+are made frame-local before setting them.  Variables are set using `set'
+in either case.  This may lead to problems if changing the variable
+requires the usage of the function specified with the :set tag in
+defcustom declarations.
+
+Called from `color-theme-install'."
+  (let ((vars (color-theme-filter vars color-theme-legal-variables)))
+    (dolist (var vars)
+      (if (or color-theme-is-global color-theme-xemacs-p)
+         (set (car var) (cdr var))
+       (make-variable-frame-local (car var))
+       (modify-frame-parameters (selected-frame) (list var))))))
+
+(defun color-theme-install-faces (faces)
+  "Change faces using FACES.
+
+Change faces for all frames and create any faces listed in FACES which
+don't exist.  The modified faces will be marked as \"unchanged from
+its standard setting\".  This is OK, since the changes made by
+installing a color theme should never by saved in .emacs by
+customization code.
+
+FACES should be a list where each entry has the form:
+
+  (FACE SPEC)
+
+See `defface' for the format of SPEC.
+
+If `color-theme-is-global' is non-nil, faces are modified on all frames
+using `face-spec-set'.  If `color-theme-is-global' is nil, faces are
+only modified on the selected frame.  Non-existing faces are created
+using `make-empty-face' in either case.  If `color-theme-is-cumulative'
+is nil, all faces are reset before installing the new faces.
+
+Called from `color-theme-install'."
+  ;; clear all previous faces
+  (when (not color-theme-is-cumulative)
+    (color-theme-reset-faces))
+  ;; install new faces
+  (let ((faces (color-theme-filter faces color-theme-illegal-faces t))
+       (frame (if color-theme-is-global nil (selected-frame))))
+    (dolist (entry faces)
+      (let ((face (nth 0 entry))
+           (spec (nth 1 entry)))
+       (or (facep face)
+           (make-empty-face face))
+       ;; remove weird properties from the default face only
+       (when (eq face 'default)
+         (setq spec (color-theme-spec-filter spec)))
+       ;; Emacs/XEmacs customization issues: filter out :bold when
+       ;; the spec contains :weight, etc, such that the spec remains
+       ;; "valid" for custom.
+       (setq spec (color-theme-spec-compat spec))
+       ;; using a spec of ((t (nil))) to reset a face doesn't work
+       ;; in Emacs 21, we use the new function face-spec-reset-face
+       ;; instead
+       (if (and (functionp 'face-spec-reset-face)
+                (equal spec '((t (nil)))))
+           (face-spec-reset-face face frame)
+         (condition-case var
+             (progn
+               (face-spec-set face spec frame)
+               (if color-theme-is-global
+                   (put face 'face-defface-spec spec)))
+           (error (message "Error using spec %S: %S" spec var))))))))
+
+;; `custom-set-faces' is unusable here because it doesn't allow to set
+;; the faces for one frame only.
+
+;; Emacs `face-spec-set': If FRAME is nil, the face is created and
+;; marked as a customized face.  This is achieved by setting the
+;; `face-defface-spec' property.  If we don't, new frames will not be
+;; created using the face we installed because `face-spec-set' is
+;; broken: If given a FRAME of nil, it will not set the default faces;
+;; instead it will walk through all the frames and set modify the faces.
+;; If we do set a property (`saved-face' or `face-defface-spec'),
+;; `make-frame' will correctly use the faces we defined with our color
+;; theme.  If we used the property `saved-face',
+;; `customize-save-customized' will save all the faces installed as part
+;; of a color-theme in .emacs.  That's why we use the
+;; `face-defface-spec' property.
+
+\f
+
+;;; Theme accessor functions, canonicalization, merging, comparing
+
+(defun color-theme-canonic (theme)
+  "Return the canonic form of THEME.
+This deals with all the backwards compatibility stuff."
+  (let (function frame-params variables faces)
+    (when (functionp (car theme))
+      (setq function (car theme)
+           theme (cdr theme)))
+    (setq frame-params (car theme)
+         theme (cdr theme))
+    ;; optional variable defintions (for backwards compatibility)
+    (when (listp (caar theme))
+      (setq variables (car theme)
+           theme (cdr theme)))
+    ;; face definitions
+    (setq faces theme)
+    (list function frame-params variables faces)))
+
+(defun color-theme-function (theme)
+  "Return function used to create THEME."
+  (nth 0 theme))
+
+(defun color-theme-frame-params (theme)
+  "Return frame-parameters defined by THEME."
+  (nth 1 theme))
+
+(defun color-theme-variables (theme)
+  "Return variables set by THEME."
+  (nth 2 theme))
+
+(defun color-theme-faces (theme)
+  "Return faces defined by THEME."
+  (nth 3 theme))
+
+(defun color-theme-merge-alists (&rest alists)
+  "Merges all the alist arguments into one alist.
+Only the first instance of every key will be part of the resulting
+alist.  Membership will be tested using `assq'."
+  (let (result)
+    (dolist (l alists)
+      (dolist (entry l)
+       (unless (assq (car entry) result)
+         (setq result (cons entry result)))))
+    (nreverse result)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)))
+;; (color-theme-merge-alists '((a . 1) (b . 2) (a . 3)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((a . 3)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4)))
+;; (color-theme-merge-alists '((a . 1) (b . 2)) '((c . 3) (d . 4) (b . 5)))
+
+;;;###autoload
+(defun color-theme-compare (theme-a theme-b)
+  "Compare two color themes.
+This will print the differences between installing THEME-A and
+installing THEME-B.  Note that the order is important: If a face is
+defined in THEME-A and not in THEME-B, then this will not show up as a
+difference, because there is no reset before installing THEME-B.  If a
+face is defined in THEME-B and not in THEME-A, then this will show up as
+a difference."
+  (interactive
+   (list
+    (intern
+     (completing-read "Theme A: "
+                     (mapcar (lambda (i) (list (symbol-name (car i))))
+                             color-themes)
+                     (lambda (i) (string-match "color-theme" (car i)))))
+    (intern
+     (completing-read "Theme B: "
+                     (mapcar (lambda (i) (list (symbol-name (car i))))
+                             color-themes)
+                     (lambda (i) (string-match "color-theme" (car i)))))))
+  ;; install the themes in a new frame and get the definitions
+  (let ((color-theme-is-global nil))
+    (select-frame (make-frame))
+    (funcall theme-a)
+    (setq theme-a (list theme-a
+                       (color-theme-get-params)
+                       (color-theme-get-vars)
+                       (color-theme-get-face-definitions)))
+    (funcall theme-b)
+    (setq theme-b (list theme-b
+                       (color-theme-get-params)
+                       (color-theme-get-vars)
+                       (color-theme-get-face-definitions)))
+    (delete-frame))
+  (let ((params (set-difference
+                (color-theme-frame-params theme-b)
+                (color-theme-frame-params theme-a)
+                :test 'equal))
+       (vars (set-difference
+              (color-theme-variables theme-b)
+              (color-theme-variables theme-a)
+              :test 'equal))
+       (faces (set-difference
+               (color-theme-faces theme-b)
+               (color-theme-faces theme-a)
+               :test 'equal)))
+    (list 'diff
+         params
+         vars
+         faces)))
+
+\f
+
+;;; Installing a color theme
+;;;###autoload
+(defun color-theme-install (theme)
+  "Install a color theme defined by frame parameters, variables and faces.
+
+The theme is installed for all present and future frames; any missing
+faces are created.  See `color-theme-install-faces'.
+
+THEME is a color theme definition.  See below for more information.
+
+If you want to install a color theme from your .emacs, use the output
+generated by `color-theme-print'.  This produces color theme function
+which you can copy to your .emacs.
+
+A color theme definition is a list:
+\([FUNCTION] FRAME-PARAMETERS VARIABLE-SETTINGS FACE-DEFINITIONS)
+
+FUNCTION is the color theme function which called `color-theme-install'.
+This is no longer used.  There was a time when this package supported
+automatic factoring of color themes.  This has been abandoned.
+
+FRAME-PARAMETERS is an alist of frame parameters.  These are installed
+with `color-theme-install-frame-params'.  These are installed last such
+that any changes to the default face can be changed by the frame
+parameters.
+
+VARIABLE-DEFINITIONS is an alist of variable settings.  These are
+installed with `color-theme-install-variables'.
+
+FACE-DEFINITIONS is an alist of face definitions.  These are installed
+with `color-theme-install-faces'.
+
+If `color-theme-is-cumulative' is nil, a color theme will undo face and
+frame-parameter settings of previous color themes."
+  (setq theme (color-theme-canonic theme))
+  (color-theme-install-variables (color-theme-variables theme))
+  (color-theme-install-faces (color-theme-faces theme))
+  ;; frame parameters override faces
+  (color-theme-install-frame-params (color-theme-frame-params theme))
+  (when color-theme-history-max-length
+    (color-theme-add-to-history
+     (car theme))))
+
+\f
+
+;; Sharing your stuff
+;;;###autoload
+(defun color-theme-submit ()
+  "Submit your color-theme to the maintainer."
+  (interactive)
+  (require 'reporter)
+  (let ((reporter-eval-buffer (current-buffer))
+       final-resting-place
+       after-sep-pos
+       (reporter-status-message "Formatting buffer...")
+       (reporter-status-count 0)
+       (problem "Yet another color-theme")
+       (agent (reporter-compose-outgoing))
+       (mailbuf (current-buffer))
+       hookvar)
+    ;; do the work
+    (require 'sendmail)
+    ;; If mailbuf did not get made visible before, make it visible now.
+    (let (same-window-buffer-names same-window-regexps)
+      (pop-to-buffer mailbuf)
+      ;; Just in case the original buffer is not visible now, bring it
+      ;; back somewhere
+      (and pop-up-windows (display-buffer reporter-eval-buffer)))
+    (goto-char (point-min))
+    (mail-position-on-field "to")
+    (insert color-theme-maintainer-address)
+    (mail-position-on-field "subject")
+    (insert problem)
+    ;; move point to the body of the message
+    (mail-text)
+    (setq after-sep-pos (point))
+    (unwind-protect
+       (progn
+         (setq final-resting-place (point-marker))
+         (goto-char final-resting-place))
+      (color-theme-print (current-buffer))
+      (goto-char final-resting-place)
+      (insert "\n\n")
+      (goto-char final-resting-place)
+      (insert "Hello there!\n\nHere's my color theme named: ")
+      (set-marker final-resting-place nil))
+    ;; compose the minibuf message and display this.
+    (let* ((sendkey-whereis (where-is-internal
+                            (get agent 'sendfunc) nil t))
+          (abortkey-whereis (where-is-internal
+                             (get agent 'abortfunc) nil t))
+          (sendkey (if sendkey-whereis
+                       (key-description sendkey-whereis)
+                     "C-c C-c")); TBD: BOGUS hardcode
+          (abortkey (if abortkey-whereis
+                        (key-description abortkey-whereis)
+                      "M-x kill-buffer"))); TBD: BOGUS hardcode
+      (message "Enter a message and type %s to send or %s to abort."
+              sendkey abortkey))))
+
+\f
+
+;; Use this to define themes
+(defmacro define-color-theme (name author description &rest forms)
+  (let ((n name))
+    `(progn 
+       (add-to-list 'color-themes
+                    (list ',n
+                          (upcase-initials
+                           (color-theme-replace-in-string
+                            (color-theme-replace-in-string 
+                             (symbol-name ',n) "^color-theme-" "") "-" " "))
+                          ,author))
+       (defun ,n ()
+        ,description
+        (interactive)
+         ,@forms))))
+
+
+;;; FIXME: is this useful ??
+;;;###autoload
+(defun color-theme-initialize ()
+  "Initialize the color theme package by loading color-theme-libraries."
+  (interactive)
+
+  (cond ((and (not color-theme-load-all-themes)
+              color-theme-directory)
+         (setq color-theme-libraries 
+               (directory-files color-theme-directory t "^color-theme")))
+        (color-theme-directory
+         (push (cdr (directory-files color-theme-directory t "^color-theme")) 
+               color-theme-libraries)))
+  (dolist (library color-theme-libraries)
+    (load library)))
+
+(when nil
+  (setq color-theme-directory "themes/"
+        color-theme-load-all-themes nil)
+  (color-theme-initialize)
+)
+;; TODO: I don't like all those function names cluttering up my namespace.
+;; Instead, a hashtable for the color-themes should be created. Now that 
+;; define-color-theme is around, it should be easy to change in just the
+;; one place. 
+
+
+(provide 'color-theme)
+
+;;; color-theme.el ends here
diff --git a/.emacs.d/elisp/local/diminish.el b/.emacs.d/elisp/local/diminish.el
new file mode 100644 (file)
index 0000000..6461e12
--- /dev/null
@@ -0,0 +1,293 @@
+;;; diminish.el --- Diminished modes are minor modes with no modeline display
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Will Mengarini <seldon@eskimo.com>
+;; URL: <http://www.eskimo.com/~seldon>
+;; Created: Th 19 Feb 98
+;; Version: 0.44, Sa 23 Jan 99
+;; Keywords: extensions, diminish, minor, codeprose
+
+;; This file is part of GNU Emacs.
+
+;; 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 2, 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Minor modes each put a word on the mode line to signify that they're
+;; active.  This can cause other displays, such as % of file that point is
+;; at, to run off the right side of the screen.  For some minor modes, such
+;; as mouse-avoidance-mode, the display is a waste of space, since users
+;; typically set the mode in their .emacs & never change it.  For other
+;; modes, such as my jiggle-mode, it's a waste because there's already a
+;; visual indication of whether the mode is in effect.
+
+;; A diminished mode is a minor mode that has had its mode line
+;; display diminished, usually to nothing, although diminishing to a
+;; shorter word or a single letter is also supported.  This package
+;; implements diminished modes.
+
+;; You can use this package either interactively or from your .emacs file.
+;; In either case, first you'll need to copy this file to a directory that
+;; appears in your load-path.  `load-path' is the name of a variable that
+;; contains a list of directories Emacs searches for files to load.
+;; To prepend another directory to load-path, put a line like
+;; (add-to-list 'load-path "c:/My_Directory") in your .emacs file.
+
+;; To create diminished modes interactively, type
+;;   M-x load-library
+;; to get a prompt like
+;;   Load library:
+;; and respond `diminish' (unquoted).  Then type
+;;   M-x diminish
+;; to get a prompt like
+;;   Diminish what minor mode:
+;; and respond with the name of some minor mode, like mouse-avoidance-mode.
+;; You'll then get this prompt:
+;;   To what mode-line display:
+;; Respond by just hitting <Enter> if you want the name of the mode
+;; completely removed from the mode line.  If you prefer, you can abbreviate
+;; the name.  If your abbreviation is 2 characters or more, such as "Av",
+;; it'll be displayed as a separate word on the mode line, just like minor
+;; modes' names.  If it's a single character, such as "V", it'll be scrunched
+;; up against the previous word, so for example if the undiminished mode line
+;; display had been "Abbrev Fill Avoid", it would become "Abbrev FillV".
+;; Multiple single-letter diminished modes will all be scrunched together.
+;; The display of undiminished modes will not be affected.
+
+;; To find out what the mode line would look like if all diminished modes
+;; were still minor, type M-x diminished-modes.  This displays in the echo
+;; area the complete list of minor or diminished modes now active, but
+;; displays them all as minor.  They remain diminished on the mode line.
+
+;; To convert a diminished mode back to a minor mode, type M-x diminish-undo
+;; to get a prompt like
+;;   Restore what diminished mode:
+;; Respond with the name of some diminished mode.  To convert all
+;; diminished modes back to minor modes, respond to that prompt
+;; with `diminished-modes' (unquoted, & note the hyphen).
+
+;; When you're responding to the prompts for mode names, you can use
+;; completion to avoid extra typing; for example, m o u SPC SPC SPC
+;; is usually enough to specify mouse-avoidance-mode.  Mode names
+;; typically end in "-mode", but for historical reasons
+;; auto-fill-mode is named by "auto-fill-function".
+
+;; To create diminished modes noninteractively in your .emacs file, put
+;; code like
+;;   (require 'diminish)
+;;   (diminish 'abbrev-mode "Abv")
+;;   (diminish 'jiggle-mode)
+;;   (diminish 'mouse-avoidance-mode "M")
+;; near the end of your .emacs file.  It should be near the end so that any
+;; minor modes your .emacs loads will already have been loaded by the time
+;; they're to be converted to diminished modes.
+
+;; To diminish a major mode, (setq mode-name "whatever") in the mode hook.
+
+;;; Epigraph:
+
+;;         "The quality of our thoughts is bordered on all sides
+;;          by our facility with language."
+;;               --J. Michael Straczynski
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar diminish-must-not-copy-minor-mode-alist nil
+  "Non-nil means loading diminish.el won't (copy-alist minor-mode-alist).
+Normally `minor-mode-alist' is setq to that copy on loading diminish because
+at least one of its cons cells, that for abbrev-mode, is read-only (see
+ELisp Info on \"pure storage\").  If you setq this variable to t & then
+try to diminish abbrev-mode under GNU Emacs 19.34, you'll get the error
+message \"Attempt to modify read-only object\".")
+
+(or diminish-must-not-copy-minor-mode-alist
+    (callf copy-alist minor-mode-alist))
+
+(defvar diminished-mode-alist nil
+  "The original `minor-mode-alist' value of all (diminish)ed modes.")
+
+(defvar diminish-history-symbols nil
+  "Command history for symbols of diminished modes.")
+
+(defvar diminish-history-names nil
+  "Command history for names of diminished modes.")
+
+;; When we diminish a mode, we are saying we want it to continue doing its
+;; work for us, but we no longer want to be reminded of it.  It becomes a
+;; night worker, like a janitor; it becomes an invisible man; it remains a
+;; component, perhaps an important one, sometimes an indispensable one, of
+;; the mechanism that maintains the day-people's world, but its place in
+;; their thoughts is diminished, usually to nothing.  As we grow old we
+;; diminish more and more such thoughts, such people, usually to nothing.
+
+;; "The wise man knows that to keep under is to endure."  The diminished
+;; often come to value their invisibility.  We speak--speak--of "the strong
+;; silent type", but only as a superficiality; a stereotype in a movie,
+;; perhaps, but even if an acquaintance, necessarily, by hypothesis, a
+;; distant one.  The strong silent type is actually a process.  It begins
+;; with introspection, continues with judgment, and is shaped by the
+;; discovery that these judgments are impractical to share; there is no
+;; appetite for the wisdom of the self-critical among the creatures of
+;; material appetite who dominate our world.  Their dominance's Darwinian
+;; implications reinforce the self-doubt that is the germ of higher wisdom.
+;; The thoughtful contemplate the evolutionary triumph of the predator.
+;; Gnostics deny the cosmos could be so evil; this must all be a prank; the
+;; thoughtful remain silent, invisible, self-diminished, and discover,
+;; perhaps at first in surprise, the freedom they thus gain, and grow strong.
+
+;;;###autoload
+(defun diminish (mode &optional to-what)
+  "Diminish mode-line display of minor mode MODE to TO-WHAT (default \"\").
+
+Interactively, enter (with completion) the name of any minor mode, followed
+on the next line by what you want it diminished to (default empty string).
+The response to neither prompt should be quoted.  However, in Lisp code,
+both args must be quoted, the first as a symbol, the second as a string,
+as in (diminish 'jiggle-mode \" Jgl\").
+
+The mode-line displays of minor modes usually begin with a space, so
+the modes' names appear as separate words on the mode line.  However, if
+you're having problems with a cramped mode line, you may choose to use single
+letters for some modes, without leading spaces.  Capitalizing them works
+best; if you then diminish some mode to \"X\" but have abbrev-mode enabled as
+well, you'll get a display like \"AbbrevX\".  This function prepends a space
+to TO-WHAT if it's > 1 char long & doesn't already begin with a space."
+  (interactive (list (read (completing-read
+                            "Diminish what minor mode: "
+                            (mapcar (lambda (x) (list (symbol-name (car x))))
+                                    minor-mode-alist)
+                            nil t nil 'diminish-history-symbols))
+                     (read-from-minibuffer
+                      "To what mode-line display: "
+                      nil nil nil 'diminish-history-names)))
+  (let ((minor (assq mode minor-mode-alist)))
+    (or minor (error "%S is not currently registered as a minor mode" mode))
+    (callf or to-what "")
+    (when (> (length to-what) 1)
+      (or (= (string-to-char to-what) ?\ )
+          (callf2 concat " " to-what)))
+    (or (assq mode diminished-mode-alist)
+        (push (copy-sequence minor) diminished-mode-alist))
+    (setcdr minor (list to-what))))
+
+;; But an image comes to me, vivid in its unreality, of a loon alone on his
+;; forest lake, shrieking his soul out into a canopy of stars.  Alone this
+;; afternoon in my warm city apartment, I can feel the bite of his night air,
+;; and smell his conifers.  In him there is no acceptance of diminishment.
+
+;; "I have a benevolent habit of pouring out myself to everybody,
+;;  and would even pay for a listener, and I am afraid
+;;  that the Athenians may think me too talkative."
+;;       --Socrates, in the /Euthyphro/
+
+;; I remember a news story about a retired plumber who had somehow managed to
+;; steal a military tank.  He rode it down city streets, rode over a parked
+;; car--no one was hurt--rode onto a freeway, that concrete symbol of the
+;; American spirit, or so we fancy it, shouting "Plumber Bob!  Plumber Bob!".
+;; He was shot dead by police.
+
+;;;###autoload
+(defun diminish-undo (mode)
+  "Restore mode-line display of diminished mode MODE to its minor-mode value.
+Do nothing if the arg is a minor mode that hasn't been diminished.
+
+Interactively, enter (with completion) the name of any diminished mode (a
+mode that was formerly a minor mode on which you invoked M-x diminish).
+To restore all diminished modes to minor status, answer `diminished-modes'.
+The response to the prompt shouldn't be quoted.  However, in Lisp code,
+the arg must be quoted as a symbol, as in (diminish-undo 'diminished-modes)."
+  (interactive
+   (list (read (completing-read
+                "Restore what diminished mode: "
+                (cons (list "diminished-modes")
+                      (mapcar (lambda (x) (list (symbol-name (car x))))
+                              diminished-mode-alist))
+                nil t nil 'diminish-history-symbols))))
+  (if (eq mode 'diminished-modes)
+      (let ((diminished-modes diminished-mode-alist))
+        (while diminished-modes
+          (diminish-undo (caar diminished-modes))
+          (callf cdr diminished-modes)))
+    (let ((minor      (assq mode      minor-mode-alist))
+          (diminished (assq mode diminished-mode-alist)))
+      (or minor
+          (error "%S is not currently registered as a minor mode" mode))
+      (when diminished
+        (setcdr minor (cdr diminished))))))
+
+;; Plumber Bob was not from Seattle, my grey city, for rainy Seattle is a
+;; city of interiors, a city of the self-diminished.  When I moved here one
+;; sunny June I was delighted to find that ducks and geese were common in
+;; the streets.  But I hoped to find a loon or two, and all I found were
+;; ducks and geese.  I wondered about this; I wondered why there were no
+;; loons in Seattle; but my confusion resulted from my ignorance of the
+;; psychology of rain, which is to say my ignorance of diminished modes.
+;; What I needed, and lacked, was a way to discover they were there.
+
+;;;###autoload
+(defun diminished-modes ()
+  "Echo all active diminished or minor modes as if they were minor.
+The display goes in the echo area; if it's too long even for that,
+you can see the whole thing in the *Messages* buffer.
+This doesn't change the status of any modes; it just lets you see
+what diminished modes would be on the mode-line if they were still minor."
+  (interactive)
+  (let ((minor-modes minor-mode-alist)
+        message)
+    (while minor-modes
+      (when (symbol-value (caar minor-modes))
+        ;; This minor mode is active in this buffer
+        (let* ((mode-pair (car minor-modes))
+               (mode (car mode-pair))
+               (minor-pair (or (assq mode diminished-mode-alist) mode-pair))
+               (minor-name (cadr minor-pair)))
+          (when (symbolp minor-name)
+            ;; This minor mode uses symbol indirection in the cdr
+            (let ((symbols-seen (list minor-name)))
+              (while (and (symbolp (callf symbol-value minor-name))
+                          (not (memq minor-name symbols-seen)))
+                (push minor-name symbols-seen))))
+          (push minor-name message)))
+      (callf cdr minor-modes))
+    (setq message (mapconcat 'identity (nreverse message) ""))
+    (when (= (string-to-char message) ?\ )
+      (callf substring message 1))
+    (message "%s" message)))
+
+;; A human mind is a Black Forest of diminished modes.  Some are dangerous;
+;; most of the mind of an intimate is a secret stranger, and these diminished
+;; modes are rendered more unpredictable by their long isolation from the
+;; corrective influence of interaction with reality.  The student of history
+;; learns that this description applies to whole societies as well.  In some
+;; ways the self-diminished are better able to discern the night worker.
+;; They are rendered safer by their heightened awareness of others'
+;; diminished modes, and more congenial by the spare blandness of their own
+;; mode lines.  To some people rain is truly depressing, but others it just
+;; makes pensive, and, forcing them indoors where they may not have the
+;; luxury of solitude, teaches them to self-diminish.  That was what I had
+;; not understood when I was searching for loons among the ducks and geese.
+;; Loons come to Seattle all the time, but the ones that like it learn to be
+;; silent, learn to self-diminish, and take on the colors of ducks and geese.
+;; Now, here a dozen years, I can recognize them everywhere, standing quietly
+;; in line with the ducks and geese at the espresso counter, gazing placidly
+;; out on the world through loon-red eyes, thinking secret thoughts.
+
+(provide 'diminish)
+
+;;; diminish.el ends here
\ No newline at end of file
diff --git a/.emacs.d/elisp/local/filladapt.el b/.emacs.d/elisp/local/filladapt.el
new file mode 100644 (file)
index 0000000..4ae63ab
--- /dev/null
@@ -0,0 +1,981 @@
+;;; Adaptive fill
+;;; Copyright (C) 1989, 1995-1998 Kyle E. Jones
+;;;
+;;; 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 2, 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.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
+;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;;; 02139, USA.
+;;;
+;;; Send bug reports to kyle_jones@wonderworks.com
+
+;; LCD Archive Entry: 
+;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| 
+;; Minor mode to adaptively set fill-prefix and overload filling functions|
+;; 28-February-1998|2.12|~/packages/filladapt.el| 
+
+;; These functions enhance the default behavior of Emacs' Auto Fill
+;; mode and the commands fill-paragraph, lisp-fill-paragraph,
+;; fill-region-as-paragraph and fill-region.
+;;
+;; The chief improvement is that the beginning of a line to be
+;; filled is examined and, based on information gathered, an
+;; appropriate value for fill-prefix is constructed.  Also the
+;; boundaries of the current paragraph are located.  This occurs
+;; only if the fill prefix is not already non-nil.
+;;
+;; The net result of this is that blurbs of text that are offset
+;; from left margin by asterisks, dashes, and/or spaces, numbered
+;; examples, included text from USENET news articles, etc. are
+;; generally filled correctly with no fuss.
+;;
+;; Since this package replaces existing Emacs functions, it cannot
+;; be autoloaded.  Save this in a file named filladapt.el in a
+;; Lisp directory that Emacs knows about, byte-compile it and put
+;;    (require 'filladapt)
+;; in your .emacs file.
+;;
+;; Note that in this release Filladapt mode is a minor mode and it is
+;; _off_ by default.  If you want it to be on by default, use
+;;   (setq-default filladapt-mode t)
+;;
+;; M-x filladapt-mode toggles Filladapt mode on/off in the current
+;; buffer.
+;;
+;; Use
+;;     (add-hook 'text-mode-hook 'turn-on-filladapt-mode)
+;; to have Filladapt always enabled in Text mode.
+;;
+;; Use
+;;     (add-hook 'c-mode-hook 'turn-off-filladapt-mode)
+;; to have Filladapt always disabled in C mode.
+;;
+;; In many cases, you can extend Filladapt by adding appropriate
+;; entries to the following three `defvar's.  See `postscript-comment'
+;; or `texinfo-comment' as a sample of what needs to be done.
+;;
+;;     filladapt-token-table
+;;     filladapt-token-match-table
+;;     filladapt-token-conversion-table
+
+(and (featurep 'filladapt)
+     (error "filladapt cannot be loaded twice in the same Emacs session."))
+
+(provide 'filladapt)
+
+(defvar filladapt-version "2.12"
+  "Version string for filladapt.")
+
+;; BLOB to make custom stuff work even without customize
+(eval-and-compile
+  (condition-case ()
+      (require 'custom)
+    (error nil))
+  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
+      nil ;; We've got what we needed
+    ;; We have the old custom-library, hack around it!
+    (defmacro defgroup (&rest args)
+      nil)
+    (defmacro defcustom (var value doc &rest args) 
+      (` (defvar (, var) (, value) (, doc))))))
+
+(defgroup filladapt nil
+  "Enhanced filling"
+  :group 'fill)
+
+(defvar filladapt-mode nil
+  "Non-nil means that Filladapt minor mode is enabled.
+Use the filladapt-mode command to toggle the mode on/off.")
+(make-variable-buffer-local 'filladapt-mode)
+
+(defcustom filladapt-mode-line-string " Filladapt"
+  "*String to display in the modeline when Filladapt mode is active.
+Set this to nil if you don't want a modeline indicator for Filladapt."
+  :type 'string
+  :group 'filladapt)
+
+(defcustom filladapt-fill-column-tolerance nil
+  "*Tolerate filled paragraph lines ending this far from the fill column.
+If any lines other than the last paragraph line end at a column
+less than fill-column - filladapt-fill-column-tolerance, fill-column will
+be adjusted using the filladapt-fill-column-*-fuzz variables and
+the paragraph will be re-filled until the tolerance is achieved
+or filladapt runs out of fuzz values to try.
+
+A nil value means behave normally, that is, don't try refilling
+paragraphs to make filled line lengths fit within any particular
+range."
+  :type '(choice (const nil)
+                integer)
+  :group 'filladapt)
+
+(defcustom filladapt-fill-column-forward-fuzz 5
+  "*Try values from fill-column to fill-column plus this variable
+when trying to make filled paragraph lines fall with the tolerance
+range specified by filladapt-fill-column-tolerance."
+  :type 'integer
+  :group 'filladapt)
+
+(defcustom filladapt-fill-column-backward-fuzz 5
+  "*Try values from fill-column to fill-column minus this variable
+when trying to make filled paragraph lines fall with the tolerance
+range specified by filladapt-fill-column-tolerance."
+  :type 'integer
+  :group 'filladapt)
+
+;; install on minor-mode-alist
+(or (assq 'filladapt-mode minor-mode-alist)
+    (setq minor-mode-alist (cons (list 'filladapt-mode
+                                      'filladapt-mode-line-string)
+                                minor-mode-alist)))
+
+(defcustom filladapt-token-table
+  '(
+    ;; this must be first
+    ("^" beginning-of-line)
+    ;; Included text in news or mail replies
+    (">+" citation->)
+    ;; Included text generated by SUPERCITE.  We can't hope to match all
+    ;; the possible variations, your mileage may vary.
+    ("\\(\\w\\|[0-9]\\)[^'`\"< \t\n]*>[ \t]*" supercite-citation)
+    ;; Lisp comments
+    (";+" lisp-comment)
+    ;; UNIX shell comments
+    ("#+" sh-comment)
+    ;; Postscript comments
+    ("%+" postscript-comment)
+    ;; C++ comments
+    ("///*" c++-comment)
+    ;; Texinfo comments
+    ("@c[ \t]" texinfo-comment)
+    ("@comment[ \t]" texinfo-comment)
+    ;; Bullet types.
+    ;;
+    ;; LaTex \item
+    ;;
+    ("\\\\item[ \t]" bullet)
+    ;;
+    ;; 1. xxxxx
+    ;;    xxxxx
+    ;;
+    ("[0-9]+\\.[ \t]" bullet)
+    ;;
+    ;; 2.1.3  xxxxx xx x xx x
+    ;;        xxx
+    ;;
+    ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" bullet)
+    ;;
+    ;; a. xxxxxx xx
+    ;;    xxx xxx
+    ;;
+    ("[A-Za-z]\\.[ \t]" bullet)
+    ;;
+    ;; 1) xxxx x xx x xx   or   (1) xx xx x x xx xx
+    ;;    xx xx xxxx                xxx xx x x xx x
+    ;;
+    ("(?[0-9]+)[ \t]" bullet)
+    ;;
+    ;; a) xxxx x xx x xx   or   (a) xx xx x x xx xx
+    ;;    xx xx xxxx                xxx xx x x xx x
+    ;;
+    ("(?[A-Za-z])[ \t]" bullet)
+    ;;
+    ;; 2a. xx x xxx x x xxx
+    ;;     xxx xx x xx x
+    ;;
+    ("[0-9]+[A-Za-z]\\.[ \t]" bullet)
+    ;;
+    ;; 1a) xxxx x xx x xx   or   (1a) xx xx x x xx xx
+    ;;     xx xx xxxx                 xxx xx x x xx x
+    ;;
+    ("(?[0-9]+[A-Za-z])[ \t]" bullet)
+    ;;
+    ;; -  xx xxx xxxx   or   *  xx xx x xxx xxx
+    ;;    xxx xx xx             x xxx x xx x x x
+    ;;
+    ("[-~*+]+[ \t]" bullet)
+    ;;
+    ;; o  xx xxx xxxx xx x xx xxx x xxx xx x xxx
+    ;;    xxx xx xx 
+    ;;
+    ("o[ \t]" bullet)
+    ;; don't touch
+    ("[ \t]+" space)
+    ("$" end-of-line)
+   )
+  "Table of tokens filladapt knows about.
+Format is
+
+   ((REGEXP SYM) ...)
+
+filladapt uses this table to build a tokenized representation of
+the beginning of the current line.  Each REGEXP is matched
+against the beginning of the line until a match is found.
+Matching is done case-sensitively.  The corresponding SYM is
+added to the list, point is moved to (match-end 0) and the
+process is repeated.  The process ends when there is no REGEXP in
+the table that matches what is at point."
+  :type '(repeat (list regexp symbol))
+  :group 'filladapt)
+
+(defcustom filladapt-not-token-table
+  '(
+    "[Ee]\\.g\\.[ \t,]"
+    "[Ii]\\.e\\.[ \t,]"
+    ;; end-of-line isn't a token if whole line is empty
+    "^$"
+   )
+  "List of regexps that can never be a token.
+Before trying the regular expressions in filladapt-token-table,
+the regexps in this list are tried.  If any regexp in this list
+matches what is at point then the token generator gives up and
+doesn't try any of the regexps in filladapt-token-table.
+
+Regexp matching is done case-sensitively."
+  :type '(repeat regexp)
+  :group 'filladapt)
+
+(defcustom filladapt-token-match-table
+  '(
+    (citation-> citation->)
+    (supercite-citation supercite-citation)
+    (lisp-comment lisp-comment)
+    (sh-comment sh-comment)
+    (postscript-comment postscript-comment)
+    (c++-comment c++-comment)
+    (texinfo-comment texinfo-comment)
+    (bullet)
+    (space bullet space)
+    (beginning-of-line beginning-of-line)
+   )
+  "Table describing what tokens a certain token will match.
+
+To decide whether a line belongs in the current paragraph,
+filladapt creates a token list for the fill prefix of both lines.
+Tokens and the columns where tokens end are compared.  This table
+specifies what a certain token will match.
+
+Table format is
+
+   (SYM [SYM1 [SYM2 ...]])
+
+The first symbol SYM is the token, subsequent symbols are the
+tokens that SYM will match."
+  :type '(repeat (repeat symbol))
+  :group 'filladapt)
+
+(defcustom filladapt-token-match-many-table
+  '(
+    space
+   )
+  "List of tokens that can match multiple tokens.
+If one of these tokens appears in a token list, it will eat all
+matching tokens in a token list being matched against it until it
+encounters a token that doesn't match or a token that ends on
+a greater column number."
+  :type '(repeat symbol)
+  :group 'filladapt)
+
+(defcustom filladapt-token-paragraph-start-table
+  '(
+    bullet
+   )
+  "List of tokens that indicate the start of a paragraph.
+If parsing a line generates a token list containing one of
+these tokens, then the line is considered to be the start of a
+paragraph."
+  :type '(repeat symbol)
+  :group 'filladapt)
+
+(defcustom filladapt-token-conversion-table
+  '(
+    (citation-> . exact)
+    (supercite-citation . exact)
+    (lisp-comment . exact)
+    (sh-comment . exact)
+    (postscript-comment . exact)
+    (c++-comment . exact)
+    (texinfo-comment . exact)
+    (bullet . spaces)
+    (space . exact)
+    (end-of-line . exact)
+   )
+  "Table that specifies how to convert a token into a fill prefix.
+Table format is
+
+   ((SYM . HOWTO) ...)
+
+SYM is the symbol naming the token to be converted.
+HOWTO specifies how to do the conversion.
+  `exact' means copy the token's string directly into the fill prefix.
+  `spaces' means convert all characters in the token string that are
+      not a TAB or a space into spaces and copy the resulting string into 
+      the fill prefix."
+  :type '(repeat (cons symbol (choice (const exact)
+                                     (const spaces))))
+  :group 'filladapt)
+
+(defvar filladapt-function-table
+  (let ((assoc-list
+        (list (cons 'fill-paragraph (symbol-function 'fill-paragraph))
+              (cons 'fill-region (symbol-function 'fill-region))
+              (cons 'fill-region-as-paragraph
+                    (symbol-function 'fill-region-as-paragraph))
+              (cons 'do-auto-fill (symbol-function 'do-auto-fill)))))
+    ;; v18 Emacs doesn't have lisp-fill-paragraph
+    (if (fboundp 'lisp-fill-paragraph)
+       (nconc assoc-list
+              (list (cons 'lisp-fill-paragraph
+                          (symbol-function 'lisp-fill-paragraph)))))
+    assoc-list )
+  "Table containing the old function definitions that filladapt usurps.")
+
+(defcustom filladapt-fill-paragraph-post-hook nil
+  "Hooks run after filladapt runs fill-paragraph."
+  :type 'hook
+  :group 'filladapt)
+
+(defvar filladapt-inside-filladapt nil
+  "Non-nil if the filladapt version of a fill function executing.
+Currently this is only checked by the filladapt version of
+fill-region-as-paragraph to avoid this infinite recursion:
+
+  fill-region-as-paragraph -> fill-paragraph -> fill-region-as-paragraph ...")
+
+(defcustom filladapt-debug nil
+  "Non-nil means filladapt debugging is enabled.
+Use the filladapt-debug command to turn on debugging.
+
+With debugging enabled, filladapt will
+
+    a. display the proposed indentation with the tokens highlighted
+       using filladapt-debug-indentation-face-1 and
+       filladapt-debug-indentation-face-2.
+    b. display the current paragraph using the face specified by
+       filladapt-debug-paragraph-face."
+  :type 'boolean
+  :group 'filladapt)
+
+(if filladapt-debug
+    (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe))
+
+(defvar filladapt-debug-indentation-face-1 'highlight
+  "Face used to display the indentation when debugging is enabled.")
+
+(defvar filladapt-debug-indentation-face-2 'secondary-selection
+  "Another face used to display the indentation when debugging is enabled.")
+
+(defvar filladapt-debug-paragraph-face 'bold
+  "Face used to display the current paragraph when debugging is enabled.")
+
+(defvar filladapt-debug-indentation-extents nil)
+(make-variable-buffer-local 'filladapt-debug-indentation-extents)
+(defvar filladapt-debug-paragraph-extent nil)
+(make-variable-buffer-local 'filladapt-debug-paragraph-extent)
+
+;; kludge city, see references in code.
+(defvar filladapt-old-line-prefix)
+
+(defun do-auto-fill ()
+  (catch 'done
+    (if (and filladapt-mode (null fill-prefix))
+       (save-restriction
+         (let ((paragraph-ignore-fill-prefix nil)
+               ;; if the user wanted this stuff, they probably
+               ;; wouldn't be using filladapt-mode.
+               (adaptive-fill-mode nil)
+               (adaptive-fill-regexp nil)
+               ;; need this or Emacs 19 ignores fill-prefix when
+               ;; inside a comment.
+               (comment-multi-line t)
+               (filladapt-inside-filladapt t)
+               fill-prefix retval)
+           (if (filladapt-adapt nil nil)
+               (progn
+                 (setq retval (filladapt-funcall 'do-auto-fill))
+                 (throw 'done retval))))))
+    (filladapt-funcall 'do-auto-fill)))
+
+(defun filladapt-fill-paragraph (function arg)
+  (catch 'done
+    (if (and filladapt-mode (null fill-prefix))
+       (save-restriction
+         (let ((paragraph-ignore-fill-prefix nil)
+               ;; if the user wanted this stuff, they probably
+               ;; wouldn't be using filladapt-mode.
+               (adaptive-fill-mode nil)
+               (adaptive-fill-regexp nil)
+               ;; need this or Emacs 19 ignores fill-prefix when
+               ;; inside a comment.
+               (comment-multi-line t)
+               fill-prefix retval)
+           (if (filladapt-adapt t nil)
+               (progn
+                 (if filladapt-fill-column-tolerance
+                     (let* ((low (- fill-column
+                                    filladapt-fill-column-backward-fuzz))
+                            (high (+ fill-column
+                                     filladapt-fill-column-forward-fuzz))
+                            (old-fill-column fill-column)
+                            (fill-column fill-column)
+                            (lim (- high low))
+                            (done nil)
+                            (sign 1)
+                            (delta 0))
+                       (while (not done)
+                         (setq retval (filladapt-funcall function arg))
+                         (if (filladapt-paragraph-within-fill-tolerance)
+                             (setq done 'success)
+                           (setq delta (1+ delta)
+                                 sign (* sign -1)
+                                 fill-column (+ fill-column (* delta sign)))
+                           (while (and (<= delta lim)
+                                       (or (< fill-column low)
+                                           (> fill-column high)))
+                             (setq delta (1+ delta)
+                                   sign (* sign -1)
+                                   fill-column (+ fill-column
+                                                  (* delta sign))))
+                           (setq done (> delta lim))))
+                       ;; if the paragraph lines never fell
+                       ;; within the tolerances, refill using
+                       ;; the old fill-column.
+                       (if (not (eq done 'success))
+                           (let ((fill-column old-fill-column))
+                             (setq retval (filladapt-funcall function arg)))))
+                   (setq retval (filladapt-funcall function arg)))
+                 (run-hooks 'filladapt-fill-paragraph-post-hook)
+                 (throw 'done retval))))))
+    ;; filladapt-adapt failed, so do fill-paragraph normally.
+    (filladapt-funcall function arg)))
+
+(defun fill-paragraph (arg)
+  "Fill paragraph at or after point.  Prefix arg means justify as well.
+
+(This function has been overloaded with the `filladapt' version.)
+
+If `sentence-end-double-space' is non-nil, then period followed by one
+space does not end a sentence, so don't break a line there.
+
+If `fill-paragraph-function' is non-nil, we call it (passing our
+argument to it), and if it returns non-nil, we simply return its value."
+  (interactive "*P")
+  (let ((filladapt-inside-filladapt t))
+    (filladapt-fill-paragraph 'fill-paragraph arg)))
+
+(defun lisp-fill-paragraph (&optional arg)
+  "Like \\[fill-paragraph], but handle Emacs Lisp comments.
+
+(This function has been overloaded with the `filladapt' version.)
+
+If any of the current line is a comment, fill the comment or the
+paragraph of it that point is in, preserving the comment's indentation
+and initial semicolons."
+  (interactive "*P")
+  (let ((filladapt-inside-filladapt t))
+    (filladapt-fill-paragraph 'lisp-fill-paragraph arg)))
+
+(defun fill-region-as-paragraph (beg end &optional justify
+                                nosqueeze squeeze-after)
+  "Fill the region as one paragraph.
+
+(This function has been overloaded with the `filladapt' version.)
+
+It removes any paragraph breaks in the region and extra newlines at the end,
+indents and fills lines between the margins given by the
+`current-left-margin' and `current-fill-column' functions.
+It leaves point at the beginning of the line following the paragraph.
+
+Normally performs justification according to the `current-justification'
+function, but with a prefix arg, does full justification instead.
+
+From a program, optional third arg JUSTIFY can specify any type of
+justification.  Fourth arg NOSQUEEZE non-nil means not to make spaces
+between words canonical before filling.  Fifth arg SQUEEZE-AFTER, if non-nil,
+means don't canonicalize spaces before that position.
+
+If `sentence-end-double-space' is non-nil, then period followed by one
+space does not end a sentence, so don't break a line there."
+  (interactive "*r\nP")
+  (if (and filladapt-mode (not filladapt-inside-filladapt))
+      (save-restriction
+       (narrow-to-region beg end)
+       (let ((filladapt-inside-filladapt t)
+             line-start last-token)
+         (goto-char beg)
+         (while (equal (char-after (point)) ?\n)
+           (delete-char 1))
+         (end-of-line)
+         (while (zerop (forward-line))
+           (if (setq last-token
+                     (car (filladapt-tail (filladapt-parse-prefixes))))
+               (progn
+                 (setq line-start (point))
+                 (move-to-column (nth 1 last-token))
+                 (delete-region line-start (point))))
+           ;; Dance...
+           ;;
+           ;; Do this instead of (delete-char -1) to keep
+           ;; markers on the correct side of the whitespace.
+           (goto-char (1- (point)))
+           (insert " ")
+           (delete-char 1)
+
+           (end-of-line))
+         (goto-char beg)
+         (fill-paragraph justify))
+       ;; In XEmacs 19.12 and Emacs 18.59 fill-region relies on
+       ;; fill-region-as-paragraph to do this.  If we don't do
+       ;; it, fill-region will spin in an endless loop.
+       (goto-char (point-max)))
+    (condition-case nil
+       ;; five args for Emacs 19.31
+       (filladapt-funcall 'fill-region-as-paragraph beg end
+                          justify nosqueeze squeeze-after)
+      (wrong-number-of-arguments
+       (condition-case nil
+          ;; four args for Emacs 19.29
+          (filladapt-funcall 'fill-region-as-paragraph beg end
+                             justify nosqueeze)
+        ;; three args for the rest of the world.
+        (wrong-number-of-arguments
+         (filladapt-funcall 'fill-region-as-paragraph beg end justify)))))))
+
+(defun fill-region (beg end &optional justify nosqueeze to-eop)
+  "Fill each of the paragraphs in the region.
+
+(This function has been overloaded with the `filladapt' version.)
+
+Prefix arg (non-nil third arg, if called from program) means justify as well.
+
+Noninteractively, fourth arg NOSQUEEZE non-nil means to leave
+whitespace other than line breaks untouched, and fifth arg TO-EOP
+non-nil means to keep filling to the end of the paragraph (or next
+hard newline, if `use-hard-newlines' is on).
+
+If `sentence-end-double-space' is non-nil, then period followed by one
+space does not end a sentence, so don't break a line there."
+  (interactive "*r\nP")
+  (if (and filladapt-mode (not filladapt-inside-filladapt))
+      (save-restriction
+       (narrow-to-region beg end)
+       (let ((filladapt-inside-filladapt t)
+             start)
+         (goto-char beg)
+         (while (not (eobp))
+           (setq start (point))
+           (while (and (not (eobp)) (not (filladapt-parse-prefixes)))
+             (forward-line 1))
+           (if (not (equal start (point)))
+               (progn
+                 (save-restriction
+                   (narrow-to-region start (point))
+                   (fill-region start (point) justify nosqueeze to-eop)
+                   (goto-char (point-max)))
+                 (if (and (not (bolp)) (not (eobp)))
+                     (forward-line 1))))
+           (if (filladapt-parse-prefixes)
+               (progn
+                 (save-restriction
+                   ;; for the clipping region
+                   (filladapt-adapt t t)
+                   (fill-paragraph justify)
+                   (goto-char (point-max)))
+                 (if (and (not (bolp)) (not (eobp)))
+                     (forward-line 1)))))))
+    (condition-case nil
+       (filladapt-funcall 'fill-region beg end justify nosqueeze to-eop)
+      (wrong-number-of-arguments
+       (condition-case nil
+          (filladapt-funcall 'fill-region beg end justify nosqueeze)
+        (wrong-number-of-arguments
+         (filladapt-funcall 'fill-region beg end justify)))))))
+
+(defvar zmacs-region-stays) ; for XEmacs
+
+(defun filladapt-mode (&optional arg)
+  "Toggle Filladapt minor mode.
+With arg, turn Filladapt mode on iff arg is positive.  When
+Filladapt mode is enabled, auto-fill-mode and the fill-paragraph
+command are both smarter about guessing a proper fill-prefix and
+finding paragraph boundaries when bulleted and indented lines and
+paragraphs are used."
+  (interactive "P")
+  ;; don't deactivate the region.
+  (setq zmacs-region-stays t)
+  (setq filladapt-mode (or (and arg (> (prefix-numeric-value arg) 0))
+                          (and (null arg) (null filladapt-mode))))
+  (if (fboundp 'force-mode-line-update)
+      (force-mode-line-update)
+    (set-buffer-modified-p (buffer-modified-p))))
+
+(defun turn-on-filladapt-mode ()
+  "Unconditionally turn on Filladapt mode in the current buffer."
+  (filladapt-mode 1))
+
+(defun turn-off-filladapt-mode ()
+  "Unconditionally turn off Filladapt mode in the current buffer."
+  (filladapt-mode -1))
+
+(defun filladapt-funcall (function &rest args)
+  "Call the old definition of a function that filladapt has usurped."
+  (apply (cdr (assoc function filladapt-function-table)) args))
+
+(defun filladapt-paragraph-start (list)
+  "Returns non-nil if LIST contains a paragraph starting token.
+LIST should be a token list as returned by filladapt-parse-prefixes."
+  (catch 'done
+    (while list
+      (if (memq (car (car list)) filladapt-token-paragraph-start-table)
+         (throw 'done t))
+      (setq list (cdr list)))))
+
+(defun filladapt-parse-prefixes ()
+  "Parse all the tokens after point and return a list of them.
+The tokens regular expressions are specified in
+filladapt-token-table.  The list returned is of this form
+
+  ((SYM COL STRING) ...)
+
+SYM is a token symbol as found in filladapt-token-table.
+COL is the column at which the token ended.
+STRING is the token's text."
+  (save-excursion
+    (let ((token-list nil)
+         (done nil)
+         (old-point (point))
+         (case-fold-search nil)
+         token-table not-token-table moved)
+      (catch 'done
+       (while (not done)
+         (setq not-token-table filladapt-not-token-table)
+         (while not-token-table
+           (if (looking-at (car not-token-table))
+               (throw 'done t))
+           (setq not-token-table (cdr not-token-table)))
+         (setq token-table filladapt-token-table
+               done t)
+         (while token-table
+           (if (null (looking-at (car (car token-table))))
+               (setq token-table (cdr token-table))
+             (goto-char (match-end 0))
+             (setq token-list (cons (list (nth 1 (car token-table))
+                                          (current-column)
+                                          (buffer-substring
+                                           (match-beginning 0)
+                                           (match-end 0)))
+                                    token-list)
+                   moved (not (eq (point) old-point))
+                   token-table (if moved nil (cdr token-table))
+                   done (not moved)
+                   old-point (point))))))
+      (nreverse token-list))))
+
+(defun filladapt-tokens-match-p (list1 list2)
+  "Compare two token lists and return non-nil if they match, nil otherwise.
+The lists are walked through in lockstep, comparing tokens.
+
+When two tokens A and B are compared, they are considered to
+match if
+
+    1. A appears in B's list of matching tokens or
+       B appears in A's list of matching tokens
+and
+    2. A and B both end at the same column
+         or
+       A can match multiple tokens and ends at a column > than B
+         or
+       B can match multiple tokens and ends at a column > than A
+
+In the case where the end columns differ the list pointer for the
+token with the greater end column is not moved forward, which
+allows its current token to be matched against the next token in
+the other list in the next iteration of the matching loop.
+
+All tokens must be matched in order for the lists to be considered
+matching."
+  (let ((matched t)
+       (done nil))
+    (while (and (not done) list1 list2)
+      (let* ((token1 (car (car list1)))
+            (token1-matches-many-p
+                (memq token1 filladapt-token-match-many-table))
+            (token1-matches (cdr (assq token1 filladapt-token-match-table)))
+            (token1-endcol (nth 1 (car list1)))
+            (token2 (car (car list2)))
+            (token2-matches-many-p
+                (memq token2 filladapt-token-match-many-table))
+            (token2-matches (cdr (assq token2 filladapt-token-match-table)))
+            (token2-endcol (nth 1 (car list2)))
+            (tokens-match (or (memq token1 token2-matches)
+                              (memq token2 token1-matches))))
+       (cond ((not tokens-match)
+              (setq matched nil
+                    done t))
+             ((and token1-matches-many-p token2-matches-many-p)
+              (cond ((= token1-endcol token2-endcol)
+                     (setq list1 (cdr list1)
+                           list2 (cdr list2)))
+                    ((< token1-endcol token2-endcol)
+                     (setq list1 (cdr list1)))
+                    (t
+                     (setq list2 (cdr list2)))))
+             (token1-matches-many-p
+              (cond ((= token1-endcol token2-endcol)
+                     (setq list1 (cdr list1)
+                           list2 (cdr list2)))
+                    ((< token1-endcol token2-endcol)
+                     (setq matched nil
+                           done t))
+                    (t
+                     (setq list2 (cdr list2)))))
+             (token2-matches-many-p
+              (cond ((= token1-endcol token2-endcol)
+                     (setq list1 (cdr list1)
+                           list2 (cdr list2)))
+                    ((< token2-endcol token1-endcol)
+                     (setq matched nil
+                           done t))
+                    (t
+                     (setq list1 (cdr list1)))))
+             ((= token1-endcol token2-endcol)
+              (setq list1 (cdr list1)
+                    list2 (cdr list2)))
+             (t
+              (setq matched nil
+                    done t)))))
+    (and matched (null list1) (null list2)) ))
+
+(defun filladapt-make-fill-prefix (list)
+  "Build a fill-prefix for a token LIST.
+filladapt-token-conversion-table specifies how this is done."
+  (let ((prefix-list nil)
+       (conversion-spec nil))
+    (while list
+      (setq conversion-spec (cdr (assq (car (car list))
+                                      filladapt-token-conversion-table)))
+      (cond ((eq conversion-spec 'spaces)
+            (setq prefix-list
+                  (cons
+                   (filladapt-convert-to-spaces (nth 2 (car list)))
+                   prefix-list)))
+           ((eq conversion-spec 'exact)
+            (setq prefix-list
+                  (cons
+                   (nth 2 (car list))
+                   prefix-list))))
+      (setq list (cdr list)))
+    (apply (function concat) (nreverse prefix-list)) ))
+
+(defun filladapt-paragraph-within-fill-tolerance ()
+  (catch 'done
+    (save-excursion
+      (let ((low (- fill-column filladapt-fill-column-tolerance))
+           (shortline nil))
+       (goto-char (point-min))
+       (while (not (eobp))
+         (if shortline
+             (throw 'done nil)
+           (end-of-line)
+           (setq shortline (< (current-column) low))
+           (forward-line 1)))
+       t ))))
+
+(defun filladapt-convert-to-spaces (string)
+  "Return a copy of STRING, with all non-tabs and non-space changed to spaces."
+  (let ((i 0)
+       (space-list '(?\  ?\t))
+       (space ?\ )
+       (lim (length string)))
+    (setq string (copy-sequence string))
+    (while (< i lim)
+      (if (not (memq (aref string i) space-list))
+         (aset string i space))
+      (setq i (1+ i)))
+    string ))
+
+(defun filladapt-adapt (paragraph debugging)
+  "Set fill-prefix based on the contents of the current line.
+
+If the first arg PARAGRAPH is non-nil, also set a clipping region
+around the current paragraph.
+
+If the second arg DEBUGGING is non-nil, don't do the kludge that's
+necessary to make certain paragraph fills work properly."
+  (save-excursion
+    (beginning-of-line)
+    (let ((token-list (filladapt-parse-prefixes))
+         curr-list done)
+      (if (null token-list)
+         nil
+       (setq fill-prefix (filladapt-make-fill-prefix token-list))
+       (if paragraph
+           (let (beg end)
+             (if (filladapt-paragraph-start token-list)
+                 (setq beg (point))
+               (save-excursion
+                 (setq done nil)
+                 (while (not done)
+                   (cond ((not (= 0 (forward-line -1)))
+                          (setq done t
+                                beg (point)))
+                         ((not (filladapt-tokens-match-p
+                                token-list
+                                (setq curr-list (filladapt-parse-prefixes))))
+                          (forward-line 1)
+                          (setq done t
+                                beg (point)))
+                         ((filladapt-paragraph-start curr-list)
+                          (setq done t
+                                beg (point)))))))
+             (save-excursion
+               (setq done nil)
+               (while (not done)
+                 (cond ((not (= 0 (progn (end-of-line) (forward-line 1))))
+                        (setq done t
+                              end (point)))
+                       ((not (filladapt-tokens-match-p
+                              token-list
+                              (setq curr-list (filladapt-parse-prefixes))))
+                        (setq done t
+                              end (point)))
+                       ((filladapt-paragraph-start curr-list)
+                        (setq done t
+                              end (point))))))
+             (narrow-to-region beg end)
+             ;; Multiple spaces after the bullet at the start of
+             ;; a hanging list paragraph get squashed by
+             ;; fill-paragraph.  We kludge around this by
+             ;; replacing the line prefix with the fill-prefix
+             ;; used by the rest of the lines in the paragraph.
+             ;; fill-paragraph will not alter the fill prefix so
+             ;; we win.  The post hook restores the old line prefix
+             ;; after fill-paragraph has been called.
+             (if (and paragraph (not debugging))
+                 (let (col)
+                   (setq col (nth 1 (car (filladapt-tail token-list))))
+                   (goto-char (point-min))
+                   (move-to-column col)
+                   (setq filladapt-old-line-prefix
+                         (buffer-substring (point-min) (point)))
+                   (delete-region (point-min) (point))
+                   (insert fill-prefix)
+                   (add-hook 'filladapt-fill-paragraph-post-hook
+                             'filladapt-cleanup-kludge-at-point-min)))))
+       t ))))
+
+(defun filladapt-cleanup-kludge-at-point-min ()
+  "Cleanup the paragraph fill kludge.
+See filladapt-adapt."
+  (save-excursion
+    (goto-char (point-min))
+    (insert filladapt-old-line-prefix)
+    (delete-char (length fill-prefix))
+    (remove-hook 'filladapt-fill-paragraph-post-hook
+                'filladapt-cleanup-kludge-at-point-min)))
+
+(defun filladapt-tail (list)
+  "Returns the last cons in LIST."
+  (if (null list)
+      nil
+    (while (consp (cdr list))
+      (setq list (cdr list)))
+    list ))
+
+(defun filladapt-delete-extent (e)
+  (if (fboundp 'delete-extent)
+      (delete-extent e)
+    (delete-overlay e)))
+
+(defun filladapt-make-extent (beg end)
+  (if (fboundp 'make-extent)
+      (make-extent beg end)
+    (make-overlay beg end)))
+
+(defun filladapt-set-extent-endpoints (e beg end)
+  (if (fboundp 'set-extent-endpoints)
+      (set-extent-endpoints e beg end)
+    (move-overlay e beg end)))
+
+(defun filladapt-set-extent-property (e prop val)
+  (if (fboundp 'set-extent-property)
+      (set-extent-property e prop val)
+    (overlay-put e prop val)))
+
+(defun filladapt-debug ()
+  "Toggle filladapt debugging on/off in the current buffer."
+;;  (interactive)
+  (make-local-variable 'filladapt-debug)
+  (setq filladapt-debug (not filladapt-debug))
+  (if (null filladapt-debug)
+      (progn
+       (mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1)))
+               filladapt-debug-indentation-extents)
+       (if filladapt-debug-paragraph-extent
+           (progn
+             (filladapt-delete-extent filladapt-debug-paragraph-extent)
+             (setq filladapt-debug-paragraph-extent nil)))))
+  (add-hook 'post-command-hook 'filladapt-display-debug-info-maybe))
+
+(defun filladapt-display-debug-info-maybe ()
+  (cond ((null filladapt-debug) nil)
+       (fill-prefix nil)
+       (t
+        (if (null filladapt-debug-paragraph-extent)
+            (let ((e (filladapt-make-extent 1 1)))
+              (filladapt-set-extent-property e 'detachable nil)
+              (filladapt-set-extent-property e 'evaporate nil)
+              (filladapt-set-extent-property e 'face
+                                             filladapt-debug-paragraph-face)
+              (setq filladapt-debug-paragraph-extent e)))
+        (save-excursion
+          (save-restriction
+            (let ((ei-list filladapt-debug-indentation-extents)
+                  (ep filladapt-debug-paragraph-extent)
+                  (face filladapt-debug-indentation-face-1)
+                  fill-prefix token-list)
+              (if (null (filladapt-adapt t t))
+                  (progn
+                    (filladapt-set-extent-endpoints ep 1 1)
+                    (while ei-list
+                      (filladapt-set-extent-endpoints (car ei-list) 1 1)
+                      (setq ei-list (cdr ei-list))))
+                (filladapt-set-extent-endpoints ep (point-min) (point-max))
+                (beginning-of-line)
+                (setq token-list (filladapt-parse-prefixes))
+                (message "(%s)" (mapconcat (function
+                                          (lambda (q) (symbol-name (car q))))
+                                         token-list
+                                         " "))
+                (while token-list
+                  (if ei-list
+                      (setq e (car ei-list)
+                            ei-list (cdr ei-list))
+                    (setq e (filladapt-make-extent 1 1))
+                    (filladapt-set-extent-property e 'detachable nil)
+                    (filladapt-set-extent-property e 'evaporate nil)
+                    (setq filladapt-debug-indentation-extents
+                          (cons e filladapt-debug-indentation-extents)))
+                  (filladapt-set-extent-property e 'face face)
+                  (filladapt-set-extent-endpoints e (point)
+                                                  (progn
+                                                    (move-to-column
+                                                     (nth 1
+                                                          (car token-list)))
+                                                    (point)))
+                  (if (eq face filladapt-debug-indentation-face-1)
+                      (setq face filladapt-debug-indentation-face-2)
+                    (setq face filladapt-debug-indentation-face-1))
+                  (setq token-list (cdr token-list)))
+                (while ei-list
+                  (filladapt-set-extent-endpoints (car ei-list) 1 1)
+                  (setq ei-list (cdr ei-list))))))))))
index 7055903..15bd2e8 100644 (file)
@@ -925,6 +925,7 @@ buffer is not visiting a file."
   "Kill all buffers but the current one.
 Doesn't mess with special buffers."
   (interactive)
+  (require 'dash)
   (-each
    (->> (buffer-list)
      (-filter #'buffer-file-name)
diff --git a/.emacs.d/elisp/local/region-bindings-mode.el b/.emacs.d/elisp/local/region-bindings-mode.el
new file mode 100644 (file)
index 0000000..24aaa93
--- /dev/null
@@ -0,0 +1,119 @@
+;;; region-bindings-mode.el --- Enable custom bindings when mark is active.
+
+;; Copyright (C) 2012  Fabián E. Gallina
+
+;; Author: Fabián E. Gallina <fabian@anue.biz>
+;; URL: https://github.com/fgallina/region-bindings-mode
+;; Version: 0.1
+;; Created: Oct 2012
+;; Keywords: convenience
+
+;; This file is NOT part of GNU Emacs.
+
+;; region-bindings-mode 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 of
+;; the License, or (at your option) any later version.
+
+;; region-bindings-mode 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 region-bindings-mode.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Minor mode that enables the ability of having a custom keys for
+;; working with regions.  This is a pretty good way to keep the global
+;; bindings clean.
+
+;;; Installation:
+
+;; Add this to your .emacs:
+
+;; (add-to-list 'load-path "/folder/containing/file")
+;; (require 'region-bindings-mode)
+;; (region-bindings-mode-enable)
+
+;;; Usage:
+
+;; Now that region-bindings-mode has been installed and initialized
+;; all you need to do is to add keys to it, here's and example:
+
+;; (define-key region-bindings-mode-map "g" 'keyboard-quit)
+
+;; And as you would expect that will trigger a `keyboard-quit' when
+;; pressing g, but this only happens when region is active.
+
+;; You can have fine grained control on the situations where this mode
+;; should not be enabled, the first is using the simple
+;; `region-bindings-mode-disabled-modes' variable and the other is
+;; using `region-bindings-mode-disable-predicates'.  This is just a
+;; list of functions that receive no args and if any of them return
+;; non-nil the mode is not enabled.
+
+;; If you want to disable the mode completely, please use
+;; `region-bindings-mode-disable'.
+
+;;; Code:
+
+(defgroup region-bindings-mode nil
+  "Indenting and region-bindings-modeing text."
+  :group 'region-bindings-mode)
+
+(defvar region-bindings-mode-map
+  (let ((region-bindings-mode-map (make-sparse-keymap)))
+    region-bindings-mode-map)
+  "Keymaps for command `region-bindings-mode-map'.")
+
+(defcustom region-bindings-mode-disable-predicates nil
+  "List of predicates that disable the mode.
+Each function in the list receive no argument."
+  :group 'region-bindings-mode)
+
+(defcustom region-bindings-mode-disabled-modes nil
+  "Modes where `region-bindings-mode' should not activate."
+  :group 'region-bindings-mode
+  :type '(repeat symbol))
+
+(define-minor-mode region-bindings-mode
+  "Enable special bindings when working with regions."
+  :lighter " rk" :group 'convenience)
+
+(defun region-bindings-mode-on ()
+  "Turn on region bindings mode.
+Don't use this, use `region-bindings-mode-enable'."
+  (and (not (memq major-mode region-bindings-mode-disabled-modes))
+       (not (catch 'disable
+              (dolist (pred region-bindings-mode-disable-predicates)
+                (and (funcall pred)
+                     (throw 'disable t)))))
+       (region-bindings-mode 1)))
+
+(defun region-bindings-mode-off ()
+  "Turn off region bindings mode.
+Don't use this, use `region-bindings-mode-disable'."
+  (region-bindings-mode -1))
+
+(defun region-bindings-mode-enable ()
+  "Add initialization hooks."
+  (add-hook 'activate-mark-hook 'region-bindings-mode-on)
+  (add-hook 'deactivate-mark-hook 'region-bindings-mode-off))
+
+(defun region-bindings-mode-disable ()
+  "Remove initialization hooks and turn off."
+  (remove-hook 'activate-mark-hook 'region-bindings-mode-on)
+  (remove-hook 'deactivate-mark-hook 'region-bindings-mode-off)
+  (region-bindings-mode -1))
+
+(provide 'region-bindings-mode)
+
+;; Local Variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
+
+;;; region-bindings-mode.el ends here