--- a/.hgignore Sat Jun 22 22:54:53 2013 -0500
+++ b/.hgignore Mon Jun 24 21:39:26 2013 -0500
@@ -1,8 +1,6 @@
syntax: regexp
-yasnippet\/
-nav\/
-url\/
-
+^url\/
+^elpa\/
\.elc$
~$
\#.*\#$
--- a/haskell-init.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,45 +0,0 @@
-;; ~/.emacs.d/haskell-init.el
-;; Luke Hoersten <[email protected]>
-
-(add-to-list 'load-path "~/.emacs.d/thirdparty/haskell-mode/")
-(require 'haskell-mode-autoloads)
-
-;; (add-to-list 'load-path "~/.emacs.d/thirdparty/haskell-mode") ; override haskell mode on system
-;;(add-to-list 'load-path "~/.cabal/share/ghc-mod-2.0.2") ; load ghc-mod from cabal
-;; (autoload 'ghc-init "~/.emacs.d/thirdparty/ghc-mod-2.0.2/ghc" nil t)
-
-;; (load "haskell-site-file")
-
-;; ;; scion
-;; (if (file-exists-p "~/.cabal/share/scion-0.3/emacs/scion.el")
-;; (progn
-;; (add-to-list 'load-path "~/.cabal/share/scion-0.3/emacs")
-;; (require 'scion)
-;; (setq scion-program "~/.cabal/bin/scion-server")
-;; (add-hook
-;; 'haskell-mode-hook
-;; (lambda ()
-;; (scion-mode 1)
-;; (scion-flycheck-on-save 1)
-;; (setq scion-completing-read-function 'ido-completing-read)))))
-
-(add-hook
- 'haskell-mode-hook
- (lambda ()
- ;; (ghc-init)
- (turn-on-haskell-indent)
- (capitalized-words-mode)
- (turn-on-haskell-doc-mode)
- (turn-on-haskell-decl-scan)
- (imenu-add-menubar-index)
- (setq
- haskell-font-lock-haddock t
- haskell-stylish-on-save t
- ;; haskell-tags-on-save t
- haskell-program-name "ghci"
- haskell-indent-offset 4
- whitespace-line-column 78)
- ))
-
-(message "Loading haskell-init...done")
-(provide 'haskell-init)
--- a/init.el Sat Jun 22 22:54:53 2013 -0500
+++ b/init.el Mon Jun 24 21:39:26 2013 -0500
@@ -40,7 +40,10 @@
;;; Darwin
(if (string-match "darwin" (emacs-version))
(progn
- (setq-default mac-command-modifier 'meta)))
+ (setq-default
+ mac-command-modifier 'meta
+ ns-pop-up-frames nil
+ ispell-program-name "/usr/local/bin/aspell")))
;;; Xorg
(if window-system
@@ -75,8 +78,8 @@
;;;; Mode-Specific ;;;;
;;; text-mode
-(add-hook 'fundamental-mode-hook 'flyspell-mode t) ; spellcheck text
-(add-hook 'fundamental-mode-hook 'turn-on-auto-fill) ; autofill text
+(add-hook 'fundamental-mode-hook 'flyspell-mode t) ; spellcheck text
+(add-hook 'fundamental-mode-hook 'turn-on-auto-fill) ; autofill text
;;; ido-mode
(ido-mode t) ; file/buffer selector
@@ -128,43 +131,60 @@
(ibuffer-switch-to-saved-filter-groups "default")))
-;;;; Requires ;;;;
+;;;; Requires and Packages ;;;;
-(add-to-list 'load-path "~/.emacs.d/thirdparty") ; set default third party path
-
-;;; language init
+;;; custom inits
(require 'c-init) ; c specific elisp
-(require 'haskell-init) ; haskell specific elisp
-(require 'color-theme-init) ; color theme specific elisp
-(require 'rainbow-delimiters) ; multi-colored parens
-
-;;; function init
(require 'align-with-spaces) ; use only spaces for alignment
(require 'pastebin-region) ; send selected text to pastebin
(require 'move-line) ; move line up or down
+(require 'uniquify) ; unique buffer names with dirs
+
+;;; uniquify
+(setq
+ uniquify-buffer-name-style 'post-forward
+ uniquify-separator ":")
+
+;;; packages
+(package-initialize)
+(add-to-list 'package-archives '("melpa" . "http://melpa.milkbox.net/packages/") t)
+(add-to-list 'package-archives '("marmalade" . "http://marmalade-repo.org/packages/") t)
+
+;; install
+(let ((ensure-installed
+ (lambda (name)
+ (unless (package-installed-p name) (package-install name))))
+ (packages
+ '(flymake-haskell-multi ghc ghci-completion haskell-mode js2-mode
+ rainbow-delimiters rainbow-mode scion solarized-theme
+ yasnippet zencoding-mode)))
+ (mapc ensure-installed packages))
+
+;;; color-theme
+(setq-default
+ custom-safe-themes
+ '("8aebf25556399b58091e533e455dd50a6a9cba958cc4ebb0aab175863c25b9a4"
+ "d677ef584c6dfc0697901a44b885cc18e206f05114c8a3b7fde674fce6180879" default))
+(load-theme 'solarized-light)
;;; yasnippets
-(add-to-list 'load-path "~/.emacs.d/thirdparty/yasnippet")
-(require 'yasnippet)
(setq-default yas-prompt-functions '(yas-ido-prompt yas-dropdown-prompt)) ; use ido for multiple snippets
-(setq-default yas-snippet-dirs '("~/.emacs.d/thirdparty/yasnippet/snippets"
- "~/.emacs.d/thirdparty/snippets"))
+(setq-default yas-snippet-dirs
+ '("~/.emacs.d/thirdparty/yasnippet/snippets"
+ "~/.emacs.d/thirdparty/snippets"))
(yas-global-mode t)
;;; java-mode
(add-hook 'java-mode-hook (lambda () (setq whitespace-line-column 140)))
+;;; js2-mode
+(add-to-list 'auto-mode-alist '("\\.js$" . js2-mode))
+(add-hook 'js-mode-hook 'js2-minor-mode)
+
;;; zencoding-mode - html
-(require 'zencoding-mode)
(add-hook 'sgml-mode-hook 'zencoding-mode) ; Auto-start on any markup modes
(add-to-list 'auto-mode-alist '("\\.tpl\\'" . html-mode))
-;;; unique buffer names with dirs
-(require 'uniquify)
-(setq
- uniquify-buffer-name-style 'post-forward
- uniquify-separator ":")
-
;;; coding-modes map
(mapc
(lambda (x)
@@ -176,3 +196,22 @@
haskell-mode-hook
clojure-mode-hook
emacs-lisp-mode-hook))
+
+;;; haskell-mode
+(add-hook
+ 'haskell-mode-hook
+ (lambda ()
+ ;; (ghc-init)
+ (turn-on-haskell-indent)
+ (capitalized-words-mode)
+ (turn-on-haskell-doc-mode)
+ (turn-on-haskell-decl-scan)
+ (imenu-add-menubar-index)
+ (setq
+ haskell-font-lock-haddock t
+ haskell-stylish-on-save t
+ ;; haskell-tags-on-save t
+ haskell-program-name "ghci"
+ haskell-indent-offset 4
+ whitespace-line-column 78)
+ ))
--- a/thirdparty/color-theme-solarized/LICENSE Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,20 +0,0 @@
-Copyright (c) 2011 Ethan Schoonover
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in
-all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-THE SOFTWARE.
-
--- a/thirdparty/color-theme-solarized/README.md Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,163 +0,0 @@
-Solarized Colorscheme for Emacs
-===============================
-
-Stolen from Ethan Schoonover <[email protected]> by Greg Pfeil <[email protected]>
-
-Visit the [Solarized homepage]
-------------------------------
-
-See the [Solarized homepage] for screenshots,
-details and colorscheme versions for Vim, Mutt, popular terminal emulators and
-other applications.
-
-Screenshots
------------
-
-
-
-Downloads
----------
-
-If you have come across this colorscheme via the [Emacs-only repository] on
-github, see the link above to the Solarized homepage or visit the main [Solarized repository].
-
-The [Emacs-only repository] is kept in sync with the main [Solarized repository]. Issues, bug reports, changelogs that are not specific to the Emacs implementation should be submitted to the main [Solarized repository].
-
-[Solarized homepage]: http://ethanschoonover.com/solarized
-[Solarized repository]: https://github.com/altercation/solarized
-[Emacs-only repository]: https://github.com/sellout/emacs-color-theme-solarized
-[color-theme]: http://www.nongnu.org/color-theme
-
-Installation & Usage
---------------------
-
-### Emacs 24
-
-1. Add the `emacs-color-theme-solarized` directory to your Emacs `custom-theme-load-path`.
-2. Add `(load-theme solarized-[light|dark] t)` to your Emacs init file.
-3. Reload the init file, or restart Emacs.
-
-### [color-theme] \(pre-Emacs 24\)
-
-1. Download and install [color-theme].
-2. Add the `emacs-color-theme-solarized` directory to your Emacs `load-path`.
-3. Add `(require 'color-theme-solarized)` to your Emacs init file (usually `~/.emacs`).
-3. Reload the init file, or restart Emacs.
-4. Use the usual [color-theme] mechanism to select one of the Solarized themes, or `M-x color-theme-solarized-[light|dark]`.
-
-### IMPORTANT NOTE FOR TERMINAL USERS:
-
-If you are going to use Solarized in Terminal mode (i.e. not in a GUI version
-like Cocoa or X11 Emacs), **please please please** consider setting your
-terminal emulator's colorscheme to use the Solarized palette. The [Solarized
-repository] includes palettes for some popular terminal emulator as well as
-Xdefaults; or you can download them from the official [Solarized homepage].
-If you use this emacs color theme *without* having changed your emulator's
-palette, you will need to configure Solarized to degrade its colorscheme to
-a set compatible with the terminal's default limited 256 color palette
-(whereas by using the terminal's 16 ANSI color values, you would
-see the correct, specific values for the Solarized palette).
-
-If you do use the custom terminal colors, i.e. the 16 overridden ANSI color
-values, the emacs colorscheme should work out of the box for you. If you are
-using a terminal emulator that supports 256 colors and don't want to use
-the custom Solarized terminal colors, you will need to use the degraded 256
-colorscheme. To do so, simply customize the `solarized-termcolor` variable to
-`256`.
-
-Again, I recommend just changing your terminal colors to Solarized values
-either manually or via one of the many terminal schemes available for import.
-
-Advanced Configuration
-----------------------
-
-Solarized will work out of the box with just the instructions specified above
-but does include several variables that can be customized.
-
- variable name default optional
- --------------------------------------------
- solarized-termcolors = 16 | 256
- solarized-degrade = nil | t
- solarized-bold = t | nil
- solarized-underline = t | nil
- solarized-italic = t | nil
- solarized-contrast = normal| high, low
- solarized-visibility = normal| high, low
- solarized-broken-srgb= nil | t (see details for Mac behavior)
- --------------------------------------------
-
-### Option Details
-
-* solarized-termcolors
-
- This is set to *16* by default, meaning that Solarized will attempt to use
- the standard 16 colors of your terminal emulator, assuming that you've set
- these colors to the correct Solarized values either manually or by
- importing one of the many colorscheme available for popular terminal
- emulators and Xdefaults.
- If you don't want to use the Solarized colors via the terminal
- emulator's palette, you can set this to *256*, which will use a degraded
- version of the Solarized palette by displaying the closest colors in
- the terminal's default 256 colors as shown in [Xterm's color
- chart](http://en.wikipedia.org/wiki/File:Xterm_color_chart.png).
-
-* solarized-degrade
-
- For test purposes only; in GUI mode, this forces Solarized to use the 256
- degraded color mode to test the approximate color values for accuracy.
-
-* solarized-bold | solarized-underline | solarized-italic
-
- If you wish to stop Solarized from displaying bold, underlined or
- italicized typefaces, simply set the appropriate variable to `nil`.
-
-* solarized-contrast
-
- Stick with normal! It's been carefully tested. Setting this option to high
- or low does use the same Solarized palette but simply shifts some values
- up or down in order to expand or compress the tonal range displayed.
-
-* solarized-visibility
-
- Special characters such as trailing whitespace, tabs, newlines, when
- displayed using `:set list` can be set to one of three levels depending on
- your needs. Default value is `normal` with `high` and `low` options.
-
-* solarized-broken-srgb
-
- Emacs [bug #8402](http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8402)
- results in incorrect color handling on Macs. If this is `t` (the default
- on Macs), Solarized works around it with alternative colors. However,
- these colors are not totally portable, so you may be able to edit the
- "Gen RGB" column in `solarized-definitions.el` to improve them further.
-
-Code Notes
-----------
-
-I have attempted to modularize the creation of Emacs colorschemes in this script and, while it could be refactored further, it should be a good foundation for the creation of any color scheme. By simply changing the values in the `solarized-colors` table in `solarized-definitions.el` and testing in a GUI Emacs, you can rapidly prototype new colorschemes without diving into the weeds of line-item editing each syntax highlight declaration.
-
-The Values
-----------
-
-L\*a\*b values are canonical (White D65, Reference D50), other values are
-matched in sRGB space.
-
- SOLARIZED HEX 16/8 TERMCOL XTERM/HEX L*A*B RGB HSB
- --------- ------- ---- ------- ----------- ---------- ----------- -----------
- base03 #002b36 8/4 brblack 234 #1c1c1c 15 -12 -12 0 43 54 193 100 21
- base02 #073642 0/4 black 235 #262626 20 -12 -12 7 54 66 192 90 26
- base01 #586e75 10/7 brgreen 240 #585858 45 -07 -07 88 110 117 194 25 46
- base00 #657b83 11/7 bryellow 241 #626262 50 -07 -07 101 123 131 195 23 51
- base0 #839496 12/6 brblue 244 #808080 60 -06 -03 131 148 150 186 13 59
- base1 #93a1a1 14/4 brcyan 245 #8a8a8a 65 -05 -02 147 161 161 180 9 63
- base2 #eee8d5 7/7 white 254 #e4e4e4 92 -00 10 238 232 213 44 11 93
- base3 #fdf6e3 15/7 brwhite 230 #ffffd7 97 00 10 253 246 227 44 10 99
- yellow #b58900 3/3 yellow 136 #af8700 60 10 65 181 137 0 45 100 71
- orange #cb4b16 9/3 brred 166 #d75f00 50 50 55 203 75 22 18 89 80
- red #dc322f 1/1 red 160 #d70000 50 65 45 220 50 47 1 79 86
- magenta #d33682 5/5 magenta 125 #af005f 50 65 -05 211 54 130 331 74 83
- violet #6c71c4 13/5 brmagenta 61 #5f5faf 50 15 -45 108 113 196 237 45 77
- blue #268bd2 4/4 blue 33 #0087ff 55 -10 -45 38 139 210 205 82 82
- cyan #2aa198 6/6 cyan 37 #00afaf 60 -35 -05 42 161 152 175 74 63
- green #859900 2/2 green 64 #5f8700 60 -20 65 133 153 0 68 100 60
-
--- a/thirdparty/color-theme-solarized/color-theme-solarized-pkg.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1 +0,0 @@
-(define-package "color-theme-solarized" "%%version%%" "Solarized themes for Emacs" '((color-theme "6.6.1")))
--- a/thirdparty/color-theme-solarized/color-theme-solarized.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-;;; Author: Ethan Schoonover, Solarized; Greg Pfeil, Emacs adaptation
-;;; URL: http://ethanschoonover.com/solarized
-
-;;; This file is not (YET) part of GNU Emacs.
-
-;;; # Usage
-
-;;; 1. Install the color-theme package
-;;; (http://www.emacswiki.org/cgi-bin/wiki/ColorTheme)
-;;; 2. Load this file
-;;; 3. M-x color-theme-solarized-[dark|light]
-
-(require 'solarized-definitions
- (let* ((reqname (concat (file-name-directory (or load-file-name
- buffer-file-name))
- "solarized-definitions.el"))
- (compreqname (concat reqname "c")))
- (if (file-exists-p compreqname) compreqname reqname)))
-
-(eval-when-compile
- (require 'color-theme))
-
-;;;###autoload
-(defun color-theme-solarized (mode)
- "Color theme by Ethan Schoonover, created 2011-03-24.
-Ported to Emacs by Greg Pfeil, http://ethanschoonover.com/solarized."
- (interactive "Slight or dark? ")
- (color-theme-install
- (let* ((definitions (solarized-color-definitions mode))
- (faces (first definitions))
- (variables (second definitions)))
- (solarized-color-definitions mode)
- `(,(intern (concat "color-theme-solarized-" (symbol-name mode)))
- ,variables
- ,@faces))))
-
-;;;###autoload
-(defun color-theme-solarized-dark ()
- (interactive)
- (color-theme-solarized 'dark))
-
-;;;###autoload
-(defun color-theme-solarized-light ()
- (interactive)
- (color-theme-solarized 'light))
-
-(add-to-list 'color-themes
- `(color-theme-solarized-light
- "Solarized Light"
- ,solarized-description))
-(add-to-list 'color-themes
- `(color-theme-solarized-dark
- "Solarized Dark"
- ,solarized-description))
-
-(provide 'color-theme-solarized)
--- a/thirdparty/color-theme-solarized/makepkg.sh Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,17 +0,0 @@
-#!/usr/bin/env bash
-
-version=$1
-
-if [ "$version" = "" ]; then
- version=$(date -u '+%Y%m%d')
-fi
-echo "version = $version"
-
-dir="color-theme-solarized-${version}"
-
-mkdir $dir
-
-cp *.el $dir
-sed -i "s/%%version%%/$version/" "$dir/color-theme-solarized-pkg.el"
-
-tar cf color-theme-solarized-${version}.tar $dir
--- a/thirdparty/color-theme-solarized/solarized-dark-theme.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,5 +0,0 @@
-(require 'solarized-definitions
- (locate-file "solarized-definitions.el" custom-theme-load-path
- '("c" "")))
-
-(create-solarized-theme dark)
--- a/thirdparty/color-theme-solarized/solarized-definitions.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,426 +0,0 @@
-(eval-when-compile
- (require 'cl))
-
-(defconst solarized-description
- "Color theme by Ethan Schoonover, created 2011-03-24.
-Ported to Emacs by Greg Pfeil, http://ethanschoonover.com/solarized.")
-
-(defcustom solarized-degrade nil
- "For test purposes only; when in GUI mode, forces Solarized to use the 256
-degraded color mode to test the approximate color values for accuracy."
- :type 'boolean
- :group 'solarized)
-
-(defcustom solarized-diff-mode 'normal
- "Sets the level of highlighting to use in diff-like modes."
- :type 'symbol
- :options '(high normal low)
- :group 'solarized)
-
-(defcustom solarized-bold t
- "Stops Solarized from displaying bold when nil."
- :type 'boolean
- :group 'solarized)
-
-(defcustom solarized-underline t
- "Stops Solarized from displaying underlines when nil."
- :type 'boolean
- :group 'solarized)
-
-(defcustom solarized-italic t
- "Stops Solarized from displaying italics when nil."
- :type 'boolean
- :group 'solarized)
-
-(defcustom solarized-termcolors 16
- "This setting applies to emacs in terminal (non-GUI) mode.
-If set to 16, emacs will use the terminal emulator's colorscheme (best option
-as long as you've set your emulator's colors to the Solarized palette). If
-set to 256 and your terminal is capable of displaying 256 colors, emacs will
-use the 256 degraded color mode."
- :type 'integer
- :options '(16 256)
- :group 'solarized)
-
-(defcustom solarized-contrast 'normal
- "Stick with normal! It's been carefully tested. Setting this option to high or
-low does use the same Solarized palette but simply shifts some values up or
-down in order to expand or compress the tonal range displayed."
- :type 'symbol
- :options '(high normal low)
- :group 'solarized)
-
-(defcustom solarized-broken-srgb (if (eq system-type 'darwin) t nil)
- "Emacs bug #8402 results in incorrect color handling on Macs. If this is t
-(the default on Macs), Solarized works around it with alternative colors.
-However, these colors are not totally portable, so you may be able to edit
-the \"Gen RGB\" column in solarized-definitions.el to improve them further."
- :type 'boolean
- :group 'solarized)
-
-;; FIXME: The Generic RGB colors will actually vary from device to device, but
-;; hopefully these are closer to the intended colors than the sRGB values
-;; that Emacs seems to dislike
-(defvar solarized-colors
- ;; name sRGB Gen RGB degraded ANSI(Solarized terminal)
- '((base03 "#002b36" "#042028" "#1c1c1c" "#7f7f7f")
- (base02 "#073642" "#0a2832" "#262626" "#000000")
- (base01 "#586e75" "#465a61" "#585858" "#00ff00")
- (base00 "#657b83" "#52676f" "#626262" "#ffff00")
- (base0 "#839496" "#708183" "#808080" "#5c5cff")
- (base1 "#93a1a1" "#81908f" "#8a8a8a" "#00ffff")
- (base2 "#eee8d5" "#e9e2cb" "#e4e4e4" "#e5e5e5")
- (base3 "#fdf6e3" "#fcf4dc" "#ffffd7" "#ffffff")
- (yellow "#b58900" "#a57705" "#af8700" "#cdcd00")
- (orange "#cb4b16" "#bd3612" "#d75f00" "#ff0000")
- (red "#dc322f" "#c60007" "#d70000" "#cd0000")
- (magenta "#d33682" "#c61b6e" "#af005f" "#cd00cd")
- (violet "#6c71c4" "#5859b7" "#5f5faf" "#ff00ff")
- (blue "#268bd2" "#2075c7" "#0087ff" "#0000ee")
- (cyan "#2aa198" "#259185" "#00afaf" "#00cdcd")
- (green "#859900" "#728a05" "#5f8700" "#00cd00"))
- "This is a table of all the colors used by the Solarized color theme. Each
- column is a different set, one of which will be chosen based on term
- capabilities, etc.")
-
-(defun solarized-color-definitions (mode)
- (flet ((find-color (name)
- (let ((index (if window-system
- (if solarized-degrade
- 3
- (if solarized-broken-srgb 2 1))
- (if (= solarized-termcolors 256)
- 3
- 4))))
- (nth index (assoc name solarized-colors)))))
- (let ((base03 (find-color 'base03))
- (base02 (find-color 'base02))
- (base01 (find-color 'base01))
- (base00 (find-color 'base00))
- (base0 (find-color 'base0))
- (base1 (find-color 'base1))
- (base2 (find-color 'base2))
- (base3 (find-color 'base3))
- (yellow (find-color 'yellow))
- (orange (find-color 'orange))
- (red (find-color 'red))
- (magenta (find-color 'magenta))
- (violet (find-color 'violet))
- (blue (find-color 'blue))
- (cyan (find-color 'cyan))
- (green (find-color 'green))
- (bold (if solarized-bold 'bold 'normal))
- (bright-bold (if solarized-bold 'normal 'bold))
- (underline (if solarized-underline t nil))
- (opt-under nil)
- (italic (if solarized-italic 'italic 'normal)))
- (when (eq 'light mode)
- (rotatef base03 base3)
- (rotatef base02 base2)
- (rotatef base01 base1)
- (rotatef base00 base0))
- (let ((back base03))
- (cond ((eq 'high solarized-contrast)
- (let ((orig-base3 base3))
- (rotatef base01 base00 base0 base1 base2 base3)
- (setf base3 orig-base3)))
- ((eq 'low solarized-contrast)
- (setf back base02
- opt-under t)))
- (let ((bg-back `(:background ,back))
- (bg-base03 `(:background ,base03))
- (bg-base02 `(:background ,base02))
- (bg-base01 `(:background ,base01))
- (bg-base00 `(:background ,base00))
- (bg-base0 `(:background ,base0))
- (bg-base1 `(:background ,base1))
- (bg-base2 `(:background ,base2))
- (bg-base3 `(:background ,base3))
- (bg-green `(:background ,green))
- (bg-yellow `(:background ,yellow))
- (bg-orange `(:background ,orange))
- (bg-red `(:background ,red))
- (bg-magenta `(:background ,magenta))
- (bg-violet `(:background ,violet))
- (bg-blue `(:background ,blue))
- (bg-cyan `(:background ,cyan))
-
- (fg-base03 `(:foreground ,base03))
- (fg-base02 `(:foreground ,base02))
- (fg-base01 `(:foreground ,base01))
- (fg-base00 `(:foreground ,base00))
- (fg-base0 `(:foreground ,base0))
- (fg-base1 `(:foreground ,base1))
- (fg-base2 `(:foreground ,base2))
- (fg-base3 `(:foreground ,base3))
- (fg-green `(:foreground ,green))
- (fg-yellow `(:foreground ,yellow))
- (fg-orange `(:foreground ,orange))
- (fg-red `(:foreground ,red))
- (fg-magenta `(:foreground ,magenta))
- (fg-violet `(:foreground ,violet))
- (fg-blue `(:foreground ,blue))
- (fg-cyan `(:foreground ,cyan))
-
- (fmt-bold `(:weight ,bold))
- (fmt-bldi `(:weight ,bold))
- (fmt-undr `(:underline ,underline))
- (fmt-undb `(:underline ,underline :weight ,bold))
- (fmt-undi `(:underline ,underline))
- (fmt-uopt `(:underline ,opt-under))
- (fmt-curl `(:underline t)) ; FIXME: not quite the same
- (fmt-ital `(:slant ,italic))
- (fmt-stnd `(:inverse-video t)) ; FIXME: not quite the same
- (fmt-revr `(:inverse-video t))
- (fmt-revb `(:inverse-video t :weight ,bold))
- (fmt-revbb `(:inverse-video t :weight ,bright-bold))
- (fmt-revbbu `(:inverse-video t
- :weight ,bright-bold
- :underline ,underline)))
- `((;; basic
- (default ((t (,@fg-base0 ,@bg-back)))) ; Normal
- (cursor ((t (,@fg-base03 ,@bg-base0)))) ; Cursor
- (escape-glyph-face ((t (,@fg-red))))
- (fringe ((t (,@fg-base01 ,@bg-base02))))
- (linum ((t (,@fg-base01 ,@bg-base02))))
- (header-line ((t (,@fg-base0 ,@bg-base2))))
- (highlight ((t (,@bg-base02))))
-
- (hl-line ((t (,@fmt-uopt ,@bg-base02)))) ; CursorLine
- (isearch ((t (,@fmt-stnd ,@fg-orange)))) ; IncSearch
- (lazy-highlight ((t (,@bg-base2 ,@fg-base00))))
- (link ((t (,@fmt-undr ,@fg-violet))))
- (link-visited ((t (,@fmt-undr ,@fg-magenta))))
- (menu ((t (,@fg-base0 ,@bg-base02))))
- (minibuffer-prompt ((t (,@fg-blue))))
- (mode-line
- ((t (,@fg-base1 ,@bg-base02 :box (:line-width 1 :color ,base1)))))
- (mode-line-buffer-id ((t (,@fg-base1))))
- (mode-line-inactive
- ((t (,@fg-base0 ,@bg-base02
- :box (:line-width 1 :color ,base02)))))
- (region ((t (,@fg-base01 ,@bg-base03 ,@fmt-revbb)))) ; Visual
- (secondary-selection ((t (,@bg-base02))))
- (shadow ((t (,@fg-base01))))
- (trailing-whitespace ((t (,@fmt-revr ,@fg-red))))
- (vertical-border ((t (,@fg-base0))))
- ;; comint
- (comint-highlight-prompt ((t (,@fg-blue))))
- ;; compilation
- (compilation-info ((t (,@fmt-bold ,@fg-green))))
- (compilation-warning ((t (,@fmt-bold ,@fg-orange))))
- ;; custom
- (custom-button
- ((t (,@fg-base1 ,@bg-base02
- :box (:line-width 2 :style released-button)))))
- (custom-button-mouse
- ((t (,@fmt-revr ,@fg-base1 ,@bg-base02 :inherit custom-button))))
- (custom-button-pressed
- ((t (,@fmt-revr ,@fg-base1 ,@bg-base02
- :box (:line-width 2 :style pressed-button)
- :inherit custom-button-mouse))))
- (custom-changed ((t (,@fmt-revr ,@fg-blue ,@bg-base3))))
- (custom-comment ((t (,@fg-base1 ,@bg-base02))))
- (custom-comment-tag ((t (,@fg-base1 ,@bg-base02))))
- (custom-documentation ((t (:inherit default))))
- (custom-group-tag ((t (,@fg-base1))))
- (custom-group-tag-1 ((t (,fmt-bold ,@fg-base1))))
- (custom-invalid ((t (,@fmt-revr ,@fg-red ,@bg-back))))
- (custom-link ((t (,@fg-violet))))
- (custom-state ((t (,@fg-green))))
- (custom-variable-tag ((t (,@fg-base1))))
- ;; diff - DiffAdd, DiffChange, DiffDelete, and DiffText
- ,@(case solarized-diff-mode
- (high
- `((diff-added ((t (,@fmt-revr ,@fg-green))))
- (diff-changed ((t (,@fmt-revr ,@fg-yellow))))
- (diff-removed ((t (,@fmt-revr ,@fg-red))))
- (diff-header ((t (,@fmt-revr ,@fg-blue ,@bg-back))))))
- (low
- `((diff-added ((t (,@fmt-undr ,@fg-green))))
- (diff-changed ((t (,@fmt-undr ,@fg-yellow))))
- (diff-removed ((t (,@fmt-bold ,@fg-red))))
- (diff-header ((t (,@fmt-undr ,@fg-blue ,@bg-back))))))
- (normal
- (if window-system
- `((diff-added ((t (,@fmt-bold ,@fg-green))))
- (diff-changed ((t (,@fmt-bold ,@fg-yellow))))
- (diff-removed ((t (,@fmt-bold ,@fg-red))))
- (diff-header ((t (,@fmt-bold ,@fg-blue ,@bg-back)))))
- `((diff-added ((t (,@fg-green))))
- (diff-changed ((t (,@fg-yellow))))
- (diff-removed ((t (,@fg-red))))
- (diff-header ((t (,@fg-blue ,@bg-back))))))))
- (diff-file-header ((t (,@bg-back))))
- (diff-refine-change ((t (,@bg-base3))))
- ;; IDO
- (ido-only-match ((t (,@fg-green))))
- (ido-subdir ((t (,@fg-blue))))
- (ido-first-match ((t (,@fmt-bold ,@fg-green))))
- ;; emacs-wiki
- (emacs-wiki-bad-link-face ((t (,@fmt-undr ,@fg-red))))
- (emacs-wiki-link-face ((t (,@fmt-undr ,@fg-blue))))
- (emacs-wiki-verbatim-face ((t (,@fmt-undr ,@fg-base00))))
- ;; eshell
- (eshell-ls-archive ((t (,@fg-magenta))))
- (eshell-ls-backup ((t (,@fg-yellow))))
- (eshell-ls-clutter ((t (,@fg-orange))))
- (eshell-ls-directory ((t (,@fg-blue))))
- (eshell-ls-executable ((t (,@fg-green))))
- (eshell-ls-missing ((t (,@fg-red))))
- (eshell-ls-product ((t (,@fg-yellow))))
- (eshell-ls-readonly ((t (,@fg-base1))))
- (eshell-ls-special ((t (,@fg-violet))))
- (eshell-ls-symlink ((t (,@fg-cyan))))
- (eshell-ls-unreadable ((t (,@fg-base00))))
- (eshell-prompt ((t (,@fmt-bold ,@fg-green))))
- ;; font-lock
- (font-lock-builtin-face ((t (,@fg-green)))) ; Statement
- (font-lock-comment-face ((t (,@fmt-ital ,@fg-base01)))) ; Comment
- (font-lock-constant-face ((t (,@fg-cyan)))) ; Constant
- (font-lock-function-name-face ((t (,@fg-blue)))) ; Identifier
- (font-lock-keyword-face ((t (,@fg-green)))) ; Statement
- (font-lock-string-face ((t (,@fg-cyan)))) ; Constant
- (font-lock-type-face ((t (,@fg-yellow)))) ; Type
- (font-lock-variable-name-face ((t (,@fg-blue)))) ; Identifier
- (font-lock-warning-face ((t (,@fmt-bold ,@fg-red)))) ; Error
- (font-lock-doc-face ((t (,@fmt-ital ,@fg-cyan))))
- (font-lock-color-constant-face ((t (,@fg-green))))
- (font-lock-comment-delimiter-face ; Comment
- ((t (,@fmt-ital ,@fg-base01))))
- (font-lock-doc-string-face ((t (,@fg-green))))
- (font-lock-preprocessor-face ((t (,@fg-orange)))) ; PreProc
- (font-lock-reference-face ((t (,@fg-cyan))))
- (font-lock-negation-char-face ((t (,@fg-red))))
- (font-lock-other-type-face ((t (,@fmt-ital ,@fg-blue))))
- (font-lock-regexp-grouping-construct ((t (,@fg-orange))))
- (font-lock-special-keyword-face ((t (,@fg-magenta))))
- (font-lock-exit-face ((t (,@fg-red))))
- (font-lock-other-emphasized-face ((t (,@fmt-bldi ,@fg-violet))))
- (font-lock-regexp-grouping-backslash ((t (,@fg-yellow))))
- ;; info
- (info-xref ((t (,@fmt-undr ,@fg-blue))))
- (info-xref-visited ((t (,@fg-magenta :inherit info-xref))))
- ;; org
- (org-hide ((t (,@fg-base03))))
- (org-todo ((t (,@fmt-bold ,@fg-base03 ,@bg-red))))
- (org-done ((t (,@fmt-bold ,@fg-green))))
- (org-todo-kwd-face ((t (,@fg-red ,@bg-base03))))
- (org-done-kwd-face ((t (,@fg-green ,@bg-base03))))
- (org-project-kwd-face ((t (,@fg-violet ,@bg-base03))))
- (org-waiting-kwd-face ((t (,@fg-orange ,@bg-base03))))
- (org-someday-kwd-face ((t (,@fg-blue ,@bg-base03))))
- (org-started-kwd-face ((t (,@fg-yellow ,@bg-base03))))
- (org-cancelled-kwd-face ((t (,@fg-green ,@bg-base03))))
- (org-delegated-kwd-face ((t (,@fg-cyan ,@bg-base03))))
- ;; show-paren - MatchParen
- (show-paren-match-face ((t (,@fg-cyan ,@fg-base01))))
- (show-paren-mismatch-face ((t (,@fg-red ,@fg-base01))))
- ;; widgets
- (widget-field
- ((t (,@fg-base1 ,@bg-base02 :box (:line-width 1 :color ,base2)
- :inherit default))))
- (widget-single-line-field ((t (:inherit widget-field))))
- ;; extra modules
- ;; -------------
- ;; gnus
- (gnus-cite-1 ((t (,@fg-magenta))))
- (gnus-cite-2 ((t (,@fg-base2))))
- (gnus-cite-3 ((t (,@fg-base3))))
- (gnus-cite-4 ((t (,@fg-base1))))
- (gnus-cite-5 ((t (,@fg-magenta))))
- (gnus-cite-6 ((t (,@fg-base2))))
- (gnus-cite-7 ((t (,@fg-base3))))
- (gnus-cite-8 ((t (,@fg-base1))))
- (gnus-cite-9 ((t (,@fg-base2))))
- (gnus-cite-10 ((t (,@fg-base3))))
- (gnus-cite-11 ((t (,@fg-blue))))
- (gnus-group-mail-1 ((t (,@fmt-bold ,@fg-base3))))
- (gnus-group-mail-1-empty ((t (,@fg-base3))))
- (gnus-group-mail-2 ((t (,@fmt-bold ,@fg-base2))))
- (gnus-group-mail-2-empty ((t (,@fg-base2))))
- (gnus-group-mail-3 ((t (,@fmt-bold ,@fg-magenta))))
- (gnus-group-mail-3-empty ((t (,@fg-magenta))))
- (gnus-group-mail-low ((t (,@fmt-bold ,@fg-base00))))
- (gnus-group-mail-low-empty ((t (,@fg-base00))))
- (gnus-group-news-1 ((t (,@fmt-bold ,@fg-base1))))
- (gnus-group-news-1-empty ((t (,@fg-base1))))
- (gnus-group-news-2 ((t (,@fmt-bold ,@fg-blue))))
- (gnus-group-news-2-empty ((t (,@fg-blue))))
- (gnus-group-news-low ((t (,@fmt-bold ,@fg-violet))))
- (gnus-group-news-low-empty ((t (,@fg-violet))))
- (gnus-header-content ((t (,@fmt-ital ,@fg-cyan))))
- (gnus-header-from ((t (,@fg-base2))))
- (gnus-header-name ((t (,@fg-blue))))
- (gnus-header-newsgroups ((t (,@fmt-ital ,@fg-green))))
- (gnus-header-subject ((t (,@fg-base1))))
- (gnus-server-agent ((t (,@fmt-bold ,@fg-base3))))
- (gnus-server-closed ((t (,@fmt-ital ,@fg-base1))))
- (gnus-server-denied ((t (,@fmt-bold ,@fg-base2))))
- (gnus-server-offline ((t (,@fmt-bold ,@fg-green))))
- (gnus-server-opened ((t (,@fmt-bold ,@fg-cyan))))
- (gnus-splash ((t (,@fg-base2))))
- (gnus-summary-high-ancient ((t (,@fmt-bold ,@fg-magenta))))
- (gnus-summary-high-read ((t (,@fmt-bold ,@fg-base1))))
- (gnus-summary-high-ticked ((t (,@fmt-bold ,@fg-base3))))
- (gnus-summary-high-undownloaded ((t (,@fmt-bold ,@fg-base2))))
- (gnus-summary-low-ancient ((t (,@fmt-ital ,@fg-magenta))))
- (gnus-summary-low-read ((t (,@fmt-ital ,@fg-base1))))
- (gnus-summary-low-ticked ((t (,@fmt-ital ,@fg-base3))))
- (gnus-summary-low-undownloaded ((t (,@fmt-ital ,@fg-base2))))
- (gnus-summary-normal-ancient ((t (,@fg-magenta))))
- (gnus-summary-normal-read ((t (,@fg-base1))))
- (gnus-summary-normal-ticked ((t (,@fg-base3))))
- (gnus-summary-normal-undownloaded ((t (,@fg-base2))))
- ;; Flymake
- (flymake-errline ((t (,@bg-base3))))
- (flymake-warnline ((t (,@bg-base02))))
- ;; whitespace
- (whitespace-empty ((t (,@fg-red))))
- (whitespace-hspace ((t (,@fg-orange))))
- (whitespace-indentation ((t (,@fg-base02))))
- (whitespace-space ((t (,@fg-base02))))
- (whitespace-space-after-tab ((t (,@fg-cyan))))
- (whitespace-space-before-tab ((t (,@fmt-bold ,@fg-red))))
- (whitespace-tab ((t (,@fg-base02))))
- (whitespace-trailing ((t (,@fmt-bold ,@fg-red ,@bg-base02))))
- (whitespace-highlight-face ((t (,@fg-red ,@bg-blue))))
- ;; Message
- (message-mml ((t (,@fg-blue))))
- (message-cited-text ((t (,@fg-base2))))
- (message-separator ((t (,@fg-base3))))
- (message-header-xheader ((t (,@fg-violet))))
- (message-header-name ((t (,@fg-cyan))))
- (message-header-other ((t (,@fg-red))))
- (message-header-newsgroups ((t (,@fmt-bldi ,@fg-yellow))))
- (message-header-subject ((t (,@fg-base00))))
- (message-header-cc ((t (,@fmt-bold ,@fg-green))))
- (message-header-to ((t (,@fmt-bold ,@fg-base1))))
- ;; rainbow-delimiters
- (rainbow-delimiters-depth-1-face ((t (,@fg-cyan))))
- (rainbow-delimiters-depth-2-face ((t (,@fg-yellow))))
- (rainbow-delimiters-depth-3-face ((t (,@fg-blue))))
- (rainbow-delimiters-depth-4-face ((t (,@fg-red))))
- (rainbow-delimiters-depth-5-face ((t (,@fg-green))))
- (rainbow-delimiters-depth-6-face ((t (,@fg-blue))))
- (rainbow-delimiters-depth-7-face ((t (,@fg-orange))))
- (rainbow-delimiters-depth-8-face ((t (,@fg-magenta))))
- (rainbow-delimiters-depth-9-face ((t (,@fg-base0)))))
- ((foreground-color . ,base0)
- (background-color . ,base03)
- (background-mode . ,mode)
- (cursor-color . ,base0))))))))
-
-(defmacro create-solarized-theme (mode)
- (let* ((theme-name (intern (concat "solarized-" (symbol-name mode))))
- (defs (solarized-color-definitions mode))
- (theme-vars (mapcar (lambda (def) (list (car def) (cdr def)))
- (second defs)))
- (theme-faces (first defs)))
- `(progn
- (deftheme ,theme-name ,solarized-description)
- (apply 'custom-theme-set-variables ',theme-name ',theme-vars)
- (apply 'custom-theme-set-faces ',theme-name ',theme-faces)
- (provide-theme ',theme-name))))
-
-(provide 'solarized-definitions)
--- a/thirdparty/color-theme-solarized/solarized-light-theme.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,5 +0,0 @@
-(require 'solarized-definitions
- (locate-file "solarized-definitions.el" custom-theme-load-path
- '("c" "")))
-
-(create-solarized-theme light)
--- a/thirdparty/color-theme.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1668 +0,0 @@
-;;; color-theme.el --- install color themes
-
-;; Copyright (C) 1999, 2000 Jonadab the Unsightly One <[email protected]>
-;; Copyright (C) 2000, 2001, 2002, 2003 Alex Schroeder <[email protected]>
-;; Copyright (C) 2003, 2004, 2005, 2006 Xavier Maillard <[email protected]>
-
-;; Version: 6.6.0
-;; Keywords: faces
-;; Author: Jonadab the Unsightly One <[email protected]>
-;; Maintainer: Xavier Maillard <[email protected]>
-;; 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 <[email protected]>
-;; S. Pokrovsky <[email protected]> for ideas and discussion.
-;; Gordon Messmer <[email protected]> for ideas and discussion.
-;; Sriram Karra <[email protected]> for the color-theme-submit stuff.
-;; Olgierd `Kingsajz' Ziolko <[email protected]> for the spec-filter idea.
-;; Brian Palmer for color-theme-library ideas and code
-;; All the users that contributed their color themes.
-
-
-
-;;; 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 "[email protected]"
- "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
-(or (fboundp 'replace-in-string)
- (defun replace-in-string (target old new)
- (replace-regexp-in-string old new target)))
-
-;; 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
- (concat
- (file-name-directory (locate-library "color-theme"))
- "/themes") 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)
-
-
-
-;; List of color themes used to create the *Color Theme Selection*
-;; buffer.
-
-(defvar color-themes
- '((color-theme-aalto-dark "Aalto Dark" "Jari Aalto <[email protected]>")
- (color-theme-aalto-light "Aalto Light" "Jari Aalto <[email protected]>")
- (color-theme-aliceblue "Alice Blue" "Girish Bharadwaj <[email protected]>")
- (color-theme-andreas "Andreas" "Andreas Busch <[email protected]>")
- (color-theme-arjen "Arjen" "Arjen Wiersma <[email protected]>")
- (color-theme-beige-diff "Beige Diff" "Alex Schroeder <[email protected]>" t)
- (color-theme-bharadwaj "Bharadwaj" "Girish Bharadwaj <[email protected]>")
- (color-theme-bharadwaj-slate "Bharadwaj Slate" "Girish Bharadwaj <[email protected]>")
- (color-theme-billw "Billw" "Bill White <[email protected]>")
- (color-theme-black-on-gray "BlackOnGray" "Sudhir Bhojwani <[email protected]>")
- (color-theme-blippblopp "Blipp Blopp" "Thomas Sicheritz-Ponten<[email protected]>")
- (color-theme-simple-1 "Black" "Jonadab <[email protected]>")
- (color-theme-blue-erc "Blue ERC" "Alex Schroeder <[email protected]>" t)
- (color-theme-blue-gnus "Blue Gnus" "Alex Schroeder <[email protected]>" t)
- (color-theme-blue-mood "Blue Mood" "Nelson Loyola <[email protected]>")
- (color-theme-blue-sea "Blue Sea" "Alex Schroeder <[email protected]>")
- (color-theme-calm-forest "Calm Forest" "Artur Hefczyc <[email protected]>")
- (color-theme-charcoal-black "Charcoal Black" "Lars Chr. Hausmann <[email protected]>")
- (color-theme-goldenrod "Cheap Goldenrod" "Alex Schroeder <[email protected]>")
- (color-theme-clarity "Clarity and Beauty" "Richard Wellum <[email protected]>")
- (color-theme-classic "Classic" "Frederic Giroud <[email protected]>")
- (color-theme-comidia "Comidia" "Marcelo Dias de Toledo <[email protected]>")
- (color-theme-jsc-dark "Cooper Dark" "John S Cooper <[email protected]>")
- (color-theme-jsc-light "Cooper Light" "John S Cooper <[email protected]>")
- (color-theme-jsc-light2 "Cooper Light 2" "John S Cooper <[email protected]>")
- (color-theme-dark-blue "Dark Blue" "Chris McMahan <[email protected]>")
- (color-theme-dark-blue2 "Dark Blue 2" "Chris McMahan <[email protected]>")
- (color-theme-dark-green "Dark Green" "[email protected]")
- (color-theme-dark-laptop "Dark Laptop" "Laurent Michel <[email protected]>")
- (color-theme-deep-blue "Deep Blue" "Tomas Cerha <[email protected]>")
- (color-theme-digital-ofs1 "Digital OFS1" "Gareth Owen <[email protected]>")
- (color-theme-euphoria "Euphoria" "[email protected]")
- (color-theme-feng-shui "Feng Shui" "Walter Higgins <[email protected]>")
- (color-theme-fischmeister "Fischmeister"
- "Sebastian Fischmeister <[email protected]>")
- (color-theme-gnome "Gnome" "Jonadab <[email protected]>")
- (color-theme-gnome2 "Gnome 2" "Alex Schroeder <[email protected]>")
- (color-theme-gray1 "Gray1" "Paul Pulli <[email protected]>")
- (color-theme-gray30 "Gray30" "Girish Bharadwaj <[email protected]>")
- (color-theme-kingsajz "Green Kingsajz" "Olgierd `Kingsajz' Ziolko <[email protected]>")
- (color-theme-greiner "Greiner" "Kevin Greiner <[email protected]>")
- (color-theme-gtk-ide "GTK IDE" "Gordon Messmer <[email protected]>")
- (color-theme-high-contrast "High Contrast" "Alex Schroeder <[email protected]>")
- (color-theme-hober "Hober" "Edward O'Connor <[email protected]>")
- (color-theme-infodoc "Infodoc" "Frederic Giroud <[email protected]>")
- (color-theme-jb-simple "JB Simple" "[email protected]")
- (color-theme-jedit-grey "Jedit Grey" "Gordon Messmer <[email protected]>")
- (color-theme-jonadabian "Jonadab" "Jonadab <[email protected]>")
- (color-theme-jonadabian-slate "Jonadabian Slate" "Jonadab <[email protected]>")
- (color-theme-katester "Katester" "[email protected]")
- (color-theme-late-night "Late Night" "Alex Schroeder <[email protected]>")
- (color-theme-lawrence "Lawrence" "lawrence mitchell <[email protected]>")
- (color-theme-lethe "Lethe" "Ivica Loncar <[email protected]>")
- (color-theme-ld-dark "Linh Dang Dark" "Linh Dang <[email protected]>")
- (color-theme-marine "Marine" "Girish Bharadwaj <[email protected]>")
- (color-theme-matrix "Matrix" "Walter Higgins <[email protected]>")
- (color-theme-marquardt "Marquardt" "Colin Marquardt <[email protected]>")
- (color-theme-midnight "Midnight" "Gordon Messmer <[email protected]>")
- (color-theme-mistyday "Misty Day" "Hari Kumar <[email protected]>")
- (color-theme-montz "Montz" "Brady Montz <[email protected]>")
- (color-theme-oswald "Oswald" "Tom Oswald <[email protected]>")
- (color-theme-parus "Parus" "Jon K Hellan <[email protected]>")
- (color-theme-pierson "Pierson" "Dan L. Pierson <[email protected]>")
- (color-theme-ramangalahy "Ramangalahy" "Solofo Ramangalahy <[email protected]>")
- (color-theme-raspopovic "Raspopovic" "Pedja Raspopovic <[email protected]>")
- (color-theme-renegade "Renegade" "Dave Benjamin <[email protected]>")
- (color-theme-resolve "Resolve" "Damien Elmes <[email protected]>")
- (color-theme-retro-green "Retro Green" "Alex Schroeder <[email protected]>")
- (color-theme-retro-orange "Retro Orange" "Alex Schroeder <[email protected]>")
- (color-theme-robin-hood "Robin Hood" "Alex Schroeder <[email protected]>")
- (color-theme-rotor "Rotor" "Jinwei Shen <[email protected]>")
- (color-theme-ryerson "Ryerson" "Luis Fernandes <[email protected]>")
- (color-theme-salmon-diff "Salmon Diff" "Alex Schroeder <[email protected]>" t)
- (color-theme-salmon-font-lock "Salmon Font-Lock" "Alex Schroeder <[email protected]>" t)
- (color-theme-scintilla "Scintilla" "Gordon Messmer <[email protected]>")
- (color-theme-shaman "Shaman" "[email protected]")
- (color-theme-sitaramv-nt "Sitaram NT"
- "Sitaram Venkatraman <[email protected]>")
- (color-theme-sitaramv-solaris "Sitaram Solaris"
- "Sitaram Venkatraman <[email protected]>")
- (color-theme-snow "Snow" "Nicolas Rist <[email protected]>")
- (color-theme-snowish "Snowish" "Girish Bharadwaj <[email protected]>")
- (color-theme-standard-ediff "Standard Ediff" "Emacs Team, added by Alex Schroeder <[email protected]>" t)
- (color-theme-standard "Standard Emacs 20" "Emacs Team, added by Alex Schroeder <[email protected]>")
- (color-theme-emacs-21 "Standard Emacs 21" "Emacs Team, added by Alex Schroeder <[email protected]>")
- (color-theme-emacs-nw "Standard Emacs 21 No Window" "Emacs Team, added by D. Goel <[email protected]>")
- (color-theme-xemacs "Standard XEmacs" "XEmacs Team, added by Alex Schroeder <[email protected]>")
- (color-theme-subtle-blue "Subtle Blue" "Chris McMahan <[email protected]>")
- (color-theme-subtle-hacker "Subtle Hacker" "Colin Walters <[email protected]>")
- (color-theme-taming-mr-arneson "Taming Mr Arneson" "Erik Arneson <[email protected]>")
- (color-theme-taylor "Taylor" "Art Taylor <[email protected]>")
- (color-theme-tty-dark "TTY Dark" "O Polite <[email protected]>")
- (color-theme-vim-colors "Vim Colors" "Michael Soulier <[email protected]>")
- (color-theme-whateveryouwant "Whateveryouwant" "Fabien Penso <[email protected]>, color by Scott Jaderholm <[email protected]>")
- (color-theme-wheat "Wheat" "Alex Schroeder <[email protected]>")
- (color-theme-pok-wob "White On Black" "S. Pokrovsky <[email protected]>")
- (color-theme-pok-wog "White On Grey" "S. Pokrovsky <[email protected]>")
- (color-theme-word-perfect "WordPerfect" "Thomas Gehrlein <[email protected]>")
- (color-theme-xp "XP" "Girish Bharadwaj <[email protected]>"))
- "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)))
-
-
-
-;; 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))))))
-
-
-
-;;; 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.
-
-
-
-;;; 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)))
-
-
-
-;;; 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))))
-
-
-
-;; 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))))
-
-
-
-;; 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
- (replace-in-string
- (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
--- a/thirdparty/rainbow-delimiters.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,392 +0,0 @@
-;;; rainbow-delimiters.el --- Color nested parentheses, brackets, and braces according to their depth.
-
-;; Copyright (C) 2010-2011 Jeremy L. Rayman.
-;; Author: Jeremy L. Rayman <[email protected]>
-;; Maintainer: Jeremy L. Rayman <[email protected]>
-;; Created: 2010-09-02
-;; Version: 1.2.1
-;; Keywords: faces, convenience, lisp, matching, tools
-;; EmacsWiki: RainbowDelimiters
-;; URL: http://www.emacswiki.org/emacs/rainbow-delimiters.el
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-
-;;; Commentary:
-
-;; This is a "rainbow parentheses" mode which includes support for
-;; parens "()", brackets "[]", and braces "{}". It conveys nesting
-;; depth by using a different face for each level. It colors all
-;; statements at a given level using the same color - if several
-;; statements are all at the same nested depth, they will all be the
-;; same color.
-;;
-;; Great care has been taken to make this mode FAST. You should see no
-;; discernible change in scrolling or editing speed while using it,
-;; even with delimiter-rich languages like Clojure, Lisp, and Scheme.
-;;
-;; The one exception is with extremely large nested data structures
-;; having hundreds of delimiters; in that case there will be a brief
-;; pause to colorize the structure the very first time it is displayed
-;; on screen; from then on editing this structure will perform at full
-;; speed.
-;;
-;; Default colors have been chosen with the philosophy that it's
-;; better be less intrusive than to be more colorful. Color schemes
-;; are always a matter of taste. If you do take the time to design a
-;; new color scheme, please post it on the EmacsWiki page!
-;; URL: http://www.emacswiki.org/emacs/RainbowDelimiters
-
-;;; Installation:
-
-;; 1. Place rainbow-delimiters.el on your emacs load-path.
-;;
-;; 2. Compile the file (necessary for speed):
-;; M-x byte-compile-file <location of rainbow-delimiters.el>
-;;
-;; 3. Add the following to your dot-emacs/init file:
-;; (require 'rainbow-delimiters)
-;;
-;; 4. Add hooks for modes where you want it enabled, for example:
-;; (add-hook 'clojure-mode-hook 'rainbow-delimiters-mode)
-;;
-;; - To activate rainbow-delimiters mode temporarily in a buffer:
-;; M-x rainbow-delimiters-mode
-
-;;; Customization:
-
-;; To customize various options, including the color scheme:
-;; M-x customize-group rainbow-delimiters
-;;
-;; color-theme.el users:
-;; If you use the color-theme package, you can specify custom colors
-;; by adding the appropriate faces to your theme.
-;; - Faces take the form of:
-;; 'rainbow-delimiters-depth-#-face' with # being the depth.
-;; Depth begins at 1, the outermost color.
-;; Faces exist for depths 1-12.
-;; - The unmatched delimiter face is:
-;; 'rainbow-delimiters-unmatched-delimiter-face'
-
-;;; Change Log:
-
-;; 1.0 - Initial release.
-;; 1.1 - Stop tracking each delimiter's depth independently.
-;; This had lead to confusing results when viewing clojure
-;; code. Instead, just color based on current nesting inside
-;; all delimiters combined.
-;; - Added 'all-delimiters' faces to apply a color scheme to
-;; all delimiters at once. Other faces inherit from this group.
-;; 1.1.1 - Change color scheme to a lighter, more subtle style.
-;; 1.1.2: (2011-03-25)
-;; - Add an unmatched-delimiter face and correct problem with
-;; coloring of text following unmatched closing delims.
-;; 1.2: (2011-03-28)
-;; - Unify delimiter faces: all delimiter types now use the same depth
-;; faces, of form 'rainbow-delimiters-depth-#-face'.
-;; 1.2.1: (2011-03-29)
-;; - Conform to ELPA conventions.
-
-;;; TODO:
-
-;; - Add support for nested tags (XML, HTML)
-
-;;; Issues:
-
-;; - Rainbow-delimiters mode does not appear to change the color of
-;; delimiters when Org-mode is enabled.
-
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-
-;;; Customize interface:
-
-(defgroup rainbow-delimiters nil
- "Color nested parentheses, brackets, and braces according to their depth."
- :prefix "rainbow-delimiters-"
- :link '(url-link :tag "Website for rainbow-delimiters (EmacsWiki)"
- "http://www.emacswiki.org/emacs/RainbowDelimiters")
- :group 'applications)
-
-(defgroup rainbow-delimiters-faces nil
- "Faces for each nested depth. Used to color delimiter pairs.
-
-Depths 1-12 are defined. Depth 1 is the outermost delimiter pair."
- :group 'rainbow-delimiters
- :link '(custom-group-link "rainbow-delimiters")
- :prefix 'rainbow-delimiters-faces-)
-
-
-;;; Faces:
-
-;; Unmatched delimiter face:
-(defface rainbow-delimiters-unmatched-face
- '((t (:foreground "#88090B")))
- "Face to color unmatched closing delimiters with."
- :group 'rainbow-delimiters
- :group 'rainbow-delimiters-faces)
-
-
-;; NOTE: The use of repetitious definitions for depth faces is temporary.
-;; Once the emacs 24 color theme support comes in, this will be reevaluated.
-
-;; Faces for colorizing delimiters at each level:
-(defface rainbow-delimiters-depth-1-face
- '((t (:foreground "grey55")))
- "Rainbow-delimiters nested delimiter face, depth 1 - the outermost pair."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-2-face
- '((t (:foreground "#93a8c6")))
- "Rainbow-delimiters nested delimiter face, depth 2."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-3-face
- '((t (:foreground "#b0b1a3")))
- "Rainbow-delimiters nested delimiter face, depth 3."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-4-face
- '((t (:foreground "#97b098")))
- "Rainbow-delimiters nested delimiter face, depth 4."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-5-face
- '((t (:foreground "#aebed8")))
- "Rainbow-delimiters nested delimiter face, depth 5."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-6-face
- '((t (:foreground "#b0b0b3")))
- "Rainbow-delimiters nested delimiter face, depth 6."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-7-face
- '((t (:foreground "#90a890")))
- "Rainbow-delimiters nested delimiter face, depth 7."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-8-face
- '((t (:foreground "#a2b6da")))
- "Rainbow-delimiters nested delimiter face, depth 8."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-9-face
- '((t (:foreground "#9cb6ad")))
- "Rainbow-delimiters nested delimiter face, depth 9."
- :group 'rainbow-delimiters-faces)
-
-;; Emacs doesn't sort face names by number correctly above 1-9; trick it into
-;; proper sorting by prepending a _ before the faces with depths over 10.
-(defface rainbow-delimiters-depth-_10-face
- '((t (:foreground "#83787e")))
- "Rainbow-delimiters nested delimiter face, depth 10."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-_11-face
- '((t (:foreground "#e1ddca")))
- "Rainbow-delimiters nested delimiter face, depth 11."
- :group 'rainbow-delimiters-faces)
-
-(defface rainbow-delimiters-depth-_12-face
- '((t (:foreground "#e0c7c7")))
- "Rainbow-delimiters nested delimiter face, depth 12."
- :group 'rainbow-delimiters-faces)
-
-;; Variable aliases for faces 10+:
-;; We prepend an underline to numbers 10+ to force customize to sort correctly.
-;; Here we define aliases without the underline for use everywhere else.
-(put 'rainbow-delimiters-depth-10-face
- 'face-alias
- 'rainbow-delimiters-depth-_10-face)
-(put 'rainbow-delimiters-depth-11-face
- 'face-alias
- 'rainbow-delimiters-depth-_11-face)
-(put 'rainbow-delimiters-depth-12-face
- 'face-alias
- 'rainbow-delimiters-depth-_12-face)
-
-
-;;; Face utility functions
-
-;; inlining this function for speed:
-;; see: http://www.gnu.org/s/emacs/manual/html_node/elisp/Compilation-Tips.html
-;; this will cause problems with debugging. To debug, change defsubst -> defun.
-(defsubst rainbow-delimiters-depth-face (depth)
- "Return face-name 'rainbow-delimiters-depth-DEPTH-face' as a string.
-
-DEPTH is the number of nested levels deep for the delimiter being colorized.
-
-Returns a face namestring the of form 'rainbow-delimiters-depth-DEPTH-face',
-e.g. 'rainbow-delimiters-depth-1-face'."
- (concat "rainbow-delimiters-depth-" (number-to-string depth) "-face"))
-
-
-;;; Nesting level
-
-;; syntax-table: used with parse-partial-sexp for determining current depth.
-(defvar rainbow-delimiters-delim-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?\( "() " table)
- (modify-syntax-entry ?\) ")( " table)
- (modify-syntax-entry ?\[ "(]" table)
- (modify-syntax-entry ?\] ")[" table)
- (modify-syntax-entry ?\{ "(}" table)
- (modify-syntax-entry ?\} "){" table)
- table)
- "Syntax table for recognizing all supported delimiter types.")
-
-(defun rainbow-delimiters-depth (point)
- "Return # of nested levels of parens, brackets, braces POINT is inside of."
- (save-excursion
- (beginning-of-defun)
- (let ((depth
- (with-syntax-table rainbow-delimiters-delim-syntax-table
- (car (parse-partial-sexp (point) point)))))
- (if (>= depth 0)
- depth
- 0)))) ; ignore negative depths created by unmatched closing parens.
-
-
-;;; Text properties
-
-;; inlining this function for speed:
-;; see: http://www.gnu.org/s/emacs/manual/html_node/elisp/Compilation-Tips.html
-;; this will cause problems with debugging. To debug, change defsubst -> defun.
-(defsubst rainbow-delimiters-propertize-delimiter (point depth)
- "Colorize delimiter at POINT according to DEPTH.
-
-POINT is the point of character to propertize.
-DEPTH is the nested delimiter depth at POINT, which determines the face to use.
-
-Sets text properties:
-`font-lock-face' to the corresponding delimiter face.
-`rear-nonsticky' to prevent color from bleeding into subsequent characters typed by the user."
- (with-silent-modifications
- (let ((delim-face (if (<= depth 0)
- "rainbow-delimiters-unmatched-face"
- (rainbow-delimiters-depth-face depth))))
- ;; (when (eq depth -1) (message "Unmatched delimiter at char %s." point))
- (add-text-properties point (1+ point)
- `(font-lock-face ,delim-face
- rear-nonsticky t)))))
-
-
-(defun rainbow-delimiters-unpropertize-delimiter (point)
- "Remove text properties set by rainbow-delimiters mode from char at POINT."
- (remove-text-properties point (1+ point)
- '(font-lock-face nil
- rear-nonsticky nil)))
-
-
-(defun rainbow-delimiters-char-ineligible-p (point)
- "Return t if char at POINT should be skipped, e.g. if inside a comment.
-
-Returns t if char at point meets one of the following conditions:
-- Inside a string.
-- Inside a comment.
-- Is an escaped char, e.g. ?\)"
- (let ((parse-state (save-excursion
- (beginning-of-defun)
- ;; (point) is at beg-of-defun; point is the char location
- (parse-partial-sexp (point) point))))
- (or
- (nth 3 parse-state) ; inside string?
- (nth 4 parse-state) ; inside comment?
- (and (eq (char-before point) ?\\) ; escaped char, e.g. ?\) - not counted
- (and (not (eq (char-before (1- point)) ?\\)) ; special-case: ignore ?\\
- (eq (char-before (1- point)) ?\?))))))
-;; standard char read syntax '?)' is not tested for because emacs manual states
-;; that punctuation such as delimiters should _always_ use escaped '?\)' form.
-
-
-;;; JIT-Lock functionality
-
-;; Used to skip delimiter-by-delimiter `rainbow-delimiters-propertize-region'.
-(defvar rainbow-delimiters-delim-regex "\\(\(\\|\)\\|\\[\\|\\]\\|\{\\|\}\\)"
- "Regex matching all opening and closing delimiters we intend to colorize.")
-
-;; main function called by jit-lock:
-(defun rainbow-delimiters-propertize-region (start end)
- "Colorize delimiters in region between START and END.
-
-Used by jit-lock for dynamic highlighting."
- (save-excursion
- (goto-char start)
- ;; START can be anywhere in buffer; begin depth counts from values at START.
- (let ((depth (rainbow-delimiters-depth start)))
- (while (and (< (point) end)
- (re-search-forward rainbow-delimiters-delim-regex end t))
- (backward-char) ; re-search-forward places point after delim; go back.
- (unless (rainbow-delimiters-char-ineligible-p (point))
- (let ((delim (char-after (point))))
- (cond ((eq ?\( delim) ; (
- (setq depth (1+ depth))
- (rainbow-delimiters-propertize-delimiter (point)
- depth))
- ((eq ?\) delim) ; )
- (rainbow-delimiters-propertize-delimiter (point)
- depth)
- (setq depth (or (and (<= depth 0) 0) ; unmatched paren
- (1- depth))))
- ((eq ?\[ delim) ; [
- (setq depth (1+ depth))
- (rainbow-delimiters-propertize-delimiter (point)
- depth))
- ((eq ?\] delim) ; ]
- (rainbow-delimiters-propertize-delimiter (point)
- depth)
- (setq depth (or (and (<= depth 0) 0) ; unmatched bracket
- (1- depth))))
- ((eq ?\{ delim) ; {
- (setq depth (1+ depth))
- (rainbow-delimiters-propertize-delimiter (point)
- depth))
- ((eq ?\} delim) ; }
- (rainbow-delimiters-propertize-delimiter (point)
- depth)
- (setq depth (or (and (<= depth 0) 0) ; unmatched brace
- (1- depth)))))))
- ;; move past delimiter so re-search-forward doesn't pick it up again
- (forward-char)))))
-
-(defun rainbow-delimiters-unpropertize-region (start end)
- "Remove mode faces from delimiters in region between START and END."
- (save-excursion
- (goto-char start)
- (while (and (< (point) end)
- (re-search-forward rainbow-delimiters-delim-regex end t))
- ;; re-search-forward places point 1 further than the delim matched:
- (rainbow-delimiters-unpropertize-delimiter (1- (point))))))
-
-
-;;; Minor mode:
-
-;;;###autoload
-(define-minor-mode rainbow-delimiters-mode
- "Color nested parentheses, brackets, and braces according to their depth."
- nil "" nil ; No modeline lighter - it's already obvious when the mode is on.
- (if (not rainbow-delimiters-mode)
- (progn
- (jit-lock-unregister 'rainbow-delimiters-propertize-region)
- (rainbow-delimiters-unpropertize-region (point-min) (1- (point-max))))
- (jit-lock-register 'rainbow-delimiters-propertize-region t)))
-
-
-(provide 'rainbow-delimiters)
-
-;;; rainbow-delimiters.el ends here.
--- a/thirdparty/zencoding-mode.el Sat Jun 22 22:54:53 2013 -0500
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1064 +0,0 @@
-;;; zencoding-mode.el --- Unfold CSS-selector-like expressions to markup
-
-;; Copyright (C) 2009, Chris Done
-
-;; Version: 0.5.1
-;; Author: Chris Done <[email protected]>
-;; URL: https://github.com/rooney/zencoding
-;; Last-Updated: 2011-12-31 Sat
-;; Keywords: convenience
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-;;
-;; This file 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; Unfold CSS-selector-like expressions to markup. Intended to be used
-;; with sgml-like languages; xml, html, xhtml, xsl, etc.
-;;
-;; See `zencoding-mode' for more information.
-;;
-;; Copy zencoding-mode.el to your load-path and add to your .emacs:
-;;
-;; (require 'zencoding-mode)
-;;
-;; Example setup:
-;;
-;; (add-to-list 'load-path "~/Emacs/zencoding/")
-;; (require 'zencoding-mode)
-;; (add-hook 'sgml-mode-hook 'zencoding-mode) ;; Auto-start on any markup modes
-;;
-;; Enable the minor mode with M-x zencoding-mode.
-;;
-;; See ``Test cases'' section for a complete set of expression types.
-;;
-;; If you are hacking on this project, eval (zencoding-test-cases) to
-;; ensure that your changes have not broken anything. Feel free to add
-;; new test cases if you add new features.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; History:
-;;
-;; Modified by Lennart Borgman.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Code:
-
-(defconst zencoding-mode:version "0.5.1")
-
-;; Include the trie data structure for caching
-;(require 'zencoding-trie)
-
-(require 'cl)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Generic parsing macros and utilities
-
-(defmacro zencoding-aif (test-form then-form &rest else-forms)
- "Anaphoric if. Temporary variable `it' is the result of test-form."
- `(let ((it ,test-form))
- (if it ,then-form ,@(or else-forms '(it)))))
-
-(defmacro zencoding-pif (test-form then-form &rest else-forms)
- "Parser anaphoric if. Temporary variable `it' is the result of test-form."
- `(let ((it ,test-form))
- (if (not (eq 'error (car it))) ,then-form ,@(or else-forms '(it)))))
-
-(defmacro zencoding-parse (regex nums label &rest body)
- "Parse according to a regex and update the `input' variable."
- `(zencoding-aif (zencoding-regex ,regex input ',(number-sequence 0 nums))
- (let ((input (elt it ,nums)))
- ,@body)
- `,`(error ,(concat "expected " ,label))))
-
-(defmacro zencoding-run (parser then-form &rest else-forms)
- "Run a parser and update the input properly, extract the parsed
- expression."
- `(zencoding-pif (,parser input)
- (let ((input (cdr it))
- (expr (car it)))
- ,then-form)
- ,@(or else-forms '(it))))
-
-(defmacro zencoding-por (parser1 parser2 then-form &rest else-forms)
- "OR two parsers. Try one parser, if it fails try the next."
- `(zencoding-pif (,parser1 input)
- (let ((input (cdr it))
- (expr (car it)))
- ,then-form)
- (zencoding-pif (,parser2 input)
- (let ((input (cdr it))
- (expr (car it)))
- ,then-form)
- ,@else-forms)))
-
-(defun zencoding-regex (regexp string refs)
- "Return a list of (`ref') matches for a `regex' on a `string' or nil."
- (if (string-match (concat "^" regexp "\\([^\n]*\\)$") string)
- (mapcar (lambda (ref) (match-string ref string))
- (if (sequencep refs) refs (list refs)))
- nil))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Zen coding parsers
-
-(defun zencoding-expr (input)
- "Parse a zen coding expression with optional filters."
- (zencoding-pif (zencoding-parse "\\(.*?\\)|" 2 "expr|filter" it)
- (let ((input (elt it 1))
- (filters (elt it 2)))
- (zencoding-pif (zencoding-extract-filters filters)
- (zencoding-filter input it)
- it))
- (zencoding-filter input (zencoding-default-filter))))
-
-(defun zencoding-subexpr (input)
- "Parse a zen coding expression with no filter. This pretty much defines precedence."
- (zencoding-run zencoding-siblings
- it
- (zencoding-run zencoding-parent-child
- it
- (zencoding-run zencoding-multiplier
- it
- (zencoding-run zencoding-pexpr
- it
- (zencoding-run zencoding-tag
- it
- '(error "no match, expecting ( or a-zA-Z0-9")))))))
-
-(defun zencoding-extract-filters (input)
- "Extract filters from expression."
- (zencoding-pif (zencoding-parse "\\([^\\|]+?\\)|" 2 "" it)
- (let ((filter-name (elt it 1))
- (more-filters (elt it 2)))
- (zencoding-pif (zencoding-extract-filters more-filters)
- (cons filter-name it)
- it))
- (zencoding-parse "\\([^\\|]+\\)" 1 "filter name" `(,(elt it 1)))))
-
-(defun zencoding-filter (input filters)
- "Construct AST with specified filters."
- (zencoding-pif (zencoding-subexpr input)
- (let ((result (car it))
- (rest (cdr it)))
- `((filter ,filters ,result) . ,rest))
- it))
-
-(defun zencoding-default-filter ()
- "Default filter(s) to be used if none is specified."
- (let* ((file-ext (car (zencoding-regex ".*\\(\\..*\\)" (or (buffer-file-name) "") 1)))
- (defaults '(".html" ("html")
- ".htm" ("html")
- ".haml" ("haml")
- ".clj" ("hic")))
- (default-else '("html"))
- (selected-default (member file-ext defaults)))
- (if selected-default
- (cadr selected-default)
- default-else)))
-
-(defun zencoding-multiplier (input)
- (zencoding-por zencoding-pexpr zencoding-tag
- (let ((multiplier expr))
- (zencoding-parse "\\*\\([0-9]+\\)" 2 "*n where n is a number"
- (let ((multiplicand (read (elt it 1))))
- `((list ,(make-list multiplicand multiplier)) . ,input))))
- '(error "expected *n multiplier")))
-
-(defun zencoding-tag (input)
- "Parse a tag."
- (zencoding-run zencoding-tagname
- (let ((tagname (cadr expr))
- (has-body? (cddr expr)))
- (zencoding-pif (zencoding-run zencoding-identifier
- (zencoding-tag-classes
- `(tag (,tagname ,has-body? ,(cddr expr))) input)
- (zencoding-tag-classes
- `(tag (,tagname ,has-body? nil)) input))
- (let ((expr (car it))
- (input (cdr it)))
- (zencoding-tag-props expr input))))
- (zencoding-default-tag input)))
-
-(defun zencoding-default-tag (input)
- "Parse a #id or .class"
- (zencoding-parse "\\([#|\\.]\\)" 1 "tagname"
- (zencoding-tag (concat "div" (elt it 0)))))
-
-(defun zencoding-tag-props (tag input)
- (let ((tag-data (cadr tag)))
- (zencoding-run zencoding-props
- (let ((props (cdr expr)))
- `((tag ,(append tag-data (list props))) . ,input))
- `((tag ,(append tag-data '(nil))) . ,input))))
-
-(defun zencoding-props (input)
- "Parse many props."
- (zencoding-run zencoding-prop
- (zencoding-pif (zencoding-props input)
- `((props . ,(cons expr (cdar it))) . ,(cdr it))
- `((props . ,(list expr)) . ,input))))
-
-(defun zencoding-prop (input)
- (zencoding-parse
- " " 1 "space"
- (zencoding-run
- zencoding-name
- (let ((name (cdr expr)))
- (zencoding-pif (zencoding-prop-value name input)
- it
- `((,(read name) "") . ,input))))))
-
-(defun zencoding-prop-value (name input)
- (zencoding-pif (zencoding-parse "=\"\\(.*?\\)\"" 2
- "=\"property value\""
- (let ((value (elt it 1))
- (input (elt it 2)))
- `((,(read name) ,value) . ,input)))
- it
- (zencoding-parse "=\\([^\\,\\+\\>\\ )]*\\)" 2
- "=property value"
- (let ((value (elt it 1))
- (input (elt it 2)))
- `((,(read name) ,value) . ,input)))))
-
-(defun zencoding-tag-classes (tag input)
- (let ((tag-data (cadr tag)))
- (zencoding-run zencoding-classes
- (let ((classes (mapcar (lambda (cls) (cdadr cls))
- (cdr expr))))
- `((tag ,(append tag-data (list classes))) . ,input))
- `((tag ,(append tag-data '(nil))) . ,input))))
-
-(defun zencoding-tagname (input)
- "Parse a tagname a-zA-Z0-9 tagname (e.g. html/head/xsl:if/br)."
- (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9:-]*\/?\\)" 2 "tagname, a-zA-Z0-9"
- (let* ((tag-spec (elt it 1))
- (empty-tag (zencoding-regex "\\([^\/]*\\)\/" tag-spec 1))
- (tag (if empty-tag
- (car empty-tag)
- tag-spec)))
- `((tagname . (,tag . ,(not empty-tag))) . ,input))))
-
-(defun zencoding-pexpr (input)
- "A zen coding expression with parentheses around it."
- (zencoding-parse "(" 1 "("
- (zencoding-run zencoding-subexpr
- (zencoding-aif (zencoding-regex ")" input '(0 1))
- `(,expr . ,(elt it 1))
- '(error "expecting `)'")))))
-
-(defun zencoding-parent-child (input)
- "Parse an tag>e expression, where `n' is an tag and `e' is any
- expression."
- (zencoding-run zencoding-multiplier
- (let* ((items (cadr expr))
- (rest (zencoding-child-sans expr input)))
- (if (not (eq (car rest) 'error))
- (let ((child (car rest))
- (input (cdr rest)))
- (cons (cons 'list
- (cons (mapcar (lambda (parent)
- `(parent-child ,parent ,child))
- items)
- nil))
- input))
- '(error "expected child")))
- (zencoding-run zencoding-tag
- (zencoding-child expr input)
- '(error "expected parent"))))
-
-(defun zencoding-child-sans (parent input)
- (zencoding-parse ">" 1 ">"
- (zencoding-run zencoding-subexpr
- it
- '(error "expected child"))))
-
-(defun zencoding-child (parent input)
- (zencoding-parse ">" 1 ">"
- (zencoding-run zencoding-subexpr
- (let ((child expr))
- `((parent-child ,parent ,child) . ,input))
- '(error "expected child"))))
-
-(defun zencoding-sibling (input)
- (zencoding-por zencoding-pexpr zencoding-multiplier
- it
- (zencoding-run zencoding-tag
- it
- '(error "expected sibling"))))
-
-(defun zencoding-siblings (input)
- "Parse an e+e expression, where e is an tag or a pexpr."
- (zencoding-run zencoding-sibling
- (let ((parent expr))
- (zencoding-parse "\\+" 1 "+"
- (zencoding-run zencoding-subexpr
- (let ((child expr))
- `((sibling ,parent ,child) . ,input))
- (zencoding-expand parent input))))
- '(error "expected first sibling")))
-
-(defvar zencoding-expandable-tags
- '("dl" ">(dt+dd)"
- "ol" ">li"
- "ul" ">li"
- "table" ">tr>td"))
-
-(defun zencoding-expand (parent input)
- "Parse an e+ expression, where e is an expandable tag"
- (let* ((parent-tag (car (elt parent 1)))
- (expandable (member parent-tag zencoding-expandable-tags)))
- (if expandable
- (let ((expansion (zencoding-child parent (concat (cadr expandable)))))
- (zencoding-pif (zencoding-parse "+\\(.*\\)" 1 "+expr"
- (zencoding-subexpr (elt it 1)))
- `((sibling ,(car expansion) ,(car it)))
- expansion))
- '(error "expected second sibling"))))
-
-(defun zencoding-name (input)
- "Parse a class or identifier name, e.g. news, footer, mainimage"
- (zencoding-parse "\\([a-zA-Z][a-zA-Z0-9-_:]*\\)" 2 "class or identifer name"
- `((name . ,(elt it 1)) . ,input)))
-
-(defun zencoding-class (input)
- "Parse a classname expression, e.g. .foo"
- (zencoding-parse "\\." 1 "."
- (zencoding-run zencoding-name
- `((class ,expr) . ,input)
- '(error "expected class name"))))
-(defun zencoding-identifier (input)
- "Parse an identifier expression, e.g. #foo"
- (zencoding-parse "#" 1 "#"
- (zencoding-run zencoding-name
- `((identifier . ,expr) . ,input))))
-
-(defun zencoding-classes (input)
- "Parse many classes."
- (zencoding-run zencoding-class
- (zencoding-pif (zencoding-classes input)
- `((classes . ,(cons expr (cdar it))) . ,(cdr it))
- `((classes . ,(list expr)) . ,input))
- '(error "expected class")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Zen coding transformer from AST to string
-
-(defvar zencoding-inline-tags
- '("a"
- "abbr"
- "acronym"
- "cite"
- "code"
- "dd"
- "dfn"
- "dt"
- "em"
- "h1" "h2" "h3" "h4" "h5" "h6"
- "kbd"
- "li"
- "q"
- "span"
- "strong"
- "var"))
-
-(defvar zencoding-block-tags
- '("p"))
-
-(defvar zencoding-self-closing-tags
- '("br"
- "img"
- "input"))
-
-(defvar zencoding-leaf-function nil
- "Function to execute when expanding a leaf node in the
- Zencoding AST.")
-
-(defvar zencoding-filters
- '("html" (zencoding-primary-filter zencoding-make-html-tag)
- "c" (zencoding-primary-filter zencoding-make-commented-html-tag)
- "haml" (zencoding-primary-filter zencoding-make-haml-tag)
- "hic" (zencoding-primary-filter zencoding-make-hiccup-tag)
- "e" (zencoding-escape-xml)))
-
-(defun zencoding-primary-filter (input proc)
- "Process filter that needs to be executed first, ie. not given output from other filter."
- (if (listp input)
- (let ((tag-maker (cadr proc)))
- (zencoding-transform-ast input tag-maker))
- nil))
-
-(defun zencoding-process-filter (filters input)
- "Process filters, chain one filter output as the input of the next filter."
- (let ((filter-data (member (car filters) zencoding-filters))
- (more-filters (cdr filters)))
- (if filter-data
- (let* ((proc (cadr filter-data))
- (fun (car proc))
- (filter-output (funcall fun input proc)))
- (if more-filters
- (zencoding-process-filter more-filters filter-output)
- filter-output))
- nil)))
-
-(defun zencoding-make-tag (tag-maker tag-info &optional content)
- "Extract tag info and pass them to tag-maker."
- (let* ((name (pop tag-info))
- (has-body? (pop tag-info))
- (id (pop tag-info))
- (classes (pop tag-info))
- (props (pop tag-info))
- (self-closing? (not (or content
- (and has-body?
- (not (member name zencoding-self-closing-tags)))))))
- (funcall tag-maker name id classes props self-closing?
- (if content content
- (if zencoding-leaf-function (funcall zencoding-leaf-function))))))
-
-(defun zencoding-make-html-tag (tag-name tag-id tag-classes tag-props self-closing? content)
- "Create HTML markup string"
- (let* ((id (zencoding-concat-or-empty " id=\"" tag-id "\""))
- (classes (zencoding-mapconcat-or-empty " class=\"" tag-classes " " "\""))
- (props (zencoding-mapconcat-or-empty " " tag-props " " nil
- (lambda (prop)
- (concat (symbol-name (car prop)) "=\"" (cadr prop) "\""))))
- (content-multiline? (and content (string-match "\n" content)))
- (block-tag? (or (member tag-name zencoding-block-tags)
- (and (> (length tag-name) 1)
- (not (member tag-name zencoding-inline-tags)))))
- (lf (if (or content-multiline? block-tag?)
- "\n")))
- (concat "<" tag-name id classes props (if self-closing?
- "/>"
- (concat ">" (if content
- (if (or content-multiline? block-tag?)
- (zencoding-indent content)
- content))
- lf
- "</" tag-name ">")))))
-
-(defun zencoding-make-commented-html-tag (tag-name tag-id tag-classes tag-props self-closing? content)
- "Create HTML markup string with extra comments for elements with #id or .classes"
- (let ((body (zencoding-make-html-tag tag-name tag-id tag-classes tag-props self-closing? content)))
- (if (or tag-id tag-classes)
- (let ((id (zencoding-concat-or-empty "#" tag-id))
- (classes (zencoding-mapconcat-or-empty "." tag-classes ".")))
- (concat "<!-- " id classes " -->\n"
- body
- "\n<!-- /" id classes " -->"))
- body)))
-
-(defun zencoding-make-haml-tag (tag-name tag-id tag-classes tag-props self-closing? content)
- "Create HAML string"
- (let ((name (if (and (equal tag-name "div")
- (or tag-id tag-classes))
- ""
- (concat "%" tag-name)))
- (id (zencoding-concat-or-empty "#" tag-id))
- (classes (zencoding-mapconcat-or-empty "." tag-classes "."))
- (props (zencoding-mapconcat-or-empty "{" tag-props ", " "}"
- (lambda (prop)
- (concat ":" (symbol-name (car prop)) " => \"" (cadr prop) "\"")))))
- (concat name id classes props (if content
- (zencoding-indent content)))))
-
-(defun zencoding-make-hiccup-tag (tag-name tag-id tag-classes tag-props self-closing? content)
- "Create Hiccup string"
- (let* ((id (zencoding-concat-or-empty "#" tag-id))
- (classes (zencoding-mapconcat-or-empty "." tag-classes "."))
- (props (zencoding-mapconcat-or-empty " {" tag-props ", " "}"
- (lambda (prop)
- (concat ":" (symbol-name (car prop)) " \"" (cadr prop) "\""))))
- (content-multiline? (and content (string-match "\n" content)))
- (block-tag? (or (member tag-name zencoding-block-tags)
- (and (> (length tag-name) 1)
- (not (member tag-name zencoding-inline-tags))))))
- (concat "[:" tag-name id classes props
- (if content
- (if (or content-multiline? block-tag?)
- (zencoding-indent content)
- (concat " " content)))
- "]")))
-
-(defun zencoding-concat-or-empty (prefix body &optional suffix)
- "Return prefixed suffixed text or empty string."
- (if body
- (concat prefix body suffix)
- ""))
-
-(defun zencoding-mapconcat-or-empty (prefix list-body delimiter &optional suffix map-fun)
- "Return prefixed suffixed mapconcated text or empty string."
- (if list-body
- (let* ((mapper (if map-fun map-fun 'identity))
- (body (mapconcat mapper list-body delimiter)))
- (concat prefix body suffix))
- ""))
-
-(defun zencoding-escape-xml (input proc)
- "Escapes XML-unsafe characters: <, > and &."
- (replace-regexp-in-string
- "<" "<"
- (replace-regexp-in-string
- ">" ">"
- (replace-regexp-in-string
- "&" "&"
- (if (stringp input)
- input
- (zencoding-process-filter (zencoding-default-filter) input))))))
-
-(defun zencoding-transform (ast-with-filters)
- "Transform AST (containing filter data) into string."
- (let ((filters (cadr ast-with-filters))
- (ast (caddr ast-with-filters)))
- (zencoding-process-filter filters ast)))
-
-(defun zencoding-transform-ast (ast tag-maker)
- "Transform AST (without filter data) into string."
- (let ((type (car ast)))
- (cond
- ((eq type 'list)
- (mapconcat (lexical-let ((make-tag-fun tag-maker))
- #'(lambda (sub-ast)
- (zencoding-transform-ast sub-ast make-tag-fun)))
- (cadr ast)
- "\n"))
- ((eq type 'tag)
- (zencoding-make-tag tag-maker (cadr ast)))
- ((eq type 'parent-child)
- (let ((parent (cadadr ast))
- (children (zencoding-transform-ast (caddr ast) tag-maker)))
- (zencoding-make-tag tag-maker parent children)))
- ((eq type 'sibling)
- (let ((sib1 (zencoding-transform-ast (cadr ast) tag-maker))
- (sib2 (zencoding-transform-ast (caddr ast) tag-maker)))
- (concat sib1 "\n" sib2))))))
-
-(defun zencoding-indent (text)
- "Indent the text"
- (if text
- (replace-regexp-in-string "\n" "\n " (concat "\n" text))
- nil))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Test-cases
-
-(defun zencoding-test-cases ()
- (let ((tests '(;; Tags
- ("a" "<a></a>")
- ("a.x" "<a class=\"x\"></a>")
- ("a#q.x" "<a id=\"q\" class=\"x\"></a>")
- ("a#q.x.y.z" "<a id=\"q\" class=\"x y z\"></a>")
- ("#q" "<div id=\"q\">"
- "</div>")
- (".x" "<div class=\"x\">"
- "</div>")
- ("#q.x" "<div id=\"q\" class=\"x\">"
- "</div>")
- ("#q.x.y.z" "<div id=\"q\" class=\"x y z\">"
- "</div>")
- ;; Empty tags
- ("a/" "<a/>")
- ("a/.x" "<a class=\"x\"/>")
- ("a/#q.x" "<a id=\"q\" class=\"x\"/>")
- ("a/#q.x.y.z" "<a id=\"q\" class=\"x y z\"/>")
- ;; Self-closing tags
- ("input type=text" "<input type=\"text\"/>")
- ("img" "<img/>")
- ("img>metadata/*2" "<img>"
- " <metadata/>"
- " <metadata/>"
- "</img>")
- ;; Siblings
- ("a+b" "<a></a>"
- "<b></b>")
- ("a+b+c" "<a></a>"
- "<b></b>"
- "<c></c>")
- ("a.x+b" "<a class=\"x\"></a>"
- "<b></b>")
- ("a#q.x+b" "<a id=\"q\" class=\"x\"></a>"
- "<b></b>")
- ("a#q.x.y.z+b" "<a id=\"q\" class=\"x y z\"></a>"
- "<b></b>")
- ("a#q.x.y.z+b#p.l.m.n" "<a id=\"q\" class=\"x y z\"></a>"
- "<b id=\"p\" class=\"l m n\"></b>")
- ;; Tag expansion
- ("table+" "<table>"
- " <tr>"
- " <td>"
- " </td>"
- " </tr>"
- "</table>")
- ("dl+" "<dl>"
- " <dt></dt>"
- " <dd></dd>"
- "</dl>")
- ("ul+" "<ul>"
- " <li></li>"
- "</ul>")
- ("ul++ol+" "<ul>"
- " <li></li>"
- "</ul>"
- "<ol>"
- " <li></li>"
- "</ol>")
- ("ul#q.x.y m=l+" "<ul id=\"q\" class=\"x y\" m=\"l\">"
- " <li></li>"
- "</ul>")
- ;; Parent > child
- ("a>b" "<a><b></b></a>")
- ("a>b>c" "<a><b><c></c></b></a>")
- ("a.x>b" "<a class=\"x\"><b></b></a>")
- ("a#q.x>b" "<a id=\"q\" class=\"x\"><b></b></a>")
- ("a#q.x.y.z>b" "<a id=\"q\" class=\"x y z\"><b></b></a>")
- ("a#q.x.y.z>b#p.l.m.n" "<a id=\"q\" class=\"x y z\"><b id=\"p\" class=\"l m n\"></b></a>")
- ("#q>.x" "<div id=\"q\">"
- " <div class=\"x\">"
- " </div>"
- "</div>")
- ("a>b+c" "<a>"
- " <b></b>"
- " <c></c>"
- "</a>")
- ("a>b+c>d" "<a>"
- " <b></b>"
- " <c><d></d></c>"
- "</a>")
- ;; Multiplication
- ("a*1" "<a></a>")
- ("a*2" "<a></a>"
- "<a></a>")
- ("a/*2" "<a/>"
- "<a/>")
- ("a*2+b*2" "<a></a>"
- "<a></a>"
- "<b></b>"
- "<b></b>")
- ("a*2>b*2" "<a>"
- " <b></b>"
- " <b></b>"
- "</a>"
- "<a>"
- " <b></b>"
- " <b></b>"
- "</a>")
- ("a>b*2" "<a>"
- " <b></b>"
- " <b></b>"
- "</a>")
- ("a#q.x>b#q.x*2" "<a id=\"q\" class=\"x\">"
- " <b id=\"q\" class=\"x\"></b>"
- " <b id=\"q\" class=\"x\"></b>"
- "</a>")
- ("a#q.x>b/#q.x*2" "<a id=\"q\" class=\"x\">"
- " <b id=\"q\" class=\"x\"/>"
- " <b id=\"q\" class=\"x\"/>"
- "</a>")
- ;; Properties
- ("a x" "<a x=\"\"></a>")
- ("a x=" "<a x=\"\"></a>")
- ("a x=\"\"" "<a x=\"\"></a>")
- ("a x=y" "<a x=\"y\"></a>")
- ("a x=\"y\"" "<a x=\"y\"></a>")
- ("a x=\"()\"" "<a x=\"()\"></a>")
- ("a x m" "<a x=\"\" m=\"\"></a>")
- ("a x= m=\"\"" "<a x=\"\" m=\"\"></a>")
- ("a x=y m=l" "<a x=\"y\" m=\"l\"></a>")
- ("a/ x=y m=l" "<a x=\"y\" m=\"l\"/>")
- ("a#foo x=y m=l" "<a id=\"foo\" x=\"y\" m=\"l\"></a>")
- ("a.foo x=y m=l" "<a class=\"foo\" x=\"y\" m=\"l\"></a>")
- ("a#foo.bar.mu x=y m=l" "<a id=\"foo\" class=\"bar mu\" x=\"y\" m=\"l\"></a>")
- ("a/#foo.bar.mu x=y m=l" "<a id=\"foo\" class=\"bar mu\" x=\"y\" m=\"l\"/>")
- ("a x=y+b" "<a x=\"y\"></a>"
- "<b></b>")
- ("a x=y+b x=y" "<a x=\"y\"></a>"
- "<b x=\"y\"></b>")
- ("a x=y>b" "<a x=\"y\"><b></b></a>")
- ("a x=y>b x=y" "<a x=\"y\"><b x=\"y\"></b></a>")
- ("a x=y>b x=y+c x=y" "<a x=\"y\">"
- " <b x=\"y\"></b>"
- " <c x=\"y\"></c>"
- "</a>")
- ;; Parentheses
- ("(a)" "<a></a>")
- ("(a)+(b)" "<a></a>"
- "<b></b>")
- ("a>(b)" "<a><b></b></a>")
- ("(a>b)>c" "<a><b></b></a>")
- ("(a>b)+c" "<a><b></b></a>"
- "<c></c>")
- ("z+(a>b)+c+k" "<z></z>"
- "<a><b></b></a>"
- "<c></c>"
- "<k></k>")
- ("(a)*2" "<a></a>"
- "<a></a>")
- ("((a)*2)" "<a></a>"
- "<a></a>")
- ("((a))*2" "<a></a>"
- "<a></a>")
- ("(a>b)*2" "<a><b></b></a>"
- "<a><b></b></a>")
- ("(a+b)*2" "<a></a>"
- "<b></b>"
- "<a></a>"
- "<b></b>")
- ;; Filter: comment
- ("a.b|c" "<!-- .b -->"
- "<a class=\"b\"></a>"
- "<!-- /.b -->")
- ("#a>.b|c" "<!-- #a -->"
- "<div id=\"a\">"
- " <!-- .b -->"
- " <div class=\"b\">"
- " </div>"
- " <!-- /.b -->"
- "</div>"
- "<!-- /#a -->")
- ;; Filter: HAML
- ("a|haml" "%a")
- ("a#q.x.y.z|haml" "%a#q.x.y.z")
- ("a#q.x x=y m=l|haml" "%a#q.x{:x => \"y\", :m => \"l\"}")
- ("div|haml" "%div")
- ("div.footer|haml" ".footer")
- (".footer|haml" ".footer")
- ("p>a href=#+br|haml" "%p"
- " %a{:href => \"#\"}"
- " %br")
- ;; Filter: Hiccup
- ("a|hic" "[:a]")
- ("a#q.x.y.z|hic" "[:a#q.x.y.z]")
- ("a#q.x x=y m=l|hic" "[:a#q.x {:x \"y\", :m \"l\"}]")
- (".footer|hic" "[:div.footer]")
- ("p>a href=#+br|hic" "[:p"
- " [:a {:href \"#\"}]"
- " [:br]]")
- ("#q>(a*2>b)+p>b|hic" "[:div#q"
- " [:a [:b]]"
- " [:a [:b]]"
- " [:p"
- " [:b]]]")
- ;; Filter: escape
- ("script src="|e" "<script src=\"&quot;\">"
- "</script>")
- )))
- (mapc (lambda (input)
- (let ((expected (mapconcat 'identity (cdr input) "\n"))
- (actual (zencoding-transform (car (zencoding-expr (car input))))))
- (if (not (equal expected actual))
- (error (concat "Assertion " (car input) " failed:"
- expected
- " == "
- actual)))))
- tests)
- (concat (number-to-string (length tests)) " tests performed. All OK.")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Zencoding minor mode
-
-(defgroup zencoding nil
- "Customization group for zencoding-mode."
- :group 'convenience)
-
-(defun zencoding-expr-on-line ()
- "Extract a zencoding expression and the corresponding bounds
- for the current line."
- (let* ((start (line-beginning-position))
- (end (line-end-position))
- (line (buffer-substring-no-properties start end))
- (expr (zencoding-regex "\\([ \t]*\\)\\([^\n]+\\)" line 2)))
- (if (first expr)
- (list (first expr) start end))))
-
-(defcustom zencoding-indentation 4
- "Number of spaces used for indentation."
- :type '(number :tag "Spaces")
- :group 'zencoding)
-
-(defun zencoding-prettify (markup indent)
- (let ((first-col (format (format "%%%ds" indent) ""))
- (tab (format (format "%%%ds" zencoding-indentation) "")))
- (concat first-col
- (replace-regexp-in-string "\n" (concat "\n" first-col)
- (replace-regexp-in-string " " tab markup)))))
-
-;;;###autoload
-(defun zencoding-expand-line (arg)
- "Replace the current line's zencode expression with the corresponding expansion.
-If prefix ARG is given or region is visible call `zencoding-preview' to start an
-interactive preview.
-
-Otherwise expand line directly.
-
-For more information see `zencoding-mode'."
- (interactive "P")
- (let* ((here (point))
- (preview (if zencoding-preview-default (not arg) arg))
- (beg (if preview
- (progn
- (beginning-of-line)
- (skip-chars-forward " \t")
- (point))
- (when mark-active (region-beginning))))
- (end (if preview
- (progn
- (end-of-line)
- (skip-chars-backward " \t")
- (point))
- (when mark-active (region-end)))))
- (if beg
- (progn
- (goto-char here)
- (zencoding-preview beg end))
- (let ((expr (zencoding-expr-on-line)))
- (if expr
- (let* ((markup (zencoding-transform (car (zencoding-expr (first expr)))))
- (pretty (zencoding-prettify markup (current-indentation))))
- (save-excursion
- (delete-region (second expr) (third expr))
- (zencoding-insert-and-flash pretty))))))))
-
-(defvar zencoding-mode-keymap nil
- "Keymap for zencode minor mode.")
-
-(if zencoding-mode-keymap
- nil
- (progn
- (setq zencoding-mode-keymap (make-sparse-keymap))
- (define-key zencoding-mode-keymap (kbd "C-j") 'zencoding-expand-line)
- (define-key zencoding-mode-keymap (kbd "<C-return>") 'zencoding-expand-line)))
-
-;;;###autoload
-(define-minor-mode zencoding-mode
- "Minor mode for writing HTML and CSS markup.
-With zen coding for HTML and CSS you can write a line like
-
- ul#name>li.item*2
-
-and have it expanded to
-
- <ul id=\"name\">
- <li class=\"item\"></li>
- <li class=\"item\"></li>
- </ul>
-
-This minor mode defines keys for quick access:
-
-\\{zencoding-mode-keymap}
-
-Home page URL `http://www.emacswiki.org/emacs/ZenCoding'.
-
-See also `zencoding-expand-line'."
- :lighter " Zen"
- :keymap zencoding-mode-keymap)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Zencoding yasnippet integration
-
-(defun zencoding-transform-yas (ast)
- (let* ((leaf-count 0)
- (zencoding-leaf-function
- (lambda ()
- (format "$%d" (incf leaf-count)))))
- (zencoding-transform ast)))
-
-;;;###autoload
-(defun zencoding-expand-yas ()
- (interactive)
- (let ((expr (zencoding-expr-on-line)))
- (if expr
- (let* ((markup (zencoding-transform-yas (car (zencoding-expr (first expr)))))
- (filled (replace-regexp-in-string "><" ">\n<" markup)))
- (delete-region (second expr) (third expr))
- (insert filled)
- (indent-region (second expr) (point))
- (yas/expand-snippet
- (buffer-substring (second expr) (point))
- (second expr) (point))))))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Real-time preview
-;;
-
-;;;;;;;;;;
-;; Lennart's version
-
-(defvar zencoding-preview-input nil)
-(make-local-variable 'zencoding-preview-input)
-(defvar zencoding-preview-output nil)
-(make-local-variable 'zencoding-preview-output)
-(defvar zencoding-old-show-paren nil)
-(make-local-variable 'zencoding-old-show-paren)
-
-(defface zencoding-preview-input
- '((default :box t :inherit secondary-selection))
- "Face for preview input field."
- :group 'zencoding)
-
-(defface zencoding-preview-output
- '((default :inherit highlight))
- "Face for preview output field."
- :group 'zencoding)
-
-(defvar zencoding-preview-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "RET") 'zencoding-preview-accept)
- (define-key map (kbd "<return>") 'zencoding-preview-accept)
- (define-key map [(control ?g)] 'zencoding-preview-abort)
- map))
-
-(defun zencoding-preview-accept ()
- (interactive)
- (let ((ovli zencoding-preview-input))
- (if (not (and (overlayp ovli)
- (bufferp (overlay-buffer ovli))))
- (message "Preview is not active")
- (let* ((indent (current-indentation))
- (markup (zencoding-preview-transformed indent)))
- (when markup
- (delete-region (line-beginning-position) (overlay-end ovli))
- (zencoding-insert-and-flash markup)))))
- (zencoding-preview-abort))
-
-(defvar zencoding-flash-ovl nil)
-(make-variable-buffer-local 'zencoding-flash-ovl)
-
-(defun zencoding-remove-flash-ovl (buf)
- (with-current-buffer buf
- (when (overlayp zencoding-flash-ovl)
- (delete-overlay zencoding-flash-ovl))
- (setq zencoding-flash-ovl nil)))
-
-(defcustom zencoding-preview-default t
- "If non-nil then preview is the default action.
-This determines how `zencoding-expand-line' works by default."
- :type 'boolean
- :group 'zencoding)
-
-(defcustom zencoding-insert-flash-time 0.5
- "Time to flash insertion.
-Set this to a negative number if you do not want flashing the
-expansion after insertion."
- :type '(number :tag "Seconds")
- :group 'zencoding)
-
-(defun zencoding-insert-and-flash (markup)
- (zencoding-remove-flash-ovl (current-buffer))
- (let ((here (point)))
- (insert markup)
- (setq zencoding-flash-ovl (make-overlay here (point)))
- (overlay-put zencoding-flash-ovl 'face 'zencoding-preview-output)
- (when (< 0 zencoding-insert-flash-time)
- (run-with-idle-timer zencoding-insert-flash-time
- nil 'zencoding-remove-flash-ovl (current-buffer)))))
-
-;;;###autoload
-(defun zencoding-preview (beg end)
- "Expand zencode between BEG and END interactively.
-This will show a preview of the expanded zen code and you can
-accept it or skip it."
- (interactive (if mark-active
- (list (region-beginning) (region-end))
- (list nil nil)))
- (zencoding-preview-abort)
- (if (not beg)
- (message "Region not active")
- (setq zencoding-old-show-paren show-paren-mode)
- (show-paren-mode -1)
- (let ((here (point)))
- (goto-char beg)
- (forward-line 1)
- (unless (= 0 (current-column))
- (insert "\n"))
- (let* ((opos (point))
- (ovli (make-overlay beg end nil nil t))
- (ovlo (make-overlay opos opos))
- (info (propertize " Zen preview. Choose with RET. Cancel by stepping out. \n"
- 'face 'tooltip)))
- (overlay-put ovli 'face 'zencoding-preview-input)
- (overlay-put ovli 'keymap zencoding-preview-keymap)
- (overlay-put ovlo 'face 'zencoding-preview-output)
- (overlay-put ovlo 'before-string info)
- (setq zencoding-preview-input ovli)
- (setq zencoding-preview-output ovlo)
- (add-hook 'before-change-functions 'zencoding-preview-before-change t t)
- (goto-char here)
- (add-hook 'post-command-hook 'zencoding-preview-post-command t t)))))
-
-(defvar zencoding-preview-pending-abort nil)
-(make-variable-buffer-local 'zencoding-preview-pending-abort)
-
-(defun zencoding-preview-before-change (beg end)
- (when
- (or (> beg (overlay-end zencoding-preview-input))
- (< beg (overlay-start zencoding-preview-input))
- (> end (overlay-end zencoding-preview-input))
- (< end (overlay-start zencoding-preview-input)))
- (setq zencoding-preview-pending-abort t)))
-
-(defun zencoding-preview-abort ()
- "Abort zen code preview."
- (interactive)
- (setq zencoding-preview-pending-abort nil)
- (remove-hook 'before-change-functions 'zencoding-preview-before-change t)
- (when (overlayp zencoding-preview-input)
- (delete-overlay zencoding-preview-input))
- (setq zencoding-preview-input nil)
- (when (overlayp zencoding-preview-output)
- (delete-overlay zencoding-preview-output))
- (setq zencoding-preview-output nil)
- (remove-hook 'post-command-hook 'zencoding-preview-post-command t)
- (when zencoding-old-show-paren (show-paren-mode 1)))
-
-(defun zencoding-preview-post-command ()
- (condition-case err
- (zencoding-preview-post-command-1)
- (error (message "zencoding-preview-post: %s" err))))
-
-(defun zencoding-preview-post-command-1 ()
- (if (and (not zencoding-preview-pending-abort)
- (<= (point) (overlay-end zencoding-preview-input))
- (>= (point) (overlay-start zencoding-preview-input)))
- (zencoding-update-preview (current-indentation))
- (zencoding-preview-abort)))
-
-(defun zencoding-preview-transformed (indent)
- (let* ((string (buffer-substring-no-properties
- (overlay-start zencoding-preview-input)
- (overlay-end zencoding-preview-input)))
- (ast (car (zencoding-expr string))))
- (when (not (eq ast 'error))
- (let ((output (zencoding-transform ast)))
- (when output
- (zencoding-prettify output indent))))))
-
-(defun zencoding-update-preview (indent)
- (let* ((pretty (zencoding-preview-transformed indent))
- (show (when pretty
- (propertize pretty 'face 'highlight))))
- (when show
- (overlay-put zencoding-preview-output 'after-string
- (concat show "\n")))))
-
-(provide 'zencoding-mode)
-
-;;; zencoding-mode.el ends here