From: Andreas Gerler Date: Tue, 28 Apr 2015 17:13:00 +0000 (+0200) Subject: introduced lisp/ directory for cleanup. X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=66dfbbebad22e24371b129f72fb1884ace88f398;p=emacsconfig.git introduced lisp/ directory for cleanup. Signed-off-by: Andreas Gerler --- diff --git a/bba.org b/bba.org index 5f41e655..b42f6967 100644 --- a/bba.org +++ b/bba.org @@ -708,7 +708,7 @@ taken from http://doc.norang.ca/org-mode.org #+BEGIN_SRC emacs-lisp ;; (load-library "cfengine") - (load-file (expand-file-name "~/.emacs.d/cfengine.el")) + (load-file (expand-file-name "~/.emacs.d/lisp/cfengine.el")) (add-to-list 'auto-mode-alist '("\\.cf$" . cfengine3-mode)) ;; post-commit and post-merge hook for git: diff --git a/cfengine-code-style.el b/cfengine-code-style.el deleted file mode 100644 index 237ca9e8..00000000 --- a/cfengine-code-style.el +++ /dev/null @@ -1,66 +0,0 @@ -;;; cfengine-code-style.el --- C code style for CFEngine project. - -;; Author: Mikhail Gusarov -;; URL: https://github.com/cfengine/core - -;;; Commentary: - -;; Usage: -;; -;; To enable coding style for the current buffer: -;; -;; M-x c-set-style cfengine -;; -;; To enable coding style permanently, create file .dir-locals.el with the -;; following contents in the directory with the source code: -;; -;; ((c-mode . ((c-file-style . "cfengine")))) -;; - -;; -;; TODO: special rule for C99 (Foo) { 1, 2, 3 } initializers. -;; TODO: special rule for whitespace between if/while/for and paren. -;; - -;;; Code: - -(defconst cfengine-c-style - '(;; 4 spaces - (c-basic-offset . 4) - ;; Braces on new lines - (c-hanging-braces-alist . ((substatement-open before after) - (statement-cont) - (brace-list-open) - (brace-list-close) - (brace-list-intro) - (brace-entry-open))) - ;; Newline after 'case' label - (c-hanging-colons-alist . ((case-label after))) - ;; Don't place comma on a separate line after array/aggregate - (c-cleanup-list . (list-close-comma)) - ;; Indentation - (c-offsets-alist . ((defun-open . 0) - (defun-block-intro . +) - (substatement-open . 0) - (statement-cont . +)))) - "CFEngine Code Style") - -(c-add-style "CFEngine" cfengine-c-style) - -;; -;; CFEngine uses CapitalizedWords for function names -;; - -(defun cfengine-c-mode-hook () - (if (eq c-file-style "CFEngine") - (progn - (setq indent-tabs-mode nil) - (setq c-tab-always-indent t) - (setq tab-width 4) - (subword-mode 1)))) - -(add-hook 'c-mode-hook 'cfengine-c-mode-hook) - -(provide 'cfengine-code-style) - -;;; cfengine-code-style.el ends here diff --git a/cfengine.el b/cfengine.el deleted file mode 100644 index 9ff3ca08..00000000 --- a/cfengine.el +++ /dev/null @@ -1,1455 +0,0 @@ -;;; cfengine.el --- mode for editing Cfengine files - -;; Copyright (C) 2001-2014 Free Software Foundation, Inc. - -;; Author: Dave Love -;; Maintainer: Ted Zlatanov -;; Keywords: languages -;; Version: 1.3 - -;; This file is part of GNU Emacs, but has trivial compatibility -;; modifications for Emacs versions before 24. Emacs 24 and newer -;; includes this code and you should use that version. The following -;; is the copyright notice from Emacs, which still applies to this -;; code and all derivations thereof. - -;; GNU Emacs 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. - -;; GNU Emacs 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. If not, see . - -;;; Commentary: - -;; Provides support for editing GNU Cfengine files, including -;; font-locking, Imenu and indentation, but with no special keybindings. - -;; By default, CFEngine 3.x syntax is used. - -;; You can set it up so either `cfengine2-mode' (2.x and earlier) or -;; `cfengine3-mode' (3.x) will be picked, depending on the buffer -;; contents: - -;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-auto-mode)) - -;; OR you can choose to always use a specific version, if you prefer -;; it: - -;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine3-mode)) -;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode)) -;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode)) - -;; It's *highly* recommended that you enable the eldoc minor mode: - -;; (add-hook 'cfengine3-mode-hook 'eldoc-mode) - -;; It's *highly* recommended that you use this mode with the latest -;; Emacs, or at least 24.1. - -;; This is not the same as the mode written by Rolf Ebert -;; , distributed with cfengine-2.0.5. It does -;; better fontification and indentation, inter alia. - -;;; Code: - -;; Set up compatibility with Emacsen where prog-mode doesn't exist. -(defalias 'cfengine-prog-mode (if (fboundp 'prog-mode) - 'prog-mode - 'fundamental-mode)) - -;; `setq-local' was introduced in 24.3 -(eval-when-compile - (or (fboundp 'setq-local) - (defmacro setq-local (var val) - `(set (make-local-variable ',var) ,val)))) - -(autoload 'json-read "json") -(autoload 'regexp-opt "regexp-opt") - -(defgroup cfengine () - "Editing CFEngine files." - :group 'languages) - -(defcustom cfengine-indent 2 - "Size of a CFEngine indentation step in columns." - :group 'cfengine - :type 'integer) - -(defcustom cfengine-cf-promises - (or (executable-find "cf-promises") - (executable-find "/var/cfengine/bin/cf-promises") - (executable-find "/usr/bin/cf-promises") - (executable-find "/usr/sbin/cf-promises") - (executable-find "/usr/local/bin/cf-promises") - (executable-find "/usr/local/sbin/cf-promises") - (executable-find "~/bin/cf-promises") - (executable-find "~/sbin/cf-promises")) - "The location of the cf-promises executable. -Used for syntax discovery and checking. Set to nil to disable -the `compile-command' override. In that case, the ElDoc support -will use a fallback syntax definition." - :version "24.4" - :group 'cfengine - :type '(choice file (const nil))) - -(defcustom cfengine-parameters-indent '(promise pname 0) - "Indentation of CFEngine3 promise parameters (hanging indent). - -For example, say you have this code: - -bundle x y -{ - section: - class:: - promise ... - promiseparameter => ... -} - -You can choose to indent promiseparameter from the beginning of -the line (absolutely) or from the word \"promise\" (relatively). - -You can also choose to indent the start of the word -\"promiseparameter\" or the arrow that follows it. - -Finally, you can choose the amount of the indent. - -The default is to anchor at promise, indent parameter name, and offset 0: - -bundle agent rcfiles -{ - files: - any:: - \"/tmp/netrc\" - comment => \"my netrc\", - perms => mog(\"600\", \"tzz\", \"tzz\"); -} - -Here we anchor at beginning of line, indent arrow, and offset 10: - -bundle agent rcfiles -{ - files: - any:: - \"/tmp/netrc\" - comment => \"my netrc\", - perms => mog(\"600\", \"tzz\", \"tzz\"); -} - -Some, including cfengine_stdlib.cf, like to anchor at promise, indent -arrow, and offset 16 or so: - -bundle agent rcfiles -{ - files: - any:: - \"/tmp/netrc\" - comment => \"my netrc\", - perms => mog(\"600\", \"tzz\", \"tzz\"); -} -" - :version "24.4" - :group 'cfengine - :type '(list - (choice (const :tag "Anchor at beginning of promise" promise) - (const :tag "Anchor at beginning of line" bol)) - (choice (const :tag "Indent parameter name" pname) - (const :tag "Indent arrow" arrow)) - (integer :tag "Indentation amount from anchor"))) - -(defvar cfengine-mode-debug nil - "Whether `cfengine-mode' should print debugging info.") - -(defvar cfengine-mode-syntax-cache nil - "Cache for `cfengine-mode' syntax trees obtained from 'cf-promises -s json'.") - -; Be sure to keep these two in sync with libpromises/cf3.defs.h -(defconst cfengine3-uint-range "0,2147483647") -(defconst cfengine3-sint-range "-2147483648,2147483647") - -(defconst cfengine3-fallback-syntax - '((functions - (userexists - (category . "system") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (usemodule - (category . "utils") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (unique - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (translatepath - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "string") (status . "normal")) - (sum - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "real") (status . "normal")) - (sublist - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "head,tail") (type . "option")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "slist") (status . "normal")) - (strftime - (category . "data") (variadic . :json-false) - (parameters . [((range . "gmtime,localtime") (type . "option")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "string") (status . "normal")) - (strcmp - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (splitstring - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "slist") (status . "normal")) - (splayclass - (category . "utils") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "daily,hourly") (type . "option"))]) - (returnType . "context") (status . "normal")) - (sort - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "lex") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (some - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "context") (status . "normal")) - (shuffle - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (selectservers - (category . "communication") (variadic . :json-false) - (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "int") (status . "normal")) - (reverse - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (rrange - (category . "data") (variadic . :json-false) - (parameters . [((range . "-9.99999E100,9.99999E100") (type . "real")) - ((range . "-9.99999E100,9.99999E100") (type . "real"))]) - (returnType . "rrange") (status . "normal")) - (returnszero - (category . "utils") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . "useshell,noshell,powershell") (type . "option"))]) - (returnType . "context") (status . "normal")) - (remoteclassesmatching - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "true,false,yes,no,on,off") (type . "option")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "context") (status . "normal")) - (remotescalar - (category . "communication") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "true,false,yes,no,on,off") (type . "option"))]) - (returnType . "string") (status . "normal")) - (regldap - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "subtree,onelevel,base") (type . "option")) - ((range . ".*") (type . "string")) - ((range . "none,ssl,sasl") (type . "option"))]) - (returnType . "context") (status . "normal")) - (reglist - (category . "data") (variadic . :json-false) - (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (regline - (category . "io") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (registryvalue - (category . "system") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (regextract - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "context") (status . "normal")) - (regcmp - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (regarray - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (readtcp - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "string") (status . "normal")) - (readstringlist - (category . "io") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "slist") (status . "normal")) - (readstringarrayidx - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (readstringarray - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (readreallist - (category . "io") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "rlist") (status . "normal")) - (readrealarray - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (readintlist - (category . "io") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "ilist") (status . "normal")) - (readintarray - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (readfile - (category . "io") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "string") (status . "normal")) - (randomint - (category . "data") (variadic . :json-false) - (parameters . [((range . cfengine3-sint-range) (type . "int")) - ((range . cfengine3-sint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (product - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "real") (status . "normal")) - (peerleaders - (category . "communication") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "slist") (status . "normal")) - (peerleader - (category . "communication") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "string") (status . "normal")) - (peers - (category . "communication") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "slist") (status . "normal")) - (parsestringarrayidx - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (parsestringarray - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (parserealarray - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (parseintarray - (category . "io") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . cfengine3-uint-range) (type . "int")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "int") (status . "normal")) - (or - (category . "data") (variadic . t) - (parameters . []) - (returnType . "string") (status . "normal")) - (on - (category . "data") (variadic . :json-false) - (parameters . [((range . "1970,3000") (type . "int")) - ((range . "1,12") (type . "int")) - ((range . "1,31") (type . "int")) - ((range . "0,23") (type . "int")) - ((range . "0,59") (type . "int")) - ((range . "0,59") (type . "int"))]) - (returnType . "int") (status . "normal")) - (nth - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "string") (status . "normal")) - (now - (category . "system") (variadic . :json-false) - (parameters . []) - (returnType . "int") (status . "normal")) - (not - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (none - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "context") (status . "normal")) - (maplist - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (maparray - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (lsdir - (category . "files") (variadic . :json-false) - (parameters . [((range . ".+") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "true,false,yes,no,on,off") (type . "option"))]) - (returnType . "slist") (status . "normal")) - (length - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "int") (status . "normal")) - (ldapvalue - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "subtree,onelevel,base") (type . "option")) - ((range . "none,ssl,sasl") (type . "option"))]) - (returnType . "string") (status . "normal")) - (ldaplist - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "subtree,onelevel,base") (type . "option")) - ((range . "none,ssl,sasl") (type . "option"))]) - (returnType . "slist") (status . "normal")) - (ldaparray - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string")) - ((range . "subtree,onelevel,base") (type . "option")) - ((range . "none,ssl,sasl") (type . "option"))]) - (returnType . "context") (status . "normal")) - (laterthan - (category . "files") (variadic . :json-false) - (parameters . [((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,40000") (type . "int"))]) - (returnType . "context") (status . "normal")) - (lastnode - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (join - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "string") (status . "normal")) - (isvariable - (category . "utils") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "context") (status . "normal")) - (isplain - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")) - (isnewerthan - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")) - (islink - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")) - (islessthan - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (isgreaterthan - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (isexecutable - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")) - (isdir - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")) - (irange - (category . "data") (variadic . :json-false) - (parameters . [((range . cfengine3-sint-range) (type . "int")) - ((range . cfengine3-sint-range) (type . "int"))]) - (returnType . "irange") (status . "normal")) - (iprange - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (intersection - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (ifelse - (category . "data") (variadic . t) - (parameters . []) - (returnType . "string") (status . "normal")) - (hubknowledge - (category . "communication") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "string") (status . "normal")) - (hostswithclass - (category . "communication") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_]+") (type . "string")) - ((range . "name,address") (type . "option"))]) - (returnType . "slist") (status . "normal")) - (hostsseen - (category . "communication") (variadic . :json-false) - (parameters . [((range . cfengine3-uint-range) (type . "int")) - ((range . "lastseen,notseen") (type . "option")) - ((range . "name,address") (type . "option"))]) - (returnType . "slist") (status . "normal")) - (hostrange - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (hostinnetgroup - (category . "system") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (ip2host - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (host2ip - (category . "communication") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (hashmatch - (category . "data") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . "md5,sha1,crypt,cf_sha224,cf_sha256,cf_sha384,cf_sha512") (type . "option")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "context") (status . "normal")) - (hash - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "md5,sha1,sha256,sha512,sha384,crypt") (type . "option"))]) - (returnType . "string") (status . "normal")) - (groupexists - (category . "system") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (grep - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (getvalues - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (getusers - (category . "system") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (getuid - (category . "system") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "int") (status . "normal")) - (getindices - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (getgid - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "int") (status . "normal")) - (getfields - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "\"?(/.*)") (type . "string")) - ((range . ".*") (type . "string")) - ((range . ".*") (type . "string"))]) - (returnType . "int") (status . "normal")) - (getenv - (category . "system") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "string") (status . "normal")) - (format - (category . "data") (variadic . t) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (filter - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "true,false,yes,no,on,off") (type . "option")) - ((range . "true,false,yes,no,on,off") (type . "option")) - ((range . cfengine3-uint-range) (type . "int"))]) - (returnType . "slist") (status . "normal")) - (filestat - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . "size,gid,uid,ino,nlink,ctime,atime,mtime,mode,modeoct,permstr,permoct,type,devno,dev_minor,dev_major,basename,dirname") (type . "option"))]) - (returnType . "string") (status . "normal")) - (filesize - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "int") (status . "normal")) - (filesexist - (category . "files") (variadic . :json-false) - (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))]) - (returnType . "context") (status . "normal")) - (fileexists - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")) - (execresult - (category . "utils") (variadic . :json-false) - (parameters . [((range . ".+") (type . "string")) - ((range . "useshell,noshell,powershell") (type . "option"))]) - (returnType . "string") (status . "normal")) - (every - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "context") (status . "normal")) - (escape - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (diskfree - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string"))]) - (returnType . "int") (status . "normal")) - (dirname - (category . "files") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (difference - (category . "data") (variadic . :json-false) - (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) - ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (countlinesmatching - (category . "io") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string")) - ((range . "\"?(/.*)") (type . "string"))]) - (returnType . "int") (status . "normal")) - (countclassesmatching - (category . "utils") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "int") (status . "normal")) - (classesmatching - (category . "utils") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "slist") (status . "normal")) - (classmatch - (category . "utils") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (classify - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "context") (status . "normal")) - (changedbefore - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")) - (concat - (category . "data") (variadic . t) - (parameters . []) - (returnType . "string") (status . "normal")) - (canonify - (category . "data") (variadic . :json-false) - (parameters . [((range . ".*") (type . "string"))]) - (returnType . "string") (status . "normal")) - (and - (category . "data") (variadic . t) - (parameters . []) - (returnType . "string") (status . "normal")) - (ago - (category . "data") (variadic . :json-false) - (parameters . [((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,40000") (type . "int"))]) - (returnType . "int") (status . "normal")) - (accumulated - (category . "data") (variadic . :json-false) - (parameters . [((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,1000") (type . "int")) - ((range . "0,40000") (type . "int"))]) - (returnType . "int") (status . "normal")) - (accessedbefore - (category . "files") (variadic . :json-false) - (parameters . [((range . "\"?(/.*)") (type . "string")) - ((range . "\"?(/.*)") (type . "string"))]) - (returnType . "context") (status . "normal")))) - "Fallback CFEngine syntax, containing just function definitions.") - -(defvar cfengine-mode-syntax-functions-regex - (regexp-opt (mapcar (lambda (def) - (format "%s" (car def))) - (cdr (assq 'functions cfengine3-fallback-syntax))) - 'symbols)) - -(defcustom cfengine-mode-abbrevs nil - "Abbrevs for CFEngine2 mode." - :group 'cfengine - :type '(repeat (list (string :tag "Name") - (string :tag "Expansion") - (choice :tag "Hook" (const nil) function)))) - -(make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1") - -;; Taken from the doc for pre-release 2.1. -(eval-and-compile - (defconst cfengine2-actions - '("acl" "alerts" "binservers" "broadcast" "control" "classes" "copy" - "defaultroute" "disks" "directories" "disable" "editfiles" "files" - "filters" "groups" "homeservers" "ignore" "import" "interfaces" - "links" "mailserver" "methods" "miscmounts" "mountables" - "processes" "packages" "rename" "required" "resolve" - "shellcommands" "tidy" "unmount" - ;; Keywords for cfservd. - "admit" "grant" "deny") - "List of the action keywords supported by Cfengine. -This includes those for cfservd as well as cfagent.") - - (defconst cfengine3-defuns '("bundle" "body") - "List of the CFEngine 3.x defun headings.") - - (defconst cfengine3-defuns-regex (regexp-opt cfengine3-defuns t) - "Regex to match the CFEngine 3.x defuns.") - - (defconst cfengine3-defun-full-re (concat "^\\s-*" cfengine3-defuns-regex - "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type - "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id - ) - "Regexp matching full defun declaration (excluding argument list).") - - (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::") - - (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):") - - (defconst cfengine3-vartypes '("string" "int" "real" "slist" "ilist" "rlist" - "irange" "rrange" "counter" "data") - "List of the CFEngine 3.x variable types.")) - -(defconst cfengine-font-lock-syntactic-keywords - ;; In the main syntax-table, backslash is marked as a punctuation, because - ;; of its use in DOS-style directory separators. Here we try to recognize - ;; the cases where backslash is used as an escape inside strings. - '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\"))) - -(defvar cfengine2-font-lock-keywords - `(;; Actions. - ;; List the allowed actions explicitly, so that errors are more obvious. - (,(concat "^[ \t]*" (eval-when-compile - (regexp-opt cfengine2-actions t)) - ":") - 1 font-lock-keyword-face) - ;; Classes. - ("^[ \t]*\\([[:alnum:]_().|!]+\\)::" 1 font-lock-function-name-face) - ;; Variables. - ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face) - ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face) - ;; Variable definitions. - ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) - ;; File, acl &c in group: { token ... } - ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) - -(defvar cfengine3-font-lock-keywords - `( - ;; Defuns. This happens early so they don't get caught by looser - ;; patterns. - (,(concat "\\_<" cfengine3-defuns-regex "\\_>" - "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>" - "[ \t]+\\_<\\([[:alnum:]_.:]+\\)" - ;; Optional parentheses with variable names inside. - "\\(?:(\\([^)]*\\))\\)?") - (1 font-lock-builtin-face) - (2 font-lock-constant-face) - (3 font-lock-function-name-face) - (4 font-lock-variable-name-face nil t)) - - ;; Class selectors. - (,(concat "^[ \t]*" cfengine3-class-selector-regex) - 1 font-lock-keyword-face) - - ;; Categories. - (,(concat "^[ \t]*" cfengine3-category-regex) - 1 font-lock-builtin-face) - - ;; Variables, including scope, e.g. module.var - ("[@$](\\([[:alnum:]_.:]+\\))" 1 font-lock-variable-name-face) - ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face) - - ;; Variable definitions. - ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) - - ;; Variable types. - (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>") - 1 font-lock-type-face))) - -(defvar cfengine2-imenu-expression - `((nil ,(concat "^[ \t]*" (eval-when-compile - (regexp-opt cfengine2-actions t)) - ":[^:]") - 1) - ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1) - ("Variables/classes" "\\_[ \t]+\\([[:alnum:]_]+\\)" 1)) - "`imenu-generic-expression' for CFEngine mode.") - -(defun cfengine2-outline-level () - "`outline-level' function for CFEngine mode." - (if (looking-at "[^:]+\\(?:[:]+\\)$") - (length (match-string 1)))) - -(defun cfengine2-beginning-of-defun () - "`beginning-of-defun' function for CFEngine mode. -Treats actions as defuns." - (unless (<= (current-column) (current-indentation)) - (end-of-line)) - (if (re-search-backward "^[[:alpha:]]+: *$" nil t) - (beginning-of-line) - (goto-char (point-min))) - t) - -(defun cfengine2-end-of-defun () - "`end-of-defun' function for CFEngine mode. -Treats actions as defuns." - (end-of-line) - (if (re-search-forward "^[[:alpha:]]+: *$" nil t) - (beginning-of-line) - (goto-char (point-max))) - t) - -;; Fixme: Should get an extra indent step in editfiles BeginGroup...s. - -(defun cfengine2-indent-line () - "Indent a line in Cfengine mode. -Intended as the value of `indent-line-function'." - (let ((pos (- (point-max) (point)))) - (save-restriction - (narrow-to-defun) - (back-to-indentation) - (cond - ;; Action selectors aren't indented; class selectors are - ;; indented one step. - ((looking-at "[[:alnum:]_().|!]+:\\(:\\)?") - (if (match-string 1) - (indent-line-to cfengine-indent) - (indent-line-to 0))) - ;; Outdent leading close brackets one step. - ((or (eq ?\} (char-after)) - (eq ?\) (char-after))) - (condition-case () - (indent-line-to (save-excursion - (forward-char) - (backward-sexp) - (current-column))) - (error nil))) - ;; Inside brackets/parens: indent to start column of non-comment - ;; token on line following open bracket or by one step from open - ;; bracket's column. - ((condition-case () - (progn (indent-line-to (save-excursion - (backward-up-list) - (forward-char) - (skip-chars-forward " \t") - (if (looking-at "[^\n#]") - (current-column) - (skip-chars-backward " \t") - (+ (current-column) -1 - cfengine-indent)))) - t) - (error nil))) - ;; Indent by two steps after a class selector. - ((save-excursion - (re-search-backward "^[ \t]*[[:alnum:]_().|!]+::" nil t)) - (indent-line-to (* 2 cfengine-indent))) - ;; Indent by one step if we're after an action header. - ((save-excursion - (goto-char (point-min)) - (looking-at "[[:alpha:]]+:[ \t]*$")) - (indent-line-to cfengine-indent)) - ;; Else don't indent. - (t - (indent-line-to 0)))) - ;; If initial point was within line's indentation, - ;; position after the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))))) - -;; This doesn't work too well in Emacs 21.2. See 22.1 development -;; code. -(defun cfengine-fill-paragraph (&optional justify) - "Fill `paragraphs' in Cfengine code." - (interactive "P") - (or (if (fboundp 'fill-comment-paragraph) - (fill-comment-paragraph justify) ; post Emacs 21.3 - ;; else do nothing in a comment - (nth 4 (parse-partial-sexp (save-excursion - (beginning-of-defun) - (point)) - (point)))) - (let ((paragraph-start - ;; Include start of parenthesized block. - "\f\\|[ \t]*$\\|.*\(") - (paragraph-separate - ;; Include action and class lines, start and end of - ;; bracketed blocks and end of parenthesized blocks to - ;; avoid including these in fill. This isn't ideal. - "[ \t\f]*$\\|.*#\\|.*[\){}]\\|\\s-*[[:alpha:]_().|!]+:") - fill-paragraph-function) - (fill-paragraph justify)) - t)) - -(defun cfengine3-beginning-of-defun () - "`beginning-of-defun' function for Cfengine 3 mode. -Treats body/bundle blocks as defuns." - (unless (<= (current-column) (current-indentation)) - (end-of-line)) - (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) - (beginning-of-line) - (goto-char (point-min))) - t) - -(defun cfengine3-end-of-defun () - "`end-of-defun' function for Cfengine 3 mode. -Treats body/bundle blocks as defuns." - (end-of-line) - (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t) - (beginning-of-line) - (goto-char (point-max))) - t) - -(defun cfengine3-indent-line () - "Indent a line in Cfengine 3 mode. -Intended as the value of `indent-line-function'." - (let ((pos (- (point-max) (point))) - parse) - (save-restriction - (narrow-to-defun) - (back-to-indentation) - (setq parse (parse-partial-sexp (point-min) (point))) - (when cfengine-mode-debug - (message "%S" parse)) - - (cond - ;; Body/bundle blocks start at 0. - ((looking-at (concat cfengine3-defuns-regex "\\_>")) - (indent-line-to 0)) - ;; Categories are indented one step. - ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$")) - (indent-line-to cfengine-indent)) - ;; Class selectors are indented two steps. - ((looking-at (concat cfengine3-class-selector-regex "[ \t]*\\(#.*\\)*$")) - (indent-line-to (* 2 cfengine-indent))) - ;; Outdent leading close brackets one step. - ((or (eq ?\} (char-after)) - (eq ?\) (char-after))) - (condition-case () - (indent-line-to (save-excursion - (forward-char) - (backward-sexp) - (move-beginning-of-line nil) - (skip-chars-forward " \t") - (current-column))) - (error nil))) - ;; Inside a string and it starts before this line: do nothing. - ((and (nth 3 parse) - (< (nth 8 parse) (save-excursion (beginning-of-line) (point)))) - ) - - ;; Inside a defun, but not a nested list (depth is 1). This is - ;; a promise, usually. - - ;; Indent to cfengine-indent times the nested depth - ;; plus 2. That way, promises indent deeper than class - ;; selectors, which in turn are one deeper than categories. - ((= 1 (nth 0 parse)) - (let ((p-anchor (nth 0 cfengine-parameters-indent)) - (p-what (nth 1 cfengine-parameters-indent)) - (p-indent (nth 2 cfengine-parameters-indent))) - ;; Do we have the parameter anchor and location and indent - ;; defined, and are we looking at a promise parameter? - (if (and p-anchor p-what p-indent - (looking-at "\\([[:alnum:]_]+[ \t]*\\)=>")) - (let* ((arrow-offset (* -1 (length (match-string 1)))) - (extra-offset (if (eq p-what 'arrow) arrow-offset 0)) - (base-offset (if (eq p-anchor 'promise) - (* (+ 2 (nth 0 parse)) cfengine-indent) - 0))) - (indent-line-to (max 0 (+ p-indent base-offset extra-offset)))) - ;; Else, indent to cfengine-indent times the nested depth - ;; plus 2. That way, promises indent deeper than class - ;; selectors, which in turn are one deeper than categories. - (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent))))) - ;; Inside brackets/parens: indent to start column of non-comment - ;; token on line following open bracket or by one step from open - ;; bracket's column. - ((condition-case () - (progn (indent-line-to (save-excursion - (backward-up-list) - (forward-char) - (skip-chars-forward " \t") - (cond - ((looking-at "[^\n#]") - (current-column)) - ((looking-at "[^\n#]") - (current-column)) - (t - (skip-chars-backward " \t") - (+ (current-column) -1 - cfengine-indent))))) - t) - (error nil))) - ;; Else don't indent. - (t (indent-line-to 0)))) - ;; If initial point was within line's indentation, - ;; position after the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))))) - -;; CFEngine 3.x grammar - -;; specification: blocks -;; blocks: block | blocks block; -;; block: bundle typeid blockid bundlebody -;; | bundle typeid blockid usearglist bundlebody -;; | body typeid blockid bodybody -;; | body typeid blockid usearglist bodybody; - -;; typeid: id -;; blockid: id -;; usearglist: '(' aitems ')'; -;; aitems: aitem | aitem ',' aitems |; -;; aitem: id - -;; bundlebody: '{' statements '}' -;; statements: statement | statements statement; -;; statement: category | classpromises; - -;; bodybody: '{' bodyattribs '}' -;; bodyattribs: bodyattrib | bodyattribs bodyattrib; -;; bodyattrib: class | selections; -;; selections: selection | selections selection; -;; selection: id ASSIGN rval ';' ; - -;; classpromises: classpromise | classpromises classpromise; -;; classpromise: class | promises; -;; promises: promise | promises promise; -;; category: CATEGORY -;; promise: promiser ARROW rval constraints ';' | promiser constraints ';'; -;; constraints: constraint | constraints ',' constraint |; -;; constraint: id ASSIGN rval; -;; class: CLASS -;; id: ID -;; rval: ID | QSTRING | NAKEDVAR | list | usefunction -;; list: '{' litems '}' ; -;; litems: litem | litem ',' litems |; -;; litem: ID | QSTRING | NAKEDVAR | list | usefunction - -;; functionid: ID | NAKEDVAR -;; promiser: QSTRING -;; usefunction: functionid givearglist -;; givearglist: '(' gaitems ')' -;; gaitems: gaitem | gaitems ',' gaitem |; -;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction - -;; # from lexer: - -;; bundle: "bundle" -;; body: "body" -;; COMMENT #[^\n]* -;; NAKEDVAR [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}] -;; ID: [a-zA-Z0-9_\200-\377]+ -;; ASSIGN: "=>" -;; ARROW: "->" -;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*` -;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+:: -;; CATEGORY: [a-zA-Z_]+: - -(defun cfengine3--current-function () - "Look up current CFEngine 3 function" - (let* ((syntax (cfengine3-make-syntax-cache)) - (flist (assq 'functions syntax))) - (when flist - (let ((w (save-excursion - (skip-syntax-forward "w_") - (when (search-backward-regexp - cfengine-mode-syntax-functions-regex - (point-at-bol) - t) - (match-string 1))))) - (and w (assq (intern w) flist)))))) - -;; format from "cf-promises -s json", e.g. "sort" function: -;; ((category . "data") -;; (variadic . :json-false) -;; (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string")) -;; ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))]) -;; (returnType . "slist") -;; (status . "normal")) - -(defun cfengine3-format-function-docstring (fdef) - (let* ((f (format "%s" (car-safe fdef))) - (def (cdr fdef)) - (rtype (cdr (assq 'returnType def))) - (plist (cdr (assq 'parameters def))) - (has-some-parameters (> (length plist) 0)) - (variadic (eq t (cdr (assq 'variadic def))))) - - ;; (format "[%S]%s %s(%s%s)" def - (format "%s %s(%s%s)" - (if rtype - (propertize rtype 'face 'font-lock-variable-name-face) - "???") - (propertize f 'face 'font-lock-function-name-face) - (mapconcat (lambda (p) - (let ((type (cdr (assq 'type p))) - (range (cdr (assq 'range p)))) - (cond - ((not (stringp type)) "???type???") - ((not (stringp range)) "???range???") - ;; options are lists of possible keywords - ((equal type "option") - (propertize (concat "[" range "]") - 'face - 'font-lock-keyword-face)) - ;; anything else is a type name as a variable - (t (propertize type - 'face - 'font-lock-variable-name-face))))) - plist - ", ") - (if variadic - (if has-some-parameters ", ..." "...") - "")))) - -(defun cfengine3-clear-syntax-cache () - "Clear the internal syntax cache. -Should not be necessary unless you reinstall CFEngine." - (interactive) - (setq cfengine-mode-syntax-functions-regex nil) - (setq cfengine-mode-syntax-cache nil)) - -(defun cfengine3-make-syntax-cache () - "Build the CFEngine 3 syntax cache and return the syntax. -Calls `cfengine-cf-promises' with \"-s json\"." - (or (cdr (assoc cfengine-cf-promises cfengine-mode-syntax-cache)) - (let ((syntax (or (when cfengine-cf-promises - (with-demoted-errors "cfengine3-make-syntax-cache: %S" - (with-temp-buffer - (or (zerop (process-file cfengine-cf-promises - nil ; no input - t ; output - nil ; no redisplay - "-s" "json")) - (error "%s" (buffer-substring - (point-min) - (progn (goto-char (point-min)) - (line-end-position))))) - (goto-char (point-min)) - (json-read)))) - cfengine3-fallback-syntax))) - (push (cons cfengine-cf-promises syntax) - cfengine-mode-syntax-cache) - (setq cfengine-mode-syntax-functions-regex - (regexp-opt (mapcar (lambda (def) - (format "%s" (car def))) - (cdr (assq 'functions syntax))) - 'symbols)) - syntax))) - -(defun cfengine3-documentation-function () - "Document CFengine 3 functions around point. -Intended as the value of `eldoc-documentation-function', which see. -Use it by enabling `eldoc-mode'." - (let ((fdef (cfengine3--current-function))) - (when fdef - (cfengine3-format-function-docstring fdef)))) - -(defun cfengine3-completion-function () - "Return completions for function name around or before point." - (let* ((bounds (save-excursion - (let ((p (point))) - (skip-syntax-backward "w_" (point-at-bol)) - (list (point) p)))) - (syntax (cfengine3-make-syntax-cache)) - (flist (assq 'functions syntax))) - (when bounds - (append bounds (list (cdr flist)))))) - -(defun cfengine-common-settings () - (if (fboundp 'syntax-propertize-rules) - (set (make-local-variable 'syntax-propertize-function) - ;; In the main syntax-table, \ is marked as a punctuation, because - ;; of its use in DOS-style directory separators. Here we try to - ;; recognize the cases where \ is used as an escape inside strings. - (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\")))) - - ;; Backwards compatibility without `syntax-propertize-function'. - (setq font-lock-defaults - '(cfengine2-font-lock-keywords - nil nil nil beginning-of-line - (font-lock-syntactic-keywords - . cfengine-font-lock-syntactic-keywords)))) - - (set (make-local-variable 'parens-require-spaces) nil) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-start-skip) - "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") - ;; Like Lisp mode. Without this, we lose with, say, - ;; `backward-up-list' when there's an unbalanced quote in a - ;; preceding comment. - (set (make-local-variable 'parse-sexp-ignore-comments) t)) - -(defun cfengine-common-syntax (table) - ;; The syntax defaults seem OK to give reasonable word movement. - (modify-syntax-entry ?# "<" table) - (modify-syntax-entry ?\n ">#" table) - (modify-syntax-entry ?\" "\"" table) ; "string" - (modify-syntax-entry ?\' "\"" table) ; 'string' - ;; Variable substitution. - (modify-syntax-entry ?$ "." table) - ;; Doze path separators. - (modify-syntax-entry ?\\ "." table)) - -(defconst cfengine3--prettify-symbols-alist - '(("->" . ?→) - ("=>" . ?⇒) - ("::" . ?∷))) - -(defun cfengine3-create-imenu-index () - "A function for `imenu-create-index-function'. -Note: defun name is separated by space such as `body -package_method opencsw' and imenu will replace spaces according -to `imenu-space-replacement' (which see)." - (goto-char (point-min)) - (let ((defuns ())) - (while (re-search-forward cfengine3-defun-full-re nil t) - (push (cons (mapconcat #'match-string '(1 2 3) " ") - (copy-marker (match-beginning 3))) - defuns)) - (nreverse defuns))) - -(defun cfengine3-current-defun () - "A function for `add-log-current-defun-function'." - (end-of-line) - (beginning-of-defun) - (and (looking-at cfengine3-defun-full-re) - (mapconcat #'match-string '(1 2 3) " "))) - -;;;###autoload -(define-derived-mode cfengine3-mode cfengine-prog-mode "CFE3" - "Major mode for editing CFEngine3 input. -There are no special keybindings by default. - -Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves -to the action header." - (cfengine-common-settings) - (cfengine-common-syntax cfengine3-mode-syntax-table) - - (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line) - - (setq font-lock-defaults - '(cfengine3-font-lock-keywords - nil nil nil beginning-of-defun)) - (setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist) - - ;; `compile-command' is almost never a `make' call with CFEngine so - ;; we override it - (when cfengine-cf-promises - (set (make-local-variable 'compile-command) - (concat cfengine-cf-promises - " -f " - (when buffer-file-name - (shell-quote-argument buffer-file-name))))) - - (setq-local flycheck-cfengine-executable cfengine-cf-promises) - - (setq-local eldoc-documentation-function #'cfengine3-documentation-function) - - (add-hook 'completion-at-point-functions - #'cfengine3-completion-function nil t) - - ;; Use defuns as the essential syntax block. - (setq-local beginning-of-defun-function #'cfengine3-beginning-of-defun) - (setq-local end-of-defun-function #'cfengine3-end-of-defun) - - (setq-local imenu-create-index-function #'cfengine3-create-imenu-index) - (setq-local add-log-current-defun-function #'cfengine3-current-defun)) - -;;;###autoload -(define-derived-mode cfengine2-mode cfengine-prog-mode "CFE2" - "Major mode for editing CFEngine2 input. -There are no special keybindings by default. - -Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves -to the action header." - (cfengine-common-settings) - (cfengine-common-syntax cfengine2-mode-syntax-table) - - ;; Shell commands can be quoted by single, double or back quotes. - ;; It's debatable whether we should define string syntax, but it - ;; should avoid potential confusion in some cases. - (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table) - - (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line) - (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+") - (set (make-local-variable 'outline-level) #'cfengine2-outline-level) - (set (make-local-variable 'fill-paragraph-function) - #'cfengine-fill-paragraph) - (define-abbrev-table 'cfengine-mode-abbrev-table cfengine2-mode-abbrevs) - (setq font-lock-defaults - '(cfengine2-font-lock-keywords nil nil nil beginning-of-line)) - ;; Fixme: set the args of functions in evaluated classes to string - ;; syntax, and then obey syntax properties. - (setq imenu-generic-expression cfengine2-imenu-expression) - (set (make-local-variable 'beginning-of-defun-function) - #'cfengine2-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) #'cfengine2-end-of-defun)) - -;;;###autoload -(defun cfengine-auto-mode () - "Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents." - (interactive) - (if (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (forward-comment (point-max)) - (or (eobp) - (re-search-forward - (concat "^\\s-*" cfengine3-defuns-regex "\\_>") nil t)))) - (cfengine3-mode) - (cfengine2-mode))) - -(defalias 'cfengine-mode 'cfengine3-mode) - -(provide 'cfengine3) -(provide 'cfengine) - -;;; cfengine.el ends here diff --git a/elpa/artbollocks-mode-20141212.1332/artbollocks-mode-autoloads.el b/elpa/artbollocks-mode-20141212.1332/artbollocks-mode-autoloads.el new file mode 100644 index 00000000..5f3a95e6 --- /dev/null +++ b/elpa/artbollocks-mode-20141212.1332/artbollocks-mode-autoloads.el @@ -0,0 +1,29 @@ +;;; artbollocks-mode-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + + +;;;### (autoloads (artbollocks-mode) "artbollocks-mode" "artbollocks-mode.el" +;;;;;; (21823 48772 0 0)) +;;; Generated autoloads from artbollocks-mode.el + +(autoload 'artbollocks-mode "artbollocks-mode" "\ +Highlight passive voice, weasel words and artbollocks jargon in text, and provide useful text metrics + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("artbollocks-mode-pkg.el") (21823 48772 +;;;;;; 360275 0)) + +;;;*** + +(provide 'artbollocks-mode-autoloads) +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; artbollocks-mode-autoloads.el ends here diff --git a/elpa/artbollocks-mode-20141212.1332/artbollocks-mode-pkg.el b/elpa/artbollocks-mode-20141212.1332/artbollocks-mode-pkg.el new file mode 100644 index 00000000..332ba89e --- /dev/null +++ b/elpa/artbollocks-mode-20141212.1332/artbollocks-mode-pkg.el @@ -0,0 +1 @@ +(define-package "artbollocks-mode" "20141212.1332" "Improve your writing (especially about art)" (quote nil)) diff --git a/elpa/artbollocks-mode-20141212.1332/artbollocks-mode.el b/elpa/artbollocks-mode-20141212.1332/artbollocks-mode.el new file mode 100644 index 00000000..e4193efe --- /dev/null +++ b/elpa/artbollocks-mode-20141212.1332/artbollocks-mode.el @@ -0,0 +1,317 @@ +;;; artbollocks-mode.el --- Improve your writing (especially about art) +;; +;; Copyright (c) 2011,2012 Rob Myers +;; Minor changes (c) 2012 Sacha Chua +;; +;; Author: Rob Myers , Sacha Chua +;; URL: https://github.com/sachac/artbollocks-mode +;; Package-Version: 20141212.1332 +;; Version: 1.1.2 +;; +;; Based on fic-mode.el +;; Copyright (C) 2010, Trey Jackson +;; +;; Non-artbollocks words from: http://matt.might.net/articles/ +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero 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 . +;; +;; 2012-06-16: Renamed functions and variables to avoid collisions. +;; Incompatible changes, so please review your configuration. - Sacha +;; Chua +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Extra thanks to: +;; Brian van den Broek (words: contextuality, dialetic, problematize) +;; Isabel Brison (words: alterity, mise en abîme) +;; mneilsen, behaghel, russell, xfq, gleb, ejmr, tarsius (Emacs Lisp improvements) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Commentary: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Usage +;; +;; To use, save artbollocks-mode.el to a directory in your load-path. +;; +;; (require 'artbollocks-mode) +;; (add-hook 'text-mode-hook 'artbollocks-mode) +;; +;; or +;; +;; M-x artbollocks-mode +;; +;; NOTE: If you manually turn on artbollocks-mode, +;; you you might need to force re-fontification initially: +;; +;; M-x font-lock-fontify-buffer +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Customization +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Enable features individually + +(defcustom artbollocks-lexical-illusions t + "Whether to check for lexical illusions" + :type '(boolean) + :group 'artbollocks-mode) + +(defcustom artbollocks-passive-voice t + "Whether to check for passive voice" + :type '(boolean) + :group 'artbollocks-mode) + +(defcustom artbollocks-weasel-words t + "Whether to check for weasel words" + :type '(boolean) + :group 'artbollocks-mode) + +(defcustom artbollocks-jargon t + "Whether to check for artbollocks jargon" + :type '(boolean) + :group 'artbollocks-mode) + +(defface artbollocks-lexical-illusions-face + '((t (:foreground "black" :background "magenta"))) + "The face for lexical illusions words" + :group 'artbollocks-mode) + +(defface artbollocks-passive-voice-face + '((t (:foreground "Gray" :background "White"))) + "The face for passive voice words" + :group 'artbollocks-mode) + +(defface artbollocks-weasel-words-face + '((t (:foreground "Brown" :background "White"))) + "The face for weasel-words words" + :group 'artbollocks-mode) + +(defface artbollocks-face + '((t (:foreground "Purple" :background "White"))) + "The face for weasel-words words" + :group 'artbollocks-mode) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Lexical illusions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst artbollocks-lexical-illusions-regex "\\b\\(\\w+\\)\\W+\\(\\1\\)\\b") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Passive voice +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst artbollocks-passive-voice-regex "\\b\\(am\\|are\\|were\\|being\\|is\\|been\\|was\\|be\\)\\s-+\\(\\w+ed\\|awoken\\|been\\|born\\|beat\\|become\\|begun\\|bent\\|beset\\|bet\\|bid\\|bidden\\|bound\\|bitten\\|bled\\|blown\\|broken\\|bred\\|brought\\|broadcast\\|built\\|burnt\\|burst\\|bought\\|cast\\|caught\\|chosen\\|clung\\|come\\|cost\\|crept\\|cut\\|dealt\\|dug\\|dived\\|done\\|drawn\\|dreamt\\|driven\\|drunk\\|eaten\\|fallen\\|fed\\|felt\\|fought\\|found\\|fit\\|fled\\|flung\\|flown\\|forbidden\\|forgotten\\|foregone\\|forgiven\\|forsaken\\|frozen\\|gotten\\|given\\|gone\\|ground\\|grown\\|hung\\|heard\\|hidden\\|hit\\|held\\|hurt\\|kept\\|knelt\\|knit\\|known\\|laid\\|led\\|leapt\\|learnt\\|left\\|lent\\|let\\|lain\\|lighted\\|lost\\|made\\|meant\\|met\\|misspelt\\|mistaken\\|mown\\|overcome\\|overdone\\|overtaken\\|overthrown\\|paid\\|pled\\|proven\\|put\\|quit\\|read\\|rid\\|ridden\\|rung\\|risen\\|run\\|sawn\\|said\\|seen\\|sought\\|sold\\|sent\\|set\\|sewn\\|shaken\\|shaven\\|shorn\\|shed\\|shone\\|shod\\|shot\\|shown\\|shrunk\\|shut\\|sung\\|sunk\\|sat\\|slept\\|slain\\|slid\\|slung\\|slit\\|smitten\\|sown\\|spoken\\|sped\\|spent\\|spilt\\|spun\\|spit\\|split\\|spread\\|sprung\\|stood\\|stolen\\|stuck\\|stung\\|stunk\\|stridden\\|struck\\|strung\\|striven\\|sworn\\|swept\\|swollen\\|swum\\|swung\\|taken\\|taught\\|torn\\|told\\|thought\\|thrived\\|thrown\\|thrust\\|trodden\\|understood\\|upheld\\|upset\\|woken\\|worn\\|woven\\|wed\\|wept\\|wound\\|won\\|withheld\\|withstood\\|wrung\\|written\\)\\b") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Weasel words +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst artbollocks-weasel-words-regex "\\b\\(many\\|various\\|very\\|fairly\\|several\\|extremely\\|exceedingly\\|quite\\|remarkably\\|few\\|surprisingly\\|mostly\\|largely\\|huge\\|tiny\\|\\(\\(are\\|is\\) a number\\)\\|excellent\\|interestingly\\|significantly\\|substantially\\|clearly\\|vast\\|relatively\\|completely\\)\\b") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Artbollocks +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst artbollocks-jargon-regex "\\b\\(a priori\\|ad hoc\\|affirmation\\|affirm\\|affirms\\|alterity\\|altermodern\\|aporia\\|aporetic\\|appropriates\\|appropriation\\|archetypal\\|archetypical\\|archetype\\|archetypes\\|autonomous\\|autonomy\\|baudrillardian\\|baudrillarian\\|commodification\\|committed\\|commitment\\|commonalities\\|contemporaneity\\|context\\|contexts\\|contextual\\|contextualise\\|contextualises\\|contextualisation\\|contextialize\\|contextializes\\|contextualization\\|contextuality\\|convention\\|conventional\\|conventions\\|coterminous\\|critique\\|cunning\\|cunningly\\|death of the author\\|debunk\\|debunked\\|debunking\\|debunks\\|deconstruct\\|deconstruction\\|deconstructs\\|deleuzian\\|desire\\|desires\\|dialectic\\|dialectical\\|dialectically\\|discourse\\|discursive\\|disrupt\\|disrupts\\|engage\\|engagement\\|engages\\|episteme\\|epistemic\\|ergo\\|fetish\\|fetishes\\|fetishise\\|fetishised\\|fetishize\\|fetishized\\|gaze\\|gender\\|gendered\\|historicise\\|historicisation\\|historicize\\|historicization\\|hegemonic\\|hegemony\\|identity\\|identity politics\\|intensifies\\|intensify\\|intensifying\\|interrogate\\|interrogates\\|interrogation\\|intertextual\\|intertextuality\\|irony\\|ironic\\|ironical\\|ironically\\|ironisation\\|ironization\\|ironises\\|ironizes\\|jouissance\\|juxtapose\\|juxtaposes\\|juxtaposition\\|lacanian\\|lack\\|loci\\|locus\\|locuses\\|matrix\\|mise en abyme\\|mocking\\|mockingly\\|modalities\\|modality\\|myth\\|mythologies\\|mythology\\|myths\\|narrative\\|narrativisation\\|narrativization\\|narrativity\\|nexus\\|nodal\\|node\\|normative\\|normativity\\|notion\\|notions\\|objective\\|objectivity\\|objectivities\\|objet petit a\\|ontology\\|ontological\\|operate\\|operates\\|otherness\\|othering\\|paradigm\\|paradigmatic\\|paradigms\\|parody\\|parodic\\|parodies\\|physicality\\|plenitude\\|poetics\\|popular notions\\|position\\|post hoc\\|post internet\\|post-internet\\|postmodernism\\|postmodernist\\|postmodernity\\|postmodern\\|practice\\|practise\\|praxis\\|problematic\\|problematics\\|problematise\\|problematize\\|proposition\\|qua\\|reading\\|readings\\|reification\\|relation\\|relational\\|relationality\\|relations\\|representation\\|representations\\|rhizomatic\\|rhizome\\|simulacra\\|simulacral\\|simulation\\|simulationism\\|simulationism\\|situate\\|situated\\|situates\\|stereotype\\|stereotypes\\|strategy\\|strategies\\|subjective\\|subjectivity\\|subjectivities\\|subvert\\|subversion\\|subverts\\|text\\|textual\\|textuality\\|thinker\\|thinkers\\|trajectory\\|transgress\\|transgresses\\|transgression\\|transgressive\\|unfolding\\|undermine\\|undermining\\|undermines\\|work\\|works\\|wry\\|wryly\\|zizekian\\|zižekian\\)\\b") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Highlighting +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun artbollocks-search-for-keyword (regex limit) + "Match REGEX in buffer until LIMIT." + (let (match-data-to-set + found) + (save-match-data + (while (and (null match-data-to-set) + (re-search-forward regex limit t)) + (setq match-data-to-set (match-data)))) + (when match-data-to-set + (set-match-data match-data-to-set) + (goto-char (match-end 0)) + t))) + +(defun artbollocks-lexical-illusions-search-for-keyword (limit) + (artbollocks-search-for-keyword artbollocks-lexical-illusions-regex limit)) + +(defun artbollocks-passive-voice-search-for-keyword (limit) + (artbollocks-search-for-keyword artbollocks-passive-voice-regex limit)) + +(defun artbollocks-weasel-words-search-for-keyword (limit) + (artbollocks-search-for-keyword artbollocks-weasel-words-regex limit)) + +(defun artbollocks-search-for-jargon (limit) + (artbollocks-search-for-keyword artbollocks-jargon-regex limit)) + +(defconst artbollocks-lexicalkwlist + '((artbollocks-lexical-illusions-search-for-keyword + (2 'artbollocks-lexical-illusions-face t)))) + +(defconst artbollocks-passivekwlist + '((artbollocks-passive-voice-search-for-keyword + (0 'artbollocks-passive-voice-face t)))) + +(defconst artbollocks-weaselkwlist + '((artbollocks-weasel-words-search-for-keyword + (0 'artbollocks-weasel-words-face t)))) + +(defconst artbollocks-kwlist + '((artbollocks-search-for-jargon + (0 'artbollocks-face t)))) + +(defun artbollocks-add-keywords () + (when artbollocks-lexical-illusions + (font-lock-add-keywords nil artbollocks-lexicalkwlist)) + (when artbollocks-passive-voice + (font-lock-add-keywords nil artbollocks-passivekwlist)) + (when artbollocks-weasel-words + (font-lock-add-keywords nil artbollocks-weaselkwlist)) + (when artbollocks-jargon + (font-lock-add-keywords nil artbollocks-kwlist))) + +(defun artbollocks-remove-keywords () + (font-lock-remove-keywords nil artbollocks-lexicalkwlist) + (font-lock-remove-keywords nil artbollocks-passivekwlist) + (font-lock-remove-keywords nil artbollocks-weaselkwlist) + (font-lock-remove-keywords nil artbollocks-kwlist)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Utility macros +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro interactive-optional-region () + "Flexible variation of (interactive \"r\"). +Bind START and END parameters to either a selected region or the +entire buffer, subject to narrowing." + `(interactive + (if (use-region-p) + (list (region-beginning) (region-end)) + (list (point-min) (point-max))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Text metrics +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun artbollocks-count-letters (&optional start end) + (how-many "\\w" (or start (point-min)) (or end (point-max)))) + +(defun artbollocks-count-syllables (&optional start end) + ;; Naively count vowel runs as syllable markers + (how-many "[aeiouy]+" (or start (point-min)) (or end (point-max)))) + +(defun artbollocks-count-words (&optional start end) + "Count the number of words between START and END." + (interactive-optional-region) + (let* ((s (or start (point-min))) + (e (or end (point-max))) + (result + (if (fboundp 'count-words) + (count-words s e) + (how-many "\\w+" s e)))) + (if (called-interactively-p 'any) + (message "Word count: %s" result)) + result)) + +(defun artbollocks-count-sentences (&optional start end) + "Count the number of words between START and END." + (interactive-optional-region) + (let* ((s (or start (point-min))) + (e (or end (point-max))) + (result + (how-many "\\w[!?.]" s e))) + (if (called-interactively-p 'any) + (message "Sentence count: %s" result)) + result)) + +(defun artbollocks-automated-readability-index (&optional start end) + (let ((words (float (artbollocks-count-words start end))) + (letters (float (artbollocks-count-letters start end))) + (sentences (float (artbollocks-count-sentences start end)))) + (if (and (> words 0) (> sentences 0)) + (- (+ (* 4.71 (/ letters words)) + (* 0.5 (/ words sentences))) + 21.43) + 0.0))) + +(defun artbollocks-flesch-reading-ease (&optional start end) + (let ((words (float (artbollocks-count-words start end))) + (sentences (float (artbollocks-count-sentences start end)))) + (if (and (> sentences 0) (> words 0)) + (- 206.834 + (* 1.015 (/ words sentences)) + (* 84.6 (/ syllables words))) + 0.0))) + +(defun artbollocks-flesch-kinkaid-grade-level (&optional start end) + (let ((words (float (artbollocks-count-words start end))) + (sentences (float (artbollocks-count-sentences start end))) + (syllables (float (artbollocks-count-syllables start end)))) + (if (and (> words 0) (> sentences 0)) + (- (+ (* 11.8 (/ syllables words)) + (* 0.39 (/ words sentences))) + 15.59) + 0.0))) + +(defalias 'artbollocks-word-count 'artbollocks-count-words) +(defalias 'artbollocks-sentence-count 'artbollocks-count-sentences) + +(defun artbollocks-readability-index (&optional start end) + "Determine the automated readability index between START and END." + (interactive-optional-region) + (message "Readability index: %s" (artbollocks-automated-readability-index start end))) + +(defun artbollocks-reading-ease (&optional start end) + "Determine the Flesch reading ease between START and END." + (interactive-optional-region) + (message "Reading ease: %s" (artbollocks-flesch-reading-ease start end))) + +(defun artbollocks-grade-level (&optional start end) + "Determine the Flesch-Kinkaid grade level between START and END." + (interactive-optional-region) + (message "Grade level: %s" (artbollocks-flesch-kinkaid-grade-level start end))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The mode +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defconst artbollocks-mode-keymap (make-keymap)) + +(define-key artbollocks-mode-keymap (kbd "C-c [") 'artbollocks-word-count) +(define-key artbollocks-mode-keymap (kbd "C-c ]") 'artbollocks-sentence-count) +(define-key artbollocks-mode-keymap (kbd "C-c \\") 'artbollocks-readability-index) +(define-key artbollocks-mode-keymap (kbd "C-c /") 'artbollocks-reading-ease) +(define-key artbollocks-mode-keymap (kbd "C-c =") 'artbollocks-grade-level) + +;;;###autoload +(define-minor-mode artbollocks-mode "Highlight passive voice, weasel words and artbollocks jargon in text, and provide useful text metrics" + :lighter " AB" + :keymap artbollocks-mode-keymap + :group 'artbollocks-mode + (if artbollocks-mode + (artbollocks-add-keywords) + (artbollocks-remove-keywords))) + +(provide 'artbollocks-mode) + +;; TODO +;; Toggle adding word/sentence count to status bar +;; Pluralization +;; Incorporate diction commands if available (and advise on installation if not) +;; Split general writing back out + +;;; artbollocks-mode.el ends here diff --git a/elpa/artbollocks-mode-readme.txt b/elpa/artbollocks-mode-readme.txt new file mode 100644 index 00000000..517ae2bc --- /dev/null +++ b/elpa/artbollocks-mode-readme.txt @@ -0,0 +1,15 @@ +Usage + +To use, save artbollocks-mode.el to a directory in your load-path. + +(require 'artbollocks-mode) +(add-hook 'text-mode-hook 'artbollocks-mode) + +or + +M-x artbollocks-mode + +NOTE: If you manually turn on artbollocks-mode, +you you might need to force re-fontification initially: + + M-x font-lock-fontify-buffer diff --git a/elpa/package.el b/elpa/package.el deleted file mode 100644 index 6a00b382..00000000 --- a/elpa/package.el +++ /dev/null @@ -1,1760 +0,0 @@ -;;; package.el --- Simple package system for Emacs - -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. - -;; Author: Tom Tromey -;; Created: 10 Mar 2007 -;; Version: 1.0 -;; Keywords: tools -;; Package-Requires: ((tabulated-list "0")) - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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. If not, see . - -;;; Change Log: - -;; 2 Apr 2007 - now using ChangeLog file -;; 15 Mar 2007 - updated documentation -;; 14 Mar 2007 - Changed how obsolete packages are handled -;; 13 Mar 2007 - Wrote package-install-from-buffer -;; 12 Mar 2007 - Wrote package-menu mode - -;;; Commentary: - -;; The idea behind package.el is to be able to download packages and -;; install them. Packages are versioned and have versioned -;; dependencies. Furthermore, this supports built-in packages which -;; may or may not be newer than user-specified packages. This makes -;; it possible to upgrade Emacs and automatically disable packages -;; which have moved from external to core. (Note though that we don't -;; currently register any of these, so this feature does not actually -;; work.) - -;; A package is described by its name and version. The distribution -;; format is either a tar file or a single .el file. - -;; A tar file should be named "NAME-VERSION.tar". The tar file must -;; unpack into a directory named after the package and version: -;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el" -;; which consists of a call to define-package. It may also contain a -;; "dir" file and the info files it references. - -;; A .el file is named "NAME-VERSION.el" in the remote archive, but is -;; installed as simply "NAME.el" in a directory named "NAME-VERSION". - -;; The downloader downloads all dependent packages. By default, -;; packages come from the official GNU sources, but others may be -;; added by customizing the `package-archives' alist. Packages get -;; byte-compiled at install time. - -;; At activation time we will set up the load-path and the info path, -;; and we will load the package's autoloads. If a package's -;; dependencies are not available, we will not activate that package. - -;; Conceptually a package has multiple state transitions: -;; -;; * Download. Fetching the package from ELPA. -;; * Install. Untar the package, or write the .el file, into -;; ~/.emacs.d/elpa/ directory. -;; * Byte compile. Currently this phase is done during install, -;; but we may change this. -;; * Activate. Evaluate the autoloads for the package to make it -;; available to the user. -;; * Load. Actually load the package and run some code from it. - -;; Other external functions you may want to use: -;; -;; M-x list-packages -;; Enters a mode similar to buffer-menu which lets you manage -;; packages. You can choose packages for install (mark with "i", -;; then "x" to execute) or deletion (not implemented yet), and you -;; can see what packages are available. This will automatically -;; fetch the latest list of packages from ELPA. -;; -;; M-x package-install-from-buffer -;; Install a package consisting of a single .el file that appears -;; in the current buffer. This only works for packages which -;; define a Version header properly; package.el also supports the -;; extension headers Package-Version (in case Version is an RCS id -;; or similar), and Package-Requires (if the package requires other -;; packages). -;; -;; M-x package-install-file -;; Install a package from the indicated file. The package can be -;; either a tar file or a .el file. A tar file must contain an -;; appropriately-named "-pkg.el" file; a .el file must be properly -;; formatted as with package-install-from-buffer. - -;;; Thanks: -;;; (sorted by sort-lines): - -;; Jim Blandy -;; Karl Fogel -;; Kevin Ryde -;; Lawrence Mitchell -;; Michael Olson -;; Sebastian Tennant -;; Stefan Monnier -;; Vinicius Jose Latorre -;; Phil Hagelberg - -;;; ToDo: - -;; - a trust mechanism, since compiling a package can run arbitrary code. -;; For example, download package signatures and check that they match. -;; - putting info dirs at the start of the info path means -;; users see a weird ordering of categories. OTOH we want to -;; override later entries. maybe emacs needs to enforce -;; the standard layout? -;; - put bytecode in a separate directory tree -;; - perhaps give users a way to recompile their bytecode -;; or do it automatically when emacs changes -;; - give users a way to know whether a package is installed ok -;; - give users a way to view a package's documentation when it -;; only appears in the .el -;; - use/extend checkdoc so people can tell if their package will work -;; - "installed" instead of a blank in the status column -;; - tramp needs its files to be compiled in a certain order. -;; how to handle this? fix tramp? -;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22? -;; - maybe we need separate .elc directories for various emacs versions -;; and also emacs-vs-xemacs. That way conditional compilation can -;; work. But would this break anything? -;; - should store the package's keywords in archive-contents, then -;; let the users filter the package-menu by keyword. See -;; finder-by-keyword. (We could also let people view the -;; Commentary, but it isn't clear how useful this is.) -;; - William Xu suggests being able to open a package file without -;; installing it -;; - Interface with desktop.el so that restarting after an install -;; works properly -;; - Implement M-x package-upgrade, to upgrade any/all existing packages -;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info -;; ... except maybe lisp? -;; - It may be nice to have a macro that expands to the package's -;; private data dir, aka ".../etc". Or, maybe data-directory -;; needs to be a list (though this would be less nice) -;; a few packages want this, eg sokoban -;; - package menu needs: -;; ability to know which packages are built-in & thus not deletable -;; it can sometimes print odd results, like 0.3 available but 0.4 active -;; why is that? -;; - Allow multiple versions on the server...? -;; [ why bother? ] -;; - Don't install a package which will invalidate dependencies overall -;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5)) -;; [ currently thinking, why bother.. KISS ] -;; - Allow optional package dependencies -;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb -;; and just don't compile to add to load path ...? -;; - Have a list of archive URLs? [ maybe there's no point ] -;; - David Kastrup pointed out on the xemacs list that for GPL it -;; is friendlier to ship the source tree. We could "support" that -;; by just having a "src" subdir in the package. This isn't ideal -;; but it probably is not worth trying to support random source -;; tree layouts, build schemes, etc. -;; - Our treatment of the info path is somewhat bogus -;; - perhaps have an "unstable" tree in ELPA as well as a stable one - -;;; Code: - -(require 'tabulated-list) - -(defgroup package nil - "Manager for Emacs Lisp packages." - :group 'applications - :version "24.1") - -;;;###autoload -(defcustom package-enable-at-startup t - "Whether to activate installed packages when Emacs starts. -If non-nil, packages are activated after reading the init file -and before `after-init-hook'. Activation is not done if -`user-init-file' is nil (e.g. Emacs was started with \"-q\"). - -Even if the value is nil, you can type \\[package-initialize] to -activate the package system at any time." - :type 'boolean - :group 'package - :version "24.1") - -(defcustom package-load-list '(all) - "List of packages for `package-initialize' to load. -Each element in this list should be a list (NAME VERSION), or the -symbol `all'. The symbol `all' says to load the latest installed -versions of all packages not specified by other elements. - -For an element (NAME VERSION), NAME is a package name (a symbol). -VERSION should be t, a string, or nil. -If VERSION is t, all versions are loaded, though obsolete ones - will be put in `package-obsolete-alist' and not activated. -If VERSION is a string, only that version is ever loaded. - Any other version, even if newer, is silently ignored. - Hence, the package is \"held\" at that version. -If VERSION is nil, the package is not loaded (it is \"disabled\")." - :type '(repeat symbol) - :risky t - :group 'package - :version "24.1") - -(defvar Info-directory-list) -(declare-function info-initialize "info" ()) -(declare-function url-http-parse-response "url-http" ()) -(declare-function lm-header "lisp-mnt" (header)) -(declare-function lm-commentary "lisp-mnt" (&optional file)) -(defvar url-http-end-of-headers) - -(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) - "An alist of archives from which to fetch. -The default value points to the GNU Emacs package repository. - -Each element has the form (ID . LOCATION). - ID is an archive name, as a string. - LOCATION specifies the base location for the archive. - If it starts with \"http:\", it is treated as a HTTP URL; - otherwise it should be an absolute directory name. - (Other types of URL are currently not supported.) - -Only add locations that you trust, since fetching and installing -a package can run arbitrary code." - :type '(alist :key-type (string :tag "Archive name") - :value-type (string :tag "URL or directory name")) - :risky t - :group 'package - :version "24.1") - -(defconst package-archive-version 1 - "Version number of the package archive understood by this file. -Lower version numbers than this will probably be understood as well.") - -(defconst package-el-version "1.0" - "Version of package.el.") - -;; We don't prime the cache since it tends to get out of date. -(defvar package-archive-contents nil - "Cache of the contents of the Emacs Lisp Package Archive. -This is an alist mapping package names (symbols) to package -descriptor vectors. These are like the vectors for `package-alist' -but have extra entries: one which is 'tar for tar packages and -'single for single-file packages, and one which is the name of -the archive from which it came.") -(put 'package-archive-contents 'risky-local-variable t) - -(defcustom package-user-dir (locate-user-emacs-file "elpa") - "Directory containing the user's Emacs Lisp packages. -The directory name should be absolute. -Apart from this directory, Emacs also looks for system-wide -packages in `package-directory-list'." - :type 'directory - :risky t - :group 'package - :version "24.1") - -(defcustom package-directory-list - ;; Defaults are subdirs named "elpa" in the site-lisp dirs. - (let (result) - (dolist (f load-path) - (and (stringp f) - (equal (file-name-nondirectory f) "site-lisp") - (push (expand-file-name "elpa" f) result))) - (nreverse result)) - "List of additional directories containing Emacs Lisp packages. -Each directory name should be absolute. - -These directories contain packages intended for system-wide; in -contrast, `package-user-dir' contains packages for personal use." - :type '(repeat directory) - :risky t - :group 'package - :version "24.1") - -;; The value is precomputed in finder-inf.el, but don't load that -;; until it's needed (i.e. when `package-initialize' is called). -(defvar package--builtins nil - "Alist of built-in packages. -The actual value is initialized by loading the library -`finder-inf'; this is not done until it is needed, e.g. by the -function `package-built-in-p'. - -Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL), where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package.") -(put 'package--builtins 'risky-local-variable t) - -(defvar package-alist nil - "Alist of all packages available for activation. -Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. - -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL) where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package. - -This variable is set automatically by `package-load-descriptor', -called via `package-initialize'. To change which packages are -loaded and/or activated, customize `package-load-list'.") -(put 'package-alist 'risky-local-variable t) - -(defvar package-activated-list nil - "List of the names of currently activated packages.") -(put 'package-activated-list 'risky-local-variable t) - -(defvar package-obsolete-alist nil - "Representation of obsolete packages. -Like `package-alist', but maps package name to a second alist. -The inner alist is keyed by version.") -(put 'package-obsolete-alist 'risky-local-variable t) - -(defun package-version-join (vlist) - "Return the version string corresponding to the list VLIST. -This is, approximately, the inverse of `version-to-list'. -\(Actually, it returns only one of the possible inverses, since -`version-to-list' is a many-to-one operation.)" - (if (null vlist) - "" - (let ((str-list (list "." (int-to-string (car vlist))))) - (dolist (num (cdr vlist)) - (cond - ((>= num 0) - (push (int-to-string num) str-list) - (push "." str-list)) - ((< num -3) - (error "Invalid version list `%s'" vlist)) - (t - ;; pre, or beta, or alpha - (cond ((equal "." (car str-list)) - (pop str-list)) - ((not (string-match "[0-9]+" (car str-list))) - (error "Invalid version list `%s'" vlist))) - (push (cond ((= num -1) "pre") - ((= num -2) "beta") - ((= num -3) "alpha")) - str-list)))) - (if (equal "." (car str-list)) - (pop str-list)) - (apply 'concat (nreverse str-list))))) - -(defun package-strip-version (dirname) - "Strip the version from a combined package name and version. -E.g., if given \"quux-23.0\", will return \"quux\"" - (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname) - (match-string 1 dirname))) - -(defun package-load-descriptor (dir package) - "Load the description file in directory DIR for package PACKAGE. -Here, PACKAGE is a string of the form NAME-VERSION, where NAME is -the package name and VERSION is its version." - (let* ((pkg-dir (expand-file-name package dir)) - (pkg-file (expand-file-name - (concat (package-strip-version package) "-pkg") - pkg-dir))) - (when (and (file-directory-p pkg-dir) - (file-exists-p (concat pkg-file ".el"))) - (load pkg-file nil t)))) - -(defun package-load-all-descriptors () - "Load descriptors for installed Emacs Lisp packages. -This looks for package subdirectories in `package-user-dir' and -`package-directory-list'. The variable `package-load-list' -controls which package subdirectories may be loaded. - -In each valid package subdirectory, this function loads the -description file containing a call to `define-package', which -updates `package-alist' and `package-obsolete-alist'." - (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'"))) - (dolist (dir (cons package-user-dir package-directory-list)) - (when (file-directory-p dir) - (dolist (subdir (directory-files dir)) - (when (string-match regexp subdir) - (package-maybe-load-descriptor (match-string 1 subdir) - (match-string 2 subdir) - dir))))))) - -(defun package-maybe-load-descriptor (name version dir) - "Maybe load a specific package from directory DIR. -NAME and VERSION are the package's name and version strings. -This function checks `package-load-list', before actually loading -the package by calling `package-load-descriptor'." - (let ((force (assq (intern name) package-load-list)) - (subdir (concat name "-" version))) - (and (file-directory-p (expand-file-name subdir dir)) - ;; Check `package-load-list': - (cond ((null force) - (memq 'all package-load-list)) - ((null (setq force (cadr force))) - nil) ; disabled - ((eq force t) - t) - ((stringp force) ; held - (version-list-= (version-to-list version) - (version-to-list force))) - (t - (error "Invalid element in `package-load-list'"))) - ;; Actually load the descriptor: - (package-load-descriptor dir subdir)))) - -(defsubst package-desc-vers (desc) - "Extract version from a package description vector." - (aref desc 0)) - -(defsubst package-desc-reqs (desc) - "Extract requirements from a package description vector." - (aref desc 1)) - -(defsubst package-desc-doc (desc) - "Extract doc string from a package description vector." - (aref desc 2)) - -(defsubst package-desc-kind (desc) - "Extract the kind of download from an archive package description vector." - (aref desc 3)) - -(defun package--dir (name version) - "Return the directory where a package is installed, or nil if none. -NAME and VERSION are both strings." - (let* ((subdir (concat name "-" version)) - (dir-list (cons package-user-dir package-directory-list)) - pkg-dir) - (while dir-list - (let ((subdir-full (expand-file-name subdir (car dir-list)))) - (if (file-directory-p subdir-full) - (setq pkg-dir subdir-full - dir-list nil) - (setq dir-list (cdr dir-list))))) - pkg-dir)) - -(defun package-activate-1 (package pkg-vec) - (let* ((name (symbol-name package)) - (version-str (package-version-join (package-desc-vers pkg-vec))) - (pkg-dir (package--dir name version-str))) - (unless pkg-dir - (error "Internal error: unable to find directory for `%s-%s'" - name version-str)) - ;; Add info node. - (when (file-exists-p (expand-file-name "dir" pkg-dir)) - ;; FIXME: not the friendliest, but simple. - (require 'info) - (info-initialize) - (push pkg-dir Info-directory-list)) - ;; Add to load path, add autoloads, and activate the package. - (push pkg-dir load-path) - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (push package package-activated-list) - ;; Don't return nil. - t)) - -(defun package-built-in-p (package &optional min-version) - "Return true if PACKAGE is built-in to Emacs. -Optional arg MIN-VERSION, if non-nil, should be a version list -specifying the minimum acceptable version." - (require 'finder-inf nil t) ; For `package--builtins'. - (if (eq package 'emacs) - (version-list-<= min-version (version-to-list emacs-version)) - (let ((elt (assq package package--builtins))) - (and elt (version-list-<= min-version - (package-desc-vers (cdr elt))))))) - -;; This function goes ahead and activates a newer version of a package -;; if an older one was already activated. This is not ideal; we'd at -;; least need to check to see if the package has actually been loaded, -;; and not merely activated. -(defun package-activate (package min-version) - "Activate package PACKAGE, of version MIN-VERSION or newer. -MIN-VERSION should be a version list. -If PACKAGE has any dependencies, recursively activate them. -Return nil if the package could not be activated." - (let ((pkg-vec (cdr (assq package package-alist))) - available-version found) - ;; Check if PACKAGE is available in `package-alist'. - (when pkg-vec - (setq available-version (package-desc-vers pkg-vec) - found (version-list-<= min-version available-version))) - (cond - ;; If no such package is found, maybe it's built-in. - ((null found) - (package-built-in-p package min-version)) - ;; If the package is already activated, just return t. - ((memq package package-activated-list) - t) - ;; Otherwise, proceed with activation. - (t - (let ((fail (catch 'dep-failure - ;; Activate its dependencies recursively. - (dolist (req (package-desc-reqs pkg-vec)) - (unless (package-activate (car req) (cadr req)) - (throw 'dep-failure req)))))) - (if fail - (warn "Unable to activate package `%s'. -Required package `%s-%s' is unavailable" - package (car fail) (package-version-join (cadr fail))) - ;; If all goes well, activate the package itself. - (package-activate-1 package pkg-vec))))))) - -(defun package-mark-obsolete (package pkg-vec) - "Put package on the obsolete list, if not already there." - (let ((elt (assq package package-obsolete-alist))) - (if elt - ;; If this obsolete version does not exist in the list, update - ;; it the list. - (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) - (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) - (cdr elt)))) - ;; Make a new association. - (push (cons package (list (cons (package-desc-vers pkg-vec) - pkg-vec))) - package-obsolete-alist)))) - -(defun define-package (name-string version-string - &optional docstring requirements - &rest _extra-properties) - "Define a new package. -NAME-STRING is the name of the package, as a string. -VERSION-STRING is the version of the package, as a string. -DOCSTRING is a short description of the package, a string. -REQUIREMENTS is a list of dependencies on other packages. - Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION), - where OTHER-VERSION is a string. - -EXTRA-PROPERTIES is currently unused." - (let* ((name (intern name-string)) - (version (version-to-list version-string)) - (new-pkg-desc - (cons name - (vector version - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requirements) - docstring))) - (old-pkg (assq name package-alist))) - (cond - ;; If there's no old package, just add this to `package-alist'. - ((null old-pkg) - (push new-pkg-desc package-alist)) - ((version-list-< (package-desc-vers (cdr old-pkg)) version) - ;; Remove the old package and declare it obsolete. - (package-mark-obsolete name (cdr old-pkg)) - (setq package-alist (cons new-pkg-desc - (delq old-pkg package-alist)))) - ;; You can have two packages with the same version, e.g. one in - ;; the system package directory and one in your private - ;; directory. We just let the first one win. - ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) - ;; The package is born obsolete. - (package-mark-obsolete name (cdr new-pkg-desc)))))) - -;; From Emacs 22. -(defun package-autoload-ensure-default-file (file) - "Make sure that the autoload file FILE exists and if not create it." - (unless (file-exists-p file) - (write-region - (concat ";;; " (file-name-nondirectory file) - " --- automatically extracted autoloads\n" - ";;\n" - ";;; Code:\n\n" - " \n;; Local Variables:\n" - ";; version-control: never\n" - ";; no-byte-compile: t\n" - ";; no-update-autoloads: t\n" - ";; End:\n" - ";;; " (file-name-nondirectory file) - " ends here\n") - nil file)) - file) - -(defun package-generate-autoloads (name pkg-dir) - (require 'autoload) ;Load before we let-bind generated-autoload-file! - (let* ((auto-name (concat name "-autoloads.el")) - ;;(ignore-name (concat name "-pkg.el")) - (generated-autoload-file (expand-file-name auto-name pkg-dir)) - (version-control 'never)) - (unless (fboundp 'autoload-ensure-default-file) - (package-autoload-ensure-default-file generated-autoload-file)) - (update-directory-autoloads pkg-dir) - (let ((buf (find-buffer-visiting generated-autoload-file))) - (when buf (kill-buffer buf))))) - -(defvar tar-parse-info) -(declare-function tar-untar-buffer "tar-mode" ()) -(declare-function tar-header-name "tar-mode" (tar-header)) -(declare-function tar-header-link-type "tar-mode" (tar-header)) - -(defun package-untar-buffer (dir) - "Untar the current buffer. -This uses `tar-untar-buffer' from Tar mode. All files should -untar into a directory named DIR; otherwise, signal an error." - (require 'tar-mode) - (tar-mode) - ;; Make sure everything extracts into DIR. - (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) - (case-fold-search (memq system-type '(windows-nt ms-dos cygwin)))) - (dolist (tar-data tar-parse-info) - (let ((name (expand-file-name (tar-header-name tar-data)))) - (or (string-match regexp name) - ;; Tarballs created by some utilities don't list - ;; directories with a trailing slash (Bug#13136). - (and (string-equal dir name) - (eq (tar-header-link-type tar-data) 5)) - (error "Package does not untar cleanly into directory %s/" dir))))) - (tar-untar-buffer)) - -(defun package-unpack (package version) - (let* ((name (symbol-name package)) - (dirname (concat name "-" version)) - (pkg-dir (expand-file-name dirname package-user-dir))) - (make-directory package-user-dir t) - ;; FIXME: should we delete PKG-DIR if it exists? - (let* ((default-directory (file-name-as-directory package-user-dir))) - (package-untar-buffer dirname) - (package--make-autoloads-and-compile name pkg-dir)))) - -(defun package--make-autoloads-and-compile (name pkg-dir) - "Generate autoloads and do byte-compilation for package named NAME. -PKG-DIR is the name of the package directory." - (package-generate-autoloads name pkg-dir) - (let ((load-path (cons pkg-dir load-path))) - ;; We must load the autoloads file before byte compiling, in - ;; case there are magic cookies to set up non-trivial paths. - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (byte-recompile-directory pkg-dir 0 t))) - -(defun package--write-file-no-coding (file-name) - (let ((buffer-file-coding-system 'no-conversion)) - (write-region (point-min) (point-max) file-name))) - -(defun package-unpack-single (file-name version desc requires) - "Install the contents of the current buffer as a package." - ;; Special case "package". - (if (string= file-name "package") - (package--write-file-no-coding - (expand-file-name (concat file-name ".el") package-user-dir)) - (let* ((pkg-dir (expand-file-name (concat file-name "-" - (package-version-join - (version-to-list version))) - package-user-dir)) - (el-file (expand-file-name (concat file-name ".el") pkg-dir)) - (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) - (make-directory pkg-dir t) - (package--write-file-no-coding el-file) - (let ((print-level nil) - (print-length nil)) - (write-region - (concat - (prin1-to-string - (list 'define-package - file-name - version - desc - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) - "\n") - nil - pkg-file - nil nil nil 'excl)) - (package--make-autoloads-and-compile file-name pkg-dir)))) - -(defmacro package--with-work-buffer (location file &rest body) - "Run BODY in a buffer containing the contents of FILE at LOCATION. -LOCATION is the base location of a package archive, and should be -one of the URLs (or file names) specified in `package-archives'. -FILE is the name of a file relative to that base location. - -This macro retrieves FILE from LOCATION into a temporary buffer, -and evaluates BODY while that buffer is current. This work -buffer is killed afterwards. Return the last value in BODY." - `(let* ((http (string-match "\\`https?:" ,location)) - (buffer - (if http - (url-retrieve-synchronously (concat ,location ,file)) - (generate-new-buffer "*package work buffer*")))) - (prog1 - (with-current-buffer buffer - (if http - (progn (package-handle-response) - (re-search-forward "^$" nil 'move) - (forward-char) - (delete-region (point-min) (point))) - (unless (file-name-absolute-p ,location) - (error "Archive location %s is not an absolute file name" - ,location)) - (insert-file-contents (expand-file-name ,file ,location))) - ,@body) - (kill-buffer buffer)))) - -(defun package-handle-response () - "Handle the response from a `url-retrieve-synchronously' call. -Parse the HTTP response and throw if an error occurred. -The url package seems to require extra processing for this. -This should be called in a `save-excursion', in the download buffer. -It will move point to somewhere in the headers." - ;; We assume HTTP here. - (require 'url-http) - (let ((response (url-http-parse-response))) - (when (or (< response 200) (>= response 300)) - (error "Error during download request:%s" - (buffer-substring-no-properties (point) (progn - (end-of-line) - (point))))))) - -(defun package-download-single (name version desc requires) - "Download and install a single-file package." - (let ((location (package-archive-base name)) - (file (concat (symbol-name name) "-" version ".el"))) - (package--with-work-buffer location file - (package-unpack-single (symbol-name name) version desc requires)))) - -(defun package-download-tar (name version) - "Download and install a tar package." - (let ((location (package-archive-base name)) - (file (concat (symbol-name name) "-" version ".tar"))) - (package--with-work-buffer location file - (package-unpack name version)))) - -(defvar package--initialized nil) - -(defun package-installed-p (package &optional min-version) - "Return true if PACKAGE, of MIN-VERSION or newer, is installed. -MIN-VERSION should be a version list." - (unless package--initialized (error "package.el is not yet initialized!")) - (let ((pkg-desc (assq package package-alist))) - (if pkg-desc - (version-list-<= min-version - (package-desc-vers (cdr pkg-desc))) - ;; Also check built-in packages. - (package-built-in-p package min-version)))) - -(defun package-compute-transaction (package-list requirements) - "Return a list of packages to be installed, including PACKAGE-LIST. -PACKAGE-LIST should be a list of package names (symbols). - -REQUIREMENTS should be a list of additional requirements; each -element in this list should have the form (PACKAGE VERSION-LIST), -where PACKAGE is a package name and VERSION-LIST is the required -version of that package. - -This function recursively computes the requirements of the -packages in REQUIREMENTS, and returns a list of all the packages -that must be installed. Packages that are already installed are -not included in this list." - (dolist (elt requirements) - (let* ((next-pkg (car elt)) - (next-version (cadr elt))) - (unless (package-installed-p next-pkg next-version) - ;; A package is required, but not installed. It might also be - ;; blocked via `package-load-list'. - (let ((pkg-desc (assq next-pkg package-archive-contents)) - hold) - (when (setq hold (assq next-pkg package-load-list)) - (setq hold (cadr hold)) - (cond ((eq hold t)) - ((eq hold nil) - (error "Required package '%s' is disabled" - (symbol-name next-pkg))) - ((null (stringp hold)) - (error "Invalid element in `package-load-list'")) - ((version-list-< (version-to-list hold) next-version) - (error "Package `%s' held at version %s, \ -but version %s required" - (symbol-name next-pkg) hold - (package-version-join next-version))))) - (unless pkg-desc - (error "Package `%s-%s' is unavailable" - (symbol-name next-pkg) - (package-version-join next-version))) - (unless (version-list-<= next-version - (package-desc-vers (cdr pkg-desc))) - (error - "Need package `%s-%s', but only %s is available" - (symbol-name next-pkg) (package-version-join next-version) - (package-version-join (package-desc-vers (cdr pkg-desc))))) - ;; Only add to the transaction if we don't already have it. - (unless (memq next-pkg package-list) - (push next-pkg package-list)) - (setq package-list - (package-compute-transaction package-list - (package-desc-reqs - (cdr pkg-desc)))))))) - package-list) - -(defun package-read-from-string (str) - "Read a Lisp expression from STR. -Signal an error if the entire string was not used." - (let* ((read-data (read-from-string str)) - (more-left - (condition-case nil - ;; The call to `ignore' suppresses a compiler warning. - (progn (ignore (read-from-string - (substring str (cdr read-data)))) - t) - (end-of-file nil)))) - (if more-left - (error "Can't read whole string") - (car read-data)))) - -(defun package--read-archive-file (file) - "Re-read archive file FILE, if it exists. -Will return the data from the file, or nil if the file does not exist. -Will throw an error if the archive version is too new." - (let ((filename (expand-file-name file package-user-dir))) - (when (file-exists-p filename) - (with-temp-buffer - (insert-file-contents-literally filename) - (let ((contents (read (current-buffer)))) - (if (> (car contents) package-archive-version) - (error "Package archive version %d is higher than %d" - (car contents) package-archive-version)) - (cdr contents)))))) - -(defun package-read-all-archive-contents () - "Re-read `archive-contents', if it exists. -If successful, set `package-archive-contents'." - (setq package-archive-contents nil) - (dolist (archive package-archives) - (package-read-archive-contents (car archive)))) - -(defun package-read-archive-contents (archive) - "Re-read archive contents for ARCHIVE. -If successful, set the variable `package-archive-contents'. -If the archive version is too new, signal an error." - ;; Version 1 of 'archive-contents' is identical to our internal - ;; representation. - (let* ((dir (concat "archives/" archive)) - (contents-file (concat dir "/archive-contents")) - contents) - (when (setq contents (package--read-archive-file contents-file)) - (dolist (package contents) - (package--add-to-archive-contents package archive))))) - -(defun package--add-to-archive-contents (package archive) - "Add the PACKAGE from the given ARCHIVE if necessary. -Also, add the originating archive to the end of the package vector." - (let* ((name (car package)) - (version (package-desc-vers (cdr package))) - (entry (cons name - (vconcat (cdr package) (vector archive)))) - (existing-package (assq name package-archive-contents))) - (cond ((not existing-package) - (add-to-list 'package-archive-contents entry)) - ((version-list-< (package-desc-vers (cdr existing-package)) - version) - ;; Replace the entry with this one. - (setq package-archive-contents - (cons entry - (delq existing-package - package-archive-contents))))))) - -(defun package-download-transaction (package-list) - "Download and install all the packages in PACKAGE-LIST. -PACKAGE-LIST should be a list of package names (symbols). -This function assumes that all package requirements in -PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed -using `package-compute-transaction'." - (dolist (elt package-list) - (let* ((desc (cdr (assq elt package-archive-contents))) - ;; As an exception, if package is "held" in - ;; `package-load-list', download the held version. - (hold (cadr (assq elt package-load-list))) - (v-string (or (and (stringp hold) hold) - (package-version-join (package-desc-vers desc)))) - (kind (package-desc-kind desc))) - (cond - ((eq kind 'tar) - (package-download-tar elt v-string)) - ((eq kind 'single) - (package-download-single elt v-string - (package-desc-doc desc) - (package-desc-reqs desc))) - (t - (error "Unknown package kind: %s" (symbol-name kind)))) - ;; If package A depends on package B, then A may `require' B - ;; during byte compilation. So we need to activate B before - ;; unpacking A. - (package-maybe-load-descriptor (symbol-name elt) v-string - package-user-dir) - (package-activate elt (version-to-list v-string))))) - -;;;###autoload -(defun package-install (name) - "Install the package named NAME. -NAME should be the name of one of the available packages in an -archive in `package-archives'. Interactively, prompt for NAME." - (interactive - (progn - ;; Initialize the package system to get the list of package - ;; symbols for completion. - (unless package--initialized - (package-initialize t)) - (unless package-archive-contents - (package-refresh-contents)) - (list (intern (completing-read - "Install package: " - (mapcar (lambda (elt) - (cons (symbol-name (car elt)) - nil)) - package-archive-contents) - nil t))))) - (let ((pkg-desc (assq name package-archive-contents))) - (unless pkg-desc - (error "Package `%s' is not available for installation" - (symbol-name name))) - (package-download-transaction - (package-compute-transaction (list name) - (package-desc-reqs (cdr pkg-desc)))))) - -(defun package-strip-rcs-id (str) - "Strip RCS version ID from the version string STR. -If the result looks like a dotted numeric version, return it. -Otherwise return nil." - (when str - (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) - (setq str (substring str (match-end 0)))) - (condition-case nil - (if (version-to-list str) - str) - (error nil)))) - -(defun package-buffer-info () - "Return a vector describing the package in the current buffer. -The vector has the form - - [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] - -FILENAME is the file name, a string, sans the \".el\" extension. -REQUIRES is a list of requirements, each requirement having the - form (NAME VER); NAME is a string and VER is a version list. -DESCRIPTION is the package description, a string. -VERSION is the version, a string. -COMMENTARY is the commentary section, a string, or nil if none. - -If the buffer does not contain a conforming package, signal an -error. If there is a package, narrow the buffer to the file's -boundaries." - (goto-char (point-min)) - (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t) - (error "Packages lacks a file header")) - (let ((file-name (match-string-no-properties 1)) - (desc (match-string-no-properties 2)) - (start (line-beginning-position))) - (unless (search-forward (concat ";;; " file-name ".el ends here")) - (error "Package lacks a terminating comment")) - ;; Try to include a trailing newline. - (forward-line) - (narrow-to-region start (point)) - (require 'lisp-mnt) - ;; Use some headers we've invented to drive the process. - (let* ((requires-str (lm-header "package-requires")) - (requires (if requires-str - (package-read-from-string requires-str))) - ;; Prefer Package-Version; if defined, the package author - ;; probably wants us to use it. Otherwise try Version. - (pkg-version - (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) - (commentary (lm-commentary))) - (unless pkg-version - (error - "Package lacks a \"Version\" or \"Package-Version\" header")) - ;; Turn string version numbers into list form. - (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) - (vector file-name requires desc pkg-version commentary)))) - -(defun package-tar-file-info (file) - "Find package information for a tar file. -FILE is the name of the tar file to examine. -The return result is a vector like `package-buffer-info'." - (let ((default-directory (file-name-directory file)) - (file (file-name-nondirectory file))) - (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'") - file) - (error "Invalid package name `%s'" file)) - (let* ((pkg-name (match-string-no-properties 1 file)) - (pkg-version (match-string-no-properties 2 file)) - ;; Extract the package descriptor. - (pkg-def-contents (shell-command-to-string - ;; Requires GNU tar. - (concat "tar -xOf " file " " - - pkg-name "-" pkg-version "/" - pkg-name "-pkg.el"))) - (pkg-def-parsed (package-read-from-string pkg-def-contents))) - (unless (eq (car pkg-def-parsed) 'define-package) - (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) - (let ((name-str (nth 1 pkg-def-parsed)) - (version-string (nth 2 pkg-def-parsed)) - (docstring (nth 3 pkg-def-parsed)) - (requires (nth 4 pkg-def-parsed)) - (readme (shell-command-to-string - ;; Requires GNU tar. - (concat "tar -xOf " file " " - pkg-name "-" pkg-version "/README")))) - (unless (equal pkg-version version-string) - (error "Package has inconsistent versions")) - (unless (equal pkg-name name-str) - (error "Package has inconsistent names")) - ;; Kind of a hack. - (if (string-match ": Not found in archive" readme) - (setq readme nil)) - ;; Turn string version numbers into list form. - (if (eq (car requires) 'quote) - (setq requires (car (cdr requires)))) - (setq requires - (mapcar (lambda (elt) - (list (car elt) - (version-to-list (cadr elt)))) - requires)) - (vector pkg-name requires docstring version-string readme))))) - -;;;###autoload -(defun package-install-from-buffer (pkg-info type) - "Install a package from the current buffer. -When called interactively, the current buffer is assumed to be a -single .el file that follows the packaging guidelines; see info -node `(elisp)Packaging'. - -When called from Lisp, PKG-INFO is a vector describing the -information, of the type returned by `package-buffer-info'; and -TYPE is the package type (either `single' or `tar')." - (interactive (list (package-buffer-info) 'single)) - (save-excursion - (save-restriction - (let* ((file-name (aref pkg-info 0)) - (requires (aref pkg-info 1)) - (desc (if (string= (aref pkg-info 2) "") - "No description available." - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3))) - ;; Download and install the dependencies. - (let ((transaction (package-compute-transaction nil requires))) - (package-download-transaction transaction)) - ;; Install the package itself. - (cond - ((eq type 'single) - (package-unpack-single file-name pkg-version desc requires)) - ((eq type 'tar) - (package-unpack (intern file-name) pkg-version)) - (t - (error "Unknown type: %s" (symbol-name type)))) - ;; Try to activate it. - (package-initialize))))) - -;;;###autoload -(defun package-install-file (file) - "Install a package from a file. -The file can either be a tar file or an Emacs Lisp file." - (interactive "fPackage file name: ") - (with-temp-buffer - (insert-file-contents-literally file) - (cond - ((string-match "\\.el$" file) - (package-install-from-buffer (package-buffer-info) 'single)) - ((string-match "\\.tar$" file) - (package-install-from-buffer (package-tar-file-info file) 'tar)) - (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) - -(defun package-delete (name version) - (let ((dir (package--dir name version))) - (if (string-equal (file-name-directory dir) - (file-name-as-directory - (expand-file-name package-user-dir))) - (progn - (delete-directory dir t t) - (message "Package `%s-%s' deleted." name version)) - ;; Don't delete "system" packages - (error "Package `%s-%s' is a system package, not deleting" - name version)))) - -(defun package-archive-base (name) - "Return the archive containing the package NAME." - (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) - (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) - -(defun package--download-one-archive (archive file) - "Retrieve an archive file FILE from ARCHIVE, and cache it. -ARCHIVE should be a cons cell of the form (NAME . LOCATION), -similar to an entry in `package-alist'. Save the cached copy to -\"archives/NAME/archive-contents\" in `package-user-dir'." - (let* ((dir (expand-file-name "archives" package-user-dir)) - (dir (expand-file-name (car archive) dir))) - (package--with-work-buffer (cdr archive) file - ;; Read the retrieved buffer to make sure it is valid (e.g. it - ;; may fetch a URL redirect page). - (when (listp (read buffer)) - (make-directory dir t) - (setq buffer-file-name (expand-file-name file dir)) - (let ((version-control 'never)) - (save-buffer)))))) - -;;;###autoload -(defun package-refresh-contents () - "Download the ELPA archive description if needed. -This informs Emacs about the latest versions of all packages, and -makes them available for download." - (interactive) - (unless (file-exists-p package-user-dir) - (make-directory package-user-dir t)) - (dolist (archive package-archives) - (condition-case-unless-debug nil - (package--download-one-archive archive "archive-contents") - (error (message "Failed to download `%s' archive." - (car archive))))) - (package-read-all-archive-contents)) - -;;;###autoload -(defun package-initialize (&optional no-activate) - "Load Emacs Lisp packages, and activate them. -The variable `package-load-list' controls which packages to load. -If optional arg NO-ACTIVATE is non-nil, don't activate packages." - (interactive) - (setq package-alist nil - package-obsolete-alist nil) - (package-load-all-descriptors) - (package-read-all-archive-contents) - (unless no-activate - (dolist (elt package-alist) - (package-activate (car elt) (package-desc-vers (cdr elt))))) - (setq package--initialized t)) - - -;;;; Package description buffer. - -;;;###autoload -(defun describe-package (package) - "Display the full documentation of PACKAGE (a symbol)." - (interactive - (let* ((guess (function-called-at-point)) - packages val) - (require 'finder-inf nil t) - ;; Load the package list if necessary (but don't activate them). - (unless package--initialized - (package-initialize t)) - (setq packages (append (mapcar 'car package-alist) - (mapcar 'car package-archive-contents) - (mapcar 'car package--builtins))) - (unless (memq guess packages) - (setq guess nil)) - (setq packages (mapcar 'symbol-name packages)) - (setq val - (completing-read (if guess - (format "Describe package (default %s): " - guess) - "Describe package: ") - packages nil t nil nil guess)) - (list (if (equal val "") guess (intern val))))) - (if (or (null package) (not (symbolp package))) - (message "No package specified") - (help-setup-xref (list #'describe-package package) - (called-interactively-p 'interactive)) - (with-help-window (help-buffer) - (with-current-buffer standard-output - (describe-package-1 package))))) - -(defun describe-package-1 (package) - (require 'lisp-mnt) - (let ((package-name (symbol-name package)) - (built-in (assq package package--builtins)) - desc pkg-dir reqs version installable archive) - (prin1 package) - (princ " is ") - (cond - ;; Loaded packages are in `package-alist'. - ((setq desc (cdr (assq package package-alist))) - (setq version (package-version-join (package-desc-vers desc))) - (if (setq pkg-dir (package--dir package-name version)) - (insert "an installed package.\n\n") - ;; This normally does not happen. - (insert "a deleted package.\n\n"))) - ;; Available packages are in `package-archive-contents'. - ((setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc)) - archive (aref desc (- (length desc) 1)) - installable t) - (if built-in - (insert "a built-in package.\n\n") - (insert "an uninstalled package.\n\n"))) - (built-in - (setq desc (cdr built-in) - version (package-version-join (package-desc-vers desc))) - (insert "a built-in package.\n\n")) - (t - (insert "an orphan package.\n\n"))) - - (insert " " (propertize "Status" 'font-lock-face 'bold) ": ") - (cond (pkg-dir - (insert (propertize "Installed" - 'font-lock-face 'font-lock-comment-face)) - (insert " in `") - ;; Todo: Add button for uninstalling. - (help-insert-xref-button (file-name-as-directory pkg-dir) - 'help-package-def pkg-dir) - (if built-in - (insert "',\n shadowing a " - (propertize "built-in package" - 'font-lock-face 'font-lock-builtin-face) - ".") - (insert "'."))) - (installable - (if built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) - " Alternate version available") - (insert "Available")) - (insert " from " archive) - (insert " -- ") - (let ((button-text (if (display-graphic-p) "Install" "[Install]")) - (button-face (if (display-graphic-p) - '(:box (:line-width 2 :color "dark grey") - :background "light grey" - :foreground "black") - 'link))) - (insert-text-button button-text 'face button-face 'follow-link t - 'package-symbol package - 'action 'package-install-button-action))) - (built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) - (t (insert "Deleted."))) - (insert "\n") - (and version (> (length version) 0) - (insert " " - (propertize "Version" 'font-lock-face 'bold) ": " version "\n")) - - (setq reqs (if desc (package-desc-reqs desc))) - (when reqs - (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ") - (let ((first t) - name vers text) - (dolist (req reqs) - (setq name (car req) - vers (cadr req) - text (format "%s-%s" (symbol-name name) - (package-version-join vers))) - (cond (first (setq first nil)) - ((>= (+ 2 (current-column) (length text)) - (window-width)) - (insert ",\n ")) - (t (insert ", "))) - (help-insert-xref-button text 'help-package name)) - (insert "\n"))) - (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (if desc (package-desc-doc desc)) "\n\n") - - (if built-in - ;; For built-in packages, insert the commentary. - (let ((fn (locate-file (concat package-name ".el") load-path - load-file-rep-suffixes)) - (opoint (point))) - (insert (or (lm-commentary fn) "")) - (save-excursion - (goto-char opoint) - (when (re-search-forward "^;;; Commentary:\n" nil t) - (replace-match "")) - (while (re-search-forward "^\\(;+ ?\\)" nil t) - (replace-match "")))) - (let ((readme (expand-file-name (concat package-name "-readme.txt") - package-user-dir)) - readme-string) - ;; For elpa packages, try downloading the commentary. If that - ;; fails, try an existing readme file in `package-user-dir'. - (cond ((condition-case nil - (package--with-work-buffer (package-archive-base package) - (concat package-name "-readme.txt") - (setq buffer-file-name - (expand-file-name readme package-user-dir)) - (let ((version-control 'never)) - (save-buffer)) - (setq readme-string (buffer-string)) - t) - (error nil)) - (insert readme-string)) - ((file-readable-p readme) - (insert-file-contents readme) - (goto-char (point-max)))))))) - -(defun package-install-button-action (button) - (let ((package (button-get button 'package-symbol))) - (when (y-or-n-p (format "Install package `%s'? " package)) - (package-install package) - (revert-buffer nil t) - (goto-char (point-min))))) - - -;;;; Package menu mode. - -(defvar package-menu-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Package"))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map "\C-m" 'package-menu-describe-package) - (define-key map "u" 'package-menu-mark-unmark) - (define-key map "\177" 'package-menu-backup-unmark) - (define-key map "d" 'package-menu-mark-delete) - (define-key map "i" 'package-menu-mark-install) - (define-key map "U" 'package-menu-mark-upgrades) - (define-key map "r" 'package-menu-refresh) - (define-key map "~" 'package-menu-mark-obsolete-for-deletion) - (define-key map "x" 'package-menu-execute) - (define-key map "h" 'package-menu-quick-help) - (define-key map "?" 'package-menu-describe-package) - (define-key map [menu-bar package-menu] (cons "Package" menu-map)) - (define-key menu-map [mq] - '(menu-item "Quit" quit-window - :help "Quit package selection")) - (define-key menu-map [s1] '("--")) - (define-key menu-map [mn] - '(menu-item "Next" next-line - :help "Next Line")) - (define-key menu-map [mp] - '(menu-item "Previous" previous-line - :help "Previous Line")) - (define-key menu-map [s2] '("--")) - (define-key menu-map [mu] - '(menu-item "Unmark" package-menu-mark-unmark - :help "Clear any marks on a package and move to the next line")) - (define-key menu-map [munm] - '(menu-item "Unmark Backwards" package-menu-backup-unmark - :help "Back up one line and clear any marks on that package")) - (define-key menu-map [md] - '(menu-item "Mark for Deletion" package-menu-mark-delete - :help "Mark a package for deletion and move to the next line")) - (define-key menu-map [mi] - '(menu-item "Mark for Install" package-menu-mark-install - :help "Mark a package for installation and move to the next line")) - (define-key menu-map [mupgrades] - '(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades - :help "Mark packages that have a newer version for upgrading")) - (define-key menu-map [s3] '("--")) - (define-key menu-map [mg] - '(menu-item "Update Package List" revert-buffer - :help "Update the list of packages")) - (define-key menu-map [mr] - '(menu-item "Refresh Package List" package-menu-refresh - :help "Download the ELPA archive")) - (define-key menu-map [s4] '("--")) - (define-key menu-map [mt] - '(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion - :help "Mark all obsolete packages for deletion")) - (define-key menu-map [mx] - '(menu-item "Execute Actions" package-menu-execute - :help "Perform all the marked actions")) - (define-key menu-map [s5] '("--")) - (define-key menu-map [mh] - '(menu-item "Help" package-menu-quick-help - :help "Show short key binding help for package-menu-mode")) - (define-key menu-map [mc] - '(menu-item "View Commentary" package-menu-view-commentary - :help "Display information about this package")) - map) - "Local keymap for `package-menu-mode' buffers.") - -(defvar package-menu--new-package-list nil - "List of newly-available packages since `list-packages' was last called.") - -(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu" - "Major mode for browsing a list of packages. -Letters do not insert themselves; instead, they are commands. -\\ -\\{package-menu-mode-map}" - (setq tabulated-list-format [("Package" 18 package-menu--name-predicate) - ("Version" 12 nil) - ("Status" 10 package-menu--status-predicate) - ("Description" 0 nil)]) - (setq tabulated-list-padding 2) - (setq tabulated-list-sort-key (cons "Status" nil)) - (tabulated-list-init-header)) - -(defmacro package--push (package desc status listname) - "Convenience macro for `package-menu--generate'. -If the alist stored in the symbol LISTNAME lacks an entry for a -package PACKAGE with descriptor DESC, add one. The alist is -keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is -a symbol and VERSION-LIST is a version list." - `(let* ((version (package-desc-vers ,desc)) - (key (cons ,package version))) - (unless (assoc key ,listname) - (push (list key ,status (package-desc-doc ,desc)) ,listname)))) - -(defun package-menu--generate (remember-pos packages) - "Populate the Package Menu. -If REMEMBER-POS is non-nil, keep point on the same entry. -PACKAGES should be t, which means to display all known packages, -or a list of package names (symbols) to display." - ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION). - (let (info-list name) - ;; Installed packages: - (dolist (elt package-alist) - (setq name (car elt)) - (when (or (eq packages t) (memq name packages)) - (package--push name (cdr elt) - (if (stringp (cadr (assq name package-load-list))) - "held" "installed") - info-list))) - - ;; Built-in packages: - (dolist (elt package--builtins) - (setq name (car elt)) - (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. - (or (eq packages t) (memq name packages))) - (package--push name (cdr elt) "built-in" info-list))) - - ;; Available and disabled packages: - (dolist (elt package-archive-contents) - (setq name (car elt)) - (when (or (eq packages t) (memq name packages)) - (let ((hold (assq name package-load-list))) - (package--push name (cdr elt) - (cond - ((and hold (null (cadr hold))) "disabled") - ((memq name package-menu--new-package-list) "new") - (t "available")) - info-list)))) - - ;; Obsolete packages: - (dolist (elt package-obsolete-alist) - (dolist (inner-elt (cdr elt)) - (when (or (eq packages t) (memq (car elt) packages)) - (package--push (car elt) (cdr inner-elt) "obsolete" info-list)))) - - ;; Print the result. - (setq tabulated-list-entries (mapcar 'package-menu--print-info info-list)) - (tabulated-list-print remember-pos))) - -(defun package-menu--print-info (pkg) - "Return a package entry suitable for `tabulated-list-entries'. -PKG has the form ((PACKAGE . VERSION) STATUS DOC). -Return (KEY [NAME VERSION STATUS DOC]), where KEY is the -identifier (NAME . VERSION-LIST)." - (let* ((package (caar pkg)) - (version (cdr (car pkg))) - (status (nth 1 pkg)) - (doc (or (nth 2 pkg) "")) - (face (cond - ((string= status "built-in") 'font-lock-builtin-face) - ((string= status "available") 'default) - ((string= status "new") 'bold) - ((string= status "held") 'font-lock-constant-face) - ((string= status "disabled") 'font-lock-warning-face) - ((string= status "installed") 'font-lock-comment-face) - (t 'font-lock-warning-face)))) ; obsolete. - (list (cons package version) - (vector (list (symbol-name package) - 'face 'link - 'follow-link t - 'package-symbol package - 'action 'package-menu-describe-package) - (propertize (package-version-join version) - 'font-lock-face face) - (propertize status 'font-lock-face face) - (propertize doc 'font-lock-face face))))) - -(defun package-menu-refresh () - "Download the Emacs Lisp package archive. -This fetches the contents of each archive specified in -`package-archives', and then refreshes the package menu." - (interactive) - (unless (derived-mode-p 'package-menu-mode) - (error "The current buffer is not a Package Menu")) - (package-refresh-contents) - (package-menu--generate t t)) - -(defun package-menu-describe-package (&optional button) - "Describe the current package. -If optional arg BUTTON is non-nil, describe its associated package." - (interactive) - (let ((package (if button (button-get button 'package-symbol) - (car (tabulated-list-get-id))))) - (if package - (describe-package package)))) - -;; fixme numeric argument -(defun package-menu-mark-delete (&optional _num) - "Mark a package for deletion and move to the next line." - (interactive "p") - (if (member (package-menu-get-status) '("installed" "obsolete")) - (tabulated-list-put-tag "D" t) - (forward-line))) - -(defun package-menu-mark-install (&optional _num) - "Mark a package for installation and move to the next line." - (interactive "p") - (if (member (package-menu-get-status) '("available" "new")) - (tabulated-list-put-tag "I" t) - (forward-line))) - -(defun package-menu-mark-unmark (&optional _num) - "Clear any marks on a package and move to the next line." - (interactive "p") - (tabulated-list-put-tag " " t)) - -(defun package-menu-backup-unmark () - "Back up one line and clear any marks on that package." - (interactive) - (forward-line -1) - (tabulated-list-put-tag " ")) - -(defun package-menu-mark-obsolete-for-deletion () - "Mark all obsolete packages for deletion." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (equal (package-menu-get-status) "obsolete") - (tabulated-list-put-tag "D" t) - (forward-line 1))))) - -(defun package-menu-quick-help () - "Show short key binding help for package-menu-mode." - (interactive) - (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp")) - -(define-obsolete-function-alias - 'package-menu-view-commentary 'package-menu-describe-package "24.1") - -(defun package-menu-get-status () - (let* ((pkg (tabulated-list-get-id)) - (entry (and pkg (assq pkg tabulated-list-entries)))) - (if entry - (aref (cadr entry) 2) - ""))) - -(defun package-menu--find-upgrades () - (let (installed available upgrades) - ;; Build list of installed/available packages in this buffer. - (dolist (entry tabulated-list-entries) - ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC]) - (let ((pkg (car entry)) - (status (aref (cadr entry) 2))) - (cond ((equal status "installed") - (push pkg installed)) - ((member status '("available" "new")) - (push pkg available))))) - ;; Loop through list of installed packages, finding upgrades - (dolist (pkg installed) - (let ((avail-pkg (assq (car pkg) available))) - (and avail-pkg - (version-list-< (cdr pkg) (cdr avail-pkg)) - (push avail-pkg upgrades)))) - upgrades)) - -(defun package-menu-mark-upgrades () - "Mark all upgradable packages in the Package Menu. -For each installed package with a newer version available, place -an (I)nstall flag on the available version and a (D)elete flag on -the installed version. A subsequent \\[package-menu-execute] -call will upgrade the package." - (interactive) - (unless (derived-mode-p 'package-menu-mode) - (error "The current buffer is not a Package Menu")) - (let ((upgrades (package-menu--find-upgrades))) - (if (null upgrades) - (message "No packages to upgrade.") - (widen) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let* ((pkg (tabulated-list-get-id)) - (upgrade (assq (car pkg) upgrades))) - (cond ((null upgrade) - (forward-line 1)) - ((equal pkg upgrade) - (package-menu-mark-install)) - (t - (package-menu-mark-delete)))))) - (message "%d package%s marked for upgrading." - (length upgrades) - (if (= (length upgrades) 1) "" "s"))))) - -(defun package-menu-execute (&optional noquery) - "Perform marked Package Menu actions. -Packages marked for installation are downloaded and installed; -packages marked for deletion are removed. -Optional argument NOQUERY non-nil means do not ask the user to confirm." - (interactive) - (unless (derived-mode-p 'package-menu-mode) - (error "The current buffer is not in Package Menu mode")) - (let (install-list delete-list cmd id) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (setq cmd (char-after)) - (unless (eq cmd ?\s) - ;; This is the key (PACKAGE . VERSION-LIST). - (setq id (tabulated-list-get-id)) - (cond ((eq cmd ?D) - (push (cons (symbol-name (car id)) - (package-version-join (cdr id))) - delete-list)) - ((eq cmd ?I) - (push (car id) install-list)))) - (forward-line))) - (when install-list - (if (or - noquery - (yes-or-no-p - (if (= (length install-list) 1) - (format "Install package `%s'? " (car install-list)) - (format "Install these %d packages (%s)? " - (length install-list) - (mapconcat 'symbol-name install-list ", "))))) - (mapc 'package-install install-list))) - ;; Delete packages, prompting if necessary. - (when delete-list - (if (or - noquery - (yes-or-no-p - (if (= (length delete-list) 1) - (format "Delete package `%s-%s'? " - (caar delete-list) - (cdr (car delete-list))) - (format "Delete these %d packages (%s)? " - (length delete-list) - (mapconcat (lambda (elt) - (concat (car elt) "-" (cdr elt))) - delete-list - ", "))))) - (dolist (elt delete-list) - (condition-case-unless-debug err - (package-delete (car elt) (cdr elt)) - (error (message (cadr err))))) - (error "Aborted"))) - ;; If we deleted anything, regenerate `package-alist'. This is done - ;; automatically if we installed a package. - (and delete-list (null install-list) - (package-initialize)) - (if (or delete-list install-list) - (package-menu--generate t t) - (message "No operations specified.")))) - -(defun package-menu--version-predicate (A B) - (let ((vA (or (aref (cadr A) 1) '(0))) - (vB (or (aref (cadr B) 1) '(0)))) - (if (version-list-= vA vB) - (package-menu--name-predicate A B) - (version-list-< vA vB)))) - -(defun package-menu--status-predicate (A B) - (let ((sA (aref (cadr A) 2)) - (sB (aref (cadr B) 2))) - (cond ((string= sA sB) - (package-menu--name-predicate A B)) - ((string= sA "new") t) - ((string= sB "new") nil) - ((string= sA "available") t) - ((string= sB "available") nil) - ((string= sA "installed") t) - ((string= sB "installed") nil) - ((string= sA "held") t) - ((string= sB "held") nil) - ((string= sA "built-in") t) - ((string= sB "built-in") nil) - ((string= sA "obsolete") t) - ((string= sB "obsolete") nil) - (t (string< sA sB))))) - -(defun package-menu--description-predicate (A B) - (let ((dA (aref (cadr A) 3)) - (dB (aref (cadr B) 3))) - (if (string= dA dB) - (package-menu--name-predicate A B) - (string< dA dB)))) - -(defun package-menu--name-predicate (A B) - (string< (symbol-name (caar A)) - (symbol-name (caar B)))) - -;;;###autoload -(defun list-packages (&optional no-fetch) - "Display a list of packages. -This first fetches the updated list of packages before -displaying, unless a prefix argument NO-FETCH is specified. -The list is displayed in a buffer named `*Packages*'." - (interactive "P") - (require 'finder-inf nil t) - ;; Initialize the package system if necessary. - (unless package--initialized - (package-initialize t)) - (let (old-archives new-packages) - (unless no-fetch - ;; Read the locally-cached archive-contents. - (package-read-all-archive-contents) - (setq old-archives package-archive-contents) - ;; Fetch the remote list of packages. - (package-refresh-contents) - ;; Find which packages are new. - (dolist (elt package-archive-contents) - (unless (assq (car elt) old-archives) - (push (car elt) new-packages)))) - - ;; Generate the Package Menu. - (let ((buf (get-buffer-create "*Packages*"))) - (with-current-buffer buf - (package-menu-mode) - (set (make-local-variable 'package-menu--new-package-list) - new-packages) - (package-menu--generate nil t)) - ;; The package menu buffer has keybindings. If the user types - ;; `M-x list-packages', that suggests it should become current. - (switch-to-buffer buf)) - - (let ((upgrades (package-menu--find-upgrades))) - (if upgrades - (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading." - (length upgrades) - (if (= (length upgrades) 1) "" "s") - (substitute-command-keys "\\[package-menu-mark-upgrades]") - (if (= (length upgrades) 1) "it" "them")))))) - -;;;###autoload -(defalias 'package-list-packages 'list-packages) - -;; Used in finder.el -(defun package-show-package-list (packages) - "Display PACKAGES in a *Packages* buffer. -This is similar to `list-packages', but it does not fetch the -updated list of packages, and it only displays packages with -names in PACKAGES (which should be a list of symbols)." - (require 'finder-inf nil t) - (let ((buf (get-buffer-create "*Packages*"))) - (with-current-buffer buf - (package-menu-mode) - (package-menu--generate nil packages)) - (switch-to-buffer buf))) - -(defun package-list-packages-no-fetch () - "Display a list of packages. -Does not fetch the updated list of packages before displaying. -The list is displayed in a buffer named `*Packages*'." - (interactive) - (list-packages t)) - -(provide 'package) - -;;; package.el ends here diff --git a/elpa/visual-regexp-20150329.954/visual-regexp-autoloads.el b/elpa/visual-regexp-20150329.954/visual-regexp-autoloads.el new file mode 100644 index 00000000..77ef987a --- /dev/null +++ b/elpa/visual-regexp-20150329.954/visual-regexp-autoloads.el @@ -0,0 +1,39 @@ +;;; visual-regexp-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + + +;;;### (autoloads (vr/query-replace vr/replace vr/mc-mark) "visual-regexp" +;;;;;; "visual-regexp.el" (21823 48542 0 0)) +;;; Generated autoloads from visual-regexp.el + +(autoload 'vr/mc-mark "visual-regexp" "\ +Convert regexp selection to multiple cursors. + +\(fn REGEXP START END)" nil nil) + +(autoload 'vr/replace "visual-regexp" "\ +Regexp-replace with live visual feedback. + +\(fn REGEXP REPLACE START END)" t nil) + +(autoload 'vr/query-replace "visual-regexp" "\ +Use vr/query-replace like you would use query-replace-regexp. + +\(fn REGEXP REPLACE START END)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("visual-regexp-pkg.el") (21823 48542 600071 +;;;;;; 0)) + +;;;*** + +(provide 'visual-regexp-autoloads) +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; visual-regexp-autoloads.el ends here diff --git a/elpa/visual-regexp-20150329.954/visual-regexp-pkg.el b/elpa/visual-regexp-20150329.954/visual-regexp-pkg.el new file mode 100644 index 00000000..1ae87390 --- /dev/null +++ b/elpa/visual-regexp-20150329.954/visual-regexp-pkg.el @@ -0,0 +1 @@ +(define-package "visual-regexp" "20150329.954" "A regexp/replace command for Emacs with interactive visual feedback" (quote ((cl-lib "0.2")))) diff --git a/elpa/visual-regexp-20150329.954/visual-regexp.el b/elpa/visual-regexp-20150329.954/visual-regexp.el new file mode 100644 index 00000000..92d59568 --- /dev/null +++ b/elpa/visual-regexp-20150329.954/visual-regexp.el @@ -0,0 +1,952 @@ +;;; visual-regexp.el --- A regexp/replace command for Emacs with interactive visual feedback + +;; Copyright (C) 2013-2015 Marko Bencun + +;; Author: Marko Bencun +;; URL: https://github.com/benma/visual-regexp.el/ +;; Package-Version: 20150329.954 +;; Version: 0.8 +;; Package-Requires: ((cl-lib "0.2")) +;; Keywords: regexp, replace, visual, feedback + +;; This file is part of visual-regexp. + +;; visual-regexp 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. + +;; visual-regexp 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 visual-regexp. If not, see . + +;;; WHAT'S NEW +;; 0.8: Error handling for vr--get-regexp-string. Bug-fixes regarding error display. +;; 0.7: Customizable separator (arrow) string and face. +;; 0.6: distinguish prompts in vr/replace, vr/query-replace, vr/mc-mark. +;; 0.5: emulate case-conversion of replace-regexp. +;; 0.4: vr/mc-mark: interface to multiple-cursors. +;; 0.3: use the same history as the regular Emacs replace commands; +;; 0.2: support for lisp expressions in the replace string, same as in (query-)replace-regexp +;; 0.1: initial release + +;;; Tip Jar +;; If you found this useful, please consider donating. +;; BTC: 1BxauiLGMQPb2pavkkQkuFe5CgrGMrUat2 + +;;; What's This? + +;; visual-regexp for Emacs is like `replace-regexp`, but with live visual feedback directly in the buffer. +;; While constructing the regexp in the minibuffer, you get live visual feedback for the matches, including group matches. +;; While constructing the replacement in the minibuffer, you get live visual feedback for the replacements. +;; It can be used to replace all matches in one go (like `replace-regexp`), or a decision can be made on each match (like `query-replace-regexp`). +;; Thanks to Detlev Zundel for his re-builder. + +;;; Where does visual-regexp come from? +;; +;; I was not happy with the way I used emacs' replace-regexp before. Constructing the regular expression is error prone and emacs' regular expressions are limited +;; (for example, no lookaheads, named groups, etc.). +;; Using re-builder to interactively build regular expressions was a step into the right direction, but manually copying over the regexp +;; to the minibuffer is cumbersome. +;; Using the idea of interactive feedback of re-builder, this package makes it possible to use just the minibuffer to construct (with live visual feedback) the regexp and replacement, +;; using Emacs style regular expressions, or optionally, regular expressions powered by other (mode modern) engines, for the replacement. For the latter part, see the package visual-regexp-steroids. + +;;; Installation + +;; If you are using Emacs 24, you can get visual-regexp from [melpa](http://melpa.milkbox.net/) with the package manager. +;; Add the following code to your init file. Of course you can select your own key bindings. +;; ---------------------------------------------------------- +;; (add-to-list 'load-path "folder-in-which-visual-regexp-files-are-in/") ;; if the files are not already in the load path +;; (require 'visual-regexp) +;; (define-key global-map (kbd "C-c r") 'vr/replace) +;; (define-key global-map (kbd "C-c q") 'vr/query-replace) +;; ;; if you use multiple-cursors, this is for you: +;; (define-key global-map (kbd "C-c m") 'vr/mc-mark) +;; ---------------------------------------------------------- +;; To customize, use `M-x customize-group [RET] visual-regexp`. + +;;; Code: +(unless (fboundp 'make-overlay) + (require 'overlay)) + +;; cl is used for the (loop ...) macro +(require 'cl-lib) + +;;; faces + +(defcustom vr/match-separator-use-custom-face nil + "If activated, vr/match-separator-face is used to display the separator. Otherwise, use the same face as the current match." + :type 'boolean + :group 'visual-regexp) + + +(defface vr/match-separator-face + '((((class color)) + :foreground "red" + :bold t) + (t + :inverse-video t)) + "Face for the arrow between match and replacement. To use this, you must activate vr/match-separator-use-custom-face" + :group 'visual-regexp) + +(defcustom vr/match-separator-string " => " + "This string is used to separate a match from the replacement during feedback." + :type 'string + :group 'visual-regexp) + +(defface vr/match-0 + '((((class color) (background light)) + :background "lightblue") + (((class color) (background dark)) + :background "steelblue4") + (t + :inverse-video t)) + "First face for displaying a whole match." + :group 'visual-regexp) + +(defface vr/match-1 + '((((class color) (background light)) + :background "pale turquoise") + (((class color) (background dark)) + :background "dodgerblue4") + (t + :inverse-video t)) + "Second face for displaying a whole match." + :group 'visual-regexp) + +(defface vr/group-0 + '((((class color) (background light)) + :background "aquamarine") + (((class color) (background dark)) + :background "blue3") + (t + :inverse-video t)) + "First face for displaying a matching group." + :group 'visual-regexp) + +(defface vr/group-1 + '((((class color) (background light)) + :background "springgreen") + (((class color) (background dark)) + :background "chartreuse4") + (t + :inverse-video t)) + "Second face for displaying a matching group." + :group 'visual-regexp) + +(defface vr/group-2 + '((((min-colors 88) (class color) (background light)) + :background "yellow1") + (((class color) (background light)) + :background "yellow") + (((class color) (background dark)) + :background "sienna4") + (t + :inverse-video t)) + "Third face for displaying a matching group." + :group 'visual-regexp) + +;;; variables + +(defcustom vr/auto-show-help t + "Show help message automatically when the minibuffer is entered." + :type 'boolean + :group 'visual-regexp) + +(defcustom vr/default-feedback-limit 50 + "Limit number of matches shown in visual feedback. +If nil, don't limit the number of matches shown in visual feedback." + :type 'integer + :group 'visual-regexp) + +(defcustom vr/default-replace-preview nil + "Preview of replacement activated by default? If activated, the original is not shown alongside the replacement." + :type 'boolean + :group 'visual-regexp) + +(defcustom vr/query-replace-from-history-variable query-replace-from-history-variable + "History list to use for the FROM argument. The default is to use the same history as Emacs' query-replace commands." + :type 'symbol + :group 'visual-regexp) + +(defcustom vr/query-replace-to-history-variable query-replace-to-history-variable + "History list to use for the TO argument. The default is to use the same history as Emacs' query-replace commands." + :type 'symbol + :group 'visual-regexp) + +(defvar vr/initialize-hook nil + "Hook called before vr/replace and vr/query-replace") + +;;; private variables + +(defconst vr--match-faces '(vr/match-0 vr/match-1) + "Faces in list for convenience") + +(defconst vr--group-faces '(vr/group-0 vr/group-1 vr/group-2) + "Faces in list for convenience") + +(defconst vr--overlay-priority 1001 + "Starting priority of visual-regexp overlays.") + +(defvar vr--in-minibuffer nil + "Is visual-regexp currently being used?") + +(defvar vr--calling-func nil + "Which function invoked vr--interactive-get-args?") + +(defvar vr--last-minibuffer-contents nil + "Keeping track of minibuffer changes") + +(defvar vr--target-buffer-start nil + "Starting position in target buffer.") + +(defvar vr--target-buffer-end nil + "Ending position in target buffer.") + +(defvar vr--regexp-string nil + "Entered regexp.") + +(defvar vr--replace-string nil + "Entered replacement.") + +(defvar vr--feedback-limit nil + "Feedback limit currently in use.") + +(defvar vr--replace-preview nil + "Preview of replacement activated?") + +(defvar vr--target-buffer nil + "Buffer to which visual-regexp is applied to.") + +(defvar vr--overlays (make-hash-table :test 'equal) + "Overlays used in target buffer.") + +(defvar vr--visible-overlays (list) + "Overlays currently visible.") + +(defvar vr--minibuffer-message-overlay nil) + +;;; keymap + +(defvar vr/minibuffer-regexp-keymap + (let ((map (copy-keymap minibuffer-local-map))) + (define-key map (kbd "C-c ?") 'vr--minibuffer-help) + + (define-key map (kbd "C-c a") 'vr--shortcut-toggle-limit) + map) + "Keymap used while using visual-regexp,") + +(defvar vr/minibuffer-replace-keymap + (let ((map (copy-keymap minibuffer-local-map))) + (define-key map (kbd "C-c ?") 'vr--minibuffer-help) + (define-key map (kbd "C-c m") 'vr--shortcut-show-matches) + (define-key map (kbd "C-c p") 'vr--shortcut-toggle-preview) + + (define-key map (kbd "C-c a") 'vr--shortcut-toggle-limit) + map) + "Keymap used while using visual-regexp,") + +;;; helper functions + +(defun vr--shortcut-show-matches () + (interactive) + (vr--delete-overlay-displays) + ;; wait for any input to redisplay replacements + (sit-for 100000000 t) + (vr--do-replace-feedback)) + +(defun vr--shortcut-toggle-preview () + (interactive) + (setq vr--replace-preview (not vr--replace-preview)) + (vr--update-minibuffer-prompt) + (vr--do-replace-feedback)) + +(defun vr--shortcut-toggle-limit () + "Toggle the limit of overlays shown (default limit / no limit)" + (interactive) + (if vr--feedback-limit + (setq vr--feedback-limit nil) + (setq vr--feedback-limit vr/default-feedback-limit)) + (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp) + (vr--feedback)) + ((equal vr--in-minibuffer 'vr--minibuffer-replace) + (vr--feedback t) ;; update overlays + (vr--do-replace-feedback)))) + +(defun vr--get-regexp-string (&optional for-display) + (concat (if (equal vr--in-minibuffer 'vr--minibuffer-regexp) + (minibuffer-contents-no-properties) + vr--regexp-string))) + +(defun vr--format-error (err) + (if (eq (car err) 'error) + (car (cdr err)) + (format "%s" err))) + +;;; minibuffer functions + +(defun vr--minibuffer-set-prompt (prompt) + "Updates minibuffer prompt. Call when minibuffer is active." + (let ((inhibit-read-only t)) + (put-text-property (point-min) (minibuffer-prompt-end) 'display prompt))) + +(defun vr--set-minibuffer-prompt-regexp () + (cond ((equal vr--calling-func 'vr--calling-func-query-replace) + "Query regexp: ") + ((equal vr--calling-func 'vr--calling-func-mc-mark) + "Mark regexp: ") + (t + "Regexp: "))) + +(defun vr--set-minibuffer-prompt-replace () + (let (prefix) + (setq prefix (cond ((equal vr--calling-func 'vr--calling-func-query-replace) + "Query replace") + (t + "Replace"))) + + (concat prefix + (let ((flag-infos (mapconcat 'identity + (delq nil (list (when vr--replace-preview "preview"))) + ", "))) + (when (not (string= "" flag-infos )) + (format " (%s)" flag-infos))) + (format " %s" (vr--get-regexp-string t)) + " with: "))) + +(defun vr--update-minibuffer-prompt () + (when (and vr--in-minibuffer (minibufferp)) + (vr--minibuffer-set-prompt + (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp) + (vr--set-minibuffer-prompt-regexp)) + ((equal vr--in-minibuffer 'vr--minibuffer-replace) + (vr--set-minibuffer-prompt-replace)))))) + + +(defun vr--minibuffer-message (message &rest args) + "Adaptation of minibuffer-message that does not use sit-for +to make the message disappear. The problem with this was that during sit-for, + the cursor was shown at the beginning of the message regardless of whether + the point was actually there or not. Workaround: we let the message stay +visible all the time in the minibuffer." + (if (not (and vr--in-minibuffer (minibufferp (current-buffer)))) + ;; fallback + (apply 'minibuffer-message message args) + ;; Clear out any old echo-area message to make way for our new thing. + (message nil) + (setq message (concat " [" message "]")) + (when args (setq message (apply 'format message args))) + (unless (zerop (length message)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (put-text-property 0 1 'cursor t message)) + (unless (overlayp vr--minibuffer-message-overlay) + (setq vr--minibuffer-message-overlay (make-overlay (point-max) (point-max) nil t t))) + (move-overlay vr--minibuffer-message-overlay (point-max) (point-max)) + (overlay-put vr--minibuffer-message-overlay 'after-string message))) + +(defun vr/minibuffer-help-regexp () + (vr--minibuffer-message (format (substitute-command-keys "\\\\[vr--minibuffer-help]: helps \\[vr--shortcut-toggle-limit]: toggle show all")))) + +(defun vr/minibuffer-help-replace () + (vr--minibuffer-message (format (substitute-command-keys "\\\\[vr--minibuffer-help]: help \\[vr--shortcut-show-matches]: show matches/groups, \\[vr--shortcut-toggle-preview]: toggle preview, \\[vr--shortcut-toggle-limit]: toggle show all")))) + +(defun vr--minibuffer-help () + (interactive) + (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp) + (vr/minibuffer-help-regexp)) + ((equal vr--in-minibuffer 'vr--minibuffer-replace) + (vr/minibuffer-help-replace)))) + +;;; overlay functions + +(defun vr--get-overlay (i j) + "i: match index, j: submatch index" + (let (overlay) + (setq overlay (gethash (list i j) vr--overlays)) + (unless overlay ;; create new one if overlay does not exist yet + (setq overlay (make-overlay 0 0)) + (if (= 0 j) + (overlay-put overlay 'face (nth (mod i (length vr--match-faces)) vr--match-faces)) + (overlay-put overlay 'face (nth (mod j (length vr--group-faces)) vr--group-faces))) + (overlay-put overlay 'priority (+ vr--overlay-priority (if (= j 0) 0 1))) + (overlay-put overlay 'vr-ij (list i j)) + (puthash (list i j) overlay vr--overlays)) + overlay)) + +(defun vr--delete-overlays () + "Delete all visible overlays." + (mapc (lambda (overlay) + (delete-overlay overlay)) + vr--visible-overlays) + (setq vr--visible-overlays (list))) + +(defun vr--delete-overlay-display (overlay) + (overlay-put overlay 'display nil) + (overlay-put overlay 'after-string nil) + (overlay-put overlay 'priority vr--overlay-priority)) + +(defun vr--delete-overlay-displays () + "Delete the display of all visible overlays. Call before vr--delete-overlays." + (mapc (lambda (overlay) + (cl-multiple-value-bind (i j) (overlay-get overlay 'vr-ij) + (when (= 0 j) + (vr--delete-overlay-display overlay)))) + vr--visible-overlays)) + +;;; hooks + +(defun vr--update (beg end len) + (when (and vr--in-minibuffer (minibufferp)) + ;; minibuffer-up temporarily deletes minibuffer contents before inserting new one. + ;; don't do anything then as the messages shown by visual-regexp are irritating while browsing the history. + (unless (and (string= "" (minibuffer-contents-no-properties)) + (equal last-command 'previous-history-element)) + ;; do something when minibuffer contents changes + (unless (string= vr--last-minibuffer-contents (minibuffer-contents-no-properties)) + (setq vr--last-minibuffer-contents (minibuffer-contents-no-properties)) + ;; minibuffer contents has changed, update visual feedback. + ;; not using after-change-hook because this hook applies to the whole minibuffer, including minibuffer-messages + ;; that disappear after a while. + (cond ((equal vr--in-minibuffer 'vr--minibuffer-regexp) + (vr--feedback)) + ((equal vr--in-minibuffer 'vr--minibuffer-replace) + (vr--do-replace-feedback))))))) +(add-hook 'after-change-functions 'vr--update) + +(defun vr--minibuffer-setup () + "Setup prompt and help when entering minibuffer." + (when vr--in-minibuffer + (progn + (vr--update-minibuffer-prompt) + (when vr/auto-show-help (vr--minibuffer-help))))) +(add-hook 'minibuffer-setup-hook 'vr--minibuffer-setup) + +;;; helper functions + +(defun vr--target-window () + (if vr--target-buffer + (get-buffer-window vr--target-buffer) + nil)) + +(defun vr--compose-messages (&rest msgs) + (mapconcat 'identity (delq nil (mapcar (lambda (msg) (if (or (not msg) (string= "" msg)) nil msg)) msgs)) " - ")) + +;;; show feedback functions +(defun vr--feedback-function (forward feedback-limit callback) + "Feedback function for emacs-style regexp search" + (let ((message-line "") + (err)) + (with-current-buffer vr--target-buffer + (save-excursion + (goto-char (if forward vr--target-buffer-start vr--target-buffer-end)) + (let ((i 0) + (looping t)) + (while (and looping + (condition-case err + (if forward + (re-search-forward regexp-string vr--target-buffer-end t) + (re-search-backward regexp-string vr--target-buffer-start t)) + (invalid-regexp (progn (setq message-line (car (cdr err))) nil)))) + (when (or (not feedback-limit) (< i feedback-limit)) ;; let outer loop finish so we can get the matches count + (cl-loop for (start end) on (match-data) by 'cddr + for j from 0 + when (and start end) + do + (funcall callback i j start end))) + (when (= (match-beginning 0) (match-end 0)) + (cond ;; don't get stuck on zero-width matches + ((and forward (> vr--target-buffer-end (point))) (forward-char)) + ((and (not forward) (< vr--target-buffer-start (point))) (backward-char)) + (t (setq looping nil)))) + (setq i (1+ i))) + (if (string= "" message-line) + (setq message-line (format "%s matches" i)))))) + message-line)) + +(defun vr--feedback-match-callback (i j begin end) + (with-current-buffer vr--target-buffer + (save-excursion + (when (= 0 i) ;; make first match visible + (with-selected-window (vr--target-window) + (goto-char end))) + (let ((overlay (vr--get-overlay i j))) + (move-overlay overlay begin end vr--target-buffer) + (if (and (= 0 j) (= begin end)) ;; empty match; indicate by a pipe + (overlay-put overlay 'after-string (propertize "|" 'face (nth (mod i (length vr--match-faces)) vr--match-faces) 'help-echo "empty match")) + (overlay-put overlay 'after-string nil)) + (setq vr--visible-overlays (cons overlay vr--visible-overlays))) + ;; mark if we have reached the specified feedback limit + (when (and vr--feedback-limit (= vr--feedback-limit (1+ i)) ) + (setq limit-reached t))))) + +(defun vr--feedback (&optional inhibit-message) + "Show visual feedback for matches." + (vr--delete-overlays) + (let ((limit-reached nil) + message-line) + (setq message-line + (let ((regexp-string)) + (condition-case err + (progn + (setq regexp-string (vr--get-regexp-string)) + (vr--feedback-function t vr--feedback-limit 'vr--feedback-match-callback)) + (error (vr--format-error err))))) + (unless inhibit-message + (let ((msg (vr--compose-messages message-line (when limit-reached (format "%s matches shown, hit C-c a to show all" vr--feedback-limit))))) + (unless (string= "" msg) + (vr--minibuffer-message msg)))))) + +(defun vr--get-replacement (replacement match-data i) + (with-current-buffer vr--target-buffer + (let* + ;; emulate case-conversion of (perform-replace) + ((case-fold-search (if (and case-fold-search search-upper-case) + (ignore-errors (isearch-no-upper-case-p (vr--get-regexp-string) t)) + case-fold-search)) + (nocasify (not (and case-replace case-fold-search)))) + ;; we need to set the match data again, s.t. match-substitute-replacement works correctly. + ;; (match-data) could have been modified in the meantime, e.g. by vr--get-regexp-string->pcre-to-elisp. + (set-match-data match-data) + (if (stringp replacement) + (match-substitute-replacement replacement nocasify) + (match-substitute-replacement (funcall (car replacement) (cdr replacement) i) nocasify))))) + +(defun vr--do-replace-feedback-match-callback (replacement match-data i) + (let ((begin (cl-first match-data)) + (end (cl-second match-data)) + (replacement (vr--get-replacement replacement match-data i))) + (let* ((overlay (vr--get-overlay i 0)) + (empty-match (= begin end))) + (move-overlay overlay begin end vr--target-buffer) + (vr--delete-overlay-display overlay) + (let ((current-face (nth (mod i (length vr--match-faces)) vr--match-faces))) + (if (or empty-match vr--replace-preview) + (progn + (overlay-put overlay (if empty-match 'after-string 'display) (propertize replacement 'face current-face)) + (overlay-put overlay 'priority (+ vr--overlay-priority 2))) + (progn + (overlay-put overlay 'after-string + (concat (propertize vr/match-separator-string 'face + (if vr/match-separator-use-custom-face + 'vr/match-separator-face + current-face)) + (propertize replacement 'face current-face))) + (overlay-put overlay 'priority (+ vr--overlay-priority 0)))))))) + +(defun vr--get-replacements (feedback feedback-limit) + "Get replacements using emacs-style regexp." + (let ((regexp-string) + (message-line "") + (i 0) + (limit-reached nil) + (replacements (list)) + (err) + (buffer-contents (with-current-buffer vr--target-buffer + (buffer-substring-no-properties (point-min) (point-max))))) + + (condition-case err + (progn + ;; can signal invalid-regexp + (setq regexp-string (vr--get-regexp-string)) + + (with-current-buffer vr--target-buffer + (goto-char vr--target-buffer-start) + (let ((looping t)) + (while (and + looping + (condition-case err + (re-search-forward regexp-string vr--target-buffer-end t) + ('invalid-regexp (progn (setq message-line (car (cdr err))) nil)))) + (condition-case err + (progn + (if (or (not feedback) (not feedback-limit) (< i feedback-limit)) + (setq replacements (cons + (let ((match-data (mapcar 'marker-position (match-data)))) + (list (query-replace-compile-replacement replace-string t) match-data i)) + replacements)) + (setq limit-reached t)) + (when (= (match-beginning 0) (match-end 0)) + (if (> vr--target-buffer-end (point)) + (forward-char) ;; don't get stuck on zero-width matches + (setq looping nil))) + (setq i (1+ i))) + ('error (progn + (setq message-line (vr--format-error err)) + (setq replacements (list)) + (setq looping nil)))))))) + (invalid-regexp (setq message-line (car (cdr err)))) + (error (setq message-line (vr--format-error err)))) + (if feedback + (if (string= "" message-line) + (setq message-line (vr--compose-messages (format "%s matches" i) (when limit-reached (format "%s matches shown, hit C-c a to show all" feedback-limit))))) + (setq message-line (format "replaced %d matches" i))) + (list replacements message-line))) + +(defun vr--do-replace-feedback () + "Show visual feedback for replacements." + (vr--feedback t) ;; only really needed when regexp has not been changed from default (=> no overlays have been created) + (let ((replace-string (minibuffer-contents-no-properties))) + (cl-multiple-value-bind (replacements message-line) (vr--get-replacements t vr--feedback-limit) + ;; visual feedback for matches + (condition-case err + (mapc (lambda (replacement-info) (apply 'vr--do-replace-feedback-match-callback replacement-info)) replacements) + ('error (setq message-line (vr--format-error err)))) + (unless (string= "" message-line) + (vr--minibuffer-message message-line))))) + +;;; vr/replace + +(defun vr--do-replace (&optional silent) + "Replace matches." + (vr--delete-overlay-displays) + (vr--delete-overlays) + (let ((replace-string vr--replace-string)) + (cl-multiple-value-bind (replacements message-line) (vr--get-replacements nil nil) + (let ((replace-count 0) + (cumulative-offset 0) + last-match-data) + (cl-loop for replacement-info in replacements + for counter from 0 do + (setq replace-count (1+ replace-count)) + (cl-multiple-value-bind (replacement match-data i) replacement-info + ;; replace match + (let* ((replacement (vr--get-replacement replacement match-data i)) + (begin (cl-first match-data)) + (end (cl-second match-data))) + (with-current-buffer vr--target-buffer + (save-excursion + ;; first insert, then delete + ;; this ensures that if we had an active region before, the replaced match is still part of the region + (goto-char begin) + (insert replacement) + (setq cumulative-offset (+ cumulative-offset (- (point) end))) + (delete-char (- end begin)))) + (when (= 0 counter) + (setq last-match-data match-data)) + ))) + (unless (or silent (string= "" message-line)) + (vr--minibuffer-message message-line)) + ;; needed to correctly position the mark after query replace (finished with 'automatic ('!')) + (set-match-data (mapcar (lambda (el) (+ cumulative-offset el)) last-match-data)) + replace-count)))) + +(defun vr--interactive-get-args (mode calling-func) + "Get interactive args for the vr/replace and vr/query-replace functions." + (unwind-protect + (progn + (let ((buffer-read-only t)) ;; make target buffer + (when vr--in-minibuffer (error "visual-regexp already in use.")) + (setq vr--calling-func calling-func) + (setq vr--target-buffer (current-buffer)) + (setq vr--target-buffer-start (if (region-active-p) + (region-beginning) + (point))) + (setq vr--target-buffer-end (if (region-active-p) + (region-end) + (point-max))) + + (run-hooks 'vr/initialize-hook) + (setq vr--feedback-limit vr/default-feedback-limit) + + (setq vr--replace-preview vr/default-replace-preview) + + (save-excursion + ;; deactivate mark so that we can see our faces instead of region-face. + (deactivate-mark) + (progn + (setq vr--in-minibuffer 'vr--minibuffer-regexp) + (setq vr--last-minibuffer-contents "") + (setq vr--regexp-string + (read-from-minibuffer + " " ;; prompt will be set in vr--minibuffer-setup + nil vr/minibuffer-regexp-keymap + nil vr/query-replace-from-history-variable)) + ;;(setq vr--regexp-string (format "%s%s" (vr--get-regexp-modifiers-prefix) vr--regexp-string)) + + (when (equal mode 'vr--mode-regexp-replace) + (setq vr--in-minibuffer 'vr--minibuffer-replace) + (setq vr--last-minibuffer-contents "") + (setq vr--replace-string + (read-from-minibuffer + " " ;; prompt will be set in vr--minibuffer-setup + nil vr/minibuffer-replace-keymap + nil vr/query-replace-to-history-variable))))) + ;; Successfully got the args, deactivate mark now. If the command was aborted (C-g), the mark (region) would remain active. + (deactivate-mark) + (cond ((equal mode 'vr--mode-regexp-replace) + (list vr--regexp-string + vr--replace-string + vr--target-buffer-start + vr--target-buffer-end)) + ((equal mode 'vr--mode-regexp) + (list vr--regexp-string + vr--target-buffer-start + vr--target-buffer-end))))) + (progn ;; execute on finish + (setq vr--in-minibuffer nil) + (setq vr--calling-func nil) + (unless (overlayp vr--minibuffer-message-overlay) + (delete-overlay vr--minibuffer-message-overlay)) + (vr--delete-overlay-displays) + (vr--delete-overlays)))) + +(add-hook 'multiple-cursors-mode-enabled-hook + ;; run vr/mc-mark once per cursor by default (do not ask the user) + (lambda () + (when (boundp 'mc--default-cmds-to-run-once) + (add-to-list 'mc--default-cmds-to-run-once 'vr/mc-mark)))) + +;;;###autoload +(defun vr/mc-mark (regexp start end) + "Convert regexp selection to multiple cursors." + (require 'multiple-cursors) + (interactive + (vr--interactive-get-args 'vr--mode-regexp 'vr--calling-func-mc-mark)) + (with-current-buffer vr--target-buffer + (mc/remove-fake-cursors) + (activate-mark) + (let ((regexp-string (vr--get-regexp-string)) + ;; disable deactivating of mark after buffer-editing commands + ;; (which happens for example in visual-regexp-steroids/vr--parse-matches + ;; during the callback). + (deactivate-mark nil) + (first-fake-cursor nil)) + (vr--feedback-function t nil (lambda (i j begin end) + (with-current-buffer vr--target-buffer + (goto-char end) + (push-mark begin) + ;; temporarily enable transient mark mode + (activate-mark) + (let ((fc (mc/create-fake-cursor-at-point))) + (unless first-fake-cursor + (setq first-fake-cursor fc)))))) + + ;; one fake cursor too many, replace first one with + ;; the regular cursor. + (when first-fake-cursor + (mc/pop-state-from-overlay first-fake-cursor))) + (mc/maybe-multiple-cursors-mode))) + +;;;###autoload +(defun vr/replace (regexp replace start end) + "Regexp-replace with live visual feedback." + (interactive + (vr--interactive-get-args 'vr--mode-regexp-replace 'vr--calling-func-replace)) + (unwind-protect + (progn + (when vr--in-minibuffer (error "visual-regexp already in use.")) + (setq vr--target-buffer (current-buffer) + vr--target-buffer-start start + vr--target-buffer-end end + vr--regexp-string regexp + vr--replace-string replace) + ;; do replacement + (vr--do-replace)) + ;; execute on finish + (setq vr--in-minibuffer nil))) + +;; query-replace-regexp starts here + +(defvar vr--query-replacements nil) +;; we redefine the help text from replace.el to remove the commands we don't support. + +(defconst vr--query-replace-help + "Type Space or `y' to replace one match, Delete or `n' to skip to next, +RET or `q' to exit, Period to replace one match and exit, +Comma to replace but not move point immediately, +p to preview the replacement (like 'C-c p' during construction of the regexp), +C-r [not supported in visual-regexp], +C-w [not supported in visual-regexp], +C-l to clear the screen, redisplay, and offer same replacement again, +! to replace all remaining matches with no more questions, +^ [not supported in visual-regexp], +E [not supported in visual-regexp]" + "Help message while in `vr/query-replace'.") + +(defvar vr--query-replace-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map query-replace-map) + ;; the following replace.el commands are not supported by visual-regexp. + (define-key map "e" nil) + (define-key map "E" nil) + (define-key map "\C-r" nil) + (define-key map "\C-w" nil) + (define-key map "^" nil) + (define-key map "p" 'toggle-preview) + map + )) + +;;;###autoload +(defun vr/query-replace (regexp replace start end) + "Use vr/query-replace like you would use query-replace-regexp." + (interactive + (vr--interactive-get-args 'vr--mode-regexp-replace 'vr--calling-func-query-replace)) + (unwind-protect + (progn + (when vr--in-minibuffer (error "visual-regexp already in use.")) + (setq vr--target-buffer (current-buffer) + vr--target-buffer-start start + vr--target-buffer-end end + vr--regexp-string regexp + vr--replace-string replace) + (let ((replace-string vr--replace-string)) + (setq vr--query-replacements (nreverse (car (vr--get-replacements nil nil))))) + (vr--perform-query-replace regexp nil)) + ;; execute on finish + (setq vr--in-minibuffer nil))) + +(defun vr--perform-query-replace (from-string &optional map) + ;; This function is a heavily modified version of (perform-replace) from replace.el. + ;; The original plan was to use the original perform-replace, but various issues stood in the way. + (or map (setq map vr--query-replace-map)) + (and minibuffer-auto-raise + (raise-frame (window-frame (minibuffer-window)))) + (let* ((next-replacement nil) ;; replacement string for current match + (keep-going t) + (replace-count 0) + ;; a match can be replaced by a longer/shorter replacement. cumulate the difference + (cumulative-offset 0) + (recenter-last-op nil) ; Start cycling order with initial position. + (message + (apply 'propertize + (substitute-command-keys + "Query replacing %s with %s: (\\\\[help] for help) ") + minibuffer-prompt-properties))) + + ;; show visual feedback for all matches + (mapc (lambda (replacement-info) + (cl-multiple-value-bind (replacement match-data i) replacement-info + (vr--feedback-match-callback i 0 (cl-first match-data) (cl-second match-data)))) + vr--query-replacements) + + (goto-char vr--target-buffer-start) + (push-mark) + (undo-boundary) + (unwind-protect + ;; Loop finding occurrences that perhaps should be replaced. + (while (and keep-going vr--query-replacements) + ;; Advance replacement list + (cl-multiple-value-bind (replacement match-data i) (car vr--query-replacements) + (setq match-data (mapcar (lambda (el) (+ cumulative-offset el)) match-data)) + (let ((begin (cl-first match-data)) + (end (cl-second match-data))) + (setq next-replacement-orig replacement) + (setq next-replacement (vr--get-replacement replacement match-data replace-count)) + (goto-char begin) + (setq vr--query-replacements (cdr vr--query-replacements)) + + ;; default for new occurrence: no preview + (setq vr--replace-preview nil) + + (undo-boundary) + (let (done replaced key def) + ;; Loop reading commands until one of them sets done, + ;; which means it has finished handling this + ;; occurrence. + (while (not done) + ;; show replacement feedback for current occurrence + (unless replaced + (vr--do-replace-feedback-match-callback next-replacement-orig match-data i)) + ;; Bind message-log-max so we don't fill up the message log + ;; with a bunch of identical messages. + (let ((message-log-max nil)) + (message message from-string next-replacement)) + (setq key (read-event)) + (setq key (vector key)) + (setq def (lookup-key map key)) + + ;; can use replace-match afterwards + (set-match-data match-data) + + ;; Restore the match data while we process the command. + (cond ((eq def 'help) + (with-output-to-temp-buffer "*Help*" + (princ + (concat "Query replacing visual-regexp " + from-string " with " + next-replacement ".\n\n" + (substitute-command-keys + vr--query-replace-help))) + (with-current-buffer standard-output + (help-mode)))) + ((eq def 'exit) + (setq keep-going nil + done t)) + ((eq def 'act) + (unless replaced + (replace-match next-replacement t t) + (setq replace-count (1+ replace-count))) + (setq done t + replaced t)) + ((eq def 'act-and-exit) + (unless replaced + (replace-match next-replacement t t) + (setq replace-count (1+ replace-count))) + (setq keep-going nil + done t + replaced t)) + ((eq def 'act-and-show) + (unless replaced + (replace-match next-replacement t t) + (setq replace-count (1+ replace-count)) + (setq replaced t))) + ((eq def 'toggle-preview) + (setq vr--replace-preview (not vr--replace-preview))) + ((eq def 'automatic) + (setq vr--target-buffer-start (match-beginning 0) + vr--target-buffer-end (+ cumulative-offset vr--target-buffer-end)) + (setq replace-count (+ replace-count (vr--do-replace t))) + (setq done t + replaced t + keep-going nil)) + ((eq def 'skip) + (setq done t)) + ((eq def 'recenter) + ;; `this-command' has the value `query-replace', + ;; so we need to bind it to `recenter-top-bottom' + ;; to allow it to detect a sequence of `C-l'. + (let ((this-command 'recenter-top-bottom) + (last-command 'recenter-top-bottom)) + (recenter-top-bottom))) + (t + (setq this-command 'mode-exited) + (setq keep-going nil) + (setq unread-command-events + (append (listify-key-sequence key) + unread-command-events)) + (setq done t))) + (when replaced + (setq cumulative-offset (+ cumulative-offset (- (length next-replacement) (- end begin))))) + (unless (eq def 'recenter) + ;; Reset recenter cycling order to initial position. + (setq recenter-last-op nil)) + ;; in case of 'act-and-show: delete overlay display or it will still be + ;; visible even though the replacement has been made + (when replaced (vr--delete-overlay-display (vr--get-overlay i 0))))) + + ;; occurrence has been handled + ;; delete feedback overlay + (delete-overlay (vr--get-overlay i 0))))) + + ;; unwind + (progn + (vr--delete-overlay-displays) + (vr--delete-overlays) + ;; (replace-dehighlight) + )) + (unless unread-command-events + ;; point is set to the end of the last occurrence. + (goto-char (match-end 0)) + (message "Replaced %d occurrence%s" + replace-count + (if (= replace-count 1) "" "s"))))) + +(provide 'visual-regexp) + +;;; visual-regexp.el ends here diff --git a/htmlize.el b/htmlize.el deleted file mode 100644 index f613cfaa..00000000 --- a/htmlize.el +++ /dev/null @@ -1,1932 +0,0 @@ -;;; htmlize.el --- Convert buffer text and decorations to HTML. - -;; Copyright (C) 1997-2003,2005,2006,2009,2011,2012 Hrvoje Niksic - -;; Author: Hrvoje Niksic -;; Keywords: hypermedia, extensions -;; Version: 1.47 - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package converts the buffer text and the associated -;; decorations to HTML. Mail to to discuss -;; features and additions. All suggestions are more than welcome. - -;; To use it, just switch to the buffer you want HTML-ized and type -;; `M-x htmlize-buffer'. You will be switched to a new buffer that -;; contains the resulting HTML code. You can edit and inspect this -;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file' -;; will find a file, fontify it, and save the HTML version in -;; FILE.html, without any additional intervention. `M-x -;; htmlize-many-files' allows you to htmlize any number of files in -;; the same manner. `M-x htmlize-many-files-dired' does the same for -;; files marked in a dired buffer. - -;; htmlize supports three types of HTML output, selected by setting -;; `htmlize-output-type': `css', `inline-css', and `font'. In `css' -;; mode, htmlize uses cascading style sheets to specify colors; it -;; generates classes that correspond to Emacs faces and uses ... to color parts of text. In this mode, the -;; produced HTML is valid under the 4.01 strict DTD, as confirmed by -;; the W3C validator. `inline-css' is like `css', except the CSS is -;; put directly in the STYLE attribute of the SPAN element, making it -;; possible to paste the generated HTML into existing HTML documents. -;; In `font' mode, htmlize uses ... to -;; colorize HTML, which is not standard-compliant, but works better in -;; older browsers. `css' mode is the default. - -;; You can also use htmlize from your Emacs Lisp code. When called -;; non-interactively, `htmlize-buffer' and `htmlize-region' will -;; return the resulting HTML buffer, but will not change current -;; buffer or move the point. htmlize will do its best to work on -;; non-windowing Emacs sessions but the result will be limited to -;; colors supported by the terminal. - -;; htmlize aims for compatibility with Emacsen version 21 and later. -;; Please let me know if it doesn't work on the version of XEmacs or -;; GNU Emacs that you are using. The package relies on the presence -;; of CL extensions, especially for cross-emacs compatibility; please -;; don't try to remove that dependency. I see no practical problems -;; with using the full power of the CL extensions, except that one -;; might learn to like them too much. - -;; The latest version is available as a git repository at: -;; -;; -;; -;; The snapshot of the latest release can be obtained at: -;; -;; -;; -;; You can find a sample of htmlize's output (possibly generated with -;; an older version) at: -;; -;; - -;; Thanks go to the many people who have sent reports and contributed -;; comments, suggestions, and fixes. They include Ron Gut, Bob -;; Weiner, Toni Drabik, Peter Breton, Ville Skytta, Thomas Vogels, -;; Juri Linkov, Maciek Pasternacki, and many others. - -;; User quotes: "You sir, are a sick, sick, _sick_ person. :)" -;; -- Bill Perry, author of Emacs/W3 - - -;;; Code: - -(require 'cl) -(eval-when-compile - (defvar unresolved) - (if (string-match "XEmacs" emacs-version) - (byte-compiler-options - (warnings (- unresolved)))) - (defvar font-lock-auto-fontify) - (defvar font-lock-support-mode) - (defvar global-font-lock-mode)) - -(defconst htmlize-version "1.47") - -(defgroup htmlize nil - "Convert buffer text and faces to HTML." - :group 'hypermedia) - -(defcustom htmlize-head-tags "" - "Additional tags to insert within HEAD of the generated document." - :type 'string - :group 'htmlize) - -(defcustom htmlize-output-type 'css - "Output type of generated HTML, one of `css', `inline-css', or `font'. -When set to `css' (the default), htmlize will generate a style sheet -with description of faces, and use it in the HTML document, specifying -the faces in the actual text with . - -When set to `inline-css', the style will be generated as above, but -placed directly in the STYLE attribute of the span ELEMENT: . This makes it easier to paste the resulting HTML to -other documents. - -When set to `font', the properties will be set using layout tags -, , , , and . - -`css' output is normally preferred, but `font' is still useful for -supporting old, pre-CSS browsers, and both `inline-css' and `font' for -easier embedding of colorized text in foreign HTML documents (no style -sheet to carry around)." - :type '(choice (const css) (const inline-css) (const font)) - :group 'htmlize) - -(defcustom htmlize-use-images t - "Whether htmlize generates `img' for images attached to buffer contents." - :type 'boolean - :group 'htmlize) - -(defcustom htmlize-force-inline-images nil - "Non-nil means generate all images inline using data URLs. -Normally htmlize converts image descriptors with :file properties to -relative URIs, and those with :data properties to data URIs. With this -flag set, the images specified as a file name are loaded into memory and -embedded in the HTML as data URIs." - :type 'boolean - :group 'htmlize) - -(defcustom htmlize-max-alt-text 100 - "Maximum size of text to use as ALT text in images. - -Normally when htmlize encounters text covered by the `display' property -that specifies an image, it generates an `alt' attribute containing the -original text. If the text is larger than `htmlize-max-alt-text' characters, -this will not be done.") - -(defcustom htmlize-transform-image 'htmlize-default-transform-image - "Function called to modify the image descriptor. - -The function is called with the image descriptor found in the buffer and -the text the image is supposed to replace. It should return a (possibly -different) image descriptor property list or a replacement string to use -instead of of the original buffer text. - -Returning nil is the same as returning the original text." - :type 'boolean - :group 'htmlize) - -(defcustom htmlize-generate-hyperlinks t - "Non-nil means auto-generate the links from URLs and mail addresses in buffer. - -This is on by default; set it to nil if you don't want htmlize to -autogenerate such links. Note that this option only turns off automatic -search for contents that looks like URLs and converting them to links. -It has no effect on whether htmlize respects the `htmlize-link' property." - :type 'boolean - :group 'htmlize) - -(defcustom htmlize-hyperlink-style " - a { - color: inherit; - background-color: inherit; - font: inherit; - text-decoration: inherit; - } - a:hover { - text-decoration: underline; - } -" - "The CSS style used for hyperlinks when in CSS mode." - :type 'string - :group 'htmlize) - -(defcustom htmlize-replace-form-feeds t - "Non-nil means replace form feeds in source code with HTML separators. -Form feeds are the ^L characters at line beginnings that are sometimes -used to separate sections of source code. If this variable is set to -`t', form feed characters are replaced with the
separator. If this -is a string, it specifies the replacement to use. Note that 
 is
-temporarily closed before the separator is inserted, so the default
-replacement is effectively \"
\".  If you specify
-another replacement, don't forget to close and reopen the 
 if you
-want the output to remain valid HTML.
-
-If you need more elaborate processing, set this to nil and use
-htmlize-after-hook."
-  :type 'boolean
-  :group 'htmlize)
-
-(defcustom htmlize-html-charset nil
-  "The charset declared by the resulting HTML documents.
-When non-nil, causes htmlize to insert the following in the HEAD section
-of the generated HTML:
-
-  
-
-where CHARSET is the value you've set for htmlize-html-charset.  Valid
-charsets are defined by MIME and include strings like \"iso-8859-1\",
-\"iso-8859-15\", \"utf-8\", etc.
-
-If you are using non-Latin-1 charsets, you might need to set this for
-your documents to render correctly.  Also, the W3C validator requires
-submitted HTML documents to declare a charset.  So if you care about
-validation, you can use this to prevent the validator from bitching.
-
-Needless to say, if you set this, you should actually make sure that
-the buffer is in the encoding you're claiming it is in.  (This is
-normally achieved by using the correct file coding system for the
-buffer.)  If you don't understand what that means, you should probably
-leave this option in its default setting."
-  :type '(choice (const :tag "Unset" nil)
-		 string)
-  :group 'htmlize)
-
-(defcustom htmlize-convert-nonascii-to-entities t
-  "Whether non-ASCII characters should be converted to HTML entities.
-
-When this is non-nil, characters with codes in the 128-255 range will be
-considered Latin 1 and rewritten as \"&#CODE;\".  Characters with codes
-above 255 will be converted to \"&#UCS;\", where UCS denotes the Unicode
-code point of the character.  If the code point cannot be determined,
-the character will be copied unchanged, as would be the case if the
-option were nil.
-
-When the option is nil, the non-ASCII characters are copied to HTML
-without modification.  In that case, the web server and/or the browser
-must be set to understand the encoding that was used when saving the
-buffer.  (You might also want to specify it by setting
-`htmlize-html-charset'.)
-
-Note that in an HTML entity \"&#CODE;\", CODE is always a UCS code point,
-which has nothing to do with the charset the page is in.  For example,
-\"©\" *always* refers to the copyright symbol, regardless of charset
-specified by the META tag or the charset sent by the HTTP server.  In
-other words, \"©\" is exactly equivalent to \"©\".
-
-For most people htmlize will work fine with this option left at the
-default setting; don't change it unless you know what you're doing."
-  :type 'sexp
-  :group 'htmlize)
-
-(defcustom htmlize-ignore-face-size 'absolute
-  "Whether face size should be ignored when generating HTML.
-If this is nil, face sizes are used.  If set to t, sizes are ignored
-If set to `absolute', only absolute size specifications are ignored.
-Please note that font sizes only work with CSS-based output types."
-  :type '(choice (const :tag "Don't ignore" nil)
-		 (const :tag "Ignore all" t)
-		 (const :tag "Ignore absolute" absolute))
-  :group 'htmlize)
-
-(defcustom htmlize-css-name-prefix ""
-  "The prefix used for CSS names.
-The CSS names that htmlize generates from face names are often too
-generic for CSS files; for example, `font-lock-type-face' is transformed
-to `type'.  Use this variable to add a prefix to the generated names.
-The string \"htmlize-\" is an example of a reasonable prefix."
-  :type 'string
-  :group 'htmlize)
-
-(defcustom htmlize-use-rgb-txt t
-  "Whether `rgb.txt' should be used to convert color names to RGB.
-
-This conversion means determining, for instance, that the color
-\"IndianRed\" corresponds to the (205, 92, 92) RGB triple.  `rgb.txt'
-is the X color database that maps hundreds of color names to such RGB
-triples.  When this variable is non-nil, `htmlize' uses `rgb.txt' to
-look up color names.
-
-If this variable is nil, htmlize queries Emacs for RGB components of
-colors using `color-instance-rgb-components' and `color-values'.
-This can yield incorrect results on non-true-color displays.
-
-If the `rgb.txt' file is not found (which will be the case if you're
-running Emacs on non-X11 systems), this option is ignored."
-  :type 'boolean
-  :group 'htmlize)
-
-(defcustom htmlize-html-major-mode nil
-  "The mode the newly created HTML buffer will be put in.
-Set this to nil if you prefer the default (fundamental) mode."
-  :type '(radio (const :tag "No mode (fundamental)" nil)
-		 (function-item html-mode)
-		 (function :tag "User-defined major mode"))
-  :group 'htmlize)
-
-(defvar htmlize-before-hook nil
-  "Hook run before htmlizing a buffer.
-The hook functions are run in the source buffer (not the resulting HTML
-buffer).")
-
-(defvar htmlize-after-hook nil
-  "Hook run after htmlizing a buffer.
-Unlike `htmlize-before-hook', these functions are run in the generated
-HTML buffer.  You may use them to modify the outlook of the final HTML
-output.")
-
-(defvar htmlize-file-hook nil
-  "Hook run by `htmlize-file' after htmlizing a file, but before saving it.")
-
-(defvar htmlize-buffer-places)
-
-;;; Some cross-Emacs compatibility.
-
-;; I try to conditionalize on features rather than Emacs version, but
-;; in some cases checking against the version *is* necessary.
-(defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version))
-
-;; We need a function that efficiently finds the next change of a
-;; property regardless of whether the change occurred because of a
-;; text property or an extent/overlay.
-(cond
- (htmlize-running-xemacs
-  (defun htmlize-next-change (pos prop &optional limit)
-    (if prop
-        (next-single-char-property-change pos prop nil (or limit (point-max)))
-      (next-property-change pos nil (or limit (point-max)))))
-  (defun htmlize-next-face-change (pos &optional limit)
-    (htmlize-next-change pos 'face limit)))
- (t
-  (defun htmlize-next-change (pos prop &optional limit)
-    (if prop
-        (next-single-char-property-change pos prop nil limit)
-      (next-char-property-change pos limit)))
-  (defun htmlize-overlay-faces-at (pos)
-    (delq nil (mapcar (lambda (o) (overlay-get o 'face)) (overlays-at pos))))
-  (defun htmlize-next-face-change (pos &optional limit)
-    ;; (htmlize-next-change pos 'face limit) would skip over entire
-    ;; overlays that specify the `face' property, even when they
-    ;; contain smaller text properties that also specify `face'.
-    ;; Emacs display engine merges those faces, and so must we.
-    (or limit
-        (setq limit (point-max)))
-    (let ((next-prop (next-single-property-change pos 'face nil limit))
-          (overlay-faces (htmlize-overlay-faces-at pos)))
-      (while (progn
-               (setq pos (next-overlay-change pos))
-               (and (< pos next-prop)
-                    (equal overlay-faces (htmlize-overlay-faces-at pos)))))
-      (setq pos (min pos next-prop))
-      ;; Additionally, we include the entire region that specifies the
-      ;; `display' property.
-      (when (get-char-property pos 'display)
-        (setq pos (next-single-char-property-change pos 'display nil limit)))
-      pos)))
- (t
-  (error "htmlize requires next-single-property-change or \
-next-single-char-property-change")))
-
-(defmacro htmlize-lexlet (&rest letforms)
-  (declare (indent 1) (debug let))
-  (if (and (boundp 'lexical-binding)
-           lexical-binding)
-      `(let ,@letforms)
-    ;; cl extensions have a macro implementing lexical let
-    `(lexical-let ,@letforms)))
-
-;; Simple overlay emulation for XEmacs
-
-(cond
- (htmlize-running-xemacs
-  (defalias 'htmlize-make-overlay 'make-extent)
-  (defalias 'htmlize-overlay-put 'set-extent-property)
-  (defalias 'htmlize-overlay-get 'extent-property)
-  (defun htmlize-overlays-in (beg end) (extent-list nil beg end))
-  (defalias 'htmlize-delete-overlay 'detach-extent))
- (t
-  (defalias 'htmlize-make-overlay 'make-overlay)
-  (defalias 'htmlize-overlay-put 'overlay-put)
-  (defalias 'htmlize-overlay-get 'overlay-get)
-  (defalias 'htmlize-overlays-in 'overlays-in)
-  (defalias 'htmlize-delete-overlay 'delete-overlay)))
-
-
-;;; Transformation of buffer text: HTML escapes, untabification, etc.
-
-(defvar htmlize-basic-character-table
-  ;; Map characters in the 0-127 range to either one-character strings
-  ;; or to numeric entities.
-  (let ((table (make-vector 128 ?\0)))
-    ;; Map characters in the 32-126 range to themselves, others to
-    ;; &#CODE entities;
-    (dotimes (i 128)
-      (setf (aref table i) (if (and (>= i 32) (<= i 126))
-			       (char-to-string i)
-			     (format "&#%d;" i))))
-    ;; Set exceptions manually.
-    (setf
-     ;; Don't escape newline, carriage return, and TAB.
-     (aref table ?\n) "\n"
-     (aref table ?\r) "\r"
-     (aref table ?\t) "\t"
-     ;; Escape &, <, and >.
-     (aref table ?&) "&"
-     (aref table ?<) "<"
-     (aref table ?>) ">"
-     ;; Not escaping '"' buys us a measurable speedup.  It's only
-     ;; necessary to quote it for strings used in attribute values,
-     ;; which htmlize doesn't typically do.
-     ;(aref table ?\") """
-     )
-    table))
-
-;; A cache of HTML representation of non-ASCII characters.  Depending
-;; on the setting of `htmlize-convert-nonascii-to-entities', this maps
-;; non-ASCII characters to either "&#;" or "" (mapconcat's
-;; mapper must always return strings).  It's only filled as characters
-;; are encountered, so that in a buffer with e.g. French text, it will
-;; only ever contain French accented characters as keys.  It's cleared
-;; on each entry to htmlize-buffer-1 to allow modifications of
-;; `htmlize-convert-nonascii-to-entities' to take effect.
-(defvar htmlize-extended-character-cache (make-hash-table :test 'eq))
-
-(defun htmlize-protect-string (string)
-  "HTML-protect string, escaping HTML metacharacters and I18N chars."
-  ;; Only protecting strings that actually contain unsafe or non-ASCII
-  ;; chars removes a lot of unnecessary funcalls and consing.
-  (if (not (string-match "[^\r\n\t -%'-;=?-~]" string))
-      string
-    (mapconcat (lambda (char)
-		 (cond
-		  ((< char 128)
-		   ;; ASCII: use htmlize-basic-character-table.
-		   (aref htmlize-basic-character-table char))
-		  ((gethash char htmlize-extended-character-cache)
-		   ;; We've already seen this char; return the cached
-		   ;; string.
-		   )
-		  ((not htmlize-convert-nonascii-to-entities)
-		   ;; If conversion to entities is not desired, always
-		   ;; copy the char literally.
-		   (setf (gethash char htmlize-extended-character-cache)
-			 (char-to-string char)))
-		  ((< char 256)
-		   ;; Latin 1: no need to call encode-char.
-		   (setf (gethash char htmlize-extended-character-cache)
-			 (format "&#%d;" char)))
-		  ((encode-char char 'ucs)
-                   ;; Must check if encode-char works for CHAR;
-                   ;; it fails for Arabic and possibly elsewhere.
-		   (setf (gethash char htmlize-extended-character-cache)
-			 (format "&#%d;" (encode-char char 'ucs))))
-		  (t
-		   ;; encode-char doesn't work for this char.  Copy it
-		   ;; unchanged and hope for the best.
-		   (setf (gethash char htmlize-extended-character-cache)
-			 (char-to-string char)))))
-	       string "")))
-
-(defun htmlize-attr-escape (string)
-  ;; Like htmlize-protect-string, but also escapes double-quoted
-  ;; strings to make it usable in attribute values.
-  (setq string (htmlize-protect-string string))
-  (if (not (string-match "\"" string))
-      string
-    (mapconcat (lambda (char)
-                 (if (eql char ?\")
-                     """
-                   (char-to-string char)))
-               string "")))
-
-(defsubst htmlize-concat (list)
-  (if (and (consp list) (null (cdr list)))
-      ;; Don't create a new string in the common case where the list only
-      ;; consists of one element.
-      (car list)
-    (apply #'concat list)))
-
-(defun htmlize-format-link (linkprops text)
-  (let ((uri (if (stringp linkprops)
-                 linkprops
-               (plist-get linkprops :uri)))
-        (escaped-text (htmlize-protect-string text)))
-    (if uri
-        (format "%s" (htmlize-attr-escape uri) escaped-text)
-      escaped-text)))
-
-(defun htmlize-escape-or-link (string)
-  ;; Escape STRING and/or add hyperlinks.  STRING comes from a
-  ;; `display' property.
-  (let ((pos 0) (end (length string)) outlist)
-    (while (< pos end)
-      (let* ((link (get-char-property pos 'htmlize-link string))
-             (next-link-change (next-single-property-change
-                                pos 'htmlize-link string end))
-             (chunk (substring string pos next-link-change)))
-        (push
-         (cond (link
-                (htmlize-format-link link chunk))
-               ((get-char-property 0 'htmlize-literal chunk)
-                chunk)
-               (t
-                (htmlize-protect-string chunk)))
-         outlist)
-        (setq pos next-link-change)))
-    (htmlize-concat (nreverse outlist))))
-
-(defun htmlize-display-prop-to-html (display text)
-  (let (desc)
-    (cond ((stringp display)
-           ;; Emacs ignores recursive display properties.
-           (htmlize-escape-or-link display))
-          ((not (eq (car-safe display) 'image))
-           (htmlize-protect-string text))
-          ((null (setq desc (funcall htmlize-transform-image
-                                     (cdr display) text)))
-           (htmlize-escape-or-link text))
-          ((stringp desc)
-           (htmlize-escape-or-link desc))
-          (t
-           (htmlize-generate-image desc text)))))
-
-(defun htmlize-string-to-html (string)
-  ;; Convert the string to HTML, including images attached as
-  ;; `display' property and links as `htmlize-link' property.  In a
-  ;; string without images or links, this is equivalent to
-  ;; `htmlize-protect-string'.
-  (let ((pos 0) (end (length string)) outlist)
-    (while (< pos end)
-      (let* ((display (get-char-property pos 'display string))
-             (next-display-change (next-single-property-change
-                                   pos 'display string end))
-             (chunk (substring string pos next-display-change)))
-        (push
-         (if display
-             (htmlize-display-prop-to-html display chunk)
-           (htmlize-escape-or-link chunk))
-         outlist)
-        (setq pos next-display-change)))
-    (htmlize-concat (nreverse outlist))))
-
-(defun htmlize-default-transform-image (imgprops _text)
-  "Default transformation of image descriptor to something usable in HTML.
-
-If `htmlize-use-images' is nil, the function always returns nil, meaning
-use original text.  Otherwise, it tries to find the image for images that
-specify a file name.  If `htmlize-force-inline-images' is non-nil, it also
-converts the :file attribute to :data and returns the modified property
-list."
-  (when htmlize-use-images
-    (when (plist-get imgprops :file)
-      (let ((location (plist-get (cdr (find-image (list imgprops))) :file)))
-        (when location
-          (setq imgprops (plist-put (copy-list imgprops) :file location)))))
-    (if htmlize-force-inline-images
-        (let ((location (plist-get imgprops :file))
-              data)
-          (when location
-            (with-temp-buffer
-              (condition-case nil
-                  (progn
-                    (insert-file-contents-literally location)
-                    (setq data (buffer-string)))
-                (error nil))))
-          ;; if successful, return the new plist, otherwise return
-          ;; nil, which will use the original text
-          (and data
-               (plist-put (plist-put imgprops :file nil)
-                          :data data)))
-      imgprops)))
-
-(defun htmlize-alt-text (_imgprops origtext)
-  (and (/= (length origtext) 0)
-       (<= (length origtext) htmlize-max-alt-text)
-       (not (string-match "[\0-\x1f]" origtext))
-       origtext))
-
-(defun htmlize-generate-image (imgprops origtext)
-  (let* ((alt-text (htmlize-alt-text imgprops origtext))
-         (alt-attr (if alt-text
-                       (format " alt=\"%s\"" (htmlize-attr-escape alt-text))
-                     "")))
-    (cond ((plist-get imgprops :file)
-           ;; Try to find the image in image-load-path
-           (let* ((found-props (cdr (find-image (list imgprops))))
-                  (file (or (plist-get found-props :file)
-                            (plist-get imgprops :file))))
-             (format ""
-                     (htmlize-attr-escape (file-relative-name file))
-                     alt-attr)))
-          ((plist-get imgprops :data)
-           (format ""
-                   (or (plist-get imgprops :type) "")
-                   (base64-encode-string (plist-get imgprops :data))
-                   alt-attr)))))
-
-(defconst htmlize-ellipsis "...")
-(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
-
-(defun htmlize-match-inv-spec (inv)
-  (member* inv buffer-invisibility-spec
-           :key (lambda (i)
-                  (if (symbolp i) i (car i)))))
-
-(defun htmlize-decode-invisibility-spec (invisible)
-  ;; Return t, nil, or `ellipsis', depending on how invisible text should be inserted.
-
-  (if (not (listp buffer-invisibility-spec))
-      ;; If buffer-invisibility-spec is not a list, then all
-      ;; characters with non-nil `invisible' property are visible.
-      (not invisible)
-
-    ;; Otherwise, the value of a non-nil `invisible' property can be:
-    ;; 1. a symbol -- make the text invisible if it matches
-    ;;    buffer-invisibility-spec.
-    ;; 2. a list of symbols -- make the text invisible if
-    ;;    any symbol in the list matches
-    ;;    buffer-invisibility-spec.
-    ;; If the match of buffer-invisibility-spec has a non-nil
-    ;; CDR, replace the invisible text with an ellipsis.
-    (let ((match (if (symbolp invisible)
-                     (htmlize-match-inv-spec invisible)
-                   (some #'htmlize-match-inv-spec invisible))))
-      (cond ((null match) t)
-            ((cdr-safe (car match)) 'ellipsis)
-            (t nil)))))
-
-(defun htmlize-add-before-after-strings (beg end text)
-  ;; Find overlays specifying before-string and after-string in [beg,
-  ;; pos).  If any are found, splice them into TEXT and return the new
-  ;; text.
-  (let (additions)
-    (dolist (overlay (overlays-in beg end))
-      (let ((before (overlay-get overlay 'before-string))
-            (after (overlay-get overlay 'after-string)))
-        (when after
-          (push (cons (- (overlay-end overlay) beg)
-                      after)
-                additions))
-        (when before
-          (push (cons (- (overlay-start overlay) beg)
-                      before)
-                additions))))
-    (if additions
-        (let ((textlist nil)
-              (strpos 0))
-          (dolist (add (stable-sort additions #'< :key #'car))
-            (let ((addpos (car add))
-                  (addtext (cdr add)))
-              (push (substring text strpos addpos) textlist)
-              (push addtext textlist)
-              (setq strpos addpos)))
-          (push (substring text strpos) textlist)
-          (apply #'concat (nreverse textlist)))
-      text)))
-
-(defun htmlize-copy-prop (prop beg end string)
-  ;; Copy the specified property from the specified region of the
-  ;; buffer to the target string.  We cannot rely on Emacs to copy the
-  ;; property because we want to handle properties coming from both
-  ;; text properties and overlays.
-  (let ((pos beg))
-    (while (< pos end)
-      (let ((value (get-char-property pos prop))
-            (next-change (htmlize-next-change pos prop end)))
-        (when value
-          (put-text-property (- pos beg) (- next-change beg)
-                             prop value string))
-        (setq pos next-change)))))
-
-(defun htmlize-get-text-with-display (beg end)
-  ;; Like buffer-substring-no-properties, except it copies the
-  ;; `display' property from the buffer, if found.
-  (let ((text (buffer-substring-no-properties beg end)))
-    (htmlize-copy-prop 'display beg end text)
-    (htmlize-copy-prop 'htmlize-link beg end text)
-    (unless htmlize-running-xemacs
-      (setq text (htmlize-add-before-after-strings beg end text)))
-    text))
-
-(defun htmlize-buffer-substring-no-invisible (beg end)
-  ;; Like buffer-substring-no-properties, but don't copy invisible
-  ;; parts of the region.  Where buffer-substring-no-properties
-  ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted.
-  (let ((pos beg)
-	visible-list invisible show last-show next-change)
-    ;; Iterate over the changes in the `invisible' property and filter
-    ;; out the portions where it's non-nil, i.e. where the text is
-    ;; invisible.
-    (while (< pos end)
-      (setq invisible (get-char-property pos 'invisible)
-	    next-change (htmlize-next-change pos 'invisible end)
-            show (htmlize-decode-invisibility-spec invisible))
-      (cond ((eq show t)
-	     (push (htmlize-get-text-with-display pos next-change)
-                   visible-list))
-            ((and (eq show 'ellipsis)
-                  (not (eq last-show 'ellipsis))
-                  ;; Conflate successive ellipses.
-                  (push htmlize-ellipsis visible-list))))
-      (setq pos next-change last-show show))
-    (htmlize-concat (nreverse visible-list))))
-
-(defun htmlize-trim-ellipsis (text)
-  ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it
-  ;; starts with it.  It checks for the special property of the
-  ;; ellipsis so it doesn't work on ordinary text that begins with
-  ;; "...".
-  (if (get-text-property 0 'htmlize-ellipsis text)
-      (substring text (length htmlize-ellipsis))
-    text))
-
-(defconst htmlize-tab-spaces
-  ;; A table of strings with spaces.  (aref htmlize-tab-spaces 5) is
-  ;; like (make-string 5 ?\ ), except it doesn't cons.
-  (let ((v (make-vector 32 nil)))
-    (dotimes (i (length v))
-      (setf (aref v i) (make-string i ?\ )))
-    v))
-
-(defun htmlize-untabify (text start-column)
-  "Untabify TEXT, assuming it starts at START-COLUMN."
-  (let ((column start-column)
-	(last-match 0)
-	(chunk-start 0)
-	chunks match-pos tab-size)
-    (while (string-match "[\t\n]" text last-match)
-      (setq match-pos (match-beginning 0))
-      (cond ((eq (aref text match-pos) ?\t)
-	     ;; Encountered a tab: create a chunk of text followed by
-	     ;; the expanded tab.
-	     (push (substring text chunk-start match-pos) chunks)
-	     ;; Increase COLUMN by the length of the text we've
-	     ;; skipped since last tab or newline.  (Encountering
-	     ;; newline resets it.)
-	     (incf column (- match-pos last-match))
-	     ;; Calculate tab size based on tab-width and COLUMN.
-	     (setq tab-size (- tab-width (% column tab-width)))
-	     ;; Expand the tab, carefully recreating the `display'
-	     ;; property if one was on the TAB.
-             (let ((display (get-text-property match-pos 'display text))
-                   (expanded-tab (aref htmlize-tab-spaces tab-size)))
-               (when display
-                 (put-text-property 0 tab-size 'display display expanded-tab))
-               (push expanded-tab chunks))
-	     (incf column tab-size)
-	     (setq chunk-start (1+ match-pos)))
-	    (t
-	     ;; Reset COLUMN at beginning of line.
-	     (setq column 0)))
-      (setq last-match (1+ match-pos)))
-    ;; If no chunks have been allocated, it means there have been no
-    ;; tabs to expand.  Return TEXT unmodified.
-    (if (null chunks)
-	text
-      (when (< chunk-start (length text))
-	;; Push the remaining chunk.
-	(push (substring text chunk-start) chunks))
-      ;; Generate the output from the available chunks.
-      (htmlize-concat (nreverse chunks)))))
-
-(defun htmlize-extract-text (beg end trailing-ellipsis)
-  ;; Extract buffer text, sans the invisible parts.  Then
-  ;; untabify it and escape the HTML metacharacters.
-  (let ((text (htmlize-buffer-substring-no-invisible beg end)))
-    (when trailing-ellipsis
-      (setq text (htmlize-trim-ellipsis text)))
-    ;; If TEXT ends up empty, don't change trailing-ellipsis.
-    (when (> (length text) 0)
-      (setq trailing-ellipsis
-            (get-text-property (1- (length text))
-                               'htmlize-ellipsis text)))
-    (setq text (htmlize-untabify text (current-column)))
-    (setq text (htmlize-string-to-html text))
-    (values text trailing-ellipsis)))
-
-(defun htmlize-despam-address (string)
-  "Replace every occurrence of '@' in STRING with %40.
-This is used to protect mailto links without modifying their meaning."
-  ;; Suggested by Ville Skytta.
-  (while (string-match "@" string)
-    (setq string (replace-match "%40" nil t string)))
-  string)
-
-(defun htmlize-make-tmp-overlay (beg end props)
-  (let ((overlay (htmlize-make-overlay beg end)))
-    (htmlize-overlay-put overlay 'htmlize-tmp-overlay t)
-    (while props
-      (htmlize-overlay-put overlay (pop props) (pop props)))
-    overlay))
-
-(defun htmlize-delete-tmp-overlays ()
-  (dolist (overlay (htmlize-overlays-in (point-min) (point-max)))
-    (when (htmlize-overlay-get overlay 'htmlize-tmp-overlay)
-      (htmlize-delete-overlay overlay))))
-
-(defun htmlize-make-link-overlay (beg end uri)
-  (htmlize-make-tmp-overlay beg end `(htmlize-link (:uri ,uri))))
-
-(defun htmlize-create-auto-links ()
-  "Add `htmlize-link' property to all mailto links in the buffer."
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward
-            "<\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)>"
-            nil t)
-      (let* ((address (match-string 3))
-             (beg (match-beginning 0)) (end (match-end 0))
-             (uri (concat "mailto:" (htmlize-despam-address address))))
-        (htmlize-make-link-overlay beg end uri)))
-    (goto-char (point-min))
-    (while (re-search-forward "<\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)>"
-                              nil t)
-      (htmlize-make-link-overlay
-       (match-beginning 0) (match-end 0) (match-string 3)))))
-
-;; Tests for htmlize-create-auto-links:
-
-;; 
-;; 
-;; 
-;; 
-;; 
-;; 
-
-(defun htmlize-shadow-form-feeds ()
-  (let ((s "\n
"))
-    (put-text-property 0 (length s) 'htmlize-literal t s)
-    (let ((disp `(display ,s)))
-      (while (re-search-forward "\n\^L" nil t)
-        (htmlize-make-tmp-overlay (match-beginning 0) (match-end 0) disp)))))
-
-(defun htmlize-defang-local-variables ()
-  ;; Juri Linkov reports that an HTML-ized "Local variables" can lead
-  ;; visiting the HTML to fail with "Local variables list is not
-  ;; properly terminated".  He suggested changing the phrase to
-  ;; syntactically equivalent HTML that Emacs doesn't recognize.
-  (goto-char (point-min))
-  (while (search-forward "Local Variables:" nil t)
-    (replace-match "Local Variables:" nil t)))
-  
-
-;;; Color handling.
-
-(defvar htmlize-x-library-search-path
-  `(,data-directory
-    "/etc/X11/rgb.txt"
-    "/usr/share/X11/rgb.txt"
-    ;; the remainder of this list really belongs in a museum
-    "/usr/X11R6/lib/X11/"
-    "/usr/X11R5/lib/X11/"
-    "/usr/lib/X11R6/X11/"
-    "/usr/lib/X11R5/X11/"
-    "/usr/local/X11R6/lib/X11/"
-    "/usr/local/X11R5/lib/X11/"
-    "/usr/local/lib/X11R6/X11/"
-    "/usr/local/lib/X11R5/X11/"
-    "/usr/X11/lib/X11/"
-    "/usr/lib/X11/"
-    "/usr/local/lib/X11/"
-    "/usr/X386/lib/X11/"
-    "/usr/x386/lib/X11/"
-    "/usr/XFree86/lib/X11/"
-    "/usr/unsupported/lib/X11/"
-    "/usr/athena/lib/X11/"
-    "/usr/local/x11r5/lib/X11/"
-    "/usr/lpp/Xamples/lib/X11/"
-    "/usr/openwin/lib/X11/"
-    "/usr/openwin/share/lib/X11/"))
-
-(defun htmlize-get-color-rgb-hash (&optional rgb-file)
-  "Return a hash table mapping X color names to RGB values.
-The keys in the hash table are X11 color names, and the values are the
-#rrggbb RGB specifications, extracted from `rgb.txt'.
-
-If RGB-FILE is nil, the function will try hard to find a suitable file
-in the system directories.
-
-If no rgb.txt file is found, return nil."
-  (let ((rgb-file (or rgb-file (locate-file
-				"rgb.txt"
-				htmlize-x-library-search-path)))
-	(hash nil))
-    (when rgb-file
-      (with-temp-buffer
-	(insert-file-contents rgb-file)
-	(setq hash (make-hash-table :test 'equal))
-	(while (not (eobp))
-	  (cond ((looking-at "^\\s-*\\([!#]\\|$\\)")
-		 ;; Skip comments and empty lines.
-		 )
-		((looking-at
-		  "[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)")
-		 (setf (gethash (downcase (match-string 4)) hash)
-		       (format "#%02x%02x%02x"
-			       (string-to-number (match-string 1))
-			       (string-to-number (match-string 2))
-			       (string-to-number (match-string 3)))))
-		(t
-		 (error
-		  "Unrecognized line in %s: %s"
-		  rgb-file
-		  (buffer-substring (point) (progn (end-of-line) (point))))))
-	  (forward-line 1))))
-    hash))
-
-;; Compile the RGB map when loaded.  On systems where rgb.txt is
-;; missing, the value of the variable will be nil, and rgb.txt will
-;; not be used.
-(defvar htmlize-color-rgb-hash (htmlize-get-color-rgb-hash))
-
-;;; Face handling.
-
-(defun htmlize-face-specifies-property (face prop)
-  ;; Return t if face specifies PROP, as opposed to it being inherited
-  ;; from the default face.  The problem with e.g.
-  ;; `face-foreground-instance' is that it returns an instance for
-  ;; EVERY face because every face inherits from the default face.
-  ;; However, we'd like htmlize-face-{fore,back}ground to return nil
-  ;; when called with a face that doesn't specify its own foreground
-  ;; or background.
-  (or (eq face 'default)
-      (assq 'global (specifier-spec-list (face-property face prop)))))
-
-(defun htmlize-face-color-internal (face fg)
-  ;; Used only under GNU Emacs.  Return the color of FACE, but don't
-  ;; return "unspecified-fg" or "unspecified-bg".  If the face is
-  ;; `default' and the color is unspecified, look up the color in
-  ;; frame parameters.
-  (let* ((function (if fg #'face-foreground #'face-background))
-	 (color (funcall function face nil t)))
-    (when (and (eq face 'default) (null color))
-      (setq color (cdr (assq (if fg 'foreground-color 'background-color)
-			     (frame-parameters)))))
-    (when (or (eq color 'unspecified)
-	      (equal color "unspecified-fg")
-	      (equal color "unspecified-bg"))
-      (setq color nil))
-    (when (and (eq face 'default)
-	       (null color))
-      ;; Assuming black on white doesn't seem right, but I can't think
-      ;; of anything better to do.
-      (setq color (if fg "black" "white")))
-    color))
-
-(defun htmlize-face-foreground (face)
-  ;; Return the name of the foreground color of FACE.  If FACE does
-  ;; not specify a foreground color, return nil.
-  (cond (htmlize-running-xemacs
-	 ;; XEmacs.
-	 (and (htmlize-face-specifies-property face 'foreground)
-	      (color-instance-name (face-foreground-instance face))))
-	(t
-	 ;; GNU Emacs.
-	 (htmlize-face-color-internal face t))))
-
-(defun htmlize-face-background (face)
-  ;; Return the name of the background color of FACE.  If FACE does
-  ;; not specify a background color, return nil.
-  (cond (htmlize-running-xemacs
-	 ;; XEmacs.
-	 (and (htmlize-face-specifies-property face 'background)
-	      (color-instance-name (face-background-instance face))))
-	(t
-	 ;; GNU Emacs.
-	 (htmlize-face-color-internal face nil))))
-
-;; Convert COLOR to the #RRGGBB string.  If COLOR is already in that
-;; format, it's left unchanged.
-
-(defun htmlize-color-to-rgb (color)
-  (let ((rgb-string nil))
-    (cond ((null color)
-	   ;; Ignore nil COLOR because it means that the face is not
-	   ;; specifying any color.  Hence (htmlize-color-to-rgb nil)
-	   ;; returns nil.
-	   )
-	  ((string-match "\\`#" color)
-	   ;; The color is already in #rrggbb format.
-	   (setq rgb-string color))
-	  ((and htmlize-use-rgb-txt
-		htmlize-color-rgb-hash)
-	   ;; Use of rgb.txt is requested, and it's available on the
-	   ;; system.  Use it.
-	   (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash)))
-	  (t
-	   ;; We're getting the RGB components from Emacs.
-	   (let ((rgb
-		  (if (fboundp 'color-instance-rgb-components)
-		      (mapcar (lambda (arg)
-				(/ arg 256))
-			      (color-instance-rgb-components
-			       (make-color-instance color)))
-		    (mapcar (lambda (arg)
-			      (/ arg 256))
-			    (color-values color)))))
-	     (when rgb
-	       (setq rgb-string (apply #'format "#%02x%02x%02x" rgb))))))
-    ;; If RGB-STRING is still nil, it means the color cannot be found,
-    ;; for whatever reason.  In that case just punt and return COLOR.
-    ;; Most browsers support a decent set of color names anyway.
-    (or rgb-string color)))
-
-;; We store the face properties we care about into an
-;; `htmlize-fstruct' type.  That way we only have to analyze face
-;; properties, which can be time consuming, once per each face.  The
-;; mapping between Emacs faces and htmlize-fstructs is established by
-;; htmlize-make-face-map.  The name "fstruct" refers to variables of
-;; type `htmlize-fstruct', while the term "face" is reserved for Emacs
-;; faces.
-
-(defstruct htmlize-fstruct
-  foreground				; foreground color, #rrggbb
-  background				; background color, #rrggbb
-  size					; size
-  boldp					; whether face is bold
-  italicp				; whether face is italic
-  underlinep				; whether face is underlined
-  overlinep				; whether face is overlined
-  strikep				; whether face is struck through
-  css-name				; CSS name of face
-  )
-
-(defun htmlize-face-set-from-keyword-attr (fstruct attr value)
-  ;; For ATTR and VALUE, set the equivalent value in FSTRUCT.
-  (case attr
-    (:foreground
-     (setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
-    (:background
-     (setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
-    (:height
-     (setf (htmlize-fstruct-size fstruct) value))
-    (:weight
-     (when (string-match (symbol-name value) "bold")
-       (setf (htmlize-fstruct-boldp fstruct) t)))
-    (:slant
-     (setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic)
-						 (eq value 'oblique))))
-    (:bold
-     (setf (htmlize-fstruct-boldp fstruct) value))
-    (:italic
-     (setf (htmlize-fstruct-italicp fstruct) value))
-    (:underline
-     (setf (htmlize-fstruct-underlinep fstruct) value))
-    (:overline
-     (setf (htmlize-fstruct-overlinep fstruct) value))
-    (:strike-through
-     (setf (htmlize-fstruct-strikep fstruct) value))))
-
-(defun htmlize-face-size (face)
-  ;; The size (height) of FACE, taking inheritance into account.
-  ;; Only works in Emacs 21 and later.
-  (let* ((face-list (list face))
-         (head face-list)
-         (tail face-list))
-    (while head
-      (let ((inherit (face-attribute (car head) :inherit)))
-        (cond ((listp inherit)
-               (setcdr tail (copy-list inherit))
-               (setq tail (last tail)))
-              ((eq inherit 'unspecified))
-              (t
-               (setcdr tail (list inherit))
-               (setq tail (cdr tail)))))
-      (pop head))
-    (let ((size-list
-           (loop
-            for f in face-list
-            for h = (face-attribute f :height)
-            collect (if (eq h 'unspecified) nil h))))
-      (reduce 'htmlize-merge-size (cons nil size-list)))))
-
-(defun htmlize-face-css-name (face)
-  ;; Generate the css-name property for the given face.  Emacs places
-  ;; no restrictions on the names of symbols that represent faces --
-  ;; any characters may be in the name, even control chars.  We try
-  ;; hard to beat the face name into shape, both esthetically and
-  ;; according to CSS1 specs.
-  (let ((name (downcase (symbol-name face))))
-    (when (string-match "\\`font-lock-" name)
-      ;; font-lock-FOO-face -> FOO.
-      (setq name (replace-match "" t t name)))
-    (when (string-match "-face\\'" name)
-      ;; Drop the redundant "-face" suffix.
-      (setq name (replace-match "" t t name)))
-    (while (string-match "[^-a-zA-Z0-9]" name)
-      ;; Drop the non-alphanumerics.
-      (setq name (replace-match "X" t t name)))
-    (when (string-match "\\`[-0-9]" name)
-      ;; CSS identifiers may not start with a digit.
-      (setq name (concat "X" name)))
-    ;; After these transformations, the face could come out empty.
-    (when (equal name "")
-      (setq name "face"))
-    ;; Apply the prefix.
-    (concat htmlize-css-name-prefix name)))
-
-(defun htmlize-face-to-fstruct (face)
-  "Convert Emacs face FACE to fstruct."
-  (let ((fstruct (make-htmlize-fstruct
-		  :foreground (htmlize-color-to-rgb
-			       (htmlize-face-foreground face))
-		  :background (htmlize-color-to-rgb
-			       (htmlize-face-background face)))))
-    (if htmlize-running-xemacs
-        ;; XEmacs doesn't provide a way to detect whether a face is
-        ;; bold or italic, so we need to examine the font instance.
-        (let* ((font-instance (face-font-instance face))
-               (props (font-instance-properties font-instance)))
-          (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold")
-            (setf (htmlize-fstruct-boldp fstruct) t))
-          (when (or (equalp (cdr (assq 'SLANT props)) "i")
-                    (equalp (cdr (assq 'SLANT props)) "o"))
-            (setf (htmlize-fstruct-italicp fstruct) t))
-          (setf (htmlize-fstruct-strikep fstruct)
-                (face-strikethru-p face))
-          (setf (htmlize-fstruct-underlinep fstruct)
-                (face-underline-p face)))
-      ;; GNU Emacs
-      (dolist (attr '(:weight :slant :underline :overline :strike-through))
-        (let ((value (face-attribute face attr nil t)))
-          (when (and value (not (eq value 'unspecified)))
-            (htmlize-face-set-from-keyword-attr fstruct attr value))))
-      (let ((size (htmlize-face-size face)))
-        (unless (eql size 1.0) 	; ignore non-spec
-          (setf (htmlize-fstruct-size fstruct) size))))
-    (setf (htmlize-fstruct-css-name fstruct) (htmlize-face-css-name face))
-    fstruct))
-
-(defmacro htmlize-copy-attr-if-set (attr-list dest source)
-  ;; Generate code with the following pattern:
-  ;; (progn
-  ;;   (when (htmlize-fstruct-ATTR source)
-  ;;     (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
-  ;;   ...)
-  ;; for the given list of boolean attributes.
-  (cons 'progn
-	(loop for attr in attr-list
-	      for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
-	      collect `(when (,attr-sym ,source)
-                         (setf (,attr-sym ,dest) (,attr-sym ,source))))))
-
-(defun htmlize-merge-size (merged next)
-  ;; Calculate the size of the merge of MERGED and NEXT.
-  (cond ((null merged)     next)
-	((integerp next)   next)
-	((null next)       merged)
-	((floatp merged)   (* merged next))
-	((integerp merged) (round (* merged next)))))
-
-(defun htmlize-merge-two-faces (merged next)
-  (htmlize-copy-attr-if-set
-   (foreground background boldp italicp underlinep overlinep strikep)
-   merged next)
-  (setf (htmlize-fstruct-size merged)
-	(htmlize-merge-size (htmlize-fstruct-size merged)
-			    (htmlize-fstruct-size next)))
-  merged)
-
-(defun htmlize-merge-faces (fstruct-list)
-  (cond ((null fstruct-list)
-	 ;; Nothing to do, return a dummy face.
-	 (make-htmlize-fstruct))
-	((null (cdr fstruct-list))
-	 ;; Optimize for the common case of a single face, simply
-	 ;; return it.
-	 (car fstruct-list))
-	(t
-	 (reduce #'htmlize-merge-two-faces
-		 (cons (make-htmlize-fstruct) fstruct-list)))))
-
-;; GNU Emacs 20+ supports attribute lists in `face' properties.  For
-;; example, you can use `(:foreground "red" :weight bold)' as an
-;; overlay's "face", or you can even use a list of such lists, etc.
-;; We call those "attrlists".
-;;
-;; htmlize supports attrlist by converting them to fstructs, the same
-;; as with regular faces.
-
-(defun htmlize-attrlist-to-fstruct (attrlist)
-  ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input.
-  (let ((fstruct (make-htmlize-fstruct)))
-    (cond ((eq (car attrlist) 'foreground-color)
-	   ;; ATTRLIST is (foreground-color . COLOR)
-	   (setf (htmlize-fstruct-foreground fstruct)
-		 (htmlize-color-to-rgb (cdr attrlist))))
-	  ((eq (car attrlist) 'background-color)
-	   ;; ATTRLIST is (background-color . COLOR)
-	   (setf (htmlize-fstruct-background fstruct)
-		 (htmlize-color-to-rgb (cdr attrlist))))
-	  (t
-	   ;; ATTRLIST is a plist.
-	   (while attrlist
-	     (let ((attr (pop attrlist))
-		   (value (pop attrlist)))
-	       (when (and value (not (eq value 'unspecified)))
-		 (htmlize-face-set-from-keyword-attr fstruct attr value))))))
-    (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST")
-    fstruct))
-
-(defun htmlize-decode-face-prop (prop)
-  "Turn face property PROP into a list of face-like objects."
-  ;; PROP can be a symbol naming a face, a string naming such a
-  ;; symbol, a cons (foreground-color . COLOR) or (background-color
-  ;; COLOR), a property list (:attr1 val1 :attr2 val2 ...), or a list
-  ;; of any of those.
-  ;;
-  ;; (htmlize-decode-face-prop 'face) -> (face)
-  ;; (htmlize-decode-face-prop '(face1 face2)) -> (face1 face2)
-  ;; (htmlize-decode-face-prop '(:attr "val")) -> ((:attr "val"))
-  ;; (htmlize-decode-face-prop '((:attr "val") face (foreground-color "red")))
-  ;;   -> ((:attr "val") face (foreground-color "red"))
-  ;;
-  ;; Unrecognized atoms or non-face symbols/strings are silently
-  ;; stripped away.
-  (cond ((null prop)
-         nil)
-        ((symbolp prop)
-         (and (facep prop)
-              (list prop)))
-        ((stringp prop)
-         (and (facep (intern-soft prop))
-              (list prop)))
-        ((atom prop)
-         nil)
-        ((and (symbolp (car prop))
-              (eq ?: (aref (symbol-name (car prop)) 0)))
-         (list prop))
-        ((or (eq (car prop) 'foreground-color)
-             (eq (car prop) 'background-color))
-         (list prop))
-        (t
-         (apply #'nconc (mapcar #'htmlize-decode-face-prop prop)))))
-
-(defun htmlize-make-face-map (faces)
-  ;; Return a hash table mapping Emacs faces to htmlize's fstructs.
-  ;; The keys are either face symbols or attrlists, so the test
-  ;; function must be `equal'.
-  (let ((face-map (make-hash-table :test 'equal))
-	css-names)
-    (dolist (face faces)
-      (unless (gethash face face-map)
-	;; Haven't seen FACE yet; convert it to an fstruct and cache
-	;; it.
-	(let ((fstruct (if (symbolp face)
-			   (htmlize-face-to-fstruct face)
-			 (htmlize-attrlist-to-fstruct face))))
-	  (setf (gethash face face-map) fstruct)
-	  (let* ((css-name (htmlize-fstruct-css-name fstruct))
-		 (new-name css-name)
-		 (i 0))
-	    ;; Uniquify the face's css-name by using NAME-1, NAME-2,
-	    ;; etc.
-	    (while (member new-name css-names)
-	      (setq new-name (format "%s-%s" css-name (incf i))))
-	    (unless (equal new-name css-name)
-	      (setf (htmlize-fstruct-css-name fstruct) new-name))
-	    (push new-name css-names)))))
-    face-map))
-
-(defun htmlize-unstringify-face (face)
-  "If FACE is a string, return it interned, otherwise return it unchanged."
-  (if (stringp face)
-      (intern face)
-    face))
-
-(defun htmlize-faces-in-buffer ()
-  "Return a list of faces used in the current buffer.
-Under XEmacs, this returns the set of faces specified by the extents
-with the `face' property.  (This covers text properties as well.)  Under
-GNU Emacs, it returns the set of faces specified by the `face' text
-property and by buffer overlays that specify `face'."
-  (let (faces)
-    ;; Testing for (fboundp 'map-extents) doesn't work because W3
-    ;; defines `map-extents' under FSF.
-    (if htmlize-running-xemacs
-	(let (face-prop)
-	  (map-extents (lambda (extent ignored)
-			 (setq face-prop (extent-face extent)
-			       ;; FACE-PROP can be a face or a list of
-			       ;; faces.
-			       faces (if (listp face-prop)
-					 (union face-prop faces)
-				       (adjoin face-prop faces)))
-			 nil)
-		       nil
-		       ;; Specify endpoints explicitly to respect
-		       ;; narrowing.
-		       (point-min) (point-max) nil nil 'face))
-      ;; FSF Emacs code.
-      ;; Faces used by text properties.
-      (let ((pos (point-min)) face-prop next)
-	(while (< pos (point-max))
-	  (setq face-prop (get-text-property pos 'face)
-		next (or (next-single-property-change pos 'face) (point-max)))
-          (setq faces (nunion (htmlize-decode-face-prop face-prop)
-                              faces :test 'equal))
-	  (setq pos next)))
-      ;; Faces used by overlays.
-      (dolist (overlay (overlays-in (point-min) (point-max)))
-	(let ((face-prop (overlay-get overlay 'face)))
-          (setq faces (nunion (htmlize-decode-face-prop face-prop)
-                              faces :test 'equal)))))
-    faces))
-
-;; htmlize-faces-at-point returns the faces in use at point.  The
-;; faces are sorted by increasing priority, i.e. the last face takes
-;; precedence.
-;;
-;; Under XEmacs, this returns all the faces in all the extents at
-;; point.  Under GNU Emacs, this returns all the faces in the `face'
-;; property and all the faces in the overlays at point.
-
-(cond (htmlize-running-xemacs
-       (defun htmlize-faces-at-point ()
-	 (let (extent extent-list face-list face-prop)
-	   (while (setq extent (extent-at (point) nil 'face extent))
-	     (push extent extent-list))
-	   ;; extent-list is in reverse display order, meaning that
-	   ;; smallest ones come last.  That is the order we want,
-	   ;; except it can be overridden by the `priority' property.
-	   (setq extent-list (stable-sort extent-list #'<
-					  :key #'extent-priority))
-	   (dolist (extent extent-list)
-	     (setq face-prop (extent-face extent))
-	     ;; extent's face-list is in reverse order from what we
-	     ;; want, but the `nreverse' below will take care of it.
-	     (setq face-list (if (listp face-prop)
-				 (append face-prop face-list)
-			       (cons face-prop face-list))))
-	   (nreverse face-list))))
-      (t
-       (defun htmlize-faces-at-point ()
-	 (let (all-faces)
-	   ;; Faces from text properties.
-	   (let ((face-prop (get-text-property (point) 'face)))
-             ;; we need to reverse the `face' prop because we want
-             ;; more specific faces to come later
-	     (setq all-faces (nreverse (htmlize-decode-face-prop face-prop))))
-	   ;; Faces from overlays.
-	   (let ((overlays
-		  ;; Collect overlays at point that specify `face'.
-		  (delete-if-not (lambda (o)
-				   (overlay-get o 'face))
-				 (overlays-at (point))))
-		 list face-prop)
-	     ;; Sort the overlays so the smaller (more specific) ones
-	     ;; come later.  The number of overlays at each one
-	     ;; position should be very small, so the sort shouldn't
-	     ;; slow things down.
-	     (setq overlays (sort* overlays
-				   ;; Sort by ascending...
-				   #'<
-				   ;; ...overlay size.
-				   :key (lambda (o)
-					  (- (overlay-end o)
-					     (overlay-start o)))))
-	     ;; Overlay priorities, if present, override the above
-	     ;; established order.  Larger overlay priority takes
-	     ;; precedence and therefore comes later in the list.
-	     (setq overlays (stable-sort
-			     overlays
-			     ;; Reorder (stably) by acending...
-			     #'<
-			     ;; ...overlay priority.
-			     :key (lambda (o)
-				    (or (overlay-get o 'priority) 0))))
-	     (dolist (overlay overlays)
-	       (setq face-prop (overlay-get overlay 'face)
-                     list (nconc (htmlize-decode-face-prop face-prop) list)))
-	     ;; Under "Merging Faces" the manual explicitly states
-	     ;; that faces specified by overlays take precedence over
-	     ;; faces specified by text properties.
-	     (setq all-faces (nconc all-faces list)))
-	   all-faces))))
-
-;; htmlize supports generating HTML in several flavors, some of which
-;; use CSS, and others the  element.  We take an OO approach and
-;; define "methods" that indirect to the functions that depend on
-;; `htmlize-output-type'.  The currently used methods are `doctype',
-;; `insert-head', `body-tag', and `text-markup'.  Not all output types
-;; define all methods.
-;;
-;; Methods are called either with (htmlize-method METHOD ARGS...) 
-;; special form, or by accessing the function with
-;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION).
-;; The latter form is useful in tight loops because `htmlize-method'
-;; conses.
-
-(defmacro htmlize-method (method &rest args)
-  ;; Expand to (htmlize-TYPE-METHOD ...ARGS...).  TYPE is the value of
-  ;; `htmlize-output-type' at run time.
-  `(funcall (htmlize-method-function ',method) ,@args))
-
-(defun htmlize-method-function (method)
-  ;; Return METHOD's function definition for the current output type.
-  ;; The returned object can be safely funcalled.
-  (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
-    (indirect-function (if (fboundp sym)
-			   sym
-			 (let ((default (intern (concat "htmlize-default-"
-							(symbol-name method)))))
-			   (if (fboundp default)
-			       default
-			     'ignore))))))
-
-(defvar htmlize-memoization-table (make-hash-table :test 'equal))
-
-(defmacro htmlize-memoize (key generator)
-  "Return the value of GENERATOR, memoized as KEY.
-That means that GENERATOR will be evaluated and returned the first time
-it's called with the same value of KEY.  All other times, the cached
-\(memoized) value will be returned."
-  (let ((value (gensym)))
-    `(let ((,value (gethash ,key htmlize-memoization-table)))
-       (unless ,value
-	 (setq ,value ,generator)
-	 (setf (gethash ,key htmlize-memoization-table) ,value))
-       ,value)))
-
-;;; Default methods.
-
-(defun htmlize-default-doctype ()
-  nil					; no doc-string
-  ;; Note that the `font' output is technically invalid under this DTD
-  ;; because the DTD doesn't allow embedding  in 
.
-  ""
-  )
-
-(defun htmlize-default-body-tag (face-map)
-  nil					; no doc-string
-  face-map ; shut up the byte-compiler
-  "")
-
-;;; CSS based output support.
-
-;; Internal function; not a method.
-(defun htmlize-css-specs (fstruct)
-  (let (result)
-    (when (htmlize-fstruct-foreground fstruct)
-      (push (format "color: %s;" (htmlize-fstruct-foreground fstruct))
-	    result))
-    (when (htmlize-fstruct-background fstruct)
-      (push (format "background-color: %s;"
-		    (htmlize-fstruct-background fstruct))
-	    result))
-    (let ((size (htmlize-fstruct-size fstruct)))
-      (when (and size (not (eq htmlize-ignore-face-size t)))
-	(cond ((floatp size)
-	       (push (format "font-size: %d%%;" (* 100 size)) result))
-	      ((not (eq htmlize-ignore-face-size 'absolute))
-	       (push (format "font-size: %spt;" (/ size 10.0)) result)))))
-    (when (htmlize-fstruct-boldp fstruct)
-      (push "font-weight: bold;" result))
-    (when (htmlize-fstruct-italicp fstruct)
-      (push "font-style: italic;" result))
-    (when (htmlize-fstruct-underlinep fstruct)
-      (push "text-decoration: underline;" result))
-    (when (htmlize-fstruct-overlinep fstruct)
-      (push "text-decoration: overline;" result))
-    (when (htmlize-fstruct-strikep fstruct)
-      (push "text-decoration: line-through;" result))
-    (nreverse result)))
-
-(defun htmlize-css-insert-head (buffer-faces face-map)
-  (insert "    \n"))
-
-(defun htmlize-css-text-markup (fstruct-list buffer)
-  ;; Open the markup needed to insert text colored with FACES into
-  ;; BUFFER.  Return the function that closes the markup.
-
-  ;; In CSS mode, this is easy: just nest the text in one  tag for each face in FSTRUCT-LIST.
-  (dolist (fstruct fstruct-list)
-    (princ "" buffer))
-  (htmlize-lexlet ((fstruct-list fstruct-list) (buffer buffer))
-    (lambda ()
-      (dolist (fstruct fstruct-list)
-        (ignore fstruct)                ; shut up the byte-compiler
-        (princ "" buffer)))))
-
-;; `inline-css' output support.
-
-(defun htmlize-inline-css-body-tag (face-map)
-  (format ""
-	  (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
-		     " ")))
-
-(defun htmlize-inline-css-text-markup (fstruct-list buffer)
-  (let* ((merged (htmlize-merge-faces fstruct-list))
-	 (style (htmlize-memoize
-		 merged
-		 (let ((specs (htmlize-css-specs merged)))
-		   (and specs
-			(mapconcat #'identity (htmlize-css-specs merged) " "))))))
-    (when style
-      (princ "" buffer))
-    (htmlize-lexlet ((style style) (buffer buffer))
-      (lambda ()
-        (when style
-          (princ "" buffer))))))
-
-;;; `font' tag based output support.
-
-(defun htmlize-font-body-tag (face-map)
-  (let ((fstruct (gethash 'default face-map)))
-    (format ""
-	    (htmlize-fstruct-foreground fstruct)
-	    (htmlize-fstruct-background fstruct))))
-       
-(defun htmlize-font-text-markup (fstruct-list buffer)
-  ;; In `font' mode, we use the traditional HTML means of altering
-  ;; presentation:  tag for colors,  for bold,  for
-  ;; underline, and  for strike-through.
-  (let* ((merged (htmlize-merge-faces fstruct-list))
-	 (markup (htmlize-memoize
-		  merged
-		  (cons (concat
-			 (and (htmlize-fstruct-foreground merged)
-			      (format "" (htmlize-fstruct-foreground merged)))
-			 (and (htmlize-fstruct-boldp merged)      "")
-			 (and (htmlize-fstruct-italicp merged)    "")
-			 (and (htmlize-fstruct-underlinep merged) "")
-			 (and (htmlize-fstruct-strikep merged)    ""))
-			(concat
-			 (and (htmlize-fstruct-strikep merged)    "")
-			 (and (htmlize-fstruct-underlinep merged) "")
-			 (and (htmlize-fstruct-italicp merged)    "")
-			 (and (htmlize-fstruct-boldp merged)      "")
-			 (and (htmlize-fstruct-foreground merged) ""))))))
-    (princ (car markup) buffer)
-    (htmlize-lexlet ((markup markup) (buffer buffer))
-      (lambda ()
-        (princ (cdr markup) buffer)))))
-
-(defun htmlize-buffer-1 ()
-  ;; Internal function; don't call it from outside this file.  Htmlize
-  ;; current buffer, writing the resulting HTML to a new buffer, and
-  ;; return it.  Unlike htmlize-buffer, this doesn't change current
-  ;; buffer or use switch-to-buffer.
-  (save-excursion
-    ;; Protect against the hook changing the current buffer.
-    (save-excursion
-      (run-hooks 'htmlize-before-hook))
-    ;; Convince font-lock support modes to fontify the entire buffer
-    ;; in advance.
-    (htmlize-ensure-fontified)
-    (clrhash htmlize-extended-character-cache)
-    (clrhash htmlize-memoization-table)
-    ;; It's important that the new buffer inherits default-directory
-    ;; from the current buffer.
-    (let ((htmlbuf (generate-new-buffer (if (buffer-file-name)
-                                            (htmlize-make-file-name
-                                             (file-name-nondirectory
-                                              (buffer-file-name)))
-                                          "*html*")))
-          (completed nil))
-      (unwind-protect
-          (let* ((buffer-faces (htmlize-faces-in-buffer))
-                 (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
-                 (places (gensym))
-                 (title (if (buffer-file-name)
-                            (file-name-nondirectory (buffer-file-name))
-                          (buffer-name))))
-            (when htmlize-generate-hyperlinks
-              (htmlize-create-auto-links))
-            (when htmlize-replace-form-feeds
-              (htmlize-shadow-form-feeds))
-
-            ;; Initialize HTMLBUF and insert the HTML prolog.
-            (with-current-buffer htmlbuf
-              (buffer-disable-undo)
-              (insert (htmlize-method doctype) ?\n
-                      (format "\n"
-                              htmlize-version htmlize-output-type)
-                      "\n  ")
-              (put places 'head-start (point-marker))
-              (insert "\n"
-                      "    " (htmlize-protect-string title) "\n"
-                      (if htmlize-html-charset
-                          (format (concat "    \n")
-                                  htmlize-html-charset)
-                        "")
-                      htmlize-head-tags)
-              (htmlize-method insert-head buffer-faces face-map)
-              (insert "  ")
-              (put places 'head-end (point-marker))
-              (insert "\n  ")
-              (put places 'body-start (point-marker))
-              (insert (htmlize-method body-tag face-map)
-                      "\n    ")
-              (put places 'content-start (point-marker))
-              (insert "
\n"))
-            (let ((text-markup
-                   ;; Get the inserter method, so we can funcall it inside
-                   ;; the loop.  Not calling `htmlize-method' in the loop
-                   ;; body yields a measurable speed increase.
-                   (htmlize-method-function 'text-markup))
-                  ;; Declare variables used in loop body outside the loop
-                  ;; because it's faster to establish `let' bindings only
-                  ;; once.
-                  next-change text face-list trailing-ellipsis
-                  fstruct-list last-fstruct-list
-                  (close-markup (lambda ())))
-              ;; This loop traverses and reads the source buffer, appending
-              ;; the resulting HTML to HTMLBUF.  This method is fast
-              ;; because: 1) it doesn't require examining the text
-              ;; properties char by char (htmlize-next-face-change is used
-              ;; to move between runs with the same face), and 2) it doesn't
-              ;; require frequent buffer switches, which are slow because
-              ;; they rebind all buffer-local vars.
-              (goto-char (point-min))
-              (while (not (eobp))
-                (setq next-change (htmlize-next-face-change (point)))
-                ;; Get faces in use between (point) and NEXT-CHANGE, and
-                ;; convert them to fstructs.
-                (setq face-list (htmlize-faces-at-point)
-                      fstruct-list (delq nil (mapcar (lambda (f)
-                                                       (gethash f face-map))
-                                                     face-list)))
-                (multiple-value-setq (text trailing-ellipsis)
-                  (htmlize-extract-text (point) next-change trailing-ellipsis))
-                ;; Don't bother writing anything if there's no text (this
-                ;; happens in invisible regions).
-                (when (> (length text) 0)
-                  ;; Open the new markup if necessary and insert the text.
-                  (when (not (equalp fstruct-list last-fstruct-list))
-                    (funcall close-markup)
-                    (setq last-fstruct-list fstruct-list
-                          close-markup (funcall text-markup fstruct-list htmlbuf)))
-                  (princ text htmlbuf))
-                (goto-char next-change))
-
-              ;; We've gone through the buffer; close the markup from
-              ;; the last run, if any.
-              (funcall close-markup))
-
-            ;; Insert the epilog and post-process the buffer.
-            (with-current-buffer htmlbuf
-              (insert "
")
-              (put places 'content-end (point-marker))
-              (insert "\n  ")
-              (put places 'body-end (point-marker))
-              (insert "\n\n")
-              (htmlize-defang-local-variables)
-              (goto-char (point-min))
-              (when htmlize-html-major-mode
-                ;; What sucks about this is that the minor modes, most notably
-                ;; font-lock-mode, won't be initialized.  Oh well.
-                (funcall htmlize-html-major-mode))
-              (set (make-local-variable 'htmlize-buffer-places)
-                   (symbol-plist places))
-              (run-hooks 'htmlize-after-hook)
-              (buffer-enable-undo))
-            (setq completed t)
-            htmlbuf)
-
-        (when (not completed)
-          (kill-buffer htmlbuf))
-        (htmlize-delete-tmp-overlays)))))
-
-;; Utility functions.
-
-(defmacro htmlize-with-fontify-message (&rest body)
-  ;; When forcing fontification of large buffers in
-  ;; htmlize-ensure-fontified, inform the user that he is waiting for
-  ;; font-lock, not for htmlize to finish.
-  `(progn
-     (if (> (buffer-size) 65536)
-	 (message "Forcing fontification of %s..."
-		  (buffer-name (current-buffer))))
-     ,@body
-     (if (> (buffer-size) 65536)
-	 (message "Forcing fontification of %s...done"
-		  (buffer-name (current-buffer))))))
-
-(defun htmlize-ensure-fontified ()
-  ;; If font-lock is being used, ensure that the "support" modes
-  ;; actually fontify the buffer.  If font-lock is not in use, we
-  ;; don't care because, except in htmlize-file, we don't force
-  ;; font-lock on the user.
-  (when (and (boundp 'font-lock-mode)
-	     font-lock-mode)
-    ;; In part taken from ps-print-ensure-fontified in GNU Emacs 21.
-    (cond
-     ((and (boundp 'jit-lock-mode)
-	   (symbol-value 'jit-lock-mode))
-      (htmlize-with-fontify-message
-       (jit-lock-fontify-now (point-min) (point-max))))
-     ((and (boundp 'lazy-lock-mode)
-	   (symbol-value 'lazy-lock-mode))
-      (htmlize-with-fontify-message
-       (lazy-lock-fontify-region (point-min) (point-max))))
-     ((and (boundp 'lazy-shot-mode)
-	   (symbol-value 'lazy-shot-mode))
-      (htmlize-with-fontify-message
-       ;; lazy-shot is amazing in that it must *refontify* the region,
-       ;; even if the whole buffer has already been fontified.  
-       (lazy-shot-fontify-region (point-min) (point-max))))
-     ;; There's also fast-lock, but we don't need to handle specially,
-     ;; I think.  fast-lock doesn't really defer fontification, it
-     ;; just saves it to an external cache so it's not done twice.
-     )))
-
-
-;;;###autoload
-(defun htmlize-buffer (&optional buffer)
-  "Convert BUFFER to HTML, preserving colors and decorations.
-
-The generated HTML is available in a new buffer, which is returned.
-When invoked interactively, the new buffer is selected in the current
-window.  The title of the generated document will be set to the buffer's
-file name or, if that's not available, to the buffer's name.
-
-Note that htmlize doesn't fontify your buffers, it only uses the
-decorations that are already present.  If you don't set up font-lock or
-something else to fontify your buffers, the resulting HTML will be
-plain.  Likewise, if you don't like the choice of colors, fix the mode
-that created them, or simply alter the faces it uses."
-  (interactive)
-  (let ((htmlbuf (with-current-buffer (or buffer (current-buffer))
-		   (htmlize-buffer-1))))
-    (when (interactive-p)
-      (switch-to-buffer htmlbuf))
-    htmlbuf))
-
-;;;###autoload
-(defun htmlize-region (beg end)
-  "Convert the region to HTML, preserving colors and decorations.
-See `htmlize-buffer' for details."
-  (interactive "r")
-  ;; Don't let zmacs region highlighting end up in HTML.
-  (when (fboundp 'zmacs-deactivate-region)
-    (zmacs-deactivate-region))
-  (let ((htmlbuf (save-restriction
-		   (narrow-to-region beg end)
-		   (htmlize-buffer-1))))
-    (when (interactive-p)
-      (switch-to-buffer htmlbuf))
-    htmlbuf))
-
-(defun htmlize-region-for-paste (beg end)
-  "Htmlize the region and return just the HTML as a string.
-This forces the `inline-css' style and only returns the HTML body,
-but without the BODY tag.  This should make it useful for inserting
-the text to another HTML buffer."
-  (let* ((htmlize-output-type 'inline-css)
-	 (htmlbuf (htmlize-region beg end)))
-    (unwind-protect
-	(with-current-buffer htmlbuf
-	  (buffer-substring (plist-get htmlize-buffer-places 'content-start)
-			    (plist-get htmlize-buffer-places 'content-end)))
-      (kill-buffer htmlbuf))))
-
-(defun htmlize-make-file-name (file)
-  "Make an HTML file name from FILE.
-
-In its default implementation, this simply appends `.html' to FILE.
-This function is called by htmlize to create the buffer file name, and
-by `htmlize-file' to create the target file name.
-
-More elaborate transformations are conceivable, such as changing FILE's
-extension to `.html' (\"file.c\" -> \"file.html\").  If you want them,
-overload this function to do it and htmlize will comply."
-  (concat file ".html"))
-
-;; Older implementation of htmlize-make-file-name that changes FILE's
-;; extension to ".html".
-;(defun htmlize-make-file-name (file)
-;  (let ((extension (file-name-extension file))
-;	(sans-extension (file-name-sans-extension file)))
-;    (if (or (equal extension "html")
-;	    (equal extension "htm")
-;	    (equal sans-extension ""))
-;	(concat file ".html")
-;      (concat sans-extension ".html"))))
-
-;;;###autoload
-(defun htmlize-file (file &optional target)
-  "Load FILE, fontify it, convert it to HTML, and save the result.
-
-Contents of FILE are inserted into a temporary buffer, whose major mode
-is set with `normal-mode' as appropriate for the file type.  The buffer
-is subsequently fontified with `font-lock' and converted to HTML.  Note
-that, unlike `htmlize-buffer', this function explicitly turns on
-font-lock.  If a form of highlighting other than font-lock is desired,
-please use `htmlize-buffer' directly on buffers so highlighted.
-
-Buffers currently visiting FILE are unaffected by this function.  The
-function does not change current buffer or move the point.
-
-If TARGET is specified and names a directory, the resulting file will be
-saved there instead of to FILE's directory.  If TARGET is specified and
-does not name a directory, it will be used as output file name."
-  (interactive (list (read-file-name
-		      "HTML-ize file: "
-		      nil nil nil (and (buffer-file-name)
-				       (file-name-nondirectory
-					(buffer-file-name))))))
-  (let ((output-file (if (and target (not (file-directory-p target)))
-			 target
-		       (expand-file-name
-			(htmlize-make-file-name (file-name-nondirectory file))
-			(or target (file-name-directory file)))))
-	;; Try to prevent `find-file-noselect' from triggering
-	;; font-lock because we'll fontify explicitly below.
-	(font-lock-mode nil)
-	(font-lock-auto-fontify nil)
-	(global-font-lock-mode nil)
-	;; Ignore the size limit for the purposes of htmlization.
-	(font-lock-maximum-size nil)
-	;; Disable font-lock support modes.  This will only work in
-	;; more recent Emacs versions, so htmlize-buffer-1 still needs
-	;; to call htmlize-ensure-fontified.
-	(font-lock-support-mode nil))
-    (with-temp-buffer
-      ;; Insert FILE into the temporary buffer.
-      (insert-file-contents file)
-      ;; Set the file name so normal-mode and htmlize-buffer-1 pick it
-      ;; up.  Restore it afterwards so with-temp-buffer's kill-buffer
-      ;; doesn't complain about killing a modified buffer.
-      (let ((buffer-file-name file))
-	;; Set the major mode for the sake of font-lock.
-	(normal-mode)
-	(font-lock-mode 1)
-	(unless font-lock-mode
-	  ;; In GNU Emacs (font-lock-mode 1) doesn't force font-lock,
-	  ;; contrary to the documentation.  This seems to work.
-	  (font-lock-fontify-buffer))
-	;; htmlize the buffer and save the HTML.
-	(with-current-buffer (htmlize-buffer-1)
-	  (unwind-protect
-	      (progn
-		(run-hooks 'htmlize-file-hook)
-		(write-region (point-min) (point-max) output-file))
-	    (kill-buffer (current-buffer)))))))
-  ;; I haven't decided on a useful return value yet, so just return
-  ;; nil.
-  nil)
-
-;;;###autoload
-(defun htmlize-many-files (files &optional target-directory)
-  "Convert FILES to HTML and save the corresponding HTML versions.
-
-FILES should be a list of file names to convert.  This function calls
-`htmlize-file' on each file; see that function for details.  When
-invoked interactively, you are prompted for a list of files to convert,
-terminated with RET.
-
-If TARGET-DIRECTORY is specified, the HTML files will be saved to that
-directory.  Normally, each HTML file is saved to the directory of the
-corresponding source file."
-  (interactive
-   (list
-    (let (list file)
-      ;; Use empty string as DEFAULT because setting DEFAULT to nil
-      ;; defaults to the directory name, which is not what we want.
-      (while (not (equal (setq file (read-file-name
-				     "HTML-ize file (RET to finish): "
-				     (and list (file-name-directory
-						(car list)))
-				     "" t))
-			 ""))
-	(push file list))
-      (nreverse list))))
-  ;; Verify that TARGET-DIRECTORY is indeed a directory.  If it's a
-  ;; file, htmlize-file will use it as target, and that doesn't make
-  ;; sense.
-  (and target-directory
-       (not (file-directory-p target-directory))
-       (error "target-directory must name a directory: %s" target-directory))
-  (dolist (file files)
-    (htmlize-file file target-directory)))
-
-;;;###autoload
-(defun htmlize-many-files-dired (arg &optional target-directory)
-  "HTMLize dired-marked files."
-  (interactive "P")
-  (htmlize-many-files (dired-get-marked-files nil arg) target-directory))
-
-(provide 'htmlize)
-
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions lexical unresolved obsolete)
-;; lexical-binding: t
-;; End:
-
-;;; htmlize.el ends here
diff --git a/ido-vertical-mode-0.1.1.el b/ido-vertical-mode-0.1.1.el
deleted file mode 100644
index f7738d35..00000000
--- a/ido-vertical-mode-0.1.1.el
+++ /dev/null
@@ -1,232 +0,0 @@
-;;; ido-vertical-mode.el --- Makes ido-mode display vertically.
-
-;; Copyright (C) 2013  Steven Degutis
-
-;; Author: Steven Degutis
-;; Maintainer: Daniel Gempesaw 
-;; Version: 0.1.1
-;; Keywords: convenience
-;; URL: https://github.com/gempesaw/ido-vertical-mode.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 .
-
-;;; Commentary:
-
-;; Makes ido-mode display prospects vertically
-
-;;; Code:
-
-(require 'ido)
-
-(defvar ido-vertical-decorations
-  '("\n-> "                             ; left bracket around prospect list
-    ""                                  ; right bracket around prospect list
-    "\n   "                             ; separator between prospects, depends on `ido-separator`
-    "\n   ..."                          ; inserted at the end of a truncated list of prospects
-    "["                                 ; left bracket around common match string
-    "]"                                 ; right bracket around common match string
-    " [No match]"
-    " [Matched]"
-    " [Not readable]"
-    " [Too big]"
-    " [Confirm]"
-    "\n-> "                             ; left bracket around the sole remaining completion
-    ""                                  ; right bracket around the sole remaining completion
-    )
-
-  "Changing the decorations does most of the work for ido-vertical
-
-This sets up newlines and arrows before, between, and after the
-prospects. For additional information, see `ido-decorations'.")
-
-(defvar ido-vertical-old-decorations nil
-  "The original `ido-decorations' variable
-
-We need to keep track of the original value so we can restore it
-when turning `ido-vertical-mode' off")
-
-(defvar ido-vertical-old-completions nil
-  "The original `ido-completions' function
-
-We need to keep track of the original value of `ido-completions'
-so we can restore it when turning `ido-vertical-mode' off")
-
-(defgroup ido-vertical-mode nil
-  "Make ido behave vertically."
-  :group 'ido-mode)
-
-(defcustom ido-vertical-define-keys 'C-n-and-C-p-only
-  "Defines which keys that ido-vertical-mode redefines."
-  :type '(choice
-          (const :tag "Keep default ido keys." nil)
-          (const :tag "C-p and C-n are up & down in match" 'C-n-and-C-p-only)
-          (const :tag "C-p/up and C-n/down are up and down in match." 'C-n-C-p-up-and-down)
-          (const :tag "C-p/up, C-n/down are up/down in match. left or right cycle history or directory." 'C-n-C-p-up-down-left-right))
-  :group 'ido-vertical-mode)
-
-;; borrowed from ido.el and modified to work better when vertical
-(defun ido-vertical-completions (name)
-  ;; Return the string that is displayed after the user's text.
-  ;; Modified from `icomplete-completions'.
-
-  (let* ((comps ido-matches)
-         (ind (and (consp (car comps)) (> (length (cdr (car comps))) 1)
-                   ido-merged-indicator))
-         first)
-
-    (if (and ind ido-use-faces)
-        (put-text-property 0 1 'face 'ido-indicator ind))
-
-    (if (and ido-use-faces comps)
-        (let* ((fn (ido-name (car comps)))
-               (ln (length fn)))
-          (setq first (format "%s" fn))
-          (put-text-property 0 ln 'face
-                             (if (= (length comps) 1)
-                                 (if ido-incomplete-regexp
-                                     'ido-incomplete-regexp
-                                   'ido-only-match)
-                               'ido-first-match)
-                             first)
-          (if ind (setq first (concat first ind)))
-          (setq comps (cons first (cdr comps)))))
-
-    (cond ((null comps)
-           (cond
-            (ido-show-confirm-message
-             (or (nth 10 ido-decorations) " [Confirm]"))
-            (ido-directory-nonreadable
-             (or (nth 8 ido-decorations) " [Not readable]"))
-            (ido-directory-too-big
-             (or (nth 9 ido-decorations) " [Too big]"))
-            (ido-report-no-match
-             (nth 6 ido-decorations))  ;; [No match]
-            (t "")))
-          (ido-incomplete-regexp
-           (concat " " (car comps)))
-          ((null (cdr comps))           ;one match
-           (concat (concat (nth 11 ido-decorations)  ;; [ ... ]
-                           (ido-name (car comps))
-                           (nth 12 ido-decorations))
-                   (if (not ido-use-faces) (nth 7 ido-decorations))))  ;; [Matched]
-          (t                            ;multiple matches
-           (let* ((items (if (> ido-max-prospects 0) (1+ ido-max-prospects) 999))
-                  (alternatives
-                   (apply
-                    #'concat
-                    (cdr (apply
-                          #'nconc
-                          (mapcar
-                           (lambda (com)
-                             (setq com (ido-name com))
-                             (setq items (1- items))
-                             (cond
-                              ((< items 0) ())
-                              ((= items 0) (list (nth 3 ido-decorations))) ; " | ..."
-                              (t
-                               (list (or ido-separator (nth 2 ido-decorations)) ; " | "
-                                     (let ((str (substring com 0)))
-                                       (if (and ido-use-faces
-                                                (not (string= str first))
-                                                (ido-final-slash str))
-                                           (put-text-property 0 (length str) 'face 'ido-subdir str))
-                                       str)))))
-                           comps))))))
-
-             (concat
-              ;; put in common completion item -- what you get by pressing tab
-              (if (and (stringp ido-common-match-string)
-                       (> (length ido-common-match-string) (length name)))
-                  (concat (nth 4 ido-decorations)   ;; [ ... ]
-                          (substring ido-common-match-string (length name))
-                          (nth 5 ido-decorations)))
-              ;; list all alternatives
-              (nth 0 ido-decorations)  ;; { ... }
-              alternatives
-              (nth 1 ido-decorations)))))))
-
-(defun ido-vertical-disable-line-truncation ()
-  "Prevent the newlines in the minibuffer from being truncated"
-  (set (make-local-variable 'truncate-lines) nil))
-
-(defun turn-on-ido-vertical ()
-  (if (and (eq nil ido-vertical-old-decorations)
-         (eq nil ido-vertical-old-completions))
-      (progn
-        (setq ido-vertical-old-decorations ido-decorations)
-        (setq ido-vertical-old-completions (symbol-function 'ido-completions))))
-
-  (setq ido-decorations ido-vertical-decorations)
-  (fset 'ido-completions 'ido-vertical-completions)
-
-  (add-hook 'ido-minibuffer-setup-hook 'ido-vertical-disable-line-truncation)
-  (add-hook 'ido-setup-hook 'ido-vertical-define-keys))
-
-(defun turn-off-ido-vertical ()
-  (setq ido-decorations ido-vertical-old-decorations)
-  (fset 'ido-completions ido-vertical-old-completions)
-
-  (remove-hook 'ido-minibuffer-setup-hook 'ido-vertical-disable-line-truncation)
-  (remove-hook 'ido-setup-hbook 'ido-vertical-define-keys))
-
-(defun ido-vertical-next-match ()
-  "Call the correct next-match function for right key.
-
-This is based on:
-- Different functions for completing directories and prior history.
-"
-  (interactive)
-  (cond
-   ((and (boundp 'item) item (eq item 'file))
-    (ido-next-match-dir))
-   (t
-    (next-history-element 1))))
-
-(defun ido-vertical-prev-match ()
-  "Call the correct prev-match function for left key.
-
-This is based on:
-- Different functions for completing directories and prior history.
-"
-  (interactive)
-  (cond
-   ((and (boundp 'item) item (eq item 'file))
-    (ido-prev-match-dir))
-   (t
-    (previous-history-element 1))))
-
-(defun ido-vertical-define-keys () ;; C-n/p is more intuitive in vertical layout
-  (when ido-vertical-define-keys
-    (define-key ido-completion-map (kbd "C-n") 'ido-next-match)
-    (define-key ido-completion-map (kbd "C-p") 'ido-prev-match)
-    (define-key ido-completion-map (kbd "M-p") 'ido-toggle-prefix))
-  (when (memq ido-vertical-define-keys '(C-n-C-p-up-and-down C-n-C-p-up-down-left-right))
-    (define-key ido-completion-map (kbd "") 'ido-prev-match)
-    (define-key ido-completion-map (kbd "") 'ido-next-match))
-  (when (eq ido-vertical-define-keys 'C-n-C-p-up-down-left-right)
-    (define-key ido-completion-map (kbd "") 'ido-vertical-prev-match)
-    (define-key ido-completion-map (kbd "") 'ido-vertical-next-match)))
-
-;;;###autoload
-(define-minor-mode ido-vertical-mode
-  "Makes ido-mode display vertically."
-  :global t
-  (if ido-vertical-mode
-      (turn-on-ido-vertical)
-    (turn-off-ido-vertical))
-  (message "ido-vertical-mode has been %s"
-           (if ido-vertical-mode "enabled" "disabled")))
-
-(provide 'ido-vertical-mode)
-;;; ido-vertical-mode.el ends here
diff --git a/ipcalc.el b/ipcalc.el
deleted file mode 100644
index 59fdec76..00000000
--- a/ipcalc.el
+++ /dev/null
@@ -1,189 +0,0 @@
-;; ipcalc.el --- IP subnet calculator
-
-;; Filename: ipcalc.el
-;; Description: IP calculator
-;; Author: "Aleksandar Simic" 
-;; License: BSD
-;; Created: 2012-03-11 17:10
-;; Version: 0.2.1
-;; URL: http://github.org/dotemacs/ipcalc.el
-;; Keywords: networking
-
-;;; Commentary:
-;;
-;; Usage: evaluate (ipcalc "192.168.0.23/21")
-
-;;; This file is NOT part of GNU Emacs
-;;
-;; Copyright (c) 2012, Aleksandar Simic
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;; 1. Redistributions of source code must retain the above copyright
-;;    notice, this list of conditions and the following disclaimer.
-;; 2. Redistributions in binary form must reproduce the above
-;;    copyright notice, this list of conditions and the following
-;;    disclaimer in the documentation and/or other materials provided
-;;    with the distribution.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-;; COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
-;; OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;;; Code
-
-(defconst cidr-default 32 "CIDR value")
-
-(defun int-to-bin-string (n &optional length)
-  ;; 08 Jun 1997 Jamie Zawinski  comp.emacs
-  "Convert integer N to bit string (LENGTH, default 8)."
-  (let* ((i    0)
-	 (len  (or length 8))
-	 (s (make-string len ?0)))
-    (while (< i len)
-      (if (not (zerop (logand n (ash 1 i))))
-          (aset s (- len (1+ i)) ?1))
-      (setq i (1+ i))
-      )
-    s))
-
-(defun octets-as-binary (list-of-octets)
-  "return LST of octets as a single binary string"
-  (let ((binary ""))
-  (while list-of-octets
-    (setq binary
-          (concat binary
-                  (int-to-bin-string
-                   (string-to-int (car list-of-octets)))))
-      (setq list-of-octets (cdr list-of-octets)))
-  binary))
-
-(defun ip-to-octets (ip)
-  "split IP address and return the octets"
-  (let ((octets (split-string ip "\\.")))
-    (if (= 4 (length octets))
-        octets
-      (message "not correct IP format"))))
-
-(defun ones-and-pad (num)
-  "return 1's equal to NUM and pad the rest up to 32"
-  (unless (and (<= num cidr-default) (> num 0))
-    (error "wrong value provided"))
-  (concat (make-string num ?1)
-          (make-string (- cidr-default num) ?0)))
-
-(defun invert-binary (num)
-  "Invert 1s to 0s and vice versa
-
-  (credit: the simpler version below re-writen by pjb from #emacs
-          on freenode)"
-  (map 'string
-       (lambda (ch) (aref "10" (position ch "01")))
-       (remove-if-not (lambda (ch) (position ch "01")) num)))
-
-(defun network (ip cidr)
-  "Takes IP & CIDR and produces network"
-  (let ((cidr-as-int (string-to-int cidr)))
-    (concat
-     (substring (octets-as-binary
-                 (ip-to-octets ip)) 0 cidr-as-int)
-     (make-string (- cidr-default cidr-as-int) ?0))))
-
-(defun host+1 (binary-ip)
-  "increment the given BINARY-IP by 1"
-  (let ((tmp binary-ip))
-  (aset tmp (- cidr-default 1) ?1)
-  tmp))
-
-(defun host-max (ip cidr)
-  (let ((count (string-to-int cidr))
-        (max (- cidr-default 1)))
-    (while (< count max)
-      (aset ip count ?1)
-      (setq count(incf count)))
-    ip))
-
-(defun hosts/net (num)
-  "Calculate Hosts/Net for the NUM given"
-  (- (expt 2 (- cidr-default num)) 2))
-
-(defmacro list-to-string (lst)
-  "convert LST to string"
-  `(mapconcat
-    '(lambda (val)
-       (identity (if (integerp val)
-                     (int-to-string val)
-                   val)))
-    ,lst ""))
-
-(defun insert-values (lst)
-  "insert given LST"
-  (insert
-   (list-to-string lst)))
-
-(defun bin-to-int (bin)
-  "Convert binary to integer"
-  (int-to-string (read (concat "#b" bin))))
-
-(defun binary-to-ip (binary)
-  "convert binary to IP address"
-  (let* (full-ip
-        (count 0)
-        (1st-octet (substring binary 0 8))
-        (2nd-octet (substring binary 8 16))
-        (3rd-octet (substring binary 16 24))
-        (4th-octet (substring binary 24 32))
-        (octets (mapcar
-                 'bin-to-int
-                 `(,1st-octet ,2nd-octet ,3rd-octet ,4th-octet))))
-    (while (< count 3)
-      (setq full-ip (concat full-ip (nth count octets) "."))
-      (setq count (incf count)))
-    (concat full-ip (car (last octets)))))
-
-(defun ipcalc (ip/cidr)
-  "IP calculator"
-  (let* ((ip (car (split-string ip/cidr "/")))
-         (ip-in-binary (octets-as-binary (ip-to-octets ip)))
-         (cidr (car (cdr (split-string ip/cidr "/"))))
-         (cidr-int (string-to-int cidr))
-         (cidr-binary (ones-and-pad cidr-int))
-         (wildcard-binary (invert-binary (ones-and-pad cidr-int)))
-         (wildcard-ip (binary-to-ip wildcard-binary))
-         (netmask (binary-to-ip (invert-binary wildcard-binary)))
-         (net-binary (network ip cidr))
-         (net-ip (binary-to-ip net-binary))
-         (host-max-binary (host-max (network ip cidr) cidr))
-         (host-max-ip (binary-to-ip host-max-binary))
-         (host-min-binary (host+1 (network ip cidr)))
-         (host-min-ip (binary-to-ip host-min-binary))
-         (broadcast-binary (host+1 (host-max net-binary cidr)))
-         (broadcast-ip (binary-to-ip broadcast-binary))
-         (buffer "*ipcalc*"))
-    (if (get-buffer buffer)
-        (kill-buffer buffer))
-    (pop-to-buffer buffer)
-    (insert
-     (format "Address:%15s%41s\n" ip ip-in-binary)
-     (format "Netmask:%16s = %2s %34s\n" netmask cidr cidr-binary)
-     (format "Wildcard:%11s%44s\n" wildcard-ip wildcard-binary)
-     (format "=>\nNetwork:%14s%42s\n" net-ip (network ip cidr))
-     (format "HostMin:%14s%42s\n" host-min-ip host-min-binary)
-     (format "HostMax:%16s%40s\n" host-max-ip host-max-binary)
-     (format "Broadcast:%14s%40s\n" broadcast-ip broadcast-binary)
-     (format "Hosts/Net: %d\n" (hosts/net cidr-int)))))
-
-(provide 'ipcalc)
-
-;;; ipcalc.el ends here
diff --git a/lisp/cfengine-code-style.el b/lisp/cfengine-code-style.el
new file mode 100644
index 00000000..237ca9e8
--- /dev/null
+++ b/lisp/cfengine-code-style.el
@@ -0,0 +1,66 @@
+;;; cfengine-code-style.el --- C code style for CFEngine project.
+
+;; Author: Mikhail Gusarov 
+;; URL: https://github.com/cfengine/core
+
+;;; Commentary:
+
+;; Usage:
+;;
+;; To enable coding style for the current buffer:
+;;
+;;     M-x c-set-style cfengine
+;;
+;; To enable coding style permanently, create file .dir-locals.el with the
+;; following contents in the directory with the source code:
+;;
+;;     ((c-mode . ((c-file-style . "cfengine"))))
+;;
+
+;;
+;; TODO: special rule for C99 (Foo) { 1, 2, 3 } initializers.
+;; TODO: special rule for whitespace between if/while/for and paren.
+;;
+
+;;; Code:
+
+(defconst cfengine-c-style
+  '(;; 4 spaces
+    (c-basic-offset . 4)
+    ;; Braces on new lines
+    (c-hanging-braces-alist . ((substatement-open before after)
+                               (statement-cont)
+                               (brace-list-open)
+                               (brace-list-close)
+                               (brace-list-intro)
+                               (brace-entry-open)))
+    ;; Newline after 'case' label
+    (c-hanging-colons-alist . ((case-label after)))
+    ;; Don't place comma on a separate line after array/aggregate
+    (c-cleanup-list . (list-close-comma))
+    ;; Indentation
+    (c-offsets-alist . ((defun-open . 0)
+                        (defun-block-intro . +)
+                        (substatement-open . 0)
+                        (statement-cont . +))))
+  "CFEngine Code Style")
+
+(c-add-style "CFEngine" cfengine-c-style)
+
+;;
+;; CFEngine uses CapitalizedWords for function names
+;;
+
+(defun cfengine-c-mode-hook ()
+  (if (eq c-file-style "CFEngine")
+      (progn
+        (setq indent-tabs-mode nil)
+        (setq c-tab-always-indent t)
+        (setq tab-width 4)
+        (subword-mode 1))))
+
+(add-hook 'c-mode-hook 'cfengine-c-mode-hook)
+
+(provide 'cfengine-code-style)
+
+;;; cfengine-code-style.el ends here
diff --git a/lisp/cfengine.el b/lisp/cfengine.el
new file mode 100644
index 00000000..9ff3ca08
--- /dev/null
+++ b/lisp/cfengine.el
@@ -0,0 +1,1455 @@
+;;; cfengine.el --- mode for editing Cfengine files
+
+;; Copyright (C) 2001-2014 Free Software Foundation, Inc.
+
+;; Author: Dave Love 
+;; Maintainer: Ted Zlatanov 
+;; Keywords: languages
+;; Version: 1.3
+
+;; This file is part of GNU Emacs, but has trivial compatibility
+;; modifications for Emacs versions before 24.  Emacs 24 and newer
+;; includes this code and you should use that version.  The following
+;; is the copyright notice from Emacs, which still applies to this
+;; code and all derivations thereof.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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.  If not, see .
+
+;;; Commentary:
+
+;; Provides support for editing GNU Cfengine files, including
+;; font-locking, Imenu and indentation, but with no special keybindings.
+
+;; By default, CFEngine 3.x syntax is used.
+
+;; You can set it up so either `cfengine2-mode' (2.x and earlier) or
+;; `cfengine3-mode' (3.x) will be picked, depending on the buffer
+;; contents:
+
+;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine-auto-mode))
+
+;; OR you can choose to always use a specific version, if you prefer
+;; it:
+
+;; (add-to-list 'auto-mode-alist '("\\.cf\\'" . cfengine3-mode))
+;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode))
+;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode))
+
+;; It's *highly* recommended that you enable the eldoc minor mode:
+
+;; (add-hook 'cfengine3-mode-hook 'eldoc-mode)
+
+;; It's *highly* recommended that you use this mode with the latest
+;; Emacs, or at least 24.1.
+
+;; This is not the same as the mode written by Rolf Ebert
+;; , distributed with cfengine-2.0.5.  It does
+;; better fontification and indentation, inter alia.
+
+;;; Code:
+
+;; Set up compatibility with Emacsen where prog-mode doesn't exist.
+(defalias 'cfengine-prog-mode (if (fboundp 'prog-mode)
+                                  'prog-mode
+                                'fundamental-mode))
+
+;; `setq-local' was introduced in 24.3
+(eval-when-compile
+  (or (fboundp 'setq-local)
+      (defmacro setq-local (var val)
+        `(set (make-local-variable ',var) ,val))))
+
+(autoload 'json-read "json")
+(autoload 'regexp-opt "regexp-opt")
+
+(defgroup cfengine ()
+  "Editing CFEngine files."
+  :group 'languages)
+
+(defcustom cfengine-indent 2
+  "Size of a CFEngine indentation step in columns."
+  :group 'cfengine
+  :type 'integer)
+
+(defcustom cfengine-cf-promises
+  (or (executable-find "cf-promises")
+      (executable-find "/var/cfengine/bin/cf-promises")
+      (executable-find "/usr/bin/cf-promises")
+      (executable-find "/usr/sbin/cf-promises")
+      (executable-find "/usr/local/bin/cf-promises")
+      (executable-find "/usr/local/sbin/cf-promises")
+      (executable-find "~/bin/cf-promises")
+      (executable-find "~/sbin/cf-promises"))
+  "The location of the cf-promises executable.
+Used for syntax discovery and checking.  Set to nil to disable
+the `compile-command' override.  In that case, the ElDoc support
+will use a fallback syntax definition."
+  :version "24.4"
+  :group 'cfengine
+  :type '(choice file (const nil)))
+
+(defcustom cfengine-parameters-indent '(promise pname 0)
+  "Indentation of CFEngine3 promise parameters (hanging indent).
+
+For example, say you have this code:
+
+bundle x y
+{
+  section:
+    class::
+      promise ...
+      promiseparameter => ...
+}
+
+You can choose to indent promiseparameter from the beginning of
+the line (absolutely) or from the word \"promise\" (relatively).
+
+You can also choose to indent the start of the word
+\"promiseparameter\" or the arrow that follows it.
+
+Finally, you can choose the amount of the indent.
+
+The default is to anchor at promise, indent parameter name, and offset 0:
+
+bundle agent rcfiles
+{
+  files:
+    any::
+      \"/tmp/netrc\"
+      comment => \"my netrc\",
+      perms => mog(\"600\", \"tzz\", \"tzz\");
+}
+
+Here we anchor at beginning of line, indent arrow, and offset 10:
+
+bundle agent rcfiles
+{
+  files:
+    any::
+      \"/tmp/netrc\"
+  comment => \"my netrc\",
+    perms => mog(\"600\", \"tzz\", \"tzz\");
+}
+
+Some, including cfengine_stdlib.cf, like to anchor at promise, indent
+arrow, and offset 16 or so:
+
+bundle agent rcfiles
+{
+  files:
+    any::
+      \"/tmp/netrc\"
+              comment => \"my netrc\",
+                perms => mog(\"600\", \"tzz\", \"tzz\");
+}
+"
+  :version "24.4"
+  :group 'cfengine
+  :type '(list
+          (choice (const :tag "Anchor at beginning of promise" promise)
+                  (const :tag "Anchor at beginning of line" bol))
+          (choice (const :tag "Indent parameter name" pname)
+                  (const :tag "Indent arrow" arrow))
+          (integer :tag "Indentation amount from anchor")))
+
+(defvar cfengine-mode-debug nil
+  "Whether `cfengine-mode' should print debugging info.")
+
+(defvar cfengine-mode-syntax-cache nil
+  "Cache for `cfengine-mode' syntax trees obtained from 'cf-promises -s json'.")
+
+; Be sure to keep these two in sync with libpromises/cf3.defs.h
+(defconst cfengine3-uint-range "0,2147483647")
+(defconst cfengine3-sint-range "-2147483648,2147483647")
+
+(defconst cfengine3-fallback-syntax
+  '((functions
+     (userexists
+      (category . "system") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (usemodule
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (unique
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (translatepath
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (sum
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "real") (status . "normal"))
+     (sublist
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "head,tail") (type . "option"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "slist") (status . "normal"))
+     (strftime
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "gmtime,localtime") (type . "option"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "string") (status . "normal"))
+     (strcmp
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (splitstring
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "slist") (status . "normal"))
+     (splayclass
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "daily,hourly") (type . "option"))])
+      (returnType . "context") (status . "normal"))
+     (sort
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "lex") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (some
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (shuffle
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (selectservers
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (reverse
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (rrange
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "-9.99999E100,9.99999E100") (type . "real"))
+                     ((range . "-9.99999E100,9.99999E100") (type . "real"))])
+      (returnType . "rrange") (status . "normal"))
+     (returnszero
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . "useshell,noshell,powershell") (type . "option"))])
+      (returnType . "context") (status . "normal"))
+     (remoteclassesmatching
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "true,false,yes,no,on,off") (type . "option"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (remotescalar
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "true,false,yes,no,on,off") (type . "option"))])
+      (returnType . "string") (status . "normal"))
+     (regldap
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "subtree,onelevel,base") (type . "option"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "none,ssl,sasl") (type . "option"))])
+      (returnType . "context") (status . "normal"))
+     (reglist
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (regline
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (registryvalue
+      (category . "system") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (regextract
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (regcmp
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (regarray
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (readtcp
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "string") (status . "normal"))
+     (readstringlist
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "slist") (status . "normal"))
+     (readstringarrayidx
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (readstringarray
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (readreallist
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "rlist") (status . "normal"))
+     (readrealarray
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (readintlist
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "ilist") (status . "normal"))
+     (readintarray
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (readfile
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "string") (status . "normal"))
+     (randomint
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . cfengine3-sint-range) (type . "int"))
+                     ((range . cfengine3-sint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (product
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "real") (status . "normal"))
+     (peerleaders
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "slist") (status . "normal"))
+     (peerleader
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "string") (status . "normal"))
+     (peers
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "slist") (status . "normal"))
+     (parsestringarrayidx
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (parsestringarray
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (parserealarray
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (parseintarray
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (or
+      (category . "data") (variadic . t)
+      (parameters . [])
+      (returnType . "string") (status . "normal"))
+     (on
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "1970,3000") (type . "int"))
+                     ((range . "1,12") (type . "int"))
+                     ((range . "1,31") (type . "int"))
+                     ((range . "0,23") (type . "int"))
+                     ((range . "0,59") (type . "int"))
+                     ((range . "0,59") (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (nth
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "string") (status . "normal"))
+     (now
+      (category . "system") (variadic . :json-false)
+      (parameters . [])
+      (returnType . "int") (status . "normal"))
+     (not
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (none
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (maplist
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (maparray
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (lsdir
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . ".+") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "true,false,yes,no,on,off") (type . "option"))])
+      (returnType . "slist") (status . "normal"))
+     (length
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (ldapvalue
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "subtree,onelevel,base") (type . "option"))
+                     ((range . "none,ssl,sasl") (type . "option"))])
+      (returnType . "string") (status . "normal"))
+     (ldaplist
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "subtree,onelevel,base") (type . "option"))
+                     ((range . "none,ssl,sasl") (type . "option"))])
+      (returnType . "slist") (status . "normal"))
+     (ldaparray
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . "subtree,onelevel,base") (type . "option"))
+                     ((range . "none,ssl,sasl") (type . "option"))])
+      (returnType . "context") (status . "normal"))
+     (laterthan
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,40000") (type . "int"))])
+      (returnType . "context") (status . "normal"))
+     (lastnode
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (join
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (isvariable
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (isplain
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (isnewerthan
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (islink
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (islessthan
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (isgreaterthan
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (isexecutable
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (isdir
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (irange
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . cfengine3-sint-range) (type . "int"))
+                     ((range . cfengine3-sint-range) (type . "int"))])
+      (returnType . "irange") (status . "normal"))
+     (iprange
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (intersection
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (ifelse
+      (category . "data") (variadic . t)
+      (parameters . [])
+      (returnType . "string") (status . "normal"))
+     (hubknowledge
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (hostswithclass
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_]+") (type . "string"))
+                     ((range . "name,address") (type . "option"))])
+      (returnType . "slist") (status . "normal"))
+     (hostsseen
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . cfengine3-uint-range) (type . "int"))
+                     ((range . "lastseen,notseen") (type . "option"))
+                     ((range . "name,address") (type . "option"))])
+      (returnType . "slist") (status . "normal"))
+     (hostrange
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (hostinnetgroup
+      (category . "system") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (ip2host
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (host2ip
+      (category . "communication") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (hashmatch
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . "md5,sha1,crypt,cf_sha224,cf_sha256,cf_sha384,cf_sha512") (type . "option"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (hash
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "md5,sha1,sha256,sha512,sha384,crypt") (type . "option"))])
+      (returnType . "string") (status . "normal"))
+     (groupexists
+      (category . "system") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (grep
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (getvalues
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (getusers
+      (category . "system") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (getuid
+      (category . "system") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (getindices
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (getgid
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (getfields
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))
+                     ((range . ".*") (type . "string"))
+                     ((range . ".*") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (getenv
+      (category . "system") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "string") (status . "normal"))
+     (format
+      (category . "data") (variadic . t)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (filter
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "true,false,yes,no,on,off") (type . "option"))
+                     ((range . "true,false,yes,no,on,off") (type . "option"))
+                     ((range . cfengine3-uint-range) (type . "int"))])
+      (returnType . "slist") (status . "normal"))
+     (filestat
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . "size,gid,uid,ino,nlink,ctime,atime,mtime,mode,modeoct,permstr,permoct,type,devno,dev_minor,dev_major,basename,dirname") (type . "option"))])
+      (returnType . "string") (status . "normal"))
+     (filesize
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (filesexist
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (fileexists
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (execresult
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . ".+") (type . "string"))
+                     ((range . "useshell,noshell,powershell") (type . "option"))])
+      (returnType . "string") (status . "normal"))
+     (every
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (escape
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (diskfree
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (dirname
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (difference
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+                     ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (countlinesmatching
+      (category . "io") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (countclassesmatching
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "int") (status . "normal"))
+     (classesmatching
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "slist") (status . "normal"))
+     (classmatch
+      (category . "utils") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (classify
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (changedbefore
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))
+     (concat
+      (category . "data") (variadic . t)
+      (parameters . [])
+      (returnType . "string") (status . "normal"))
+     (canonify
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . ".*") (type . "string"))])
+      (returnType . "string") (status . "normal"))
+     (and
+      (category . "data") (variadic . t)
+      (parameters . [])
+      (returnType . "string") (status . "normal"))
+     (ago
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,40000") (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (accumulated
+      (category . "data") (variadic . :json-false)
+      (parameters . [((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,1000") (type . "int"))
+                     ((range . "0,40000") (type . "int"))])
+      (returnType . "int") (status . "normal"))
+     (accessedbefore
+      (category . "files") (variadic . :json-false)
+      (parameters . [((range . "\"?(/.*)") (type . "string"))
+                     ((range . "\"?(/.*)") (type . "string"))])
+      (returnType . "context") (status . "normal"))))
+  "Fallback CFEngine syntax, containing just function definitions.")
+
+(defvar cfengine-mode-syntax-functions-regex
+  (regexp-opt (mapcar (lambda (def)
+                        (format "%s" (car def)))
+                      (cdr (assq 'functions cfengine3-fallback-syntax)))
+              'symbols))
+
+(defcustom cfengine-mode-abbrevs nil
+  "Abbrevs for CFEngine2 mode."
+  :group 'cfengine
+  :type '(repeat (list (string :tag "Name")
+		       (string :tag "Expansion")
+		       (choice  :tag "Hook" (const nil) function))))
+
+(make-obsolete-variable 'cfengine-mode-abbrevs 'edit-abbrevs "24.1")
+
+;; Taken from the doc for pre-release 2.1.
+(eval-and-compile
+  (defconst cfengine2-actions
+    '("acl" "alerts" "binservers" "broadcast" "control" "classes" "copy"
+      "defaultroute" "disks" "directories" "disable" "editfiles" "files"
+      "filters" "groups" "homeservers" "ignore" "import" "interfaces"
+      "links" "mailserver" "methods" "miscmounts" "mountables"
+      "processes" "packages" "rename" "required" "resolve"
+      "shellcommands" "tidy" "unmount"
+      ;; Keywords for cfservd.
+      "admit" "grant" "deny")
+    "List of the action keywords supported by Cfengine.
+This includes those for cfservd as well as cfagent.")
+
+  (defconst cfengine3-defuns '("bundle" "body")
+    "List of the CFEngine 3.x defun headings.")
+
+  (defconst cfengine3-defuns-regex (regexp-opt cfengine3-defuns t)
+    "Regex to match the CFEngine 3.x defuns.")
+
+  (defconst cfengine3-defun-full-re (concat "^\\s-*" cfengine3-defuns-regex
+                                            "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type
+                                            "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id
+                                            )
+    "Regexp matching full defun declaration (excluding argument list).")
+
+  (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::")
+
+  (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
+
+  (defconst cfengine3-vartypes '("string" "int" "real" "slist" "ilist" "rlist"
+                                 "irange" "rrange" "counter" "data")
+    "List of the CFEngine 3.x variable types."))
+
+(defconst cfengine-font-lock-syntactic-keywords
+  ;; In the main syntax-table, backslash is marked as a punctuation, because
+  ;; of its use in DOS-style directory separators.  Here we try to recognize
+  ;; the cases where backslash is used as an escape inside strings.
+  '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\")))
+
+(defvar cfengine2-font-lock-keywords
+  `(;; Actions.
+    ;; List the allowed actions explicitly, so that errors are more obvious.
+    (,(concat "^[ \t]*" (eval-when-compile
+			  (regexp-opt cfengine2-actions t))
+	      ":")
+     1 font-lock-keyword-face)
+    ;; Classes.
+    ("^[ \t]*\\([[:alnum:]_().|!]+\\)::" 1 font-lock-function-name-face)
+    ;; Variables.
+    ("$(\\([[:alnum:]_]+\\))" 1 font-lock-variable-name-face)
+    ("${\\([[:alnum:]_]+\\)}" 1 font-lock-variable-name-face)
+    ;; Variable definitions.
+    ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
+    ;; File, acl &c in group:   { token ... }
+    ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
+
+(defvar cfengine3-font-lock-keywords
+  `(
+    ;; Defuns.  This happens early so they don't get caught by looser
+    ;; patterns.
+    (,(concat "\\_<" cfengine3-defuns-regex "\\_>"
+              "[ \t]+\\_<\\([[:alnum:]_.:]+\\)\\_>"
+              "[ \t]+\\_<\\([[:alnum:]_.:]+\\)"
+              ;; Optional parentheses with variable names inside.
+              "\\(?:(\\([^)]*\\))\\)?")
+     (1 font-lock-builtin-face)
+     (2 font-lock-constant-face)
+     (3 font-lock-function-name-face)
+     (4 font-lock-variable-name-face nil t))
+
+    ;; Class selectors.
+    (,(concat "^[ \t]*" cfengine3-class-selector-regex)
+     1 font-lock-keyword-face)
+
+    ;; Categories.
+    (,(concat "^[ \t]*" cfengine3-category-regex)
+     1 font-lock-builtin-face)
+
+    ;; Variables, including scope, e.g. module.var
+    ("[@$](\\([[:alnum:]_.:]+\\))" 1 font-lock-variable-name-face)
+    ("[@$]{\\([[:alnum:]_.:]+\\)}" 1 font-lock-variable-name-face)
+
+    ;; Variable definitions.
+    ("\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face)
+
+    ;; Variable types.
+    (,(concat "\\_<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\_>")
+     1 font-lock-type-face)))
+
+(defvar cfengine2-imenu-expression
+  `((nil ,(concat "^[ \t]*" (eval-when-compile
+			      (regexp-opt cfengine2-actions t))
+		  ":[^:]")
+	 1)
+    ("Variables/classes" "\\_<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1)
+    ("Variables/classes" "\\_[ \t]+\\([[:alnum:]_]+\\)" 1))
+  "`imenu-generic-expression' for CFEngine mode.")
+
+(defun cfengine2-outline-level ()
+  "`outline-level' function for CFEngine mode."
+  (if (looking-at "[^:]+\\(?:[:]+\\)$")
+      (length (match-string 1))))
+
+(defun cfengine2-beginning-of-defun ()
+  "`beginning-of-defun' function for CFEngine mode.
+Treats actions as defuns."
+  (unless (<= (current-column) (current-indentation))
+    (end-of-line))
+  (if (re-search-backward "^[[:alpha:]]+: *$" nil t)
+      (beginning-of-line)
+    (goto-char (point-min)))
+  t)
+
+(defun cfengine2-end-of-defun ()
+  "`end-of-defun' function for CFEngine mode.
+Treats actions as defuns."
+  (end-of-line)
+  (if (re-search-forward "^[[:alpha:]]+: *$" nil t)
+      (beginning-of-line)
+    (goto-char (point-max)))
+  t)
+
+;; Fixme: Should get an extra indent step in editfiles BeginGroup...s.
+
+(defun cfengine2-indent-line ()
+  "Indent a line in Cfengine mode.
+Intended as the value of `indent-line-function'."
+  (let ((pos (- (point-max) (point))))
+    (save-restriction
+      (narrow-to-defun)
+      (back-to-indentation)
+      (cond
+       ;; Action selectors aren't indented; class selectors are
+       ;; indented one step.
+       ((looking-at "[[:alnum:]_().|!]+:\\(:\\)?")
+	(if (match-string 1)
+	    (indent-line-to cfengine-indent)
+	  (indent-line-to 0)))
+       ;; Outdent leading close brackets one step.
+       ((or (eq ?\} (char-after))
+	    (eq ?\) (char-after)))
+	(condition-case ()
+	    (indent-line-to (save-excursion
+			      (forward-char)
+			      (backward-sexp)
+			      (current-column)))
+	  (error nil)))
+       ;; Inside brackets/parens: indent to start column of non-comment
+       ;; token on line following open bracket or by one step from open
+       ;; bracket's column.
+       ((condition-case ()
+	    (progn (indent-line-to (save-excursion
+				     (backward-up-list)
+				     (forward-char)
+				     (skip-chars-forward " \t")
+				     (if (looking-at "[^\n#]")
+					 (current-column)
+				       (skip-chars-backward " \t")
+				       (+ (current-column) -1
+					  cfengine-indent))))
+		   t)
+	  (error nil)))
+       ;; Indent by  two steps after a class selector.
+       ((save-excursion
+	  (re-search-backward "^[ \t]*[[:alnum:]_().|!]+::" nil t))
+	(indent-line-to (* 2 cfengine-indent)))
+       ;; Indent by one step if we're after an action header.
+       ((save-excursion
+	  (goto-char (point-min))
+	  (looking-at "[[:alpha:]]+:[ \t]*$"))
+	(indent-line-to cfengine-indent))
+       ;; Else don't indent.
+       (t
+	(indent-line-to 0))))
+    ;; If initial point was within line's indentation,
+    ;; position after the indentation.  Else stay at same point in text.
+    (if (> (- (point-max) pos) (point))
+	(goto-char (- (point-max) pos)))))
+
+;; This doesn't work too well in Emacs 21.2.  See 22.1 development
+;; code.
+(defun cfengine-fill-paragraph (&optional justify)
+  "Fill `paragraphs' in Cfengine code."
+  (interactive "P")
+  (or (if (fboundp 'fill-comment-paragraph)
+	  (fill-comment-paragraph justify) ; post Emacs 21.3
+	;; else do nothing in a comment
+	(nth 4 (parse-partial-sexp (save-excursion
+				     (beginning-of-defun)
+				     (point))
+				   (point))))
+      (let ((paragraph-start
+	     ;; Include start of parenthesized block.
+	     "\f\\|[ \t]*$\\|.*\(")
+	    (paragraph-separate
+	     ;; Include action and class lines, start and end of
+	     ;; bracketed blocks and end of parenthesized blocks to
+	     ;; avoid including these in fill.  This isn't ideal.
+	     "[ \t\f]*$\\|.*#\\|.*[\){}]\\|\\s-*[[:alpha:]_().|!]+:")
+	    fill-paragraph-function)
+	(fill-paragraph justify))
+      t))
+
+(defun cfengine3-beginning-of-defun ()
+  "`beginning-of-defun' function for Cfengine 3 mode.
+Treats body/bundle blocks as defuns."
+  (unless (<= (current-column) (current-indentation))
+    (end-of-line))
+  (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t)
+      (beginning-of-line)
+    (goto-char (point-min)))
+  t)
+
+(defun cfengine3-end-of-defun ()
+  "`end-of-defun' function for Cfengine 3 mode.
+Treats body/bundle blocks as defuns."
+  (end-of-line)
+  (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\_>") nil t)
+      (beginning-of-line)
+    (goto-char (point-max)))
+  t)
+
+(defun cfengine3-indent-line ()
+  "Indent a line in Cfengine 3 mode.
+Intended as the value of `indent-line-function'."
+  (let ((pos (- (point-max) (point)))
+        parse)
+    (save-restriction
+      (narrow-to-defun)
+      (back-to-indentation)
+      (setq parse (parse-partial-sexp (point-min) (point)))
+      (when cfengine-mode-debug
+        (message "%S" parse))
+
+      (cond
+       ;; Body/bundle blocks start at 0.
+       ((looking-at (concat cfengine3-defuns-regex "\\_>"))
+        (indent-line-to 0))
+       ;; Categories are indented one step.
+       ((looking-at (concat cfengine3-category-regex "[ \t]*\\(#.*\\)*$"))
+        (indent-line-to cfengine-indent))
+       ;; Class selectors are indented two steps.
+       ((looking-at (concat cfengine3-class-selector-regex "[ \t]*\\(#.*\\)*$"))
+        (indent-line-to (* 2 cfengine-indent)))
+       ;; Outdent leading close brackets one step.
+       ((or (eq ?\} (char-after))
+            (eq ?\) (char-after)))
+        (condition-case ()
+            (indent-line-to (save-excursion
+                              (forward-char)
+                              (backward-sexp)
+                              (move-beginning-of-line nil)
+                              (skip-chars-forward " \t")
+                              (current-column)))
+          (error nil)))
+       ;; Inside a string and it starts before this line: do nothing.
+       ((and (nth 3 parse)
+             (< (nth 8 parse) (save-excursion (beginning-of-line) (point))))
+        )
+
+       ;; Inside a defun, but not a nested list (depth is 1).  This is
+       ;; a promise, usually.
+
+       ;; Indent to cfengine-indent times the nested depth
+       ;; plus 2.  That way, promises indent deeper than class
+       ;; selectors, which in turn are one deeper than categories.
+       ((= 1 (nth 0 parse))
+        (let ((p-anchor (nth 0 cfengine-parameters-indent))
+              (p-what (nth 1 cfengine-parameters-indent))
+              (p-indent (nth 2 cfengine-parameters-indent)))
+          ;; Do we have the parameter anchor and location and indent
+          ;; defined, and are we looking at a promise parameter?
+          (if (and p-anchor p-what p-indent
+                   (looking-at  "\\([[:alnum:]_]+[ \t]*\\)=>"))
+              (let* ((arrow-offset (* -1 (length (match-string 1))))
+                     (extra-offset (if (eq p-what 'arrow) arrow-offset 0))
+                     (base-offset (if (eq p-anchor 'promise)
+                                      (* (+ 2 (nth 0 parse)) cfengine-indent)
+                                    0)))
+                (indent-line-to (max 0 (+ p-indent base-offset extra-offset))))
+            ;; Else, indent to cfengine-indent times the nested depth
+            ;; plus 2.  That way, promises indent deeper than class
+            ;; selectors, which in turn are one deeper than categories.
+          (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent)))))
+       ;; Inside brackets/parens: indent to start column of non-comment
+       ;; token on line following open bracket or by one step from open
+       ;; bracket's column.
+       ((condition-case ()
+            (progn (indent-line-to (save-excursion
+                                     (backward-up-list)
+                                     (forward-char)
+                                     (skip-chars-forward " \t")
+                                     (cond
+                                      ((looking-at "[^\n#]")
+                                       (current-column))
+                                      ((looking-at "[^\n#]")
+                                       (current-column))
+                                      (t
+                                       (skip-chars-backward " \t")
+                                       (+ (current-column) -1
+                                          cfengine-indent)))))
+                   t)
+          (error nil)))
+       ;; Else don't indent.
+       (t (indent-line-to 0))))
+    ;; If initial point was within line's indentation,
+    ;; position after the indentation.  Else stay at same point in text.
+    (if (> (- (point-max) pos) (point))
+        (goto-char (- (point-max) pos)))))
+
+;; CFEngine 3.x grammar
+
+;; specification: blocks
+;; blocks: block | blocks block;
+;; block:                 bundle typeid blockid bundlebody
+;;                      | bundle typeid blockid usearglist bundlebody
+;;                      | body typeid blockid bodybody
+;;                      | body typeid blockid usearglist bodybody;
+
+;; typeid: id
+;; blockid: id
+;; usearglist: '(' aitems ')';
+;; aitems: aitem | aitem ',' aitems |;
+;; aitem: id
+
+;; bundlebody: '{' statements '}'
+;; statements: statement | statements statement;
+;; statement: category | classpromises;
+
+;; bodybody: '{' bodyattribs '}'
+;; bodyattribs: bodyattrib | bodyattribs bodyattrib;
+;; bodyattrib: class | selections;
+;; selections: selection | selections selection;
+;; selection: id ASSIGN rval ';' ;
+
+;; classpromises: classpromise | classpromises classpromise;
+;; classpromise: class | promises;
+;; promises: promise | promises promise;
+;; category: CATEGORY
+;; promise: promiser ARROW rval constraints ';' | promiser constraints ';';
+;; constraints: constraint | constraints ',' constraint |;
+;; constraint: id ASSIGN rval;
+;; class: CLASS
+;; id: ID
+;; rval: ID | QSTRING | NAKEDVAR | list | usefunction
+;; list: '{' litems '}' ;
+;; litems: litem | litem ',' litems |;
+;; litem: ID | QSTRING | NAKEDVAR | list | usefunction
+
+;; functionid: ID | NAKEDVAR
+;; promiser: QSTRING
+;; usefunction: functionid givearglist
+;; givearglist: '(' gaitems ')'
+;; gaitems: gaitem | gaitems ',' gaitem |;
+;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction
+
+;; # from lexer:
+
+;; bundle: "bundle"
+;; body: "body"
+;; COMMENT    #[^\n]*
+;; NAKEDVAR   [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}]
+;; ID: [a-zA-Z0-9_\200-\377]+
+;; ASSIGN: "=>"
+;; ARROW: "->"
+;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*`
+;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
+;; CATEGORY: [a-zA-Z_]+:
+
+(defun cfengine3--current-function ()
+  "Look up current CFEngine 3 function"
+  (let* ((syntax (cfengine3-make-syntax-cache))
+         (flist (assq 'functions syntax)))
+    (when flist
+      (let ((w (save-excursion
+                 (skip-syntax-forward "w_")
+                 (when (search-backward-regexp
+                        cfengine-mode-syntax-functions-regex
+                        (point-at-bol)
+                        t)
+                   (match-string 1)))))
+        (and w (assq (intern w) flist))))))
+
+;; format from "cf-promises -s json", e.g. "sort" function:
+;; ((category . "data")
+;;  (variadic . :json-false)
+;;  (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+;;                 ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))])
+;;  (returnType . "slist")
+;;  (status . "normal"))
+
+(defun cfengine3-format-function-docstring (fdef)
+  (let* ((f (format "%s" (car-safe fdef)))
+         (def (cdr fdef))
+         (rtype (cdr (assq 'returnType def)))
+         (plist (cdr (assq 'parameters def)))
+         (has-some-parameters (> (length plist) 0))
+         (variadic (eq t (cdr (assq 'variadic def)))))
+
+    ;; (format "[%S]%s %s(%s%s)" def
+    (format "%s %s(%s%s)"
+            (if rtype
+                (propertize rtype 'face 'font-lock-variable-name-face)
+              "???")
+            (propertize f 'face 'font-lock-function-name-face)
+            (mapconcat (lambda (p)
+                         (let ((type (cdr (assq 'type p)))
+                               (range (cdr (assq 'range p))))
+                           (cond
+                            ((not (stringp type)) "???type???")
+                            ((not (stringp range)) "???range???")
+                            ;; options are lists of possible keywords
+                            ((equal type "option")
+                             (propertize (concat "[" range "]")
+                                         'face
+                                         'font-lock-keyword-face))
+                            ;; anything else is a type name as a variable
+                            (t (propertize type
+                                           'face
+                                           'font-lock-variable-name-face)))))
+                       plist
+                       ", ")
+            (if variadic
+                (if has-some-parameters ", ..." "...")
+              ""))))
+
+(defun cfengine3-clear-syntax-cache ()
+  "Clear the internal syntax cache.
+Should not be necessary unless you reinstall CFEngine."
+  (interactive)
+  (setq cfengine-mode-syntax-functions-regex nil)
+  (setq cfengine-mode-syntax-cache nil))
+
+(defun cfengine3-make-syntax-cache ()
+  "Build the CFEngine 3 syntax cache and return the syntax.
+Calls `cfengine-cf-promises' with \"-s json\"."
+  (or (cdr (assoc cfengine-cf-promises cfengine-mode-syntax-cache))
+      (let ((syntax (or (when cfengine-cf-promises
+                          (with-demoted-errors "cfengine3-make-syntax-cache: %S"
+                            (with-temp-buffer
+                              (or (zerop (process-file cfengine-cf-promises
+                                                       nil ; no input
+                                                       t   ; output
+                                                       nil ; no redisplay
+                                                       "-s" "json"))
+                                  (error "%s" (buffer-substring
+                                               (point-min)
+                                               (progn (goto-char (point-min))
+                                                      (line-end-position)))))
+                              (goto-char (point-min))
+                              (json-read))))
+                        cfengine3-fallback-syntax)))
+        (push (cons cfengine-cf-promises syntax)
+              cfengine-mode-syntax-cache)
+        (setq cfengine-mode-syntax-functions-regex
+              (regexp-opt (mapcar (lambda (def)
+                                    (format "%s" (car def)))
+                                  (cdr (assq 'functions syntax)))
+                          'symbols))
+        syntax)))
+
+(defun cfengine3-documentation-function ()
+  "Document CFengine 3 functions around point.
+Intended as the value of `eldoc-documentation-function', which see.
+Use it by enabling `eldoc-mode'."
+  (let ((fdef (cfengine3--current-function)))
+    (when fdef
+      (cfengine3-format-function-docstring fdef))))
+
+(defun cfengine3-completion-function ()
+  "Return completions for function name around or before point."
+  (let* ((bounds (save-excursion
+                   (let ((p (point)))
+                     (skip-syntax-backward "w_" (point-at-bol))
+                     (list (point) p))))
+         (syntax (cfengine3-make-syntax-cache))
+         (flist (assq 'functions syntax)))
+    (when bounds
+      (append bounds (list (cdr flist))))))
+
+(defun cfengine-common-settings ()
+  (if (fboundp 'syntax-propertize-rules)
+    (set (make-local-variable 'syntax-propertize-function)
+         ;; In the main syntax-table, \ is marked as a punctuation, because
+         ;; of its use in DOS-style directory separators.  Here we try to
+         ;; recognize the cases where \ is used as an escape inside strings.
+         (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
+
+    ;; Backwards compatibility without `syntax-propertize-function'.
+    (setq font-lock-defaults
+          '(cfengine2-font-lock-keywords
+            nil nil nil beginning-of-line
+            (font-lock-syntactic-keywords
+             . cfengine-font-lock-syntactic-keywords))))
+
+  (set (make-local-variable 'parens-require-spaces) nil)
+  (set (make-local-variable 'comment-start)  "# ")
+  (set (make-local-variable 'comment-start-skip)
+       "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*")
+  ;; Like Lisp mode.  Without this, we lose with, say,
+  ;; `backward-up-list' when there's an unbalanced quote in a
+  ;; preceding comment.
+  (set (make-local-variable 'parse-sexp-ignore-comments) t))
+
+(defun cfengine-common-syntax (table)
+  ;; The syntax defaults seem OK to give reasonable word movement.
+  (modify-syntax-entry ?# "<" table)
+  (modify-syntax-entry ?\n ">#" table)
+  (modify-syntax-entry ?\" "\"" table)  ; "string"
+  (modify-syntax-entry ?\' "\"" table)  ; 'string'
+  ;; Variable substitution.
+  (modify-syntax-entry ?$ "." table)
+  ;; Doze path separators.
+  (modify-syntax-entry ?\\ "." table))
+
+(defconst cfengine3--prettify-symbols-alist
+  '(("->"  . ?→)
+    ("=>"  . ?⇒)
+    ("::" . ?∷)))
+
+(defun cfengine3-create-imenu-index ()
+  "A function for `imenu-create-index-function'.
+Note: defun name is separated by space such as `body
+package_method opencsw' and imenu will replace spaces according
+to `imenu-space-replacement' (which see)."
+  (goto-char (point-min))
+  (let ((defuns ()))
+    (while (re-search-forward cfengine3-defun-full-re nil t)
+      (push (cons (mapconcat #'match-string '(1 2 3) " ")
+                  (copy-marker (match-beginning 3)))
+            defuns))
+    (nreverse defuns)))
+
+(defun cfengine3-current-defun ()
+  "A function for `add-log-current-defun-function'."
+  (end-of-line)
+  (beginning-of-defun)
+  (and (looking-at cfengine3-defun-full-re)
+       (mapconcat #'match-string '(1 2 3) " ")))
+
+;;;###autoload
+(define-derived-mode cfengine3-mode cfengine-prog-mode "CFE3"
+  "Major mode for editing CFEngine3 input.
+There are no special keybindings by default.
+
+Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
+to the action header."
+  (cfengine-common-settings)
+  (cfengine-common-syntax cfengine3-mode-syntax-table)
+
+  (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
+
+  (setq font-lock-defaults
+        '(cfengine3-font-lock-keywords
+          nil nil nil beginning-of-defun))
+  (setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist)
+
+  ;; `compile-command' is almost never a `make' call with CFEngine so
+  ;; we override it
+  (when cfengine-cf-promises
+    (set (make-local-variable 'compile-command)
+         (concat cfengine-cf-promises
+                 " -f "
+                 (when buffer-file-name
+                   (shell-quote-argument buffer-file-name)))))
+
+  (setq-local flycheck-cfengine-executable cfengine-cf-promises)
+
+  (setq-local eldoc-documentation-function #'cfengine3-documentation-function)
+
+  (add-hook 'completion-at-point-functions
+            #'cfengine3-completion-function nil t)
+
+  ;; Use defuns as the essential syntax block.
+  (setq-local beginning-of-defun-function #'cfengine3-beginning-of-defun)
+  (setq-local end-of-defun-function #'cfengine3-end-of-defun)
+
+  (setq-local imenu-create-index-function #'cfengine3-create-imenu-index)
+  (setq-local add-log-current-defun-function #'cfengine3-current-defun))
+
+;;;###autoload
+(define-derived-mode cfengine2-mode cfengine-prog-mode "CFE2"
+  "Major mode for editing CFEngine2 input.
+There are no special keybindings by default.
+
+Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves
+to the action header."
+  (cfengine-common-settings)
+  (cfengine-common-syntax cfengine2-mode-syntax-table)
+
+  ;; Shell commands can be quoted by single, double or back quotes.
+  ;; It's debatable whether we should define string syntax, but it
+  ;; should avoid potential confusion in some cases.
+  (modify-syntax-entry ?\` "\"" cfengine2-mode-syntax-table)
+
+  (set (make-local-variable 'indent-line-function) #'cfengine2-indent-line)
+  (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+")
+  (set (make-local-variable 'outline-level) #'cfengine2-outline-level)
+  (set (make-local-variable 'fill-paragraph-function)
+       #'cfengine-fill-paragraph)
+  (define-abbrev-table 'cfengine-mode-abbrev-table cfengine2-mode-abbrevs)
+  (setq font-lock-defaults
+        '(cfengine2-font-lock-keywords nil nil nil beginning-of-line))
+  ;; Fixme: set the args of functions in evaluated classes to string
+  ;; syntax, and then obey syntax properties.
+  (setq imenu-generic-expression cfengine2-imenu-expression)
+  (set (make-local-variable 'beginning-of-defun-function)
+       #'cfengine2-beginning-of-defun)
+  (set (make-local-variable 'end-of-defun-function) #'cfengine2-end-of-defun))
+
+;;;###autoload
+(defun cfengine-auto-mode ()
+  "Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents."
+  (interactive)
+  (if (save-excursion
+        (save-restriction
+          (widen)
+          (goto-char (point-min))
+          (forward-comment (point-max))
+          (or (eobp)
+              (re-search-forward
+               (concat "^\\s-*" cfengine3-defuns-regex "\\_>") nil t))))
+      (cfengine3-mode)
+    (cfengine2-mode)))
+
+(defalias 'cfengine-mode 'cfengine3-mode)
+
+(provide 'cfengine3)
+(provide 'cfengine)
+
+;;; cfengine.el ends here
diff --git a/lisp/ipcalc.el b/lisp/ipcalc.el
new file mode 100644
index 00000000..59fdec76
--- /dev/null
+++ b/lisp/ipcalc.el
@@ -0,0 +1,189 @@
+;; ipcalc.el --- IP subnet calculator
+
+;; Filename: ipcalc.el
+;; Description: IP calculator
+;; Author: "Aleksandar Simic" 
+;; License: BSD
+;; Created: 2012-03-11 17:10
+;; Version: 0.2.1
+;; URL: http://github.org/dotemacs/ipcalc.el
+;; Keywords: networking
+
+;;; Commentary:
+;;
+;; Usage: evaluate (ipcalc "192.168.0.23/21")
+
+;;; This file is NOT part of GNU Emacs
+;;
+;; Copyright (c) 2012, Aleksandar Simic
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;; 1. Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above
+;;    copyright notice, this list of conditions and the following
+;;    disclaimer in the documentation and/or other materials provided
+;;    with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+;; COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+;; OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Code
+
+(defconst cidr-default 32 "CIDR value")
+
+(defun int-to-bin-string (n &optional length)
+  ;; 08 Jun 1997 Jamie Zawinski  comp.emacs
+  "Convert integer N to bit string (LENGTH, default 8)."
+  (let* ((i    0)
+	 (len  (or length 8))
+	 (s (make-string len ?0)))
+    (while (< i len)
+      (if (not (zerop (logand n (ash 1 i))))
+          (aset s (- len (1+ i)) ?1))
+      (setq i (1+ i))
+      )
+    s))
+
+(defun octets-as-binary (list-of-octets)
+  "return LST of octets as a single binary string"
+  (let ((binary ""))
+  (while list-of-octets
+    (setq binary
+          (concat binary
+                  (int-to-bin-string
+                   (string-to-int (car list-of-octets)))))
+      (setq list-of-octets (cdr list-of-octets)))
+  binary))
+
+(defun ip-to-octets (ip)
+  "split IP address and return the octets"
+  (let ((octets (split-string ip "\\.")))
+    (if (= 4 (length octets))
+        octets
+      (message "not correct IP format"))))
+
+(defun ones-and-pad (num)
+  "return 1's equal to NUM and pad the rest up to 32"
+  (unless (and (<= num cidr-default) (> num 0))
+    (error "wrong value provided"))
+  (concat (make-string num ?1)
+          (make-string (- cidr-default num) ?0)))
+
+(defun invert-binary (num)
+  "Invert 1s to 0s and vice versa
+
+  (credit: the simpler version below re-writen by pjb from #emacs
+          on freenode)"
+  (map 'string
+       (lambda (ch) (aref "10" (position ch "01")))
+       (remove-if-not (lambda (ch) (position ch "01")) num)))
+
+(defun network (ip cidr)
+  "Takes IP & CIDR and produces network"
+  (let ((cidr-as-int (string-to-int cidr)))
+    (concat
+     (substring (octets-as-binary
+                 (ip-to-octets ip)) 0 cidr-as-int)
+     (make-string (- cidr-default cidr-as-int) ?0))))
+
+(defun host+1 (binary-ip)
+  "increment the given BINARY-IP by 1"
+  (let ((tmp binary-ip))
+  (aset tmp (- cidr-default 1) ?1)
+  tmp))
+
+(defun host-max (ip cidr)
+  (let ((count (string-to-int cidr))
+        (max (- cidr-default 1)))
+    (while (< count max)
+      (aset ip count ?1)
+      (setq count(incf count)))
+    ip))
+
+(defun hosts/net (num)
+  "Calculate Hosts/Net for the NUM given"
+  (- (expt 2 (- cidr-default num)) 2))
+
+(defmacro list-to-string (lst)
+  "convert LST to string"
+  `(mapconcat
+    '(lambda (val)
+       (identity (if (integerp val)
+                     (int-to-string val)
+                   val)))
+    ,lst ""))
+
+(defun insert-values (lst)
+  "insert given LST"
+  (insert
+   (list-to-string lst)))
+
+(defun bin-to-int (bin)
+  "Convert binary to integer"
+  (int-to-string (read (concat "#b" bin))))
+
+(defun binary-to-ip (binary)
+  "convert binary to IP address"
+  (let* (full-ip
+        (count 0)
+        (1st-octet (substring binary 0 8))
+        (2nd-octet (substring binary 8 16))
+        (3rd-octet (substring binary 16 24))
+        (4th-octet (substring binary 24 32))
+        (octets (mapcar
+                 'bin-to-int
+                 `(,1st-octet ,2nd-octet ,3rd-octet ,4th-octet))))
+    (while (< count 3)
+      (setq full-ip (concat full-ip (nth count octets) "."))
+      (setq count (incf count)))
+    (concat full-ip (car (last octets)))))
+
+(defun ipcalc (ip/cidr)
+  "IP calculator"
+  (let* ((ip (car (split-string ip/cidr "/")))
+         (ip-in-binary (octets-as-binary (ip-to-octets ip)))
+         (cidr (car (cdr (split-string ip/cidr "/"))))
+         (cidr-int (string-to-int cidr))
+         (cidr-binary (ones-and-pad cidr-int))
+         (wildcard-binary (invert-binary (ones-and-pad cidr-int)))
+         (wildcard-ip (binary-to-ip wildcard-binary))
+         (netmask (binary-to-ip (invert-binary wildcard-binary)))
+         (net-binary (network ip cidr))
+         (net-ip (binary-to-ip net-binary))
+         (host-max-binary (host-max (network ip cidr) cidr))
+         (host-max-ip (binary-to-ip host-max-binary))
+         (host-min-binary (host+1 (network ip cidr)))
+         (host-min-ip (binary-to-ip host-min-binary))
+         (broadcast-binary (host+1 (host-max net-binary cidr)))
+         (broadcast-ip (binary-to-ip broadcast-binary))
+         (buffer "*ipcalc*"))
+    (if (get-buffer buffer)
+        (kill-buffer buffer))
+    (pop-to-buffer buffer)
+    (insert
+     (format "Address:%15s%41s\n" ip ip-in-binary)
+     (format "Netmask:%16s = %2s %34s\n" netmask cidr cidr-binary)
+     (format "Wildcard:%11s%44s\n" wildcard-ip wildcard-binary)
+     (format "=>\nNetwork:%14s%42s\n" net-ip (network ip cidr))
+     (format "HostMin:%14s%42s\n" host-min-ip host-min-binary)
+     (format "HostMax:%16s%40s\n" host-max-ip host-max-binary)
+     (format "Broadcast:%14s%40s\n" broadcast-ip broadcast-binary)
+     (format "Hosts/Net: %d\n" (hosts/net cidr-int)))))
+
+(provide 'ipcalc)
+
+;;; ipcalc.el ends here
diff --git a/lisp/malyon.el b/lisp/malyon.el
new file mode 100644
index 00000000..03ef759c
--- /dev/null
+++ b/lisp/malyon.el
@@ -0,0 +1,3236 @@
+; malyon.el --- mode to execute z code files version 3, 5, 8
+
+;; Maintainer: Peter Ilberg 
+;; (I am unable to continue supporting malyon.el. Please send me an
+;;  email if you are interested in taking over the project. Thanks.)
+
+;; Copyright (C) 1999-2011 Peter Ilberg
+
+;; 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.
+
+;;; Credits:
+
+;;   The author would like to thank the following people for reporting
+;;   bugs, testing, suggesting and/or contributing improvements:
+;;     Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko
+
+;;; Commentary:
+
+;; This package provides a basic interpreter for version 3, 5, 8 z code
+;; story files as generated by Inform (C) Graham Nelson and Infocom.
+
+;; If you encounter a bug please send a report to Peter Ilberg at 
+;; peter.ilberg@gmail.com. Thank you!
+
+;; To play a story file simple type M-x malyon and enter the path to the
+;; story file. If anything goes wrong and you want to manually clean
+;; up type M-x malyon-quit. In addition, you can switch back to a game in
+;; progress by typing M-x malyon-restore.
+
+;; A note on the format of saved game states:
+
+;; As of version 1.0, Malyon supports the quetzal file format for saved 
+;; games. Support for this format required changes to several internal
+;; data structures (stack frames and catch-throw) that are incompatible
+;; with the old implementation. Unfortunately, the old file format for
+;; saved games cannot be converted into quetzal.
+
+;; For backwards compatibility, however, Malyon still supports the old
+;; file format. And you can continue to play your old game states.
+
+;; Because of the incompatibility of the two file formats, Malyon now 
+;; runs, as follows, in either of two modes: quetzal and compatibility.
+
+;; - in quetzal mode, game states are saved in quetzal format
+;; - in compatibility mode, games states are saved in the old format
+;; - loading a game state in quetzal format switches to quetzal mode
+;; - loading an old game state switches to compatibility mode
+;; - quetzal mode is the default setting
+
+;; In other words, Malyon will only use the old file format if you've
+;; restored a game state saved in the old file format.
+
+;; Enjoy!
+
+;;; Code:
+
+;; global variables - moved here to appease the byte-code compiler
+
+;; story file information
+
+(defvar malyon-story-file-name nil
+  "The name of the story file being executed.")
+
+(defvar malyon-story-file nil
+  "The story file which is currently being run.")
+
+(defvar malyon-story-version nil
+  "The story file version.")
+
+(defvar malyon-supported-versions '(3 5 8)
+  "A list of supported story file versions.")
+
+;; status and transcript buffers
+
+(defvar malyon-transcript-buffer nil
+  "The main transcript buffer of the story file execution.")
+
+(defvar malyon-transcript-buffer-buffered nil
+  "Is output in the transcript buffer buffered?")
+
+(defvar malyon-status-buffer nil
+  "The status bar buffer of the story file execution.")
+
+(defvar malyon-status-buffer-lines nil
+  "The number of lines in the status bar buffer.")
+
+(defvar malyon-status-buffer-delayed-split nil
+  "If the number of lines in the status buffer is reduced,
+the window configuration is not changed immediately. It
+is changed after the next turn (read or read_char).")
+
+(defvar malyon-status-buffer-point nil
+  "The point location in the status bar buffer.")
+
+(defvar malyon-max-column 72
+  "Maximum column for text display.")
+
+;; window management
+
+(defvar malyon-window-configuration nil
+  "The current window configuration of the malyon interpreter.")
+
+(defvar malyon-current-window nil
+  "The currently active window for text output.")
+
+;; z machine registers
+
+(defvar malyon-stack nil
+  "The stack of the z machine.")
+
+(defvar malyon-stack-pointer nil
+  "The stack pointer of the z machine.")
+
+(defvar malyon-frame-pointer nil
+  "The frame pointer of the z machine.")
+
+(defvar malyon-instruction-pointer nil
+  "The instruction pointer of the z machine.")
+
+;; game file related global variables
+
+(defvar malyon-score-game nil
+  "A flag indicating whether this story uses score or time.")
+
+(defvar malyon-packed-multiplier nil
+  "The amount by which packed addresses are multiplied to get byte
+addresses.")
+
+(defvar malyon-global-variables nil
+  "A pointer to the global variable section in the story file.")
+
+(defvar malyon-abbreviations nil
+  "A pointer to the abbreviations in the story file.")
+
+(defvar malyon-alphabet nil
+  "The z machine's text alphabet.")
+
+(defvar malyon-whitespace nil
+  "A string of whitespace characters recognized by the interpreter.")
+
+;; object tables
+
+(defvar malyon-object-table nil
+  "A pointer to the object table in the story file.")
+
+(defvar malyon-object-table-entry-size nil
+  "The size of one entry in the object table.")
+
+(defvar malyon-object-properties nil
+  "The number of properties per object minus one.")
+
+(defvar malyon-object-property-offset nil
+  "The byte offset of the properties table in the object.")
+
+;; dictionaries
+
+(defvar malyon-dictionary nil
+  "A pointer to the dictionary of the story file.")
+
+(defvar malyon-dictionary-entry-length nil
+  "The length of a dictionary entry.")
+
+(defvar malyon-dictionary-num-entries nil
+  "The number of dictionary entries.")
+
+(defvar malyon-dictionary-entries nil
+  "A pointer to the first dictionary entry.")
+
+(defvar malyon-dictionary-word-length nil
+  "The length of a dictionary word.")
+
+;; game state information
+
+(defvar malyon-game-state-restart nil
+  "The machine state for implementing restart.")
+
+(defvar malyon-game-state-undo nil
+  "The machine state for implementing undo.")
+
+(defvar malyon-game-state-quetzal t
+  "Store game state information for quetzal.")
+
+;; various
+
+(defvar malyon-current-face nil
+  "The current face in which to display text.")
+
+(defvar malyon-last-cursor-position-after-input nil
+  "The last cursor position after reading input from the keyboard.")
+
+;; interactive functions
+
+(defun malyon (file-name)
+  "Major mode for playing z3/5/8 story files.
+This mode allows execution of version 3, 5, 8 z code story files."
+  (interactive "fStory file name: ")
+  (if malyon-story-file
+      (message "You are already playing a game.")
+    (if (not (string-match ".*\.z[358]$" file-name))
+	(message "%s is not a version 3, 5, or 8 story file." file-name)
+      (condition-case nil
+	  (malyon-load-story-file file-name)
+	(error
+	 (malyon-fatal-error "loading of story file failed.")))
+      (setq malyon-story-version (aref malyon-story-file 0))
+      (cond ((memq malyon-story-version malyon-supported-versions)
+	     (condition-case nil
+		 (malyon-initialize)
+	       (error
+		(malyon-fatal-error "initialization of interpreter failed.")))
+	     (malyon-interpreter))
+	    (t
+	     (message "%s is not a version 3, 5, or 8 story file." file-name)
+	     (malyon-cleanup))))))
+
+(defun malyon-restore ()
+  "Restore the save window configuration for the interpreter."
+  (interactive)
+  (condition-case nil
+      (progn
+	(malyon-restore-window-configuration)
+	(malyon-adjust-transcript))
+    (error
+     (malyon-fatal-error "restoring window configuration failed."))))
+
+(defun malyon-quit ()
+  "Exit the malyon interpreter."
+  (interactive)
+  (if malyon-story-file
+      (progn
+	(malyon-restore)
+	(if (malyon-yes-or-no-p-minibuf "Do you really want to quit? ")
+	    (malyon-cleanup)))))
+
+(defun malyon-mode ()
+  "This mode provides a basic interpreter for version 3, 5, 8 z code
+story files as generated by Inform (C) Graham Nelson and Infocom. 
+
+Note that this package is by no means complete and bug free.
+If you encounter a bug please send a report to Peter Ilberg at 
+peter.ilberg@natinst.com. Thank you!
+
+To play a story file simple type M-x malyon and enter the path to the
+story file. If anything goes wrong and you want to manually clean
+up type M-x malyon-quit. In addition, you can switch back to a game in
+progress by typing M-x malyon-restore.
+
+The author would like to thank the following people for reporting
+bugs, testing, suggesting and/or contributing improvements:
+    Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko"
+  (message "Use M-x malyon if you want to play a zcode game."))
+
+;; compatibility functions for GNU emacs
+
+(if (fboundp 'cadr)
+    (defalias 'malyon-cadr 'cadr)
+  (defun malyon-cadr (list)
+    "Take the cadr of the list."
+    (car (cdr list))))
+
+(if (fboundp 'caddr)
+    (defalias 'malyon-caddr 'caddr)
+  (defun malyon-caddr (list)
+    "Take the caddr of the list."
+    (car (cdr (cdr list)))))
+
+(if (fboundp 'cdddr)
+    (defalias 'malyon-cdddr 'cdddr)
+  (defun malyon-cdddr (list)
+    "Take the cdddr of the list."
+    (cdr (cdr (cdr list)))))
+
+(if (fboundp 'char-before)
+    (defalias 'malyon-char-before 'char-before)
+  (defun malyon-char-before ()
+    "Return the character before the point."
+    (char-after (- (point) 1))))
+
+(if (fboundp 'char-to-int)
+    (defalias 'malyon-char-to-int 'char-to-int)
+  (defun malyon-char-to-int (c)
+    "Convert a character into an integer."
+    c))
+
+(if (fboundp 'characterp)
+    (defalias 'malyon-characterp 'characterp)
+  (defun malyon-characterp (x)
+    "Test for a character."
+    (and (numberp x) (<= 0 x) (< x 256))))
+
+(defun malyon-disable-multibyte ()
+  "Disable multibyte support in the current buffer."
+  (condition-case nil (set-buffer-multibyte nil) (error)))
+
+(defun malyon-erase-buffer (&optional buffer)
+  "Erase the given buffer."
+  (save-excursion
+    (if buffer (set-buffer buffer))
+    (if (and buffer (eq buffer malyon-transcript-buffer))
+	(malyon-begin-section)
+      (erase-buffer))))
+
+(if (fboundp 'int-to-char)
+    (defalias 'malyon-int-to-char 'int-to-char)
+  (defun malyon-int-to-char (i)
+    "Convert an integer into a character."
+    i))
+
+(if (fboundp 'mapc)
+    (defalias 'malyon-mapc 'mapc)
+  (defun malyon-mapc (function list)
+    "Apply fun to every element of args ignoring the results."
+    (if (null list)
+	'()
+      (funcall function (car list))
+      (malyon-mapc function (cdr list)))))
+
+(if (fboundp 'mapcan)
+    (defalias 'malyon-mapcan 'mapcan)
+  (defun malyon-mapcan (function list)
+    "Apply fun to every element of args nconc'ing the result."
+    (if (null list)
+	'()
+      (nconc (funcall function (car list))
+	     (malyon-mapcan function (cdr list))))))
+
+; Do not use the built-in conversion via 'multibyte-char-to-unibyte.
+(defun malyon-multibyte-char-to-unibyte (char)
+  "Convert a multibyte character to unibyte."
+  char)
+
+(defun malyon-point-max (&optional buffer)
+  "Get the point-max of the given buffer."
+  (save-excursion
+    (if buffer (set-buffer buffer))
+    (point-max)))
+
+(if (fboundp 'redisplay-frame)
+    (defalias 'malyon-redisplay-frame 'redisplay-frame)
+  (defun malyon-redisplay-frame (frame &rest ignore)
+    "Redisplay the given frame."))
+
+(if (fboundp 'remove)
+    (defalias 'malyon-remove 'remove)
+  (defun malyon-remove (element list)
+    "Remove the element from the list."
+    (cond ((null list)
+	   '())
+	  ((eq element (car list))
+	   (malyon-remove element (cdr list)))
+	  ((equal element (car list))
+	   (malyon-remove element (cdr list)))
+	  (t
+	   (cons (car list)
+		 (malyon-remove element (cdr list)))))))
+
+(if (fboundp 'set-keymap-name)
+    (defalias 'malyon-set-keymap-name 'set-keymap-name)
+  (defun malyon-set-keymap-name (keymap name)
+    "Set the name of the keymap."))
+
+(if (fboundp 'string-to-list)
+    (defalias 'malyon-string-to-list 'string-to-list)
+  (defun malyon-string-to-list (s)
+    "Convert a string into a list of characters."
+    (let ((i (- (length s) 1)) (l '()))
+      (while (<= 0 i)
+	(setq l (cons (aref s i) l)
+	      i (- i 1)))
+      l)))
+
+(if (fboundp 'string-to-vector)
+    (defalias 'malyon-string-to-vector 'string-to-vector)
+  (defun malyon-string-to-vector (s)
+    "Convert a string into a vector of characters."
+    (let* ((i 0) (l (length s)) (v (make-vector l 0)))
+      (while (< i l)
+	(aset v i (aref s i))
+	(setq i (+ 1 i)))
+      v)))
+
+; Do not use the built-in conversion via 'unibyte-char-to-multibyte.
+(defun malyon-unibyte-char-to-multibyte (char)
+  "Convert a unibyte character to multibyte."
+  char)
+
+(defun malyon-vector-to-list (v begin end)
+  "Return a list of elements in v in the range [begin, end)."
+  (let ((result '()))
+    (while (< begin end)
+      (setq result (cons (aref v begin) result))
+      (setq begin (+ 1 begin)))
+    (reverse result)))
+
+(if (fboundp 'window-displayed-height)
+    (defalias 'malyon-window-displayed-height 'window-displayed-height)
+  (defun malyon-window-displayed-height (&optional window)
+    "Get the height of the window's displayed region."
+    (- (window-height) 1)))
+
+(if (fboundp 'yes-or-no-p-minibuf)
+    (defalias 'malyon-yes-or-no-p-minibuf 'yes-or-no-p-minibuf)
+  (defun malyon-yes-or-no-p-minibuf (prompt)
+    "Ask a yes or no question."
+    (yes-or-no-p prompt)))
+
+;; global variables for the malyon mode
+
+(defvar malyon-syntax-table nil
+  "Syntax table used while in malyon mode (same as in text-mode).")
+
+(if malyon-syntax-table
+    '()
+  (setq malyon-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\" ".   " malyon-syntax-table)
+  (modify-syntax-entry ?\\ ".   " malyon-syntax-table)
+  (modify-syntax-entry ?'  "w   " malyon-syntax-table))
+
+(defvar malyon-keymap-read nil
+  "Keymap for malyon mode for reading input into a buffer.")
+
+(defvar malyon-history-saved-up nil
+  "The saved binding for the up arrow key.")
+
+(defvar malyon-history-saved-down nil
+  "The saved binding for the down arrow key.")
+
+(if malyon-keymap-read
+    '()
+  (setq malyon-keymap-read (make-sparse-keymap))
+  (malyon-set-keymap-name malyon-keymap-read 'malyon-keymap-read)
+  (setq malyon-history-saved-up   (global-key-binding [up]))
+  (setq malyon-history-saved-down (global-key-binding [down]))
+  (define-key malyon-keymap-read "\r"        'malyon-end-input)
+  (define-key malyon-keymap-read [up]        'malyon-history-previous-char)
+  (define-key malyon-keymap-read [down]      'malyon-history-next-char)
+  (define-key malyon-keymap-read "\M-p"      'malyon-history-previous-char)
+  (define-key malyon-keymap-read "\M-n"      'malyon-history-next-char)
+  (define-key malyon-keymap-read "\C-a"      'malyon-beginning-of-line)
+  (define-key malyon-keymap-read "\C-w"      'malyon-kill-region)
+  (define-key malyon-keymap-read "\C-k"      'malyon-kill-line)
+  (define-key malyon-keymap-read "\M-d"      'malyon-kill-word)
+  (define-key malyon-keymap-read "\C-y"      'malyon-yank)
+  (define-key malyon-keymap-read "\M-y"      'malyon-yank-pop)
+  (define-key malyon-keymap-read "\C-d"      'malyon-delete-char)
+  (define-key malyon-keymap-read "\d"        'malyon-backward-delete-char)
+  (define-key malyon-keymap-read [del]       'malyon-delete-char)
+  (define-key malyon-keymap-read [backspace] 'malyon-backward-delete-char)
+  (substitute-key-definition (lookup-key (current-global-map) "a")
+			     'malyon-self-insert-command
+			     malyon-keymap-read (current-global-map)))
+
+(defvar malyon-keymap-readchar nil
+  "Keymap for malyon mode for waiting for input.")
+
+(if malyon-keymap-readchar
+    '()
+  (setq malyon-keymap-readchar (make-sparse-keymap))
+  (malyon-set-keymap-name malyon-keymap-readchar 'malyon-keymap-readchar)
+  (define-key malyon-keymap-readchar "\r" 'malyon-wait-char)
+  (substitute-key-definition (lookup-key (current-global-map) "a")
+			     'malyon-wait-char
+			     malyon-keymap-readchar (current-global-map)))
+
+(defvar malyon-keymap-more nil
+  "Keymap for malyon mode for browsing through text.")
+
+(if malyon-keymap-more
+    '()
+  (setq malyon-keymap-more (make-sparse-keymap))
+  (malyon-set-keymap-name malyon-keymap-more 'malyon-keymap-more)
+  (define-key malyon-keymap-more "\r" 'malyon-more-char)
+  (substitute-key-definition (lookup-key (current-global-map) "a")
+			     'malyon-more-char
+			     malyon-keymap-more (current-global-map)))
+
+(defvar malyon-keymap-more-status nil
+  "Keymap for malyon mode for browsing through the status buffer.")
+
+(if malyon-keymap-more-status
+    '()
+  (setq malyon-keymap-more-status (make-sparse-keymap))
+  (malyon-set-keymap-name malyon-keymap-more-status 'malyon-keymap-more-status)
+  (define-key malyon-keymap-more-status "\r" 'malyon-more-char-status)
+  (substitute-key-definition (lookup-key (current-global-map) "a")
+			     'malyon-more-char-status
+			     malyon-keymap-more-status (current-global-map)))
+
+(defvar malyon-faces nil
+  "An association list of text faces used by the malyon mode.")
+
+(defun malyon-initialize-faces ()
+  (copy-face 'default  'malyon-face-plain)
+  (copy-face 'bold     'malyon-face-reverse)
+  (copy-face 'bold     'malyon-face-bold)
+  (copy-face 'italic   'malyon-face-italic)
+  (copy-face 'default  'malyon-face-error)
+  (set-face-foreground 'malyon-face-error "red")
+  (setq malyon-faces '((0 . malyon-face-plain)
+		       (1 . malyon-face-reverse)
+		       (2 . malyon-face-bold)
+		       (4 . malyon-face-italic)
+		       (8 . malyon-face-plain))))
+
+(defvar malyon-print-separator nil
+  "A flag indicating whether to print the * * * separator.")
+
+(defun malyon-begin-section ()
+  "Print a section divider and begin a new section."
+  (if malyon-print-separator
+      (progn
+	(malyon-mapc 'malyon-putchar-transcript '(?\n ?\n ?* ?  ?* ?  ?*))
+	(center-line)
+	(malyon-mapc 'malyon-putchar-transcript '(?\n ?\n))
+	(setq malyon-print-separator nil)))
+  (narrow-to-region (point-max) (point-max)))
+
+(if malyon-whitespace
+    '()
+  (setq malyon-whitespace (list (malyon-char-to-int ? )
+				(malyon-char-to-int ?\t)
+				(malyon-char-to-int ?\n)
+				(malyon-char-to-int ?\r))))
+
+;; memory utilities
+
+(defsubst malyon-read-byte (address)
+  "Read a byte at address in the story file."
+  (if (<= 0 address)
+      (aref malyon-story-file address)
+    (aref malyon-story-file (+ 65536 address))))
+
+(defsubst malyon-store-byte (address value)
+  "Store a byte at address in the story file."
+  (if (<= 0 address)
+      (aset malyon-story-file address (logand 255 value))
+    (aset malyon-story-file (+ 65536 address) (logand 255 value))))
+
+(defsubst malyon-read-word (address)
+  "Read a word at address in the story file."
+  (if (<= 0 address)
+      (logior (lsh (aref malyon-story-file address) 8)
+	      (aref malyon-story-file (+ 1 address)))
+    (logior (lsh (aref malyon-story-file (+ 65536 address)) 8)
+	    (aref malyon-story-file (+ 65537 address)))))
+	
+(defsubst malyon-store-word (address value)
+  "Store a word at address in the story file."
+  (if (<= 0 address)
+      (progn
+	(aset malyon-story-file address (logand 255 (lsh value -8)))
+	(aset malyon-story-file (+ 1 address) (logand 255 value)))
+    (aset malyon-story-file (+ 65536 address) (logand 255 (lsh value -8)))
+    (aset malyon-story-file (+ 65537 address) (logand 255 value))))
+
+(defsubst malyon-read-code-byte ()
+  "Read the next byte at the program counter location."
+  (setq malyon-instruction-pointer (+ malyon-instruction-pointer 1))
+  (malyon-read-byte (- malyon-instruction-pointer 1)))
+
+(defsubst malyon-read-code-word ()
+  "Read the next word at the program counter location."
+  (setq malyon-instruction-pointer (+ malyon-instruction-pointer 2))
+  (malyon-read-word (- malyon-instruction-pointer 2)))
+
+(defsubst malyon-pop-stack ()
+  "Pop a value off the stack."
+  (if (> 0 malyon-stack-pointer)
+      (malyon-fatal-error "stack underflow."))
+  (setq malyon-stack-pointer (- malyon-stack-pointer 1))
+  (aref malyon-stack (+ malyon-stack-pointer 1)))
+
+(defsubst malyon-read-local-variable (variable)
+  "Read a local variable."
+  (aref malyon-stack (+ variable malyon-frame-pointer)))
+
+(defsubst malyon-read-global-variable (variable)
+  "Read a global variable."
+  (malyon-read-word (+ malyon-global-variables (* 2 variable))))
+
+(defsubst malyon-read-variable (variable)
+  "Read a variable."
+  (cond ((= variable 0)  (malyon-pop-stack))
+	((< variable 16) (malyon-read-local-variable variable))
+	(t               (malyon-read-global-variable (- variable 16)))))
+
+(defsubst malyon-push-stack (value)
+  "Push a value onto the stack."
+  (setq malyon-stack-pointer (+ malyon-stack-pointer 1))
+  (aset malyon-stack malyon-stack-pointer value))
+
+(defsubst malyon-store-local-variable (variable value)
+  "Store a value in a local variable."
+  (aset malyon-stack (+ variable malyon-frame-pointer) value))
+
+(defsubst malyon-store-global-variable (variable value)
+  "Store a value in a global variable."
+  (malyon-store-word (+ malyon-global-variables (* 2 variable)) value))
+
+(defsubst malyon-store-variable (var value)
+  "Store the value in a variable."
+  (setq value (logand 65535 value))
+  (cond ((= var 0)  (malyon-push-stack value))
+	((< var 16) (malyon-store-local-variable var value))
+	(t          (malyon-store-global-variable (- var 16) value))))
+
+;; list of opcodes
+
+(defvar malyon-opcodes
+  [malyon-opcode-nop
+   malyon-opcode-je	         malyon-opcode-jl
+   malyon-opcode-jg              malyon-opcode-dec-chk
+   malyon-opcode-inc-chk         malyon-opcode-jin
+   malyon-opcode-test            malyon-opcode-or
+   malyon-opcode-and             malyon-opcode-test-attr
+   malyon-opcode-set-attr        malyon-opcode-clear-attr
+   malyon-opcode-store           malyon-opcode-insert-obj
+   malyon-opcode-loadw           malyon-opcode-loadb
+   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
+   malyon-opcode-get-next-prop   malyon-opcode-add
+   malyon-opcode-sub             malyon-opcode-mul
+   malyon-opcode-div             malyon-opcode-mod
+   malyon-opcode-calls           malyon-opcode-calln
+   malyon-opcode-set-color       malyon-opcode-throw
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-je              malyon-opcode-jl
+   malyon-opcode-jg              malyon-opcode-dec-chk
+   malyon-opcode-inc-chk         malyon-opcode-jin
+   malyon-opcode-test            malyon-opcode-or
+   malyon-opcode-and             malyon-opcode-test-attr
+   malyon-opcode-set-attr        malyon-opcode-clear-attr
+   malyon-opcode-store           malyon-opcode-insert-obj
+   malyon-opcode-loadw           malyon-opcode-loadb
+   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
+   malyon-opcode-get-next-prop   malyon-opcode-add
+   malyon-opcode-sub             malyon-opcode-mul
+   malyon-opcode-div             malyon-opcode-mod
+   malyon-opcode-calls           malyon-opcode-calln
+   malyon-opcode-set-color       malyon-opcode-throw
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-je              malyon-opcode-jl 
+   malyon-opcode-jg              malyon-opcode-dec-chk
+   malyon-opcode-inc-chk         malyon-opcode-jin
+   malyon-opcode-test            malyon-opcode-or
+   malyon-opcode-and             malyon-opcode-test-attr
+   malyon-opcode-set-attr        malyon-opcode-clear-attr
+   malyon-opcode-store           malyon-opcode-insert-obj
+   malyon-opcode-loadw           malyon-opcode-loadb
+   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
+   malyon-opcode-get-next-prop   malyon-opcode-add
+   malyon-opcode-sub             malyon-opcode-mul
+   malyon-opcode-div             malyon-opcode-mod
+   malyon-opcode-calls           malyon-opcode-calln
+   malyon-opcode-set-color       malyon-opcode-throw
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-je              malyon-opcode-jl
+   malyon-opcode-jg              malyon-opcode-dec-chk
+   malyon-opcode-inc-chk         malyon-opcode-jin
+   malyon-opcode-test            malyon-opcode-or
+   malyon-opcode-and             malyon-opcode-test-attr
+   malyon-opcode-set-attr        malyon-opcode-clear-attr
+   malyon-opcode-store           malyon-opcode-insert-obj
+   malyon-opcode-loadw           malyon-opcode-loadb
+   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
+   malyon-opcode-get-next-prop   malyon-opcode-add
+   malyon-opcode-sub             malyon-opcode-mul
+   malyon-opcode-div             malyon-opcode-mod
+   malyon-opcode-calls           malyon-opcode-calln
+   malyon-opcode-set-color       malyon-opcode-throw
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-nop             malyon-opcode-jz
+   malyon-opcode-get-sibling     malyon-opcode-get-child
+   malyon-opcode-get-parent      malyon-opcode-get-prop-len
+   malyon-opcode-inc             malyon-opcode-dec
+   malyon-opcode-print-addr      malyon-opcode-calls
+   malyon-opcode-remove-obj      malyon-opcode-print-obj
+   malyon-opcode-ret             malyon-opcode-jump
+   malyon-opcode-print-paddr     malyon-opcode-load
+   malyon-opcode-calln           malyon-opcode-jz
+   malyon-opcode-get-sibling     malyon-opcode-get-child
+   malyon-opcode-get-parent      malyon-opcode-get-prop-len
+   malyon-opcode-inc             malyon-opcode-dec
+   malyon-opcode-print-addr      malyon-opcode-calls
+   malyon-opcode-remove-obj      malyon-opcode-print-obj
+   malyon-opcode-ret             malyon-opcode-jump
+   malyon-opcode-print-paddr     malyon-opcode-load
+   malyon-opcode-calln           malyon-opcode-jz
+   malyon-opcode-get-sibling     malyon-opcode-get-child
+   malyon-opcode-get-parent      malyon-opcode-get-prop-len
+   malyon-opcode-inc             malyon-opcode-dec
+   malyon-opcode-print-addr      malyon-opcode-calls
+   malyon-opcode-remove-obj      malyon-opcode-print-obj
+   malyon-opcode-ret             malyon-opcode-jump
+   malyon-opcode-print-paddr     malyon-opcode-load
+   malyon-opcode-calln           malyon-opcode-rtrue
+   malyon-opcode-rfalse          malyon-opcode-print
+   malyon-opcode-print-ret       malyon-opcode-nop
+   malyon-opcode-illegal         malyon-opcode-illegal
+   malyon-opcode-restart         malyon-opcode-ret-popped
+   malyon-opcode-catch           malyon-opcode-quit
+   malyon-opcode-new-line        malyon-opcode-illegal
+   malyon-opcode-verify          malyon-opcode-illegal
+   malyon-opcode-piracy          malyon-opcode-nop
+   malyon-opcode-je              malyon-opcode-jl
+   malyon-opcode-jg              malyon-opcode-dec-chk
+   malyon-opcode-inc-chk         malyon-opcode-jin
+   malyon-opcode-test            malyon-opcode-or
+   malyon-opcode-and             malyon-opcode-test-attr
+   malyon-opcode-set-attr        malyon-opcode-clear-attr
+   malyon-opcode-store           malyon-opcode-insert-obj
+   malyon-opcode-loadw           malyon-opcode-loadb
+   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
+   malyon-opcode-get-next-prop   malyon-opcode-add
+   malyon-opcode-sub             malyon-opcode-mul
+   malyon-opcode-div             malyon-opcode-mod
+   malyon-opcode-calls           malyon-opcode-calln
+   malyon-opcode-set-color       malyon-opcode-throw
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-nop             malyon-opcode-calls
+   malyon-opcode-storew          malyon-opcode-storeb
+   malyon-opcode-put-prop        malyon-opcode-aread
+   malyon-opcode-print-char      malyon-opcode-print-num
+   malyon-opcode-random          malyon-opcode-push
+   malyon-opcode-pull            malyon-opcode-split-window
+   malyon-opcode-set-window      malyon-opcode-calls
+   malyon-opcode-erase-window    malyon-opcode-erase-line
+   malyon-opcode-set-cursor      malyon-opcode-get-cursor
+   malyon-opcode-set-text-style  malyon-opcode-buffer-mode
+   malyon-opcode-output-stream   malyon-opcode-input-stream
+   malyon-opcode-nop             malyon-opcode-read-char
+   malyon-opcode-scan-table      malyon-opcode-not
+   malyon-opcode-calln           malyon-opcode-calln
+   malyon-opcode-tokenise        malyon-opcode-encode-text
+   malyon-opcode-copy-table      malyon-opcode-print-table
+   malyon-opcode-check-arg-count malyon-opcode-save
+   malyon-opcode-restore         malyon-opcode-log-shift
+   malyon-opcode-art-shift       malyon-opcode-set-font
+   malyon-opcode-illegal         malyon-opcode-illegal
+   malyon-opcode-illegal         malyon-opcode-illegal
+   malyon-opcode-save-undo       malyon-opcode-restore-undo
+   malyon-opcode-print-unicode   malyon-opcode-check-unicode
+   malyon-opcode-nop             malyon-opcode-nop
+   malyon-opcode-nop]
+  "A vector of all known legal z code opcodes.")
+
+;; initialization
+
+(defun malyon-load-story-file (file-name)
+  "Load a z code story file into an internal vector."
+  (save-excursion
+    (set-buffer (create-file-buffer file-name))
+    (malyon-disable-multibyte)
+    (malyon-erase-buffer)
+    (let ((coding-system-for-read 'binary))
+      (insert-file-contents file-name))
+    (setq malyon-story-file-name file-name)
+    (setq malyon-story-file (buffer-substring-no-properties (point-min)
+							    (point-max)))
+    (setq malyon-story-file (malyon-string-to-vector malyon-story-file))
+    (if (not (eq ?\^A 1))
+	(let ((i 0))
+	  (while (< i (length malyon-story-file))
+	    (aset malyon-story-file
+		  i
+		  (malyon-char-to-int (aref malyon-story-file i)))
+	    (setq i (+ 1 i)))))
+    (kill-buffer nil)))
+
+(defun malyon-initialize ()
+  "Initialize the z code interpreter."
+;  (malyon-trace-file)
+  (setq malyon-game-state-quetzal t)
+  (malyon-initialize-faces)
+  (malyon-initialize-status)
+  (malyon-initialize-transcript)
+  (malyon-initialize-windows)
+  (malyon-initialize-story-header)
+  (malyon-initialize-registers)
+  (malyon-initialize-opcodes)
+  (malyon-history-clear)
+  (setq malyon-game-state-restart (malyon-current-game-state))
+  (malyon-print-header))
+
+(defun malyon-initialize-status ()
+  "Initialize the status buffer."
+  (setq malyon-status-buffer (get-buffer-create "Malyon Status"))
+  (switch-to-buffer malyon-status-buffer)
+  (malyon-erase-buffer)
+  (kill-all-local-variables)
+  (setq malyon-status-buffer-point (point))
+  (setq malyon-status-buffer-lines 0)
+  (setq malyon-status-buffer-delayed-split nil)
+  (use-local-map malyon-keymap-read)
+  (set-syntax-table malyon-syntax-table)
+  (setq mode-name "Malyon")
+  (setq major-mode 'malyon-mode)
+  (run-hooks 'malyon-mode-hook))
+
+(defun malyon-initialize-transcript ()
+  "Initialize the transcript buffer."
+  (setq malyon-transcript-buffer (get-buffer-create "Malyon Transcript"))
+  (switch-to-buffer malyon-transcript-buffer)
+  (malyon-erase-buffer)
+  (kill-all-local-variables)
+  (setq malyon-last-cursor-position-after-input
+	(malyon-point-max malyon-transcript-buffer))
+  (use-local-map malyon-keymap-read)
+  (set-syntax-table malyon-syntax-table)
+  (setq fill-column malyon-max-column)
+  (auto-fill-mode 1)
+  (setq mode-name "Malyon")
+  (setq major-mode 'malyon-mode)
+  (run-hooks 'malyon-mode-hook))
+
+(defun malyon-initialize-windows ()
+  "Initialize the window configuration for the z machine."
+  (setq window-min-height 3)
+  (setq malyon-transcript-buffer-buffered t)
+  (malyon-set-window-configuration 0)
+  (malyon-opcode-set-window 0))
+
+(defun malyon-initialize-story-header ()
+  "Initializes the header section of the story file."
+  (malyon-store-byte 1  
+		     (if (>= malyon-story-version 5)
+			 28
+		       (logior 48 (malyon-read-byte 1))))
+  (malyon-store-byte 16 (logand 440 (malyon-read-byte 16)))
+  (malyon-store-byte 30 1)
+  (malyon-store-byte 31 65)
+  (malyon-store-byte 32 255)
+  (malyon-store-byte 33 (- malyon-max-column 1))
+  (malyon-store-word 34 (- malyon-max-column 1))
+  (malyon-store-word 36 255)
+  (malyon-store-word 38 1)
+  (malyon-store-word 39 1)
+  (malyon-store-byte 44 0)
+  (malyon-store-byte 45 0)
+  (malyon-store-byte 50 1)
+  (malyon-store-byte 51 0))
+
+(defun malyon-initialize-registers ()
+  "Initialize the interpreter's internal registers."
+  (setq malyon-stack (make-vector 1024 0))
+  (setq malyon-stack-pointer -1)
+  (malyon-push-initial-frame)
+  (setq malyon-frame-pointer malyon-stack-pointer)
+  (setq malyon-instruction-pointer (malyon-read-word 6))
+  (setq malyon-global-variables (malyon-read-word 12))
+  (setq malyon-object-table (malyon-read-word 10))
+  (cond ((< malyon-story-version 5)
+	 (setq malyon-object-table-entry-size 9)
+	 (setq malyon-object-properties       31)
+	 (setq malyon-object-property-offset  7))
+	(t
+	 (setq malyon-object-table-entry-size 14)
+	 (setq malyon-object-properties       63)
+	 (setq malyon-object-property-offset  12)))
+  (setq malyon-abbreviations (malyon-read-word 24))
+  (if (< malyon-story-version 5)
+      (setq malyon-score-game (zerop (logand 2 (malyon-read-byte 1)))))
+  (setq malyon-packed-multiplier
+	(malyon-cadr (assq malyon-story-version '((3 2) (5 4) (8 8)))))
+  (if (or (< malyon-story-version 5) (zerop (malyon-read-word 52)))
+      (setq malyon-alphabet (concat "abcdefghijklmnopqrstuvwxyz"
+				    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+				    " \n0123456789.,!?_#'\"/\\-:()"))
+    (setq malyon-alphabet (make-string 78 ? ))
+    (let ((i 0))
+      (while (< i 78)
+	(aset malyon-alphabet i
+	      (malyon-read-byte (+ i (malyon-read-word 52))))
+	(setq i (+ 1 i)))))
+  (malyon-initialize-unicode-table)
+  (setq malyon-dictionary (malyon-read-word 8))
+  (setq malyon-dictionary-entry-length
+	(malyon-read-byte
+	 (+ 1 malyon-dictionary (malyon-read-byte malyon-dictionary))))
+  (setq malyon-dictionary-num-entries
+	(malyon-read-word
+	 (+ 2 malyon-dictionary (malyon-read-byte malyon-dictionary))))
+  (setq malyon-dictionary-entries
+	(+ 4 malyon-dictionary (malyon-read-byte malyon-dictionary)))
+  (setq malyon-dictionary-word-length (if (< malyon-story-version 5) 3 5))
+  (setq malyon-current-face 'malyon-face-plain)
+  (setq malyon-print-separator nil)
+  (malyon-initialize-output-streams))
+
+(defun malyon-initialize-opcodes ()
+  "Initialize the opcode table used by the story file."
+  (cond ((< malyon-story-version 5)
+	 (aset malyon-opcodes 143 'malyon-opcode-not)
+	 (aset malyon-opcodes 181 'malyon-opcode-save)
+	 (aset malyon-opcodes 182 'malyon-opcode-restore)
+	 (aset malyon-opcodes 185 'malyon-opcode-pop)
+	 (aset malyon-opcodes 188 'malyon-opcode-show-status))
+	(t
+	 (aset malyon-opcodes 143 'malyon-opcode-calln)
+	 (aset malyon-opcodes 181 'malyon-opcode-illegal)
+	 (aset malyon-opcodes 182 'malyon-opcode-illegal)
+ 	 (aset malyon-opcodes 185 'malyon-opcode-catch)
+	 (aset malyon-opcodes 188 'malyon-opcode-illegal))))
+
+(defun malyon-print-header ()
+  "Print malyon mode header information."
+  (malyon-opcode-set-text-style 2)
+  (malyon-print "Malyon V 1.0.3")
+  (malyon-opcode-set-text-style 0)
+  (malyon-newline)
+  (malyon-print "A z-code interpreter for version 3, 5, and 8 games.")
+  (malyon-newline)
+  (malyon-print "(c) 1999-2011 by Peter Ilberg ")
+  (malyon-newline)
+  (malyon-newline))
+
+;; cleanup
+
+(defun malyon-cleanup ()
+  "Clean up the z code interpreter."
+  (condition-case nil
+      (progn
+	(setq malyon-story-file nil)
+	(setq malyon-window-configuration nil)
+	(setq malyon-game-state-restart nil)
+	(setq malyon-game-state-undo nil)
+	(if (get-buffer "Malyon Status")
+	    (kill-buffer (get-buffer "Malyon Status")))
+	(if (get-buffer "Malyon Transcript")
+	    (progn
+	      (switch-to-buffer (get-buffer "Malyon Transcript"))
+	      (malyon-redisplay-frame (selected-frame) t)
+	      (delete-other-windows (get-buffer-window (current-buffer)))
+	      (widen)
+	      (text-mode)))
+	(setq malyon-status-buffer nil)
+	(setq malyon-transcript-buffer nil))
+    (error
+     (malyon-fatal-error "cleanup failed."))))
+
+;; error handling
+
+(defun malyon-fatal-error (message)
+  "Print error message and abort."
+  (setq message (concat "Malyon fatal error: " message))
+  (unwind-protect
+      (save-excursion
+	(set-buffer malyon-transcript-buffer)
+	(goto-char (point-max))
+	(newline)
+	(newline)
+	(put-text-property 0
+			   (length message)
+			   'face
+			   'malyon-face-error
+			   message)
+	(insert message)
+	(newline))
+    (malyon-cleanup)
+    (malyon-redisplay-frame (selected-frame) t)
+    (error message)))
+
+;; conversion of zscii to ascii
+
+(defvar malyon-unicode-table nil
+  "An array mapping zscii characters to latin-1 ones.")
+
+(defvar malyon-default-unicode-table nil
+  "The default array mapping zscii characters to latin-1 ones.")
+
+(if malyon-default-unicode-table
+    '()
+  (setq malyon-default-unicode-table
+	[32 
+	 0   0   0   0   0   0   0       ;   1 -   7
+	 8   0   0   0   0   10  0   0   ;   8 -  15
+	 0   0   0   0   0   0   0   0   ;  16 -  23
+	 0   0   0   39  0   0   0   0   ;  24 -  31
+	 32  33  34  35  36  37  38  39  ;  32 -  39
+	 40  41  42  43  44  45  46  47  ;  40 -  47
+	 48  49  50  51  52  53  54  55  ;  48 -  55
+	 56  57  58  59  60  61  62  63  ;  56 -  63
+	 64  65  66  67  68  69  70  71  ;  64 -  71
+	 72  73  74  75  76  77  78  79  ;  72 -  79
+	 80  81  82  83  84  85  86  87  ;  80 -  87
+	 88  89  90  91  92  93  94  95  ;  88 -  95
+	 96  97  98  99  100 101 102 103 ;  96 - 103
+	 104 105 106 107 108 109 110 111 ; 104 - 111
+	 112 113 114 115 116 117 118 119 ; 112 - 119
+	 120 121 122 123 124 125 126 0   ; 120 - 127
+	 0   0   0   0   0   0   0   0   ; 128 - 135
+	 0   0   0   0   0   0   0   0   ; 136 - 143
+	 0   48  49  50  51  52  53  54  ; 144 - 151
+	 55  56  57  228 246 252 196 214 ; 152 - 159
+	 220 223 187 171 235 239 255 203 ; 160 - 167
+	 207 225 233 237 243 250 253 193 ; 168 - 175
+	 201 205 211 218 221 224 232 236 ; 176 - 183
+	 242 249 192 200 204 210 217 226 ; 184 - 191
+	 234 238 244 251 194 202 206 212 ; 192 - 199
+	 219 229 197 248 216 227 241 245 ; 200 - 207
+	 195 209 213 230 198 231 199 254 ; 208 - 215
+	 240 222 208 163 63  63  161 191 ; 216 - 223
+	 0   0   0   0   0   0   0   0   ; 224 - 231
+	 0   0   0   0   0   0   0   0   ; 232 - 239
+	 0   0   0   0   0   0   0   0   ; 240 - 247
+	 0   0   0   0   0   0   0   0   ; 248 - 255
+	 ]))
+
+(defun malyon-initialize-unicode-table ()
+  "Initializes the zscii-to-unicode conversion table."
+  (setq malyon-unicode-table
+	(copy-sequence malyon-default-unicode-table))
+  (let* ((ext   (malyon-read-word 54))
+	 (len   (if (zerop ext) 0 (malyon-read-word ext)))
+	 (table (if (< len 3)   0 (malyon-read-word (+ ext 6)))))
+    (if (or (< malyon-story-version 5) (zerop table))
+	'()
+      (let ((i 0))
+	(while (< i 96)
+	  (aset malyon-unicode-table (+ 155 i) (malyon-char-to-int ??))
+	  (setq i (+ 1 i))))
+      (setq len (malyon-read-byte table))
+      (let ((i 0))
+	(while (< i len)
+	  (aset malyon-unicode-table (+ 155 i)
+		(malyon-read-word (+ table 1 i)))
+	  (setq i (+ 1 i)))))))
+
+(defsubst malyon-zscii-to-unicode (char)
+  "Converts a zscii character to unicode."
+  (if (or (< char 0) (> char 255))
+      ??
+    (let ((uni (aref malyon-unicode-table char)))
+      (if (zerop uni)
+	  ??
+	(malyon-unibyte-char-to-multibyte (malyon-int-to-char uni))))))
+
+(defsubst malyon-unicode-to-zscii (char)
+  "Converts a unicode character to zscii."
+  (setq char (malyon-multibyte-char-to-unibyte char))
+  (setq char (if (malyon-characterp char) (malyon-char-to-int char) char))
+  (if (= 13 char)
+      ?\r
+    (let ((i 1) (found 0))
+      (while (and (< i 255) (zerop found))
+	(if (= char (aref malyon-unicode-table i))
+	    (setq found i))
+	(setq i (+ i 1)))
+      (malyon-int-to-char found))))
+
+;; output streams
+
+(defvar malyon-output-streams nil
+  "Valid output streams for the interpreter.")
+
+(defvar malyon-output-streams-tables nil
+  "A list of active tables for stream 3.")
+
+(defun malyon-initialize-output-streams ()
+  "Initializes the output streams."
+  (setq malyon-output-streams '())
+  (setq malyon-output-streams-tables '())
+  (malyon-add-output-stream 1 0))
+
+(defun malyon-output-stream-function (stream)
+  "Returns the output function representing the given stream."
+  (cond ((= 1 stream) (if (zerop malyon-current-window)
+			  'malyon-putchar-transcript
+			'malyon-putchar-status))
+	((= 2 stream) 'malyon-putchar-printer)))
+
+(defun malyon-add-output-stream (stream table)
+  "Add a new output stream."
+  (if (= stream 3)
+      (progn
+	(setq malyon-output-streams-tables
+	      (cons table malyon-output-streams-tables))
+	(malyon-store-word table 0))
+    (let ((function (malyon-output-stream-function stream)))
+      (setq malyon-output-streams
+	    (if (member function malyon-output-streams)
+		malyon-output-streams
+	      (cons function malyon-output-streams))))))
+
+(defun malyon-remove-output-stream (stream)
+  "Remove an output stream."
+  (if (= stream 3)
+      (setq malyon-output-streams-tables (cdr malyon-output-streams-tables))
+    (setq malyon-output-streams
+	  (malyon-remove (malyon-output-stream-function stream)
+			 malyon-output-streams))))
+
+(defun malyon-update-output-streams ()
+  "Update output streams when the output window has changed."
+  (let ((one (or (member 'malyon-putchar-transcript malyon-output-streams)
+		 (member 'malyon-putchar-status     malyon-output-streams))))
+    (setq malyon-output-streams
+	  (malyon-remove 'malyon-putchar-transcript
+			 (malyon-remove 'malyon-putchar-status
+					malyon-output-streams)))
+    (if one
+	(malyon-add-output-stream 1 0))))
+
+(defsubst malyon-output-character (char)
+  "Output a single character on all active streams."
+  (setq char (malyon-zscii-to-unicode char))
+  (if malyon-output-streams-tables
+      (malyon-putchar-table char (car malyon-output-streams-tables))
+    (malyon-mapc (lambda (s) (funcall s char)) malyon-output-streams)))
+
+;; printing text
+
+(defsubst malyon-abbrev (abbrev x)
+  "Print an abbreviation."
+  (malyon-print-ztext
+   (* 2 (malyon-read-word (+ malyon-abbreviations
+			     (* 2 (+ x (* 32 (1- abbrev)))))))))
+
+(defun malyon-newline ()
+  "Print a newline."
+  (if (eq malyon-status-buffer (current-buffer))
+      (goto-char malyon-status-buffer-point)
+    (goto-char (point-max)))
+  (malyon-output-character ?\r)
+  (if (eq malyon-status-buffer (current-buffer))
+      (setq malyon-status-buffer-point (point))
+    (goto-char malyon-last-cursor-position-after-input))
+  (malyon-redisplay-frame (selected-frame) nil))
+
+(defun malyon-print (object)
+  "Print text." 
+  (let ((text (if (malyon-characterp object) (char-to-string object) object))
+	(start))
+    (if (eq malyon-transcript-buffer (current-buffer))
+	(goto-char (point-max))
+      (goto-char malyon-status-buffer-point))
+    (setq start (point))
+    (malyon-print-characters (malyon-string-to-list text))
+    (put-text-property start (point) 'face malyon-current-face)
+    (if (eq malyon-status-buffer (current-buffer))
+	(setq malyon-status-buffer-point (point))
+      (goto-char malyon-last-cursor-position-after-input))))
+
+(defun malyon-print-characters (text)
+  "Print a list of characters."
+  (malyon-mapc 'malyon-output-character text))
+
+(defsubst malyon-print-state-new (char shift abbr zscii zcode)
+  "Generate a new print state."
+  (list char shift abbr zscii zcode))
+
+(defsubst malyon-print-state-initial ()
+  "Returns an initial state for the ztext decoder."
+  (malyon-print-state-new nil -6 0 0 0))
+
+(defsubst malyon-print-state-next (x ignore shift abbr zscii z)
+  "Print state transition function."
+  (cond ((= zscii 2)
+	 (malyon-print-state-new (+ z x) -6 0 0 0))
+	((= zscii 1)
+	 (malyon-print-state-new nil     -6 0 2 (* 32 x)))
+	((> abbr 0)
+	 (malyon-abbrev abbr x)
+	 (malyon-print-state-initial))
+	((= x 0)
+	 (malyon-print-state-new ?       -6 0 0 0))
+	((< x 4)
+	 (malyon-print-state-new nil     -6 x 0 0))
+	((= x 4)
+	 (malyon-print-state-new nil     20 0 0 0))
+	((= x 5)
+	 (malyon-print-state-new nil     46 0 0 0))
+	((and (= shift 46) (= x 6))
+	 (malyon-print-state-new nil     -6 0 1 0))
+	((and (= shift 46) (= x 7))
+	 (malyon-print-state-new ?\r     -6 0 0 0))
+	(t
+	 (malyon-print-state-new
+	  (aref malyon-alphabet (+ shift x)) -6 0 0 0))))
+
+(defun malyon-print-text (address)
+  "Print text at address and return the address of the following byte."
+  (let ((start))
+    (if (eq malyon-transcript-buffer (current-buffer))
+	(goto-char (point-max))
+      (goto-char malyon-status-buffer-point))
+    (setq start (point))
+    (setq address (malyon-print-ztext address))
+    (put-text-property start (point) 'face malyon-current-face)
+    (if (eq malyon-status-buffer (current-buffer))
+	(setq malyon-status-buffer-point (point))
+      (goto-char malyon-last-cursor-position-after-input))
+    (malyon-redisplay-frame (selected-frame) nil)
+    address))
+
+(defun malyon-print-ztext (address)
+  "Print the ztext stored at the given address."
+  (let ((high 0) (low) (a) (b) (c) (state (malyon-print-state-initial)))
+    (while (zerop (logand 128 high))
+      (setq high (malyon-read-byte address))
+      (setq low  (malyon-read-byte (+ 1 address)))
+      (setq a    (logand 31 (lsh high -2)))
+      (setq b    (logand 31 (logior (lsh high 3) (lsh low -5))))
+      (setq c    (logand 31 low))
+      (setq state (apply 'malyon-print-state-next a state))
+      (if (car state) (malyon-output-character (car state)))
+      (setq state (apply 'malyon-print-state-next b state))
+      (if (car state) (malyon-output-character (car state)))
+      (setq state (apply 'malyon-print-state-next c state))
+      (if (car state) (malyon-output-character (car state)))
+      (setq address (+ 2 address)))
+    address))
+
+(defun malyon-putchar-transcript (char)
+  "Print a single character in the transcript window."
+  (if (char-equal char ?\n)
+      (newline 1)
+    (insert char)
+    (setq malyon-print-separator (null (member char malyon-whitespace))))
+  (if (and malyon-transcript-buffer-buffered
+	   (> (current-column) (current-fill-column)))
+      (progn
+	(end-of-line)
+	(forward-word -1)
+	(if (< 0 (current-column))
+	    (newline 1))
+	(end-of-line))))
+
+(defun malyon-putchar-status (char)
+  "Print a single character in the status window."
+  (if malyon-status-buffer-delayed-split
+      (progn
+	(malyon-split-buffer-windows malyon-status-buffer-delayed-split)
+	(other-window 1)))
+  (if (char-equal char ?\n)
+      (progn
+	(beginning-of-line)
+	(forward-line 1)
+	(if (= (point) (point-max))
+	    (forward-line -1)))
+    (if (> (current-column) (current-fill-column))
+	'()
+      (insert char)
+      (delete-char 1))))
+
+(defun malyon-putchar-table (char table)
+  "Print a single character into a table."
+  (setq char (malyon-unicode-to-zscii char))
+  (malyon-store-byte (+ 2 table (malyon-read-word table)) char)
+  (malyon-store-word table (+ 1 (malyon-read-word table))))
+
+(defun malyon-putchar-printer (char)
+  "Print a single character onto a printer."); not yet implemented
+
+;; more
+
+(defvar malyon-more-continue-keymap nil
+  "The keymap with which to continue after More has finished.")
+
+(defun malyon-more (keymap)
+  "Enter More mode."
+  (if (eq malyon-status-buffer (current-buffer))
+      (use-local-map keymap)
+    (if (< malyon-story-version 5) (malyon-opcode-show-status))
+    (if (< (count-lines malyon-last-cursor-position-after-input (point-max))
+	   (malyon-window-displayed-height))
+	(progn
+	  (malyon-adjust-transcript)
+	  (use-local-map keymap))
+      (goto-char malyon-last-cursor-position-after-input)
+      (beginning-of-line)
+      (recenter 1)
+      (setq malyon-more-continue-keymap keymap)
+      (use-local-map malyon-keymap-more)
+      (message "[More]"))))
+
+(defun malyon-more-status-buffer ()
+  "Enter More mode for the status buffer."
+  (setq malyon-more-continue-keymap (current-local-map))
+  (use-local-map malyon-keymap-more-status)
+  (message "[More]")
+  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
+
+;; input history
+
+(defvar malyon-history nil
+  "The input history.")
+
+(defun malyon-history-previous ()
+  "Move one entry up in the input history."
+  (let ((prev (aref malyon-history 0))
+	(curr (aref malyon-history 1))
+	(next (aref malyon-history 2)))
+    (if (null prev)
+	curr
+      (aset malyon-history 2 (if curr (cons curr next) next))
+      (aset malyon-history 0 (cdr prev))
+      (aset malyon-history 1 (car prev)))))
+
+(defun malyon-history-next ()
+  "Move one entry down in the input history."
+  (let ((prev (aref malyon-history 0))
+	(curr (aref malyon-history 1))
+	(next (aref malyon-history 2)))
+    (if (null next)
+	curr
+      (aset malyon-history 0 (if curr (cons curr prev) prev))
+      (aset malyon-history 2 (cdr next))
+      (aset malyon-history 1 (car next)))))
+
+(defun malyon-history-clear ()
+  "Clear the input history."
+  (setq malyon-history (vector '() nil '())))
+
+(defun malyon-history-insert (entry)
+  "Insert an entry into the input history."
+  (let* ((prev (aref malyon-history 0))
+	 (curr (aref malyon-history 1))
+	 (next (aref malyon-history 2))
+	 (l    (malyon-remove entry
+			      (append (nreverse prev)
+				      (if curr (cons curr next) next))))
+	 (cut  (- (length l) 19)))
+    (while (> cut 0)
+      (setq l   (cdr l)
+	    cut (- cut 1)))
+    (aset malyon-history 0
+	  (malyon-remove nil (malyon-remove "" (cons entry (nreverse l)))))
+    (aset malyon-history 1 nil)
+    (aset malyon-history 2 '())))
+
+;; dictionary lookup
+
+(defun malyon-dictionary-word (chars)
+  "Convert a list of characters into a dictionary word."
+  (list (car (car chars))
+	(length chars)
+	(malyon-encode-dictionary-word (append (malyon-mapcan 'cdr chars)
+					       '(5 5 5 5 5 5 5 5)))))
+
+(defsubst malyon-join-characters (stop list)
+  "Joins three ztext characters into two bytes."
+  (let ((a (car          list))
+	(b (malyon-cadr  list))
+	(c (malyon-caddr list))
+	(x (if (zerop stop) 0 128)))
+    (list (logior x (logand 255 (logior (lsh a 2) (lsh b -3))))
+	  (logand 255 (logior (lsh b 5) c)))))
+
+(defun malyon-encode-dictionary-word (l)
+  "Converts a list of ztext characters into a dictionary word."
+  (let* ((first  l)
+	 (second (malyon-cdddr first))
+	 (third  (malyon-cdddr second)))
+    (apply 'vector
+	   (if (< malyon-story-version 5)
+	       (append (malyon-join-characters 0 first)
+		       (malyon-join-characters 1 second))
+	     (append (malyon-join-characters 0 first)
+		     (malyon-join-characters 0 second)
+		     (malyon-join-characters 1 third))))))
+
+(defun malyon-lookup (dict code)
+  "Look for the given code in the dictionary and return its address."
+  (cond ((not code)                 0)
+	((not dict)                 (malyon-binary-search code))
+	((= dict malyon-dictionary) (malyon-binary-search code))
+	(t                          (malyon-linear-search dict code))))
+
+(defsubst malyon-compare-words (word address)
+  "Compares the given word to the word stored at address."
+  (let* ((i 0)
+	 (j address)
+	 (x (aref word i))
+	 (y (malyon-read-byte j)))
+    (while (not (or (/= x y) (= i malyon-dictionary-word-length)))
+      (setq i (+ 1 i)
+	    j (+ 1 j)
+	    x (aref word i)
+	    y (malyon-read-byte j)))
+    (- x y)))
+
+;; search functions
+
+(defun malyon-binary-search (code)
+  "Binary search through the main dictionary."
+  (let* ((lower   0)
+	 (upper   (- malyon-dictionary-num-entries 1))
+	 (median  (/ (+ lower upper) 2))
+	 (entry   (+ malyon-dictionary-entries
+		     (* malyon-dictionary-entry-length median)))
+	 (looking (malyon-compare-words code entry)))
+    (while (not (or (> lower upper) (zerop looking)))
+      (setq lower   (if (< 0 looking) (+ median 1) lower)
+            upper   (if (> 0 looking) (- median 1) upper)
+	    median  (/ (+ lower upper) 2)
+	    entry   (+ malyon-dictionary-entries
+		       (* malyon-dictionary-entry-length median))
+	    looking (malyon-compare-words code entry)))
+    (if (zerop looking) entry 0)))
+
+(defun malyon-linear-search (dictionary code)
+  "Linear search through the given dictionary."
+  (let* ((length  (malyon-read-byte (+ dictionary 1
+				       (malyon-read-byte dictionary))))
+	 (number  (malyon-read-word (+ dictionary 2
+				       (malyon-read-byte dictionary))))
+	 (entries (+ dictionary 4 (malyon-read-byte dictionary)))
+	 (i       0)
+	 (entry   (+ entries (* length i)))
+	 (looking (malyon-compare-words code entry)))
+    (while (not (or (>= i number) (zerop looking)))
+      (setq i       (+ 1 i)
+	    entry   (+ entries (* length i))
+	    looking (malyon-compare-words code entry)))
+    (if (zerop looking) entry 0)))
+
+;; encoding text and lexical analysis
+
+(defun malyon-split-list (sep list &optional x)
+  "Split a list into sublists as indicated by the separators."
+  (cond ((null list)
+	 (list (nreverse x)))
+	((eq sep (car list))
+	 (cons (nreverse x) (malyon-split-list sep (cdr list) '())))
+	(t
+	 (malyon-split-list sep (cdr list) (cons (car list) x)))))
+
+(defun malyon-characters-to-words (list)
+  "Turn the list of characters into a list of words."
+  (mapcar 'malyon-dictionary-word
+	  (delete '() (malyon-split-list 'malyon-word-separator list))))
+
+(defsubst malyon-char-in-string (c s)
+  "Returns the index of c in s if found, or length of s."
+  (let ((i 0))
+    (while (not (or (= i (length s)) (= c (aref s i))))
+      (setq i (+ 1 i)))
+    i))
+
+(defsubst malyon-encode-into-ztext (c)
+  "Convert a character into ztext."
+  (let* ((index (malyon-char-in-string c malyon-alphabet))
+	 (shift (floor index 26))
+	 (char  (+ 6 (mod index 26))))
+    (cond ((> shift 2) (list 5 6 (logand 31 (lsh c -5)) (logand 31 c)))
+	  ((= shift 2) (list 5 char))
+	  ((= shift 1) (list 4 char))
+	  (t           (list char)))))
+
+(defun malyon-encode-single-character (terminating-characters char)
+  "Encode a character into ztext."
+  (let ((pos (car char))
+	(c   (cdr char)))
+    (cond ((member c malyon-whitespace)
+	   (list 'malyon-word-separator))
+	  ((member c terminating-characters)
+	   (list 'malyon-word-separator
+		 (cons pos (malyon-encode-into-ztext c))
+		 'malyon-word-separator))
+	  (t (list (cons pos (malyon-encode-into-ztext c)))))))
+
+(defun malyon-encode-character-list (dict list)
+  "Encode the list of characters into ztext."
+  (let ((l '())
+	(i 0))
+    (while (< i (malyon-read-byte dict))
+      (setq l (cons (malyon-read-byte (+ dict 1 i)) l)
+	    i (+ 1 i)))
+    (malyon-mapcan (lambda (x) (malyon-encode-single-character l x)) list)))
+
+(defun malyon-text-length (address)
+  "Return the length of the input text."
+  (if (>= malyon-story-version 5)
+      (malyon-read-byte (+ 1 address))
+    (let ((i 0))
+      (while (not (zerop (malyon-read-byte (+ i 1 address))))
+	(setq i (+ i 1)))
+      i)))
+
+(defun malyon-text-to-character-list (address)
+  "Convert the input text into a list of characters."
+  (let ((i    (malyon-text-length address))
+	(text '()))
+    (while (< 0 i)
+      (setq text (cons
+		  (cons (if (< malyon-story-version 5) i (+ 1 i))
+			(malyon-read-byte
+			 (+ i address (if (< malyon-story-version 5) 0 1))))
+		  text)
+	    i    (- i 1)))
+    text))
+
+(defun malyon-text-to-words (address dictionary)
+  "Turn ztext into a list of dictionary words."
+  (malyon-characters-to-words
+   (malyon-encode-character-list (if dictionary dictionary malyon-dictionary)
+				 (malyon-text-to-character-list address))))
+
+;; window management
+
+(defvar malyon-status-buffer-grew-this-turn nil
+  "A flag signalling if the status buffer grew this turn.")
+
+(defun malyon-adjust-transcript ()
+  "Adjust the position of the transcript text."
+  (save-excursion
+    (setq malyon-status-buffer-grew-this-turn nil)
+    (set-buffer malyon-transcript-buffer)
+    (goto-char (point-max))
+    (recenter (- (malyon-window-displayed-height) 2))))
+
+(defun malyon-prepare-status-buffer (status)
+  "Fill the status buffer with empty lines."
+  (save-excursion
+    (set-buffer malyon-status-buffer)
+    (let ((lines (count-lines (point-min) (point-max)))
+	  (new   status))
+      (if (zerop lines)
+	  (newline 1))
+      (goto-char (point-max))
+      (setq status (- status lines -1))
+      (while (> status 0)
+	(insert (make-string (+ 3 malyon-max-column) ? ))
+	(newline 1)
+	(setq status (- status 1)))
+      (goto-char (point-min))
+      (forward-line (+ 1 new))
+      (kill-region (point) (point-max))
+      (insert (make-string (+ 3 malyon-max-column) ? ))
+      (newline 1))))
+
+(defun malyon-restore-window-configuration ()
+  "Restore the saved window configuration."
+  (let ((buffer (window-buffer (selected-window))))
+    (if malyon-window-configuration
+	(set-window-configuration malyon-window-configuration))
+    (cond ((eq malyon-status-buffer buffer)     (other-window 1))
+	  ((eq malyon-transcript-buffer buffer) (goto-char (point-max))))))
+
+(defun malyon-set-window-configuration (status)
+  "Set up the new window configuration."
+  (cond ((< status malyon-status-buffer-lines)
+	 (setq malyon-status-buffer-delayed-split status)
+	 (if malyon-status-buffer-grew-this-turn
+	     (malyon-more-status-buffer)))
+	((> status malyon-status-buffer-lines)
+	 (malyon-split-buffer-windows status)
+	 (setq malyon-status-buffer-grew-this-turn t))
+	((not malyon-window-configuration)
+	 (malyon-split-buffer-windows status))))
+
+(defun malyon-split-buffer-windows (status)
+  "Split the buffer windows.
+The status buffer gets 'status' lines while the transcript buffer
+gets the remaining lines."
+  (delete-other-windows (get-buffer-window (current-buffer)))
+  (setq malyon-status-buffer-lines status)
+  (setq malyon-status-buffer-delayed-split nil)
+  (if (zerop status)
+      '()
+    (split-window (get-buffer-window (current-buffer)) (+ status 3))
+    (switch-to-buffer malyon-status-buffer)
+    (malyon-prepare-status-buffer status)
+    (malyon-opcode-set-cursor 1 1)
+    (other-window 1))
+  (switch-to-buffer malyon-transcript-buffer)
+  (setq malyon-window-configuration (current-window-configuration)))
+
+;; getting and setting the machine state
+
+(defun malyon-current-game-state ()
+  "Return the current state of the interpreter."
+  (vector malyon-instruction-pointer
+	  malyon-stack-pointer
+          malyon-frame-pointer
+	  (copy-sequence malyon-stack)
+	  (copy-sequence malyon-story-file)
+	  malyon-game-state-quetzal))
+
+(defun malyon-set-game-state (state)
+  "Installs the given state as the new state of the interpreter."
+  (setq malyon-instruction-pointer       (aref state 0))
+  (setq malyon-stack-pointer             (aref state 1))
+  (setq malyon-frame-pointer             (aref state 2))
+  (setq malyon-stack (copy-sequence      (aref state 3)))
+  (setq malyon-story-file (copy-sequence (aref state 4)))
+  (setq malyon-game-state-quetzal        (aref state 5))
+  (save-excursion
+    (malyon-erase-buffer malyon-status-buffer)
+    (malyon-split-buffer-windows 0)
+    (setq malyon-last-cursor-position-after-input
+	  (malyon-point-max malyon-transcript-buffer))))
+
+;; file utilities
+
+(defsubst malyon-write-byte-to-file (byte)
+  "Write a byte to a file."
+  (insert-char (logand 255 byte) 1))
+
+(defsubst malyon-write-word-to-file (word)
+  "Write a word to the last opened file."
+  (insert-char (logand 255 (lsh word -8)) 1)
+  (insert-char (logand 255 word) 1))
+
+(defsubst malyon-write-dword-to-file (dword)
+  "Write a dword to the last opened file."
+  (insert-char (logand 255 (lsh dword -24)) 1)
+  (insert-char (logand 255 (lsh dword -16)) 1)
+  (insert-char (logand 255 (lsh dword -8)) 1)
+  (insert-char (logand 255 dword) 1))
+
+(defsubst malyon-write-chunk-id-to-file (id)
+  "Write a quetzal chunk id to the last opened file."
+  (insert id))
+
+(defsubst malyon-read-byte-from-file ()
+  "Read the next byte from a file."
+  (if (= (point) (point-max))
+      0
+    (forward-char 1)
+    (malyon-char-to-int (malyon-char-before))))
+
+(defsubst malyon-read-word-from-file ()
+  "Read the next word from the last opened file."
+  (logior (lsh (malyon-read-byte-from-file) 8) (malyon-read-byte-from-file)))
+
+(defsubst malyon-read-dword-from-file ()
+  "Read the next dword from the last opened file."
+  (logior (lsh (malyon-read-byte-from-file) 24)
+	  (lsh (malyon-read-byte-from-file) 16)
+	  (lsh (malyon-read-byte-from-file) 8)
+	  (malyon-read-byte-from-file)))
+
+(defsubst malyon-read-chunk-id-from-file ()
+  "Read a quetzal chunk id from the last opened file."
+  (string (malyon-int-to-char (malyon-read-byte-from-file))
+	  (malyon-int-to-char (malyon-read-byte-from-file))
+	  (malyon-int-to-char (malyon-read-byte-from-file))
+	  (malyon-int-to-char (malyon-read-byte-from-file))))
+
+(defun malyon-get-file-name (address)
+  "Retrieves the file name stored at address."
+  (let ((name (make-string (malyon-read-byte address) ? ))
+	(i    0))
+    (while (< i (length name))
+      (aset name i (malyon-read-byte (+ address 1 i)))
+      (setq i (+ 1 i)))
+    name))
+
+;; saving data to disk
+
+(defun malyon-save-file (file &optional table length)
+  "Save the current game state or a memory section to disk."
+  (interactive "FSave file: ")
+  (condition-case nil
+      (save-excursion
+	(set-buffer (create-file-buffer file))
+	(malyon-disable-multibyte)
+	(malyon-erase-buffer)
+	(cond (table (malyon-save-table table length))
+	      (malyon-game-state-quetzal
+	       (malyon-save-quetzal-state (malyon-current-game-state)))
+	      (t
+	       (malyon-save-game-state (malyon-current-game-state))))
+	(let ((coding-system-for-write 'binary))
+	  (write-file file))
+	(kill-buffer nil)
+	1)
+    (error 0)))
+
+(defun malyon-save-table (table length)
+  "Save the given section of memory to the file."
+  (let ((i 0)
+	(j table))
+    (while (< i length)
+      (malyon-write-byte-to-file (malyon-read-byte j))
+      (setq i (+ 1 i)
+	    j (+ 1 j)))))
+
+(defun malyon-save-game-state (state)
+  "Saves the game state to disk."
+  (let ((ip    (aref state 0))
+	(sp    (aref state 1))
+	(fp    (aref state 2))
+	(stack (aref state 3))
+	(mem   (aref state 4))
+	(dyn   (malyon-read-word 14))
+	(i     0))
+    (malyon-write-word-to-file (length malyon-story-file-name))
+    (while (< i (length malyon-story-file-name))
+      (malyon-write-byte-to-file (aref malyon-story-file-name i))
+      (setq i (+ 1 i)))
+    (malyon-write-dword-to-file ip)
+    (malyon-write-word-to-file  sp)
+    (malyon-write-word-to-file  fp)
+    (malyon-write-word-to-file  dyn)
+    (setq i 0)
+    (while (<= i sp)
+      (malyon-write-dword-to-file (aref stack i))
+      (setq i (+ 1 i)))
+    (setq i 0)
+    (while (< i dyn)
+      (malyon-write-byte-to-file (aref mem i))
+      (setq i (+ 1 i)))))
+
+(defun malyon-save-quetzal-state (state)
+  "Saves the game state to disk in quetzal format."
+  (goto-char (point-min))
+  (malyon-save-quetzal-ifhd state)
+  (malyon-save-quetzal-cmem state)
+  (malyon-save-quetzal-stks state)
+  (goto-char (point-min))
+  (malyon-write-chunk-id-to-file "IFZS")
+  (goto-char (point-min))
+  (malyon-write-dword-to-file (- (point-max) (point-min)))
+  (goto-char (point-min))
+  (malyon-write-chunk-id-to-file "FORM"))
+
+(defun malyon-save-quetzal-ifhd (state)
+  "Saves the IFhd chunk of the quetzal format."
+  (malyon-write-chunk-id-to-file "IFhd")
+  (malyon-write-dword-to-file 13)
+  (malyon-write-word-to-file (malyon-read-word 2))
+  (malyon-write-word-to-file (malyon-read-word 18))
+  (malyon-write-word-to-file (malyon-read-word 20))
+  (malyon-write-word-to-file (malyon-read-word 22))
+  (malyon-write-word-to-file (malyon-read-word 28))
+  (malyon-write-byte-to-file (lsh (aref state 0) -16))
+  (malyon-write-byte-to-file (lsh (aref state 0) -8))
+  (malyon-write-byte-to-file (aref state 0))
+  (malyon-write-byte-to-file 0))
+
+(defun malyon-save-quetzal-cmem (state)
+  "Saves the CMem chunk of the quetzal format."
+  (let ((beginning (point-max))
+	(original  (aref malyon-game-state-restart 4))
+	(current   (aref state 4))
+	(size      (malyon-read-word 14))
+	(byte      0)
+	(count     0)
+	(i         0))
+    (goto-char (point-max))
+    (while (< i size)
+      (setq byte (logxor (aref current i) (aref original i)))
+      (if (zerop byte)
+	  (setq count (+ 1 count))
+	(while (> count 0)
+	  (malyon-write-byte-to-file 0)
+	  (setq count (- count 1))
+	  (malyon-write-byte-to-file (min 255 count))
+	  (setq count (- count (min 255 count))))
+	(malyon-write-byte-to-file byte))
+      (setq i (+ 1 i)))
+    (setq size (- (point-max) beginning))
+    (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
+    (goto-char beginning)
+    (malyon-write-chunk-id-to-file "CMem")
+    (malyon-write-dword-to-file size)))
+
+(defun malyon-save-quetzal-stks (state)
+  "Saves the Stks chunk of the quetzal format."
+  (let ((beginning (point-max))
+	(size      0))
+    (goto-char (point-max))
+    (malyon-save-quetzal-stack-frame (- (aref state 2) 4)
+				     (aref state 1)
+				     (aref state 3))
+    (setq size (- (point-max) beginning))
+    (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
+    (goto-char beginning)
+    (malyon-write-chunk-id-to-file "Stks")
+    (malyon-write-dword-to-file size)))
+
+(defun malyon-save-quetzal-stack-frame (fp sp stack)
+  "Saves the stack frames for the Stks chunk."
+  (let* ((frame       (malyon-get-stack-frame fp sp stack))
+	 (frame-id    (aref frame 0))
+	 (previous-fp (aref frame 1))
+	 (previous-sp (aref frame 2))
+	 (return-addr (aref frame 3))
+	 (result-addr (aref frame 4))
+	 (local-vars  (aref frame 5))
+	 (num-args    (aref frame 6))
+	 (eval-stack  (aref frame 7)))
+    (if (> frame-id 0)
+	(malyon-save-quetzal-stack-frame previous-fp previous-sp stack))
+    (malyon-write-byte-to-file (lsh return-addr -16))
+    (malyon-write-byte-to-file (lsh return-addr -8))
+    (malyon-write-byte-to-file return-addr)
+    (if (zerop frame-id)
+	(malyon-write-byte-to-file 0)
+      (malyon-write-byte-to-file (logior (if result-addr 0 16)
+					 (length local-vars))))
+    (malyon-write-byte-to-file (if result-addr result-addr 0))
+    (malyon-write-byte-to-file (- (lsh 1 num-args) 1))
+    (malyon-write-word-to-file (length eval-stack))
+    (while (not (null local-vars))
+      (malyon-write-word-to-file (car local-vars))
+      (setq local-vars (cdr local-vars)))
+    (while (not (null eval-stack))
+      (malyon-write-word-to-file (car eval-stack))
+      (setq eval-stack (cdr eval-stack)))))
+
+;; restoring data from disk
+
+(defvar malyon-restore-data-error nil
+  "An error message if restoring data from a file failed.")
+
+(defvar malyon-restore-quetzal-stack nil
+  "A temporary stack for restoring quetzal game states.")
+
+(defvar malyon-restore-quetzal-stack-pointer nil
+  "A temporary stack pointer for restoring quetzal game states.")
+
+(defvar malyon-restore-quetzal-frame-pointer nil
+  "A temporary frame-pointer for restoring quetzal game states.")
+
+(defun malyon-restore-file (file &optional table length)
+  "Restore a game state or a memory section from disk."
+  (interactive "fLoad file: ")
+  (if (not (and (file-exists-p file) (file-readable-p file)))
+      0
+    (condition-case nil
+	(save-excursion
+	  (setq malyon-restore-data-error nil)
+	  (set-buffer (create-file-buffer file))
+	  (malyon-disable-multibyte)
+	  (malyon-erase-buffer)
+	  (let ((coding-system-for-read 'binary))
+	    (insert-file-contents file))
+	  (goto-char (point-min))
+	  (if table
+	      (malyon-restore-table table length)
+	    (let* ((first  (malyon-read-chunk-id-from-file))
+		   (second (malyon-read-dword-from-file))
+		   (third  (malyon-read-chunk-id-from-file)))
+	      (if (and (string= "FORM" first) (string= "IFZS" third))
+		  (malyon-restore-quetzal-state (+ 8 second))
+		(goto-char (point-min))
+		(malyon-restore-game-state))))
+	  (kill-buffer nil)
+	  (if (null malyon-restore-data-error)
+	      2
+	    (message malyon-restore-data-error)
+	    0))
+      (error 0))))
+
+(defun malyon-restore-table (table length)
+  "Restore the given section of memory from a file."
+  (let ((i 0)
+	(j table))
+    (while (< i length)
+      (malyon-store-byte j (malyon-read-byte-from-file))
+      (setq i (+ 1 i)
+	    j (+ 1 j)))))
+
+(defun malyon-restore-game-state ()
+  "Restore a saved game state from disk."
+  (let ((len   0)
+	(name  0)
+	(story 0)
+	(ip    0)
+	(sp    0)
+	(fp    0)
+	(dyn   0)
+	(stack (copy-sequence malyon-stack))
+	(mem   (copy-sequence malyon-story-file))
+	(i     0))
+    (setq len (malyon-read-word-from-file))
+    (setq name (make-string len ? ))
+    (while (< i len)
+      (aset name i (malyon-read-byte-from-file))
+      (setq i (+ 1 i)))
+    (setq ip  (malyon-read-dword-from-file))
+    (setq sp  (malyon-read-word-from-file))
+    (setq fp  (malyon-read-word-from-file))
+    (setq dyn (malyon-read-word-from-file))
+    (setq i 0)
+    (while (<= i sp)
+      (aset stack i (malyon-read-dword-from-file))
+      (setq i (+ 1 i)))
+    (setq i 0)
+    (while (< i dyn)
+      (aset mem i (malyon-read-byte-from-file))
+      (setq i (+ 1 i)))
+    (setq name  (file-name-nondirectory name))
+    (setq story (file-name-nondirectory malyon-story-file-name))
+    (if (or (string-match name story) (string-match story name))
+	(malyon-set-game-state (vector ip sp fp stack mem nil))
+      (setq malyon-restore-data-error "Invalid save file."))))
+
+(defun malyon-restore-quetzal-state (size)
+  "Restore a saved quetzal game state from disk."
+  (let ((chunk-id  nil)
+	(chunk-len 0)
+	(ip        0)
+	(memory    nil)
+	(stack     nil)
+	(beginning 0))
+    (while (< (point) size)
+      (setq chunk-id  (malyon-read-chunk-id-from-file))
+      (setq chunk-len (malyon-read-dword-from-file))
+      (setq beginning (point))
+      (cond ((string= chunk-id "IFhd")
+	     (setq ip (malyon-restore-quetzal-ifhd chunk-len)))
+	    ((string= chunk-id "CMem")
+	     (setq memory (malyon-restore-quetzal-cmem chunk-len)))
+	    ((string= chunk-id "UMem")
+	     (setq memory (malyon-restore-quetzal-umem chunk-len)))
+	    ((string= chunk-id "Stks")
+	     (setq stack (malyon-restore-quetzal-stks chunk-len))))
+      (if (zerop (mod chunk-len 2)) '() (setq chunk-len (+ 1 chunk-len)))
+      (goto-char (+ beginning chunk-len)))
+    (cond ((and ip memory stack)
+	   (malyon-set-game-state (vector ip
+					  (aref stack 0)
+					  (aref stack 1)
+					  (aref stack 2)
+					  memory
+					  t)))
+	  ((null malyon-restore-data-error)
+	   (setq malyon-restore-data-error "invalid quetzal file.")))))
+
+(defun malyon-restore-quetzal-ifhd (size)
+  "Restore an IFhd chunk from disk. Return the instruction pointer."
+  (if (and (= (malyon-read-word-from-file) (malyon-read-word 2))
+	   (= (malyon-read-word-from-file) (malyon-read-word 18))
+	   (= (malyon-read-word-from-file) (malyon-read-word 20))
+	   (= (malyon-read-word-from-file) (malyon-read-word 22))
+	   (= (malyon-read-word-from-file) (malyon-read-word 28)))
+      (logior (lsh (malyon-read-byte-from-file) 16)
+	      (lsh (malyon-read-byte-from-file) 8)
+	      (malyon-read-byte-from-file))
+    (setq malyon-restore-data-error "quetzal file doesn't belong to game.")
+    nil))
+
+(defun malyon-restore-quetzal-cmem (size)
+  "Restore a CMem chunk from disk. Return the entire memory layout."
+  (let ((memory   (copy-sequence (aref malyon-game-state-restart 4)))
+	(max-size (+ (point) size))
+	(byte     0)
+	(i        0))
+    (while (< (point) max-size)
+      (setq byte (malyon-read-byte-from-file))
+      (if (zerop byte)
+	  (setq i (+ 1 i (malyon-read-byte-from-file)))
+	(aset memory i (logxor byte (aref memory i)))
+	(setq i (+ 1 i))))
+    memory))
+
+(defun malyon-restore-quetzal-umem (size)
+  "Restore a UMem chunk from disk. Return the entire memory layout."
+  (let ((memory (copy-sequence (aref malyon-game-state-restart 4)))
+	(i      0))
+    (while (< i size)
+      (aset memory i (malyon-read-byte-from-file))
+      (setq i (+ 1 i)))
+    memory))
+
+(defun malyon-restore-quetzal-stks (size)
+  "Restore a Stks chunk from disk. Return a vector containing the 
+stack pointer, the frame pointer, and the stack itself."
+  (let ((i 0) (frame-id 0))
+    (setq malyon-restore-quetzal-stack
+	  (copy-sequence (aref malyon-game-state-restart 3)))
+    (setq malyon-restore-quetzal-stack-pointer -1)
+    (setq malyon-restore-quetzal-frame-pointer 2)
+    (while (< i size)
+      (let* ((beginning     (point))
+	     (return3       (malyon-read-byte-from-file))
+	     (return2       (malyon-read-byte-from-file))
+	     (return1       (malyon-read-byte-from-file))
+	     (return-addr   (logior (lsh return3 16) (lsh return2 8) return1))
+	     (result-locals (malyon-read-byte-from-file))
+	     (has-result    (zerop (logand 16 result-locals)))
+	     (num-locals    (logand 15 result-locals))
+	     (result-addr   (malyon-read-byte-from-file))
+	     (arg-flags     (+ 1 (malyon-read-byte-from-file)))
+	     (num-args      0)
+	     (eval-size     (malyon-read-word-from-file))
+	     (local-vars    '())
+	     (eval-stack    '()))
+	(while (> num-locals 0)
+	  (setq local-vars (cons (malyon-read-word-from-file) local-vars))
+	  (setq num-locals (- num-locals 1)))
+	(while (> eval-size 0)
+	  (setq eval-stack (cons (malyon-read-word-from-file) eval-stack))
+	  (setq eval-size (- eval-size 1)))
+	(while (> arg-flags 1)
+	  (setq arg-flags (lsh arg-flags -1))
+	  (setq num-args (+ num-args 1)))
+	(malyon-push-stack-frame frame-id
+				 return-addr
+				 (if (zerop frame-id)
+				     nil
+				   (if has-result result-addr nil))
+				 (reverse local-vars)
+				 num-args
+				 (reverse eval-stack))
+	(setq frame-id (+ 1 frame-id))
+	(setq i (+ i (- (point) beginning)))))
+    (vector malyon-restore-quetzal-stack-pointer
+	    malyon-restore-quetzal-frame-pointer
+	    malyon-restore-quetzal-stack)))
+
+;; object table management
+
+(defsubst malyon-object-address (object)
+  "Compute the address at which the object is stored."
+  (+ malyon-object-table
+     (* 2 malyon-object-properties)
+     (* malyon-object-table-entry-size (- object 1))))
+
+(defsubst malyon-object-read-parent (address)
+  "Return the parent."
+  (if (< malyon-story-version 5)
+      (malyon-read-byte (+ 4 address))
+    (malyon-read-word (+ 6 address))))
+
+(defsubst malyon-object-read-sibling (address)
+  "Return the next sibling."
+  (if (< malyon-story-version 5)
+      (malyon-read-byte (+ 5 address))
+    (malyon-read-word (+ 8 address))))
+
+(defsubst malyon-object-read-child (address)
+  "Return the first child."
+  (if (< malyon-story-version 5)
+      (malyon-read-byte (+ 6 address))
+    (malyon-read-word (+ 10 address))))
+
+(defsubst malyon-object-store-parent (address value)
+  "Set the parent."
+  (if (< malyon-story-version 5)
+      (malyon-store-byte (+ 4 address) value)
+    (malyon-store-word (+ 6 address) value)))
+
+(defsubst malyon-object-store-sibling (address value)
+  "Set the next sibling."
+  (if (< malyon-story-version 5)
+      (malyon-store-byte (+ 5 address) value)
+    (malyon-store-word (+ 8 address) value)))
+
+(defsubst malyon-object-store-child (address value)
+  "Set the first child."
+  (if (< malyon-story-version 5)
+      (malyon-store-byte (+ 6 address) value)
+    (malyon-store-word (+ 10 address) value)))
+
+(defun malyon-find-property (object property)
+  "Return the address of the object's property, or 0 if it doesn't exist."
+  (let ((next (malyon-first-property object))
+	(number 0))
+    (setq number (logand (malyon-read-byte next) malyon-object-properties))
+    (while (> number property)
+      (setq next (malyon-next-property next))
+      (setq number (logand (malyon-read-byte next) malyon-object-properties)))
+    (if (= number property) next 0)))
+
+(defun malyon-first-property (object)
+  "Get the address of the object's first property."
+  (let ((header (malyon-read-word (+ malyon-object-property-offset
+				     (malyon-object-address object)))))
+    (+ header 1 (* 2 (malyon-read-byte header)))))
+
+(defun malyon-next-property (property)
+  "Get the address of the following property."
+  (let ((size (malyon-read-byte property))
+	(addr (+ property 1)))
+    (+ 1 addr (cond ((< malyon-story-version 5) (lsh size -5))
+		    ((zerop (logand 128 size))  (lsh size -6))
+		    (t
+		     (let ((second (logand 63 (malyon-read-byte addr))))
+		       (if (= 0 second) 64 second)))))))
+
+(defun malyon-remove-object (object)
+  "Remove the object from the children list of its parent."
+  (let* ((address (malyon-object-address object))
+	 (parent  (malyon-object-read-parent address))
+	 (sibling (malyon-object-read-sibling address)))
+    (malyon-object-store-parent address 0)
+    (malyon-object-store-sibling address 0)
+    (if (/= parent 0)
+	(let ((parent-addr (malyon-object-address parent)))
+	  (let ((children (malyon-object-read-child parent-addr)))
+	    (if (or (= children 0) (= children object))
+		(malyon-object-store-child parent-addr sibling)
+	      (let ((this (malyon-object-address children)))
+		(let ((next (malyon-object-read-sibling this)))
+		  (while (/= next object)
+		    (setq this (malyon-object-address next))
+		    (setq next (malyon-object-read-sibling this)))
+		  (malyon-object-store-sibling this sibling)))))))))
+
+;; function calls and code branches
+
+(defun malyon-call-routine (routine arguments &optional result)
+  "Call a routine with the given arguments and return its result."
+  (if (= routine 0)
+      (if result (malyon-store-variable result 0) 0)
+    (malyon-push-stack (if result 0 1))
+    (malyon-push-stack (if result result 0))
+    (malyon-push-stack malyon-instruction-pointer)
+    (malyon-push-stack
+     (logior (lsh (- malyon-stack-pointer malyon-frame-pointer) 8)
+	     (length arguments)))
+    (setq malyon-instruction-pointer (* malyon-packed-multiplier routine))
+    (let ((args (malyon-read-code-byte)) (value nil))
+      (if malyon-game-state-quetzal
+	  (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
+	    (malyon-push-stack (logior (lsh (+ 1 id) 8) args))))
+      (setq malyon-frame-pointer malyon-stack-pointer)
+      (while (> args 0)
+	(setq value (if (< malyon-story-version 5) (malyon-read-code-word) 0))
+	(malyon-push-stack (if (null arguments) value (car arguments)))
+	(setq arguments (cdr arguments))
+	(setq args (- args 1))))))
+
+(defun malyon-jump-if (condition)
+  "Jump depending on the condition and the following jump data."
+  (let ((byte   (malyon-read-code-byte))
+	(offset nil)
+	(iftrue nil))
+    (setq iftrue (/= 0 (logand byte 128)))
+    (setq offset (logand byte 63))
+    (if (= 0 (logand byte 64)) 
+	(progn
+	  (setq offset (logior (lsh offset 8) (malyon-read-code-byte)))
+	  (if (>= offset 8192) (setq offset (- offset 16384)))))
+    (if (or (and iftrue condition) (and (not iftrue) (not condition)))
+	(progn
+	  (cond ((= offset 0) (malyon-opcode-rfalse))
+		((= offset 1) (malyon-opcode-rtrue))
+		(t            (setq
+			       malyon-instruction-pointer 
+			       (+ malyon-instruction-pointer offset -2))))))))
+
+(defun malyon-return (value)
+  "Return from a routine."
+  (setq malyon-stack-pointer malyon-frame-pointer)
+  (if malyon-game-state-quetzal (malyon-pop-stack))
+  (setq malyon-frame-pointer
+	(- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
+  (setq malyon-instruction-pointer (malyon-pop-stack))
+  (let ((result (malyon-pop-stack))
+	(store  (malyon-pop-stack)))
+    (if (zerop store)
+	(malyon-return-store result value)
+      (malyon-return-ignore result value))))
+
+(defun malyon-return-ignore (where value)
+  "Return from a routine ignoring the result.")
+
+(defun malyon-return-store (where value)
+  "Return from a routine storing the result."
+  (malyon-store-variable where value))
+
+(defun malyon-push-initial-frame ()
+  "Push the initial stack frame required in quetzal mode."
+  (if malyon-game-state-quetzal
+      (progn
+	(malyon-push-stack 1)
+	(malyon-push-stack 0)
+	(malyon-push-stack 0)
+	(malyon-push-stack 0)
+	(malyon-push-stack 0))))
+
+(defun malyon-get-stack-frame (fp sp stack)
+  "Return a decoded stack frame in quetzal mode.
+The result is a vector containing the frame id, the fp of the
+previous frame, the sp of the previous frame, the return address,
+the result variable if any, a list of local variables, the number
+of arguments, and a list of the evaluation stack elements."
+  (let* ((has-result   (zerop (aref stack fp)))
+	 (result-addr  (if has-result (aref stack (+ 1 fp)) nil))
+	 (return-addr  (aref stack (+ 2 fp)))
+	 (offset       (lsh (aref stack (+ 3 fp)) -8))
+	 (num-args     (logand 255 (aref stack (+ 3 fp))))
+	 (frame-id     (lsh (aref stack (+ 4 fp)) -8))
+	 (num-locals   (logand 255 (aref stack (+ 4 fp))))
+	 (start-locals (+ 5 fp))
+	 (start-eval   (+ 5 fp num-locals))
+	 (local-vars   '())
+	 (eval-stack   '()))
+    (if (not (zerop num-locals))
+	(setq local-vars 
+	      (malyon-vector-to-list stack start-locals start-eval)))
+    (if (> sp start-eval)
+	(setq eval-stack 
+	      (malyon-vector-to-list stack start-eval (+ 1 sp))))
+    (vector frame-id
+	    (- fp offset 2)
+	    (- fp 1)
+	    return-addr
+	    result-addr
+	    local-vars
+	    num-args
+	    eval-stack)))
+
+(defsubst malyon-restore-quetzal-push-stack (value)
+  "Push a value onto the restore quetzal stack."
+  (setq malyon-restore-quetzal-stack-pointer
+	(+ malyon-restore-quetzal-stack-pointer 1))
+  (aset malyon-restore-quetzal-stack
+	malyon-restore-quetzal-stack-pointer
+	value))
+
+(defun malyon-push-stack-frame
+  (frame-id return-addr result local-vars num-args eval-stack)
+  "Pushes a new stack frame in quetzal mode."
+  (malyon-restore-quetzal-push-stack (if result 0 1))
+  (malyon-restore-quetzal-push-stack (if result result 0))
+  (malyon-restore-quetzal-push-stack return-addr)
+  (malyon-restore-quetzal-push-stack
+   (logior (lsh (- malyon-restore-quetzal-stack-pointer
+		   malyon-restore-quetzal-frame-pointer) 8)
+	   num-args))
+  (malyon-restore-quetzal-push-stack
+   (logior (lsh frame-id 8) (length local-vars)))
+  (setq malyon-restore-quetzal-frame-pointer
+	malyon-restore-quetzal-stack-pointer)
+  (while (not (null local-vars))
+    (malyon-restore-quetzal-push-stack (car local-vars))
+    (setq local-vars (cdr local-vars)))
+  (while (not (null eval-stack))
+    (malyon-restore-quetzal-push-stack (car eval-stack))
+    (setq eval-stack (cdr eval-stack))))
+
+;; other stuff
+
+(defvar malyon-aread-text nil
+  "Text buffer for user input.")
+
+(defvar malyon-aread-parse nil
+  "Parse buffer for user input.")
+
+(defvar malyon-aread-beginning-of-line nil
+  "The beginning of the input line.")
+
+;; execution
+
+(defun malyon-interpreter ()
+  "Run the z code interpreter on the given story file."
+  (condition-case nil
+      (progn
+	(malyon-restore-window-configuration)
+	(if malyon-story-file
+	    (catch 'malyon-end-of-interpreter-loop
+	      (setq malyon-last-cursor-position-after-input
+		    (malyon-point-max malyon-transcript-buffer))
+	      (malyon-execute))))
+    (error
+     (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defsubst malyon-fetch-variable-operands (specifier)
+  "Fetch a variable number of operands based on the specifier argument."
+  (let ((var  (logand specifier 49152))
+	(op   '()))
+    (setq specifier (logand 65535 specifier))
+    (while (/= 0 specifier)
+      (cond ((= var 0)     (setq op (cons (malyon-read-code-word) op)))
+	    ((= var 16384) (setq op (cons (malyon-read-code-byte) op)))
+	    ((= var 32768) (setq op (cons (malyon-read-variable
+					   (malyon-read-code-byte)) op)))
+	    (t             (setq specifier 0)))
+      (setq specifier (logand 65535 (lsh specifier 2)))
+      (setq var  (logand specifier 49152)))
+    (nreverse op)))
+
+(defsubst malyon-fetch-extended (opcode)
+  "Fetch operands for an extended instruction."
+  (malyon-fetch-variable-operands
+   (logior (lsh (malyon-read-code-byte) 8) 255)))
+
+(defsubst malyon-fetch-variable (opcode)
+  "Fetch operands for a variable instruction."
+  (malyon-fetch-variable-operands
+   (if (or (= opcode 236) (= opcode 250))
+       (malyon-read-code-word)
+     (logior (lsh (malyon-read-code-byte) 8) 255))))
+
+(defsubst malyon-fetch-short (opcode)
+  "Fetch operands for a short instruction."
+  (let ((op (logand opcode 48)))
+    (cond ((= op 0)  (list (malyon-read-code-word)))
+	  ((= op 16) (list (malyon-read-code-byte)))
+	  ((= op 32) (list (malyon-read-variable (malyon-read-code-byte)))))))
+
+(defsubst malyon-fetch-long (instr)
+  "Fetch operands for a long instruction."
+  (let ((byte1 (malyon-read-code-byte))
+	(byte2 (malyon-read-code-byte)))
+    (list (if (= (logand instr 64) 0) byte1 (malyon-read-variable byte1))
+	  (if (= (logand instr 32) 0) byte2 (malyon-read-variable byte2)))))
+
+(defun malyon-execute ()
+  "Execute z code instructions.
+Load the next instruction opcode and its operands and execute it.
+Repeat ad infinitum."
+  (let ((opcode) (operands)); (pc))
+    (while t
+;      (setq pc malyon-instruction-pointer)
+      (setq opcode (malyon-read-code-byte))
+      (setq operands (cond ((=  opcode 190) 
+			    (setq opcode (+ 256 (malyon-read-code-byte)))
+			    (malyon-fetch-extended opcode))
+			   ((>= opcode 192)
+			    (malyon-fetch-variable opcode))
+			   ((>= opcode 128)
+			    (malyon-fetch-short opcode))
+			   (t
+			    (malyon-fetch-long opcode))))
+;      (malyon-trace-opcode pc opcode operands)
+      (apply (aref malyon-opcodes opcode) operands))))
+
+;; opcodes
+
+(defsubst malyon-number (n)
+  "Convert an unsigned number into a signed one."
+  (if (< n 32768) n (- n 65536)))
+
+(defun malyon-opcode-add (a b)
+  "Addition."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (+ (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-and (a b)
+  "Bitwise and."
+  (malyon-store-variable (malyon-read-code-byte) (logand a b)))
+
+(defun malyon-opcode-aread (text parse &optional time routine)
+  "Read input text."
+  (setq malyon-aread-text text)
+  (setq malyon-aread-parse parse)
+  (goto-char (point-max))
+  (setq malyon-aread-beginning-of-line (point))
+; Some games violate these assumptions for the "Quit" question.
+;  (if (> 3 (malyon-read-byte text))
+;      (malyon-fatal-error "text buffer less than 3 bytes."))
+;  (if (and (not (zerop parse)) (> 2 (malyon-read-byte parse)))
+;      (malyon-fatal-error "parse buffer less than 2 bytes."))
+  (malyon-more malyon-keymap-read)
+  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
+
+(defun malyon-opcode-art-shift (value places)
+  "Arithmetic shift."
+  (malyon-store-variable (malyon-read-code-byte) (ash value places)))
+
+(defun malyon-opcode-buffer-mode (mode)
+  "Toggles buffering of text in the transcript window."
+  (setq malyon-transcript-buffer-buffered (/= 0 mode)))
+
+(defun malyon-opcode-calln (routine &rest arguments)
+  "Call a routine and ignore the result."
+  (malyon-call-routine routine arguments))
+
+(defun malyon-opcode-calls (routine &rest arguments)
+  "Call a routine and store the result."
+  (malyon-call-routine routine arguments (malyon-read-code-byte)))
+
+(defun malyon-opcode-catch ()
+  "Return the current stack frame."
+  (malyon-store-variable
+   (malyon-read-code-byte)
+   (if malyon-game-state-quetzal
+       (lsh (aref malyon-stack malyon-frame-pointer) -8)
+     malyon-frame-pointer)))
+
+(defun malyon-opcode-check-arg-count (count)
+  "Tests the number of arguments passed to routine."
+  (malyon-jump-if
+   (<= count (logand 255 (aref malyon-stack 
+			       (if malyon-game-state-quetzal
+				   (- malyon-frame-pointer 1)
+				 malyon-frame-pointer))))))
+
+(defun malyon-opcode-check-unicode (char)
+  "Check whether the given character is valid for input/output."
+  (malyon-store-variable (malyon-read-code-byte) 0))
+
+(defun malyon-opcode-clear-attr (object attribute)
+  "Clear the given attribute in the given object."
+  (let ((attributes (malyon-object-address object))
+	(byte       (lsh attribute -3)))
+    (malyon-store-byte (+ attributes byte)
+		       (logand (malyon-read-byte (+ attributes byte))
+			       (logxor (lsh 128 (- (logand attribute 7)))
+				       255)))))
+
+(defun malyon-opcode-copy-table (first second size)
+  "Copies first table onto second one."
+  (let* ((length  (abs (malyon-number size)))
+	 (zero    (zerop second))
+	 (forward (or (< (malyon-number size) 0) (> first second)))
+	 (i       0)
+	 (a       (if forward first (+ first length -1)))
+	 (b       (if forward (if zero first second) (+ second length -1))))
+    (while (< i length)
+      (malyon-store-byte b (if zero 0 (malyon-read-byte a)))
+      (setq i (+ i 1)
+	    a (if forward (+ a 1) (- a 1))
+	    b (if forward (+ b 1) (- b 1))))))
+
+(defun malyon-opcode-dec (var)
+  "Decrement variable."
+  (malyon-store-variable var
+			 (- (malyon-number (malyon-read-variable var)) 1)))
+
+(defun malyon-opcode-dec-chk (variable threshold)
+  "Decrement variable and jump if it's less than the given value."
+  (let ((value (malyon-number (malyon-read-variable variable))))
+    (malyon-store-variable variable (- value 1))
+    (malyon-jump-if (< (- value 1) (malyon-number threshold)))))
+
+(defun malyon-opcode-div (a b)
+  "Division."
+  (if (zerop b) (malyon-fatal-error "division by 0."))
+  (malyon-store-variable (malyon-read-code-byte)
+			 (/ (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-encode-text (text length from encoded)
+  "Encode the zscii text starting at from with the given length.
+The result is stored at encoded."
+  (let* ((i     length)
+	 (j     encoded)
+	 (l     '())
+	 (word  '()))
+    (while (< 0 i)
+      (setq l (cons (malyon-read-byte (+ text from i -1)) l)
+	    i (- i 1)))
+    (setq word (malyon-encode-dictionary-word
+		(append (malyon-mapcan 'malyon-encode-into-ztext l)
+			'(5 5 5 5 5 5 5 5))))
+    (while (< i 6)
+      (malyon-store-byte j (car l))
+      (setq i (+ 1 i)
+	    j (+ 1 j)
+	    l (cdr word)))))
+
+(defun malyon-opcode-erase-line (value)
+  "Erases the rest of the line."
+  (if (= value 1)
+      (if (eq malyon-transcript-buffer (current-buffer))
+	  (kill-line nil)
+	(save-excursion
+	  (let ((i (current-column)))
+	    (while (<= i malyon-max-column)
+	      (insert ? )
+	      (delete-char 1)
+	      (setq i (+ 1 i))))))))
+
+(defun malyon-opcode-erase-window (window)
+  "Erase the contents of the given window."
+  (save-excursion
+    (let ((w (malyon-number window)))
+      (if (or (= w 0) (= w -1) (= w -2))
+	  (malyon-erase-buffer malyon-transcript-buffer))
+      (if (or (= w 1) (= w -1) (= w -2))
+	  (malyon-erase-buffer malyon-status-buffer))
+      (if (= w -1)
+	  (malyon-split-buffer-windows 0)))
+    (setq malyon-last-cursor-position-after-input
+	  (malyon-point-max malyon-transcript-buffer))))
+
+(defun malyon-opcode-get-child (object)
+  "Get the first child of the given object and jump."
+  (let ((child (malyon-object-read-child (malyon-object-address object))))
+    (malyon-store-variable (malyon-read-code-byte) child)
+    (malyon-jump-if (/= 0 child))))
+
+(defun malyon-opcode-get-cursor (array)
+  "Retrieves the current cursor position."
+  (save-excursion
+    (set-buffer malyon-status-buffer)
+    (malyon-store-word array (- (count-lines (point-min) (point)) 1))
+    (malyon-store-word (+ 2 array) (+ 1 (current-column)))))
+
+(defun malyon-opcode-get-next-prop (object property)
+  "Retrieve the first or next property id of object."
+  (let ((next (malyon-first-property object))
+	(number 0))
+    (if (zerop property)
+	'()
+      (setq number (logand (malyon-read-byte next)
+			   malyon-object-properties))
+      (setq next (malyon-next-property next))
+      (while (> number property)
+	(setq number (logand (malyon-read-byte next)
+			     malyon-object-properties))
+	(setq next (malyon-next-property next)))
+      (if (/= number property)
+	  (malyon-fatal-error "property does not exist.")))
+    (setq number (logand (malyon-read-byte next) malyon-object-properties))
+    (malyon-store-variable (malyon-read-code-byte) number)))
+    
+(defun malyon-opcode-get-parent (object)
+  "Get the parent of the given object."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (malyon-object-read-parent
+			  (malyon-object-address object))))
+
+(defun malyon-opcode-get-prop (object property)
+  "Get the value of the object's property."
+  (let* ((address (malyon-find-property object property))
+	 (size    (malyon-read-byte address)))
+    (malyon-store-variable 
+     (malyon-read-code-byte)
+     (cond ((zerop address)
+	    (malyon-read-word (+ malyon-object-table (* 2 (- property 1)))))
+	   ((and (<  malyon-story-version 5) (zerop (lsh size -5)))
+	    (malyon-read-byte (+ address 1)))
+	   ((and (>= malyon-story-version 5) (zerop (logand 192 size)))
+	    (malyon-read-byte (+ address 1)))
+	   (t
+	    (malyon-read-word (+ address 1)))))))
+
+(defun malyon-opcode-get-prop-addr (object property)
+  "Get the address of the object's property."
+  (let* ((address (malyon-find-property object property))
+	 (size    (malyon-read-byte address))
+	 (offset  (if (< malyon-story-version 5)
+		      1
+		    (if (zerop (logand 128 size)) 1 2))))
+    (malyon-store-variable (malyon-read-code-byte)
+			   (if (zerop address) 0 (+ address offset)))))
+
+(defun malyon-opcode-get-prop-len (property)
+  "Get the length of the object's property."
+  (let ((size (malyon-read-byte (- property 1))))
+    (malyon-store-variable
+     (malyon-read-code-byte)
+     (cond ((< malyon-story-version 5) (+ 1 (lsh size -5)))
+	   ((zerop (logand 128 size))  (+ 1 (lsh size -6)))
+	   ((zerop (logand  63 size))  64)
+	   (t                          (logand 63 size))))))
+
+(defun malyon-opcode-get-sibling (object)
+  "Get the next object in the tree and jump."
+  (let ((sibling (malyon-object-read-sibling (malyon-object-address object))))
+    (malyon-store-variable (malyon-read-code-byte) sibling)
+    (malyon-jump-if (/= 0 sibling))))
+
+(defun malyon-opcode-illegal (&rest ignore)
+  "Print an error message and exit the interpreter."
+  (malyon-fatal-error "illegal opcode."))
+
+(defun malyon-opcode-inc (var)
+  "Increment variable."
+  (malyon-store-variable var
+			 (+ (malyon-number (malyon-read-variable var)) 1)))
+
+(defun malyon-opcode-inc-chk (variable threshold)
+  "Increment variable and jump if it's greater than the given value."
+  (let ((value (malyon-number (malyon-read-variable variable))))
+    (malyon-store-variable variable (+ value 1))
+    (malyon-jump-if (> (+ value 1) (malyon-number threshold)))))
+
+(defun malyon-opcode-input-stream (number)
+  "Select the given input stream. Only the keyboard is supported."
+  (if (zerop (malyon-number number))
+      '()
+    (message "Only the keyboard is supported as an input stream.")))
+
+(defun malyon-opcode-insert-obj (object destination)
+  "Insert an object into the children list of another."
+  (let ((child  (malyon-object-address object))
+	(parent (malyon-object-address destination)))
+    (malyon-remove-object object)
+    (malyon-object-store-parent  child destination)
+    (malyon-object-store-sibling child (malyon-object-read-child parent))
+    (malyon-object-store-child   parent object)))
+
+(defun malyon-opcode-je (a &rest rest)
+  "Jump if first operand equals any of the following."
+  (malyon-jump-if (member (malyon-number a) (mapcar 'malyon-number rest))))
+
+(defun malyon-opcode-jg (a b)
+  "Jump if first operand > second operand."
+  (malyon-jump-if (> (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-jin (child parent)
+  "Jump if second object is parent of the first one."
+    (malyon-jump-if
+     (= parent (malyon-object-read-parent (malyon-object-address child)))))
+
+(defun malyon-opcode-jl (a b)
+  "Jump if first operand < second operand."
+  (malyon-jump-if (< (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-jump (offset)
+  "Jump unconditionally."
+  (setq malyon-instruction-pointer (+ malyon-instruction-pointer
+				      (malyon-number offset) -2)))
+
+(defun malyon-opcode-jz (a)
+  "Jump if operand = 0."
+  (malyon-jump-if (zerop a)))
+
+(defun malyon-opcode-load (variable)
+  "Load a variable."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (malyon-read-variable variable)))
+
+(defun malyon-opcode-loadb (array index)
+  "Load an array element into a variable."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (malyon-read-byte (+ array index))))
+
+(defun malyon-opcode-loadw (array index)
+  "Load an array element into a variable."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (malyon-read-word (+ array (* 2 index)))))
+
+(defun malyon-opcode-log-shift (value places)
+  "Logical shift."
+  (malyon-store-variable (malyon-read-code-byte) (lsh value places)))
+
+(defun malyon-opcode-mod (a b)
+  "Modulo."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (mod (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-mul (a b)
+  "Multiplication."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (* (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-new-line ()
+  "Print a newline."
+  (malyon-newline))
+
+(defun malyon-opcode-nop (&rest ignore)
+  "Do nothing.")
+
+(defun malyon-opcode-not (a)
+  "Bitwise not."
+  (malyon-store-variable (malyon-read-code-byte) (logand 65535 (lognot a))))
+
+(defun malyon-opcode-or (a b)
+  "Bitwise or."
+  (malyon-store-variable (malyon-read-code-byte) (logior a b)))
+
+(defun malyon-opcode-output-stream (stream &optional table)
+  "Select an output stream."
+  (let ((stream (malyon-number stream)))
+    (cond ((< 0 stream) (malyon-add-output-stream stream table))
+	  ((> 0 stream) (malyon-remove-output-stream (- stream))))))
+
+(defun malyon-opcode-piracy ()
+  "Piracy check, effectively an unconditional jump."
+  (malyon-jump-if 1))
+
+(defun malyon-opcode-pop ()
+  "Pop a value off the stack."
+  (malyon-pop-stack))
+
+(defun malyon-opcode-print ()
+  "Print a string."
+  (setq malyon-instruction-pointer
+	(malyon-print-text malyon-instruction-pointer)))
+
+(defun malyon-opcode-print-addr (address)
+  "Print a string."
+  (malyon-print-text address))
+
+(defun malyon-opcode-print-char (c)
+  "Print a character."
+  (malyon-print (char-to-string c)))
+
+(defun malyon-opcode-print-num (n)
+  "Print a number."
+  (malyon-print (number-to-string (malyon-number n))))
+
+(defun malyon-opcode-print-obj (obj)
+  "Print the short name of the object."
+  (malyon-print-text
+   (+ 1 (malyon-read-word (+ malyon-object-property-offset
+			     (malyon-object-address obj))))))
+
+(defun malyon-opcode-print-paddr (address)
+  "Print a string."
+  (malyon-print-text (* malyon-packed-multiplier address)))
+
+(defun malyon-opcode-print-ret ()
+  "Print a string, print a newline, return true/1."
+  (setq malyon-instruction-pointer
+	(malyon-print-text malyon-instruction-pointer))
+  (malyon-newline)
+  (malyon-return 1))
+
+(defun malyon-opcode-print-table (text width &optional height skip)
+  "Print the given table."
+  (if (not height) (setq height 1))
+  (if (not skip)   (setq skip 0))
+  (let ((column  (current-column))
+	(address text)
+	(y       0)
+	(x       0))
+    (while (< y height)
+      (if (zerop y)
+	  '()
+	(malyon-newline)
+	(malyon-print-characters (make-string column ? )))
+      (setq x 0)
+      (while (< x width)
+	(malyon-output-character (malyon-read-byte address))
+	(setq address (+ 1 address))
+	(setq x (+ 1 x)))
+      (setq address (+ skip address))
+      (setq y (+ 1 y)))))
+
+(defun malyon-opcode-print-unicode (char)
+  "Prints a unicode character.")
+
+(defun malyon-opcode-pull (variable)
+  "Pull value off stack."
+  (malyon-store-variable variable (malyon-pop-stack)))
+
+(defun malyon-opcode-push (value)
+  "Push value onto stack."
+  (malyon-push-stack value))
+
+(defun malyon-opcode-put-prop (object property value)
+  "Set the object's property to the given value."
+  (let* ((address (malyon-find-property object property))
+	 (size    (malyon-read-byte address)))
+    (cond ((= address 0)
+	   (malyon-fatal-error "property does not exist."))
+	  ((and (<  malyon-story-version 5) (zerop (lsh size -5)))
+	   (malyon-store-byte (+ 1 address) (logand 255 value)))
+	  ((and (>= malyon-story-version 5) (zerop (logand size 192)))
+	   (malyon-store-byte (+ 1 address) (logand 255 value)))
+	  (t
+	   (malyon-store-word (+ 1 address) value)))))
+
+(defun malyon-opcode-quit ()
+  "End the game immediately."
+  (malyon-adjust-transcript)
+  (malyon-cleanup)
+  (throw 'malyon-end-of-interpreter-loop 'malyon-opcode-quit))
+
+(defun malyon-opcode-random (limit)
+  "Generate a random number or set the seed value."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (if (>= 0 (malyon-number limit))
+			     0
+			   (+ 1 (random (malyon-number limit))))))
+
+(defun malyon-opcode-read-char (&optional device &rest ignore)
+  "Read a character."
+  (if (and device (/= 1 device))
+      (malyon-fatal-error "illegal device specified in read_char."))
+  (if (eq malyon-transcript-buffer (current-buffer))
+      (goto-char (point-max)))
+  (message "[Press a key.]")
+  (malyon-more malyon-keymap-readchar)
+  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-character))
+
+(defun malyon-opcode-remove-obj (object)
+  "Remove an object from its parent's children list."
+  (malyon-remove-object object))
+
+(defun malyon-opcode-restart ()
+  "Restart the game."
+  (malyon-set-game-state malyon-game-state-restart))
+
+(defun malyon-opcode-restore (&optional table bytes name)
+  "Restore a saved game state or a section of memory from a file."
+  (let ((result (if name
+		    (malyon-restore-file
+		     (malyon-get-file-name name) table bytes)
+		  (call-interactively 'malyon-restore-file))))
+    (if (< malyon-story-version 5)
+	(malyon-jump-if (not (zerop result)))
+      (malyon-store-variable (malyon-read-code-byte) result))))
+
+(defun malyon-opcode-restore-undo ()
+  "Restore game state for undo."
+  (if malyon-game-state-undo
+      (malyon-set-game-state malyon-game-state-undo))
+  (malyon-store-variable (malyon-read-code-byte) 2))
+
+(defun malyon-opcode-ret (value)
+  "Return a value."
+  (malyon-return value))
+
+(defun malyon-opcode-ret-popped ()
+  "Return top of stack."
+  (malyon-return (malyon-pop-stack)))
+
+(defun malyon-opcode-rfalse ()
+  "Return false/0."
+  (malyon-return 0))
+
+(defun malyon-opcode-rtrue ()
+  "Return true/1."
+  (malyon-return 1))
+
+(defun malyon-opcode-save (&optional table bytes name)
+  "Save the current game state or a section of memory to a file."
+  (let ((result (if name
+		    (malyon-save-file (malyon-get-file-name name) table bytes)
+		  (call-interactively 'malyon-save-file))))
+    (if (< malyon-story-version 5)
+	(malyon-jump-if (not (zerop result)))
+      (malyon-store-variable (malyon-read-code-byte) result))))
+
+(defun malyon-opcode-save-undo ()
+  "Save game state for undo."
+  (setq malyon-game-state-undo (malyon-current-game-state))
+  (malyon-store-byte (malyon-read-code-byte) 1))
+
+(defun malyon-opcode-scan-table (x table len &optional form)
+  "Scan the given table for the first occurrence of x."
+  (if (not form) (setq form 130))
+  (let ((inc (logand 127 form))
+	(byte (zerop (logand 128 form)))
+	(addr table)
+	(found 0)
+	(index 0))
+    (while (and (zerop found) (< index len))
+      (setq found
+	    (if byte
+		(if (= x (malyon-read-byte addr)) addr 0)
+	      (if (= x (malyon-read-word addr)) addr 0)))
+      (setq addr (+ addr inc))
+      (setq index (+ index 1)))
+    (malyon-store-variable (malyon-read-code-byte) found)
+    (malyon-jump-if (not (zerop found)))))
+
+(defun malyon-opcode-set-attr (object attribute)
+  "Set the given attribute in the given object."
+  (let ((attributes (malyon-object-address object))
+	(byte       (lsh attribute -3)))
+    (malyon-store-byte (+ attributes byte)
+		       (logior (malyon-read-byte (+ attributes byte))
+			       (lsh 128 (- (logand attribute 7)))))))
+
+(defun malyon-opcode-set-color (foreground background)
+  "Sets the fore- and background colors ie. does nothing.")
+
+(defun malyon-opcode-set-cursor (&optional line column)
+  "Set the cursor."
+  (if (eq malyon-transcript-buffer (current-buffer))
+      (goto-char (point-max))
+    (if malyon-status-buffer-delayed-split
+	(progn
+	  (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
+	  (other-window 1)))
+    (if line   '() (setq line   (count-lines (point-min) (point))))
+    (if column '() (setq column (current-column)))
+    (if (> line malyon-status-buffer-lines)
+	(progn
+	  (malyon-split-buffer-windows line)
+	  (other-window 1)))
+    (goto-char (point-min))
+    (if (and (<= 1 line) (<= line malyon-status-buffer-lines))
+	(forward-line line)
+      (beginning-of-line))
+    (if (and (<= 1 column) (<= column malyon-max-column))
+	(forward-char (- column 1))
+      (beginning-of-line))
+    (setq malyon-status-buffer-point (point))))
+
+(defun malyon-opcode-set-font (font)
+  "Sets the font if available or 0 otherwise."
+  (malyon-store-variable (malyon-read-code-byte) 0))
+
+(defun malyon-opcode-set-text-style (style)
+  "Set the text style/face."
+  (let ((face (assq style malyon-faces)))
+    (setq malyon-current-face (if face (cdr face) 'malyon-face-plain))))
+
+(defun malyon-opcode-set-window (window)
+  "Set the current window."
+  (malyon-restore-window-configuration)
+  (setq malyon-current-window window)
+  (malyon-update-output-streams)
+  (if (zerop window)
+      (if (not (eq malyon-transcript-buffer (current-buffer)))
+	  (other-window 1))
+    (if (not (eq malyon-status-buffer (current-buffer)))
+	(other-window 1))
+    (malyon-opcode-set-cursor 1 1)))
+
+(defun malyon-opcode-show-status ()
+  "Display the status line."
+  (save-excursion
+    (malyon-opcode-split-window 1)
+    (malyon-restore-window-configuration)
+    (malyon-opcode-set-window 1)
+    (malyon-prepare-status-buffer 1)
+    (malyon-opcode-set-cursor 1 1)
+    (malyon-opcode-print-obj (malyon-read-global-variable 0))
+    (if (<= (current-column) (- (current-fill-column) 10))
+	(let* ((x     (malyon-read-global-variable 1))
+	       (y     (malyon-read-global-variable 2))
+	       (hours (if (> x 12) (- x 12) x))
+	       (ampm  (if (> x 12) "PM" "AM"))
+	       (score (format "%4d/%4d" x y))
+	       (time  (format "%02d:%02d%s" hours y ampm)))
+	  (malyon-opcode-set-cursor 1 (- (current-fill-column) 10))
+	  (malyon-print (if malyon-score-game score time))))
+    (malyon-opcode-set-window 0)
+    (malyon-adjust-transcript)))
+
+(defun malyon-opcode-split-window (size)
+  "Split upper and lower window."
+  (malyon-set-window-configuration size))
+
+(defun malyon-opcode-store (variable value)
+  "Store a value in a variable."
+  (malyon-store-variable variable value))
+
+(defun malyon-opcode-storeb (array index value)
+  "Store a value in an array at the given index."
+  (malyon-store-byte (+ array index) value))
+
+(defun malyon-opcode-storew (array index value)
+  "Store a value in an array at the given index."
+  (malyon-store-word (+ array (* 2 index)) value))
+
+(defun malyon-opcode-sub (a b)
+  "Subtraction."
+  (malyon-store-variable (malyon-read-code-byte)
+			 (- (malyon-number a) (malyon-number b))))
+
+(defun malyon-opcode-test (bitmap flags)
+  "Test if all of the flags are set in the bitmap."
+  (malyon-jump-if (= flags (logand bitmap flags))))
+
+(defun malyon-opcode-test-attr (object attribute)
+  "Jump depending on the given attribute in the given object."
+  (malyon-jump-if 
+   (/= 0 (logand (malyon-read-byte (+ (malyon-object-address object)
+				      (lsh attribute -3)))
+		 (lsh 128 (- (logand attribute 7)))))))
+
+(defun malyon-opcode-throw (value frame)
+  "Return from the given stack frame."
+  (if malyon-game-state-quetzal
+      (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
+	(while (/= frame id)
+	  (setq malyon-stack-pointer malyon-frame-pointer)
+	  (malyon-pop-stack)
+	  (setq malyon-frame-pointer
+		(- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
+	  (malyon-pop-stack)
+	  (malyon-pop-stack)
+	  (setq id (lsh (aref malyon-stack malyon-frame-pointer) -8))))
+    (setq malyon-frame-pointer frame))
+  (malyon-return value))
+
+(defun malyon-opcode-tokenise (text parse &optional dict flag)
+  "Perform lexical analysis on the text buffer."
+  (let* ((words (malyon-text-to-words text dict))
+	 (word  (car           words))
+	 (start (car           word))
+	 (len   (malyon-cadr   word))
+	 (code  (malyon-caddr  word))
+	 (entry (malyon-lookup dict code))
+	 (i     0))
+    (while (not (or (null words) (= i (malyon-read-byte parse))))
+      (if (and (zerop entry) flag (/= 0 flag))
+	  '()
+	(malyon-store-word (+ 2 parse (* 4 i)) entry)
+	(malyon-store-byte (+ 4 parse (* 4 i)) len)
+	(malyon-store-byte (+ 5 parse (* 4 i)) start))
+      (setq words (cdr           words)
+	    word  (car           words)
+	    start (car           word)
+	    len   (malyon-cadr   word)
+	    code  (malyon-caddr  word)
+	    entry (malyon-lookup dict code)
+	    i     (+ 1 i)))
+    (malyon-store-byte (+ 1 parse) i)))
+
+(defun malyon-opcode-verify ()
+  "Verify the correctness of the story file."
+  (let ((length (+ 1 (* malyon-packed-multiplier (malyon-read-word 26))))
+	(sum    0)
+	(i      64))
+    (while (< i length)
+      (setq sum (mod (+ sum (malyon-read-byte i)) 65536)
+	    i   (+ 1 i)))
+    (malyon-jump-if (= (malyon-read-word 28) sum))))
+
+;; keymap utilities
+
+(defun malyon-end-input ()
+  "Store the input line in a text buffer and perform lexical analysis."
+  (interactive)
+  (condition-case nil
+      (progn
+	(malyon-adjust-transcript)
+	(switch-to-buffer malyon-transcript-buffer)
+	(goto-char (point-max))
+	(let* ((input (downcase
+		       (buffer-substring-no-properties
+			(if (< malyon-aread-beginning-of-line (point))
+			    malyon-aread-beginning-of-line
+			  (point))
+			(point))))
+	       (vec  (malyon-string-to-vector input))
+	       (text (apply 'vector (mapcar 'malyon-unicode-to-zscii vec)))
+	       (len  (min (malyon-read-byte malyon-aread-text) (length text)))
+	       (i    0))
+	  (malyon-history-insert input)
+	  (if (>= malyon-story-version 5)
+	      (malyon-store-byte (+ malyon-aread-text 1) len))
+	  (while (< i len)
+	    (malyon-store-byte
+	     (+ malyon-aread-text (if (< malyon-story-version 5) 1 2) i)
+	     (malyon-char-to-int (aref text i)))
+	    (setq i (+ 1 i)))
+	  (if (< malyon-story-version 5)
+	      (malyon-store-byte (+ malyon-aread-text 1 len) 0)))
+	(if (/= 0 malyon-aread-parse)
+	    (malyon-opcode-tokenise malyon-aread-text malyon-aread-parse))
+	(newline)
+	(if (>= malyon-story-version 5)
+	    (malyon-store-variable (malyon-read-code-byte) 10))
+	(malyon-interpreter))
+    (error
+     (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-more-char ()
+  "Page down in More mode."
+  (interactive)
+  (condition-case nil
+      (scroll-up)
+    (error))
+  (if (>= (count-lines (point) (point-max))
+          (malyon-window-displayed-height))
+      (message "[More]")
+    (goto-char (point-max))
+    (malyon-adjust-transcript)
+    (use-local-map malyon-more-continue-keymap)))
+
+(defun malyon-more-char-status ()
+  "Wait for a key then continue."
+  (interactive)
+  (condition-case nil
+      (progn
+	(malyon-adjust-transcript)
+	(use-local-map malyon-more-continue-keymap)
+	(malyon-interpreter))
+    (error
+     (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-wait-char ()
+  "Store the input character in a variable and resume execution."
+  (interactive)
+  (condition-case nil
+      (progn
+	(malyon-store-variable 
+	 (malyon-read-code-byte)
+	 (malyon-char-to-int (malyon-unicode-to-zscii last-command-char)))
+	(use-local-map malyon-keymap-read)
+	(malyon-interpreter))
+    (error
+     (malyon-fatal-error "unspecified internal runtime error."))))
+
+(defun malyon-history-previous-char (arg)
+  "Display the previous item in the input history."
+  (interactive "p")
+  (let ((input (malyon-history-previous)))
+    (cond ((> malyon-aread-beginning-of-line (point))
+	   (funcall malyon-history-saved-up arg))
+	  (input
+	   (save-excursion
+	     (set-buffer malyon-transcript-buffer)
+	     (delete-region malyon-aread-beginning-of-line (point-max)))
+	   (goto-char (point-max))
+	   (insert input)
+	   (malyon-adjust-transcript)))))
+
+(defun malyon-history-next-char (arg)
+  "Display the next item in the input history."
+  (interactive "p")
+  (let ((input (malyon-history-next)))
+    (cond ((> malyon-aread-beginning-of-line (point))
+	   (funcall malyon-history-saved-down arg))
+	  (input
+	   (save-excursion
+	     (set-buffer malyon-transcript-buffer)
+	     (delete-region malyon-aread-beginning-of-line (point-max)))
+	   (goto-char (point-max))
+	   (insert input)
+	   (malyon-adjust-transcript)))))
+
+(defun malyon-beginning-of-line (arg)
+  "Go to the beginning of the line."
+  (interactive "p")
+  (if (> malyon-aread-beginning-of-line (point))
+      (beginning-of-line)
+    (goto-char malyon-aread-beginning-of-line)))
+
+(defun malyon-kill-region (arg)
+  "Kill region."
+  (interactive "p")
+  (if (<= malyon-aread-beginning-of-line (point))
+      (kill-region (point) (mark))
+    (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-kill-line (arg)
+  "Kill rest of the current line."
+  (interactive "p")
+  (if (<= malyon-aread-beginning-of-line (point))
+      (kill-line)
+    (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-kill-word (arg)
+  "Kill the current word."
+  (interactive "p")
+  (if (<= malyon-aread-beginning-of-line (point))
+      (kill-word 1)
+    (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-yank (arg)
+  "Yank."
+  (interactive "p")
+  (if (<= malyon-aread-beginning-of-line (point))
+      (yank)
+    (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-yank-pop (arg)
+  "Yank pop."
+  (interactive "p")
+  (if (<= malyon-aread-beginning-of-line (point))
+      (yank-pop 1)
+    (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-delete-char (arg)
+  "Delete a character."
+  (interactive "p")
+  (if (<= malyon-aread-beginning-of-line (point))
+      (delete-char 1)
+    (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-backward-delete-char (arg)
+  "Delete a character backwards."
+  (interactive "p")
+  (if (< malyon-aread-beginning-of-line (point))
+      (backward-delete-char-untabify 1)
+    (message "Editing is restricted to the input prompt.")))
+
+(defun malyon-self-insert-command (arg)
+  "Insert a character."
+  (interactive "p")
+  (if (> malyon-aread-beginning-of-line (point))
+      (goto-char (point-max)))
+  (self-insert-command 1))
+
+;; tracing utility
+
+(defun malyon-trace-file ()
+  "Turn tracing on for a particular file."
+  (let ((trace
+	 (get-buffer-create
+	  (concat "Malyon Trace " malyon-story-file-name))))
+    (if trace
+	(save-excursion
+	  (set-buffer trace)
+	  (malyon-erase-buffer)
+	  (insert (concat "Tracing " malyon-story-file-name "..."))
+	  (newline)))))
+  
+(defun malyon-trace-newline ()
+  "Output tracing newline."
+  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+    (if trace
+	(save-excursion
+	  (set-buffer trace)
+	  (goto-char (point-max))
+	  (newline)))))
+
+(defun malyon-trace-opcode (pc opcode operands)
+  "Output a z code instruction."
+  (malyon-trace-string
+   (format "%8d   %-3d %-25s %s\n"
+	   pc
+	   opcode
+	   (symbol-name (aref malyon-opcodes opcode))
+	   (apply 'concat (malyon-mapcan
+			   (lambda (x)
+			     (list " "
+				   (number-to-string
+				    (if (malyon-characterp x)
+					(malyon-char-to-int x)
+				      x))))
+			   operands)))))
+
+(defun malyon-trace-string (s)
+  "Output tracing string."
+  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+    (if (and trace s)
+	(save-excursion
+	  (set-buffer trace)
+	  (goto-char (point-max))
+	  (insert s)))))
+
+(defun malyon-trace-object (o)
+  "Output tracing object."
+  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
+    (if (and trace o)
+	(save-excursion
+	  (set-buffer trace)
+	  (goto-char (point-max))
+	  (prin1 o trace)))))
+
+;;; announce malyon-mode
+
+(provide 'malyon-mode)
+(provide 'malyon)
+
+;;; malyon-mode.el ends here
diff --git a/lisp/org-mac-protocol.el b/lisp/org-mac-protocol.el
new file mode 100755
index 00000000..32619d47
--- /dev/null
+++ b/lisp/org-mac-protocol.el
@@ -0,0 +1,408 @@
+;;; org-mac-protocol.el -- process events triggered by the
+;;; org-mac-protocol suite of AppleScripts
+
+;; Copyright (C) 2009, 2010 Christopher Suckling
+
+;; Authors: Christopher Suckling 
+
+;; 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.
+
+;; It 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.
+
+;; Version: 0.634
+;; Keywords: outlines, hyperlinks, wp
+
+;;; Commentary
+;;
+;; This file provides org-protocol handlers and various hacks to
+;; produce a nicely centered, pop-up remember frame for links passed
+;; to emacsclient by the org-mac-protocol suite of AppleScripts. It
+;; also defines new org-mode hyperlink types for opening files in
+;; various OS X applications.
+
+;;; Installation and Usage
+;;
+;; Please see org-mac-protocol.org
+
+;;; Credit
+;;
+;; Portions of this code are developed from a blog post by Jack Moffitt:
+;; http://metajack.im/2008/12/30/gtd-capture-with-emacs-orgmode/
+
+(require 'cl)
+(require 'org-protocol)
+(require 'org-bibtex)
+
+;;; Define org-mode hyperlink types
+;;
+;; BibDesk
+
+(org-add-link-type "bibdesk" 'org-mac-bibdesk-open)
+
+(defun org-mac-bibdesk-open (uri)
+  "Visit bibtex entry in BibDesk"
+  (let* ((key (when (string-match "::\\(.+\\)\\'" uri)
+		(match-string 1 uri)))
+	 (document (substring uri 0 (match-beginning 0))))    
+    (do-applescript
+     (concat
+      "tell application \"BibDesk.app\"\n"
+         "activate\n"
+         "set theDoc to \"" document "\"\n"
+         "set theKey to \"" key "\"\n"
+         "open theDoc\n"
+         "tell document 1 of application \"BibDesk\"\n"
+            "set somePubs to (publications whose cite key contains theKey)\n"
+            "set the selection to somePubs\n"
+            "set theSelection to the selection\n"
+            "set thePub to get item 1 of theSelection\n"
+            "show thePub\n"
+         "end tell\n"
+      "end tell"))))
+
+;; Skim
+
+(org-add-link-type "skim" 'org-mac-skim-open)
+
+(defun org-mac-skim-open (uri)
+  "Visit page of pdf in Skim"
+  (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
+		 (match-string 1 uri)))
+	 (document (substring uri 0 (match-beginning 0))))
+    (do-applescript
+     (concat
+      "tell application \"Skim\"\n"
+         "activate\n"
+	 "set theDoc to \"" document "\"\n"
+		     "set thePage to " page "\n"
+	 "open theDoc\n"
+	 "go document 1 to page thePage of document 1\n"
+      "end tell"))))
+
+;; Pages
+
+(org-add-link-type "pages" 'org-mac-pages-open)
+
+(defun org-mac-pages-open (uri)
+  "Visit page of document in Pages. Reliant on character offset
+from start of document, so link may degrade if document is
+edited"
+  (let* ((charoff (when (string-match "::\\(.+\\)\\'" uri)
+		 (match-string 1 uri)))
+	 (document (substring uri 0 (match-beginning 0))))
+    (do-applescript
+     (concat
+      "tell application \"Pages\"\n"
+         "activate\n"
+	 "set theDoc to \"" document "\"\n"
+	 "set theCharOff to " charoff "\n"
+	 "open theDoc\n"
+	 "select character theCharOff of document 1\n"
+      "end tell"))))
+
+;; Numbers
+
+(org-add-link-type "numbers" 'org-mac-numbers-open)
+
+(defun org-mac-numbers-open (uri)
+  "Visit range of spreadsheet in Numbers. Although the correct
+cells will be selected, it may be necessary to change sheets
+manually"
+  (let* ((sheet (when (string-match "::\\(.+\\)::\\(.+\\)::\\(.+\\)\\'" uri)
+		  (match-string 1 uri)))
+	 (table (when (string-match "::\\(.+\\)::\\(.+\\)::\\(.+\\)\\'" uri)
+		  (org-protocol-unhex-string (match-string 2 uri))))
+	 (range (when (string-match "::\\(.+\\)::\\(.+\\)::\\(.+\\)\\'" uri)
+		  (match-string 3 uri)))
+	 (document (substring uri 0 (match-beginning 0))))
+    (do-applescript
+     (concat
+      "tell application \"Numbers\"\n"
+         "activate\n"
+	 "set theDoc to \"" document "\"\n"
+	 "set theSheet to \"" sheet "\"\n"
+	 "set theTable to \"" table "\"\n"
+	 "set theRange to \"" range "\"\n"
+	 "open theDoc\n"
+	 "tell document 1\n"
+	    "tell sheet (theSheet as integer)\n"
+	       "tell table theTable\n"
+	          "set selection range to range theRange\n"
+	       "end tell\n"
+	    "end tell\n"
+	 "end tell\n"   
+       "end tell"))))
+
+
+;; Keynote
+
+(org-add-link-type "keynote" 'org-mac-keynote-open)
+
+(defun org-mac-keynote-open (uri)
+  "Visit slide in Keynote"
+  (let* ((slide (when (string-match "::\\(.+\\)\\'" uri)
+		  (match-string 1 uri)))
+	 (document (substring uri 0 (match-beginning 0))))
+    (do-applescript
+     (concat
+      "tell application \"Keynote\"\n"
+          "activate\n"
+          "set theDoc to \"" document "\"\n"
+          "set theSlide to " slide "\n"
+          "open theDoc\n"
+          "show slide theSlide of slideshow 1\n"
+      "end tell"))))
+
+
+;; iTunes
+
+(org-add-link-type "iTunes" 'org-mac-iTunes-open)
+
+(defun org-mac-iTunes-open (uri)
+  "Visit track in iTunes"
+  (let* ((track (when (string-match "[0-9a-zA-Z]+\\'" uri)
+		  (match-string 0 uri))))
+    (do-applescript
+     (concat
+      "tell application \"iTunes\"\n"
+         "activate\n"
+	 "set theTrack to \"" track "\"\n"
+	 "set view of front browser window to user playlist \"Music\" of source \"Library\"\n"
+	 "play (some track of playlist \"Music\" of source \"Library\" whose persistent ID is theTrack)\n"
+	 "playpause\n"
+      "end tell"
+	 ))))
+
+
+;; Address Book
+;; Support based on code by Alexander Poslavsky
+
+(org-add-link-type "address" 'org-mac-addressbook-open)
+
+(defun org-mac-addressbook-open (uri)
+  "Applescript to open correct address-book entry"
+  (do-applescript
+   (concat
+    "set theID to \"" uri "\"\n"
+
+    "tell application \"System Events\"\n"
+        "activate\n"
+        "try\n"
+            "open location \"addressbook\:\/\/\" \& theID\n"
+            "on error\n"
+            "display dialog \"no matching contact found\"\n"
+        "end try\n"
+    "end tell"
+    )))
+
+
+;;; Variables and advice for managing *remember* frames
+
+;; updated for org-capture hooks
+
+(defvar width-of-display (x-display-pixel-width)
+  "For some reason, (x-display-pixel-width) returns corrupted
+values when called during (org-mac-protocol-remember); this
+ensures that correct value is returned")
+(setq width-of-display (x-display-pixel-width))
+
+(defvar height-of-display (x-display-pixel-height)
+  "For some reason, (x-display-pixel-height) returns corrupted
+values when called during (org-mac-protocol-remember); this
+ensures that correct value is returned")
+(setq height-of-display (x-display-pixel-height))
+
+(defvar org-mac-protocol-app nil
+  "The application that AppleScript will activate
+after the *remember* buffer is killed")
+
+(defadvice remember-finalize (after delete-remember-frame activate)  
+  "Advise remember-finalize to close the frame if it is the mac-remember frame"  
+  (when (equal "*mac-remember*" (frame-parameter nil 'name))
+    (mapc
+     (lambda (x)
+       (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
+	 (make-frame-visible x)))
+     (frame-list))
+    (mapc
+     (lambda (x)
+       (when (equal (frame-parameter x 'name) "*mac-remember*")
+	 (delete-frame x)))
+     (frame-list))
+    (do-applescript
+     (concat
+      "tell application \"" org-mac-protocol-app "\"\n"
+      "activate\n"
+      "end tell"))))  
+
+(defadvice remember-destroy (after delete-remember-frame activate)  
+  "Advise remember-destroy to close the frame if it is the
+mac-rememeber frame"
+  (when (equal "*mac-remember*" (frame-parameter nil 'name))
+    (mapc
+     (lambda (x)
+       (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
+	 (make-frame-visible x)))
+     (frame-list))
+    (mapc
+     (lambda (x)
+       (when (equal (frame-parameter x 'name) "*mac-remember*")
+	 (delete-frame x)))
+     (frame-list))
+    (do-applescript
+     (concat
+      "tell application \"" org-mac-protocol-app "\"\n"
+      "activate\n"
+      "end tell"))))  
+
+(defadvice org-remember-apply-template (before delete-non-remember-windows activate)
+  "Advise org-remember to delete non-remember windows if it is in
+the remember frame"
+  (when (equal "*mac-remember*" (frame-parameter nil 'name))
+    (delete-other-windows)))
+
+(add-hook 'org-capture-mode-hook
+	  '(lambda ()
+	     (when (equal "*mac-remember*" (frame-parameter nil 'name))
+	       (delete-other-windows))))  
+
+(add-hook 'org-capture-after-finalize-hook
+	  '(lambda ()	     
+	     (unless (boundp 'org-refile-for-capture)
+	       (when (equal "*mac-remember*" (frame-parameter nil 'name))
+		 (mapc
+		  (lambda (x)
+		    (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
+		      (make-frame-visible x)))
+		  (frame-list))
+		 (mapc
+		  (lambda (x)
+		    (when (equal (frame-parameter x 'name) "*mac-remember*")
+		      (delete-frame x)))
+		  (frame-list))
+		 (do-applescript
+		  (concat
+		   "tell application \"" org-mac-protocol-app "\"\n"
+		   "activate\n"
+		   "end tell"))))))
+
+(add-hook 'org-after-refile-insert-hook
+	  '(lambda ()
+	     (when (boundp 'org-refile-for-capture)
+	       (when (equal "*mac-remember*" (frame-parameter nil 'name))
+		 (mapc
+		  (lambda (x)
+		    (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
+		      (make-frame-visible x)))
+		  (frame-list))
+		 (mapc
+		  (lambda (x)
+		    (when (equal (frame-parameter x 'name) "*mac-remember*")
+		      (delete-frame x)))
+		  (frame-list))
+		 (do-applescript
+		  (concat
+		   "tell application \"" org-mac-protocol-app "\"\n"
+		   "activate\n"
+		   "end tell"))))))
+
+;;; Define org-protocol protocols
+
+(add-to-list 'org-protocol-protocol-alist
+	     '("org-mac-remember"
+	       :protocol "mac-remember"
+	       :function org-mac-protocol-remember
+	       :kill-client t))
+
+(add-to-list 'org-protocol-protocol-alist
+	     '("org-mac-safari-tabs"
+	       :protocol "safari-tabs"
+	       :function org-mac-safari-tabs
+	       :kill-client t))
+
+(defun org-mac-protocol-remember (data)
+  "Process an org-protocol://mac-remember:// scheme URL.
+Pop up a small, centred Emacs frame containing a remember
+buffer. Destroys the frame after the remember buffer is filed and
+return to originating application. This code is
+essentially (org-protocol-remember) with an additional :shortdesc
+link property"
+
+  (let* ((elements (org-protocol-split-data data nil ":"))
+	 (info (car elements))
+	 (app (org-protocol-unhex-string (cadr elements)))
+	 (parts (org-protocol-split-data info t))
+	 (template (or (and (= 1 (length (car parts))) (pop parts))
+		       org-protocol-default-template-key))
+	 (url (org-protocol-sanitize-uri (car parts)))
+	 (type (if (string-match "^\\([a-z]+\\):" url)
+		   (match-string 1 url)))
+	 (title (or (cadr parts) ""))
+	 (shorttitle (or (caddr parts) ""))
+	 (region (or (cadddr parts) ""))
+	 (orglink (org-make-link-string
+		   url (if (string-match "[^[:space:]]" title) title url)))
+	 (org-capture-link-is-already-stored t)
+	 remember-annotation-functions)
+    
+    (setq org-mac-protocol-app app)
+
+    (do-applescript
+     (concat
+      "tell application \"Emacs\"\n"
+      "activate\n"
+      "end tell"))
+
+    (make-frame '((name . "*mac-remember*") (width . 80) (height . 20)))
+    (mapc (lambda (x)
+	    (if (not (equal (frame-parameter x 'name) "*mac-remember*"))
+		(make-frame-invisible x)
+	      (let ((center-left
+		     (/ (- width-of-display (frame-pixel-width)) 2))
+		    (center-top
+		     (/ (- (- height-of-display 22) (frame-pixel-height)) 2)))
+		(set-frame-parameter nil 'top center-top)
+		(set-frame-parameter nil 'left center-left))))
+	  (frame-list))
+    (select-frame-by-name "*mac-remember*")
+
+    (setq org-stored-links
+	  (cons (list url title) org-stored-links))
+    (kill-new orglink)    
+    (org-store-link-props :type type
+			  :link url
+			  :description title
+			  :shortdesc shorttitle
+			  :initial region)
+    (message "protocol: %s" (plist-get org-store-link-plist :shortdesc))
+    
+    (if (boundp 'org-capture-templates)
+	(org-capture nil template)
+      (org-remember nil (string-to-char template))))
+  nil) 
+
+(defun org-mac-safari-tabs (data)
+  "Process an org-protocol://safari-tabs:// scheme URL.
+Inserts a formatted list of hyperlinks to the tabs open in the
+front Safari window"  
+  (let* ((elements (org-protocol-split-data data nil "::"))	 
+	 ;; discard the last element, as it is blank
+	 (links (butlast elements)))
+    (mapc (lambda (x)
+	    (org-protocol-store-link x))
+	  links))
+  nil)
+
+
+(provide 'org-mac-protocol)
diff --git a/lisp/package.el b/lisp/package.el
new file mode 100644
index 00000000..6a00b382
--- /dev/null
+++ b/lisp/package.el
@@ -0,0 +1,1760 @@
+;;; package.el --- Simple package system for Emacs
+
+;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+
+;; Author: Tom Tromey 
+;; Created: 10 Mar 2007
+;; Version: 1.0
+;; Keywords: tools
+;; Package-Requires: ((tabulated-list "0"))
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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.  If not, see .
+
+;;; Change Log:
+
+;;  2 Apr 2007 - now using ChangeLog file
+;; 15 Mar 2007 - updated documentation
+;; 14 Mar 2007 - Changed how obsolete packages are handled
+;; 13 Mar 2007 - Wrote package-install-from-buffer
+;; 12 Mar 2007 - Wrote package-menu mode
+
+;;; Commentary:
+
+;; The idea behind package.el is to be able to download packages and
+;; install them.  Packages are versioned and have versioned
+;; dependencies.  Furthermore, this supports built-in packages which
+;; may or may not be newer than user-specified packages.  This makes
+;; it possible to upgrade Emacs and automatically disable packages
+;; which have moved from external to core.  (Note though that we don't
+;; currently register any of these, so this feature does not actually
+;; work.)
+
+;; A package is described by its name and version.  The distribution
+;; format is either  a tar file or a single .el file.
+
+;; A tar file should be named "NAME-VERSION.tar".  The tar file must
+;; unpack into a directory named after the package and version:
+;; "NAME-VERSION".  It must contain a file named "PACKAGE-pkg.el"
+;; which consists of a call to define-package.  It may also contain a
+;; "dir" file and the info files it references.
+
+;; A .el file is named "NAME-VERSION.el" in the remote archive, but is
+;; installed as simply "NAME.el" in a directory named "NAME-VERSION".
+
+;; The downloader downloads all dependent packages.  By default,
+;; packages come from the official GNU sources, but others may be
+;; added by customizing the `package-archives' alist.  Packages get
+;; byte-compiled at install time.
+
+;; At activation time we will set up the load-path and the info path,
+;; and we will load the package's autoloads.  If a package's
+;; dependencies are not available, we will not activate that package.
+
+;; Conceptually a package has multiple state transitions:
+;;
+;; * Download.  Fetching the package from ELPA.
+;; * Install.  Untar the package, or write the .el file, into
+;;   ~/.emacs.d/elpa/ directory.
+;; * Byte compile.  Currently this phase is done during install,
+;;   but we may change this.
+;; * Activate.  Evaluate the autoloads for the package to make it
+;;   available to the user.
+;; * Load.  Actually load the package and run some code from it.
+
+;; Other external functions you may want to use:
+;;
+;; M-x list-packages
+;;    Enters a mode similar to buffer-menu which lets you manage
+;;    packages.  You can choose packages for install (mark with "i",
+;;    then "x" to execute) or deletion (not implemented yet), and you
+;;    can see what packages are available.  This will automatically
+;;    fetch the latest list of packages from ELPA.
+;;
+;; M-x package-install-from-buffer
+;;    Install a package consisting of a single .el file that appears
+;;    in the current buffer.  This only works for packages which
+;;    define a Version header properly; package.el also supports the
+;;    extension headers Package-Version (in case Version is an RCS id
+;;    or similar), and Package-Requires (if the package requires other
+;;    packages).
+;;
+;; M-x package-install-file
+;;    Install a package from the indicated file.  The package can be
+;;    either a tar file or a .el file.  A tar file must contain an
+;;    appropriately-named "-pkg.el" file; a .el file must be properly
+;;    formatted as with package-install-from-buffer.
+
+;;; Thanks:
+;;; (sorted by sort-lines):
+
+;; Jim Blandy 
+;; Karl Fogel 
+;; Kevin Ryde 
+;; Lawrence Mitchell
+;; Michael Olson 
+;; Sebastian Tennant 
+;; Stefan Monnier 
+;; Vinicius Jose Latorre 
+;; Phil Hagelberg 
+
+;;; ToDo:
+
+;; - a trust mechanism, since compiling a package can run arbitrary code.
+;;   For example, download package signatures and check that they match.
+;; - putting info dirs at the start of the info path means
+;;   users see a weird ordering of categories.  OTOH we want to
+;;   override later entries.  maybe emacs needs to enforce
+;;   the standard layout?
+;; - put bytecode in a separate directory tree
+;; - perhaps give users a way to recompile their bytecode
+;;   or do it automatically when emacs changes
+;; - give users a way to know whether a package is installed ok
+;; - give users a way to view a package's documentation when it
+;;   only appears in the .el
+;; - use/extend checkdoc so people can tell if their package will work
+;; - "installed" instead of a blank in the status column
+;; - tramp needs its files to be compiled in a certain order.
+;;   how to handle this?  fix tramp?
+;; - on emacs 21 we don't kill the -autoloads.el buffer.  what about 22?
+;; - maybe we need separate .elc directories for various emacs versions
+;;   and also emacs-vs-xemacs.  That way conditional compilation can
+;;   work.  But would this break anything?
+;; - should store the package's keywords in archive-contents, then
+;;   let the users filter the package-menu by keyword.  See
+;;   finder-by-keyword.  (We could also let people view the
+;;   Commentary, but it isn't clear how useful this is.)
+;; - William Xu suggests being able to open a package file without
+;;   installing it
+;; - Interface with desktop.el so that restarting after an install
+;;   works properly
+;; - Implement M-x package-upgrade, to upgrade any/all existing packages
+;; - Use hierarchical layout.  PKG/etc PKG/lisp PKG/info
+;;   ... except maybe lisp?
+;; - It may be nice to have a macro that expands to the package's
+;;   private data dir, aka ".../etc".  Or, maybe data-directory
+;;   needs to be a list (though this would be less nice)
+;;   a few packages want this, eg sokoban
+;; - package menu needs:
+;;     ability to know which packages are built-in & thus not deletable
+;;     it can sometimes print odd results, like 0.3 available but 0.4 active
+;;        why is that?
+;; - Allow multiple versions on the server...?
+;;   [ why bother? ]
+;; - Don't install a package which will invalidate dependencies overall
+;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5))
+;;   [ currently thinking, why bother.. KISS ]
+;; - Allow optional package dependencies
+;;   then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
+;;   and just don't compile to add to load path ...?
+;; - Have a list of archive URLs?  [ maybe there's no point ]
+;; - David Kastrup pointed out on the xemacs list that for GPL it
+;;   is friendlier to ship the source tree.  We could "support" that
+;;   by just having a "src" subdir in the package.  This isn't ideal
+;;   but it probably is not worth trying to support random source
+;;   tree layouts, build schemes, etc.
+;; - Our treatment of the info path is somewhat bogus
+;; - perhaps have an "unstable" tree in ELPA as well as a stable one
+
+;;; Code:
+
+(require 'tabulated-list)
+
+(defgroup package nil
+  "Manager for Emacs Lisp packages."
+  :group 'applications
+  :version "24.1")
+
+;;;###autoload
+(defcustom package-enable-at-startup t
+  "Whether to activate installed packages when Emacs starts.
+If non-nil, packages are activated after reading the init file
+and before `after-init-hook'.  Activation is not done if
+`user-init-file' is nil (e.g. Emacs was started with \"-q\").
+
+Even if the value is nil, you can type \\[package-initialize] to
+activate the package system at any time."
+  :type 'boolean
+  :group 'package
+  :version "24.1")
+
+(defcustom package-load-list '(all)
+  "List of packages for `package-initialize' to load.
+Each element in this list should be a list (NAME VERSION), or the
+symbol `all'.  The symbol `all' says to load the latest installed
+versions of all packages not specified by other elements.
+
+For an element (NAME VERSION), NAME is a package name (a symbol).
+VERSION should be t, a string, or nil.
+If VERSION is t, all versions are loaded, though obsolete ones
+ will be put in `package-obsolete-alist' and not activated.
+If VERSION is a string, only that version is ever loaded.
+ Any other version, even if newer, is silently ignored.
+ Hence, the package is \"held\" at that version.
+If VERSION is nil, the package is not loaded (it is \"disabled\")."
+  :type '(repeat symbol)
+  :risky t
+  :group 'package
+  :version "24.1")
+
+(defvar Info-directory-list)
+(declare-function info-initialize "info" ())
+(declare-function url-http-parse-response "url-http" ())
+(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-commentary "lisp-mnt" (&optional file))
+(defvar url-http-end-of-headers)
+
+(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
+  "An alist of archives from which to fetch.
+The default value points to the GNU Emacs package repository.
+
+Each element has the form (ID . LOCATION).
+ ID is an archive name, as a string.
+ LOCATION specifies the base location for the archive.
+  If it starts with \"http:\", it is treated as a HTTP URL;
+  otherwise it should be an absolute directory name.
+  (Other types of URL are currently not supported.)
+
+Only add locations that you trust, since fetching and installing
+a package can run arbitrary code."
+  :type '(alist :key-type (string :tag "Archive name")
+                :value-type (string :tag "URL or directory name"))
+  :risky t
+  :group 'package
+  :version "24.1")
+
+(defconst package-archive-version 1
+  "Version number of the package archive understood by this file.
+Lower version numbers than this will probably be understood as well.")
+
+(defconst package-el-version "1.0"
+  "Version of package.el.")
+
+;; We don't prime the cache since it tends to get out of date.
+(defvar package-archive-contents nil
+  "Cache of the contents of the Emacs Lisp Package Archive.
+This is an alist mapping package names (symbols) to package
+descriptor vectors.  These are like the vectors for `package-alist'
+but have extra entries: one which is 'tar for tar packages and
+'single for single-file packages, and one which is the name of
+the archive from which it came.")
+(put 'package-archive-contents 'risky-local-variable t)
+
+(defcustom package-user-dir (locate-user-emacs-file "elpa")
+  "Directory containing the user's Emacs Lisp packages.
+The directory name should be absolute.
+Apart from this directory, Emacs also looks for system-wide
+packages in `package-directory-list'."
+  :type 'directory
+  :risky t
+  :group 'package
+  :version "24.1")
+
+(defcustom package-directory-list
+  ;; Defaults are subdirs named "elpa" in the site-lisp dirs.
+  (let (result)
+    (dolist (f load-path)
+      (and (stringp f)
+	   (equal (file-name-nondirectory f) "site-lisp")
+	   (push (expand-file-name "elpa" f) result)))
+    (nreverse result))
+  "List of additional directories containing Emacs Lisp packages.
+Each directory name should be absolute.
+
+These directories contain packages intended for system-wide; in
+contrast, `package-user-dir' contains packages for personal use."
+  :type '(repeat directory)
+  :risky t
+  :group 'package
+  :version "24.1")
+
+;; The value is precomputed in finder-inf.el, but don't load that
+;; until it's needed (i.e. when `package-initialize' is called).
+(defvar package--builtins nil
+  "Alist of built-in packages.
+The actual value is initialized by loading the library
+`finder-inf'; this is not done until it is needed, e.g. by the
+function `package-built-in-p'.
+
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
+The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
+  VERSION-LIST is a version list.
+  REQS is a list of packages required by the package, each
+   requirement having the form (NAME VL), where NAME is a string
+   and VL is a version list.
+  DOCSTRING is a brief description of the package.")
+(put 'package--builtins 'risky-local-variable t)
+
+(defvar package-alist nil
+  "Alist of all packages available for activation.
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
+
+The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
+  VERSION-LIST is a version list.
+  REQS is a list of packages required by the package, each
+   requirement having the form (NAME VL) where NAME is a string
+   and VL is a version list.
+  DOCSTRING is a brief description of the package.
+
+This variable is set automatically by `package-load-descriptor',
+called via `package-initialize'.  To change which packages are
+loaded and/or activated, customize `package-load-list'.")
+(put 'package-alist 'risky-local-variable t)
+
+(defvar package-activated-list nil
+  "List of the names of currently activated packages.")
+(put 'package-activated-list 'risky-local-variable t)
+
+(defvar package-obsolete-alist nil
+  "Representation of obsolete packages.
+Like `package-alist', but maps package name to a second alist.
+The inner alist is keyed by version.")
+(put 'package-obsolete-alist 'risky-local-variable t)
+
+(defun package-version-join (vlist)
+  "Return the version string corresponding to the list VLIST.
+This is, approximately, the inverse of `version-to-list'.
+\(Actually, it returns only one of the possible inverses, since
+`version-to-list' is a many-to-one operation.)"
+  (if (null vlist)
+      ""
+    (let ((str-list (list "." (int-to-string (car vlist)))))
+      (dolist (num (cdr vlist))
+	(cond
+	 ((>= num 0)
+	  (push (int-to-string num) str-list)
+	  (push "." str-list))
+	 ((< num -3)
+	  (error "Invalid version list `%s'" vlist))
+	 (t
+	  ;; pre, or beta, or alpha
+	  (cond ((equal "." (car str-list))
+		 (pop str-list))
+		((not (string-match "[0-9]+" (car str-list)))
+		 (error "Invalid version list `%s'" vlist)))
+	  (push (cond ((= num -1) "pre")
+		      ((= num -2) "beta")
+		      ((= num -3) "alpha"))
+		str-list))))
+      (if (equal "." (car str-list))
+	  (pop str-list))
+      (apply 'concat (nreverse str-list)))))
+
+(defun package-strip-version (dirname)
+  "Strip the version from a combined package name and version.
+E.g., if given \"quux-23.0\", will return \"quux\""
+  (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname)
+      (match-string 1 dirname)))
+
+(defun package-load-descriptor (dir package)
+  "Load the description file in directory DIR for package PACKAGE.
+Here, PACKAGE is a string of the form NAME-VERSION, where NAME is
+the package name and VERSION is its version."
+  (let* ((pkg-dir (expand-file-name package dir))
+	 (pkg-file (expand-file-name
+		    (concat (package-strip-version package) "-pkg")
+		    pkg-dir)))
+    (when (and (file-directory-p pkg-dir)
+	       (file-exists-p (concat pkg-file ".el")))
+      (load pkg-file nil t))))
+
+(defun package-load-all-descriptors ()
+  "Load descriptors for installed Emacs Lisp packages.
+This looks for package subdirectories in `package-user-dir' and
+`package-directory-list'.  The variable `package-load-list'
+controls which package subdirectories may be loaded.
+
+In each valid package subdirectory, this function loads the
+description file containing a call to `define-package', which
+updates `package-alist' and `package-obsolete-alist'."
+  (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'")))
+    (dolist (dir (cons package-user-dir package-directory-list))
+      (when (file-directory-p dir)
+	(dolist (subdir (directory-files dir))
+	  (when (string-match regexp subdir)
+	    (package-maybe-load-descriptor (match-string 1 subdir)
+					   (match-string 2 subdir)
+					   dir)))))))
+
+(defun package-maybe-load-descriptor (name version dir)
+  "Maybe load a specific package from directory DIR.
+NAME and VERSION are the package's name and version strings.
+This function checks `package-load-list', before actually loading
+the package by calling `package-load-descriptor'."
+  (let ((force (assq (intern name) package-load-list))
+	(subdir (concat name "-" version)))
+    (and (file-directory-p (expand-file-name subdir dir))
+	 ;; Check `package-load-list':
+	 (cond ((null force)
+		(memq 'all package-load-list))
+	       ((null (setq force (cadr force)))
+		nil) ; disabled
+	       ((eq force t)
+		t)
+	       ((stringp force) ; held
+		(version-list-= (version-to-list version)
+				(version-to-list force)))
+	       (t
+		(error "Invalid element in `package-load-list'")))
+	 ;; Actually load the descriptor:
+	 (package-load-descriptor dir subdir))))
+
+(defsubst package-desc-vers (desc)
+  "Extract version from a package description vector."
+  (aref desc 0))
+
+(defsubst package-desc-reqs (desc)
+  "Extract requirements from a package description vector."
+  (aref desc 1))
+
+(defsubst package-desc-doc (desc)
+  "Extract doc string from a package description vector."
+  (aref desc 2))
+
+(defsubst package-desc-kind (desc)
+  "Extract the kind of download from an archive package description vector."
+  (aref desc 3))
+
+(defun package--dir (name version)
+  "Return the directory where a package is installed, or nil if none.
+NAME and VERSION are both strings."
+  (let* ((subdir (concat name "-" version))
+	 (dir-list (cons package-user-dir package-directory-list))
+	 pkg-dir)
+    (while dir-list
+      (let ((subdir-full (expand-file-name subdir (car dir-list))))
+	(if (file-directory-p subdir-full)
+	    (setq pkg-dir  subdir-full
+		  dir-list nil)
+	  (setq dir-list (cdr dir-list)))))
+    pkg-dir))
+
+(defun package-activate-1 (package pkg-vec)
+  (let* ((name (symbol-name package))
+	 (version-str (package-version-join (package-desc-vers pkg-vec)))
+	 (pkg-dir (package--dir name version-str)))
+    (unless pkg-dir
+      (error "Internal error: unable to find directory for `%s-%s'"
+	     name version-str))
+    ;; Add info node.
+    (when (file-exists-p (expand-file-name "dir" pkg-dir))
+      ;; FIXME: not the friendliest, but simple.
+      (require 'info)
+      (info-initialize)
+      (push pkg-dir Info-directory-list))
+    ;; Add to load path, add autoloads, and activate the package.
+    (push pkg-dir load-path)
+    (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
+    (push package package-activated-list)
+    ;; Don't return nil.
+    t))
+
+(defun package-built-in-p (package &optional min-version)
+  "Return true if PACKAGE is built-in to Emacs.
+Optional arg MIN-VERSION, if non-nil, should be a version list
+specifying the minimum acceptable version."
+  (require 'finder-inf nil t) ; For `package--builtins'.
+  (if (eq package 'emacs)
+      (version-list-<= min-version (version-to-list emacs-version))
+    (let ((elt (assq package package--builtins)))
+      (and elt (version-list-<= min-version
+				(package-desc-vers (cdr elt)))))))
+
+;; This function goes ahead and activates a newer version of a package
+;; if an older one was already activated.  This is not ideal; we'd at
+;; least need to check to see if the package has actually been loaded,
+;; and not merely activated.
+(defun package-activate (package min-version)
+  "Activate package PACKAGE, of version MIN-VERSION or newer.
+MIN-VERSION should be a version list.
+If PACKAGE has any dependencies, recursively activate them.
+Return nil if the package could not be activated."
+  (let ((pkg-vec (cdr (assq package package-alist)))
+	available-version found)
+    ;; Check if PACKAGE is available in `package-alist'.
+    (when pkg-vec
+      (setq available-version (package-desc-vers pkg-vec)
+	    found (version-list-<= min-version available-version)))
+    (cond
+     ;; If no such package is found, maybe it's built-in.
+     ((null found)
+      (package-built-in-p package min-version))
+     ;; If the package is already activated, just return t.
+     ((memq package package-activated-list)
+      t)
+     ;; Otherwise, proceed with activation.
+     (t
+      (let ((fail (catch 'dep-failure
+		    ;; Activate its dependencies recursively.
+		    (dolist (req (package-desc-reqs pkg-vec))
+		      (unless (package-activate (car req) (cadr req))
+			(throw 'dep-failure req))))))
+	(if fail
+	    (warn "Unable to activate package `%s'.
+Required package `%s-%s' is unavailable"
+		  package (car fail) (package-version-join (cadr fail)))
+	  ;; If all goes well, activate the package itself.
+	  (package-activate-1 package pkg-vec)))))))
+
+(defun package-mark-obsolete (package pkg-vec)
+  "Put package on the obsolete list, if not already there."
+  (let ((elt (assq package package-obsolete-alist)))
+    (if elt
+	;; If this obsolete version does not exist in the list, update
+	;; it the list.
+	(unless (assoc (package-desc-vers pkg-vec) (cdr elt))
+	  (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec)
+			    (cdr elt))))
+      ;; Make a new association.
+      (push (cons package (list (cons (package-desc-vers pkg-vec)
+				      pkg-vec)))
+	    package-obsolete-alist))))
+
+(defun define-package (name-string version-string
+				&optional docstring requirements
+				&rest _extra-properties)
+  "Define a new package.
+NAME-STRING is the name of the package, as a string.
+VERSION-STRING is the version of the package, as a string.
+DOCSTRING is a short description of the package, a string.
+REQUIREMENTS is a list of dependencies on other packages.
+ Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
+ where OTHER-VERSION is a string.
+
+EXTRA-PROPERTIES is currently unused."
+  (let* ((name (intern name-string))
+	 (version (version-to-list version-string))
+	 (new-pkg-desc
+	  (cons name
+		(vector version
+			(mapcar
+			 (lambda (elt)
+			   (list (car elt)
+				 (version-to-list (car (cdr elt)))))
+			 requirements)
+			docstring)))
+	 (old-pkg (assq name package-alist)))
+    (cond
+     ;; If there's no old package, just add this to `package-alist'.
+     ((null old-pkg)
+      (push new-pkg-desc package-alist))
+     ((version-list-< (package-desc-vers (cdr old-pkg)) version)
+      ;; Remove the old package and declare it obsolete.
+      (package-mark-obsolete name (cdr old-pkg))
+      (setq package-alist (cons new-pkg-desc
+				(delq old-pkg package-alist))))
+     ;; You can have two packages with the same version, e.g. one in
+     ;; the system package directory and one in your private
+     ;; directory.  We just let the first one win.
+     ((not (version-list-= (package-desc-vers (cdr old-pkg)) version))
+      ;; The package is born obsolete.
+      (package-mark-obsolete name (cdr new-pkg-desc))))))
+
+;; From Emacs 22.
+(defun package-autoload-ensure-default-file (file)
+  "Make sure that the autoload file FILE exists and if not create it."
+  (unless (file-exists-p file)
+    (write-region
+     (concat ";;; " (file-name-nondirectory file)
+	     " --- automatically extracted autoloads\n"
+	     ";;\n"
+	     ";;; Code:\n\n"
+	     "\n;; Local Variables:\n"
+	     ";; version-control: never\n"
+	     ";; no-byte-compile: t\n"
+	     ";; no-update-autoloads: t\n"
+	     ";; End:\n"
+	     ";;; " (file-name-nondirectory file)
+	     " ends here\n")
+     nil file))
+  file)
+
+(defun package-generate-autoloads (name pkg-dir)
+  (require 'autoload)         ;Load before we let-bind generated-autoload-file!
+  (let* ((auto-name (concat name "-autoloads.el"))
+	 ;;(ignore-name (concat name "-pkg.el"))
+	 (generated-autoload-file (expand-file-name auto-name pkg-dir))
+	 (version-control 'never))
+    (unless (fboundp 'autoload-ensure-default-file)
+      (package-autoload-ensure-default-file generated-autoload-file))
+    (update-directory-autoloads pkg-dir)
+    (let ((buf (find-buffer-visiting generated-autoload-file)))
+      (when buf (kill-buffer buf)))))
+
+(defvar tar-parse-info)
+(declare-function tar-untar-buffer "tar-mode" ())
+(declare-function tar-header-name "tar-mode" (tar-header))
+(declare-function tar-header-link-type "tar-mode" (tar-header))
+
+(defun package-untar-buffer (dir)
+  "Untar the current buffer.
+This uses `tar-untar-buffer' from Tar mode.  All files should
+untar into a directory named DIR; otherwise, signal an error."
+  (require 'tar-mode)
+  (tar-mode)
+  ;; Make sure everything extracts into DIR.
+  (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
+	(case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
+    (dolist (tar-data tar-parse-info)
+      (let ((name (expand-file-name (tar-header-name tar-data))))
+	(or (string-match regexp name)
+	    ;; Tarballs created by some utilities don't list
+	    ;; directories with a trailing slash (Bug#13136).
+	    (and (string-equal dir name)
+		 (eq (tar-header-link-type tar-data) 5))
+	    (error "Package does not untar cleanly into directory %s/" dir)))))
+  (tar-untar-buffer))
+
+(defun package-unpack (package version)
+  (let* ((name (symbol-name package))
+	 (dirname (concat name "-" version))
+	 (pkg-dir (expand-file-name dirname package-user-dir)))
+    (make-directory package-user-dir t)
+    ;; FIXME: should we delete PKG-DIR if it exists?
+    (let* ((default-directory (file-name-as-directory package-user-dir)))
+      (package-untar-buffer dirname)
+      (package--make-autoloads-and-compile name pkg-dir))))
+
+(defun package--make-autoloads-and-compile (name pkg-dir)
+  "Generate autoloads and do byte-compilation for package named NAME.
+PKG-DIR is the name of the package directory."
+  (package-generate-autoloads name pkg-dir)
+  (let ((load-path (cons pkg-dir load-path)))
+    ;; We must load the autoloads file before byte compiling, in
+    ;; case there are magic cookies to set up non-trivial paths.
+    (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
+    (byte-recompile-directory pkg-dir 0 t)))
+
+(defun package--write-file-no-coding (file-name)
+  (let ((buffer-file-coding-system 'no-conversion))
+    (write-region (point-min) (point-max) file-name)))
+
+(defun package-unpack-single (file-name version desc requires)
+  "Install the contents of the current buffer as a package."
+  ;; Special case "package".
+  (if (string= file-name "package")
+      (package--write-file-no-coding
+       (expand-file-name (concat file-name ".el") package-user-dir))
+    (let* ((pkg-dir  (expand-file-name (concat file-name "-"
+					       (package-version-join
+						(version-to-list version)))
+				       package-user-dir))
+	   (el-file  (expand-file-name (concat file-name ".el") pkg-dir))
+	   (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir)))
+      (make-directory pkg-dir t)
+      (package--write-file-no-coding el-file)
+      (let ((print-level nil)
+	    (print-length nil))
+	(write-region
+	 (concat
+	  (prin1-to-string
+	   (list 'define-package
+		 file-name
+		 version
+		 desc
+		 (list 'quote
+		       ;; Turn version lists into string form.
+		       (mapcar
+			(lambda (elt)
+			  (list (car elt)
+				(package-version-join (cadr elt))))
+			requires))))
+	  "\n")
+	 nil
+	 pkg-file
+	 nil nil nil 'excl))
+      (package--make-autoloads-and-compile file-name pkg-dir))))
+
+(defmacro package--with-work-buffer (location file &rest body)
+  "Run BODY in a buffer containing the contents of FILE at LOCATION.
+LOCATION is the base location of a package archive, and should be
+one of the URLs (or file names) specified in `package-archives'.
+FILE is the name of a file relative to that base location.
+
+This macro retrieves FILE from LOCATION into a temporary buffer,
+and evaluates BODY while that buffer is current.  This work
+buffer is killed afterwards.  Return the last value in BODY."
+  `(let* ((http (string-match "\\`https?:" ,location))
+	  (buffer
+	   (if http
+	       (url-retrieve-synchronously (concat ,location ,file))
+	     (generate-new-buffer "*package work buffer*"))))
+     (prog1
+	 (with-current-buffer buffer
+	   (if http
+	       (progn (package-handle-response)
+		      (re-search-forward "^$" nil 'move)
+		      (forward-char)
+		      (delete-region (point-min) (point)))
+	     (unless (file-name-absolute-p ,location)
+	       (error "Archive location %s is not an absolute file name"
+		      ,location))
+	     (insert-file-contents (expand-file-name ,file ,location)))
+	   ,@body)
+       (kill-buffer buffer))))
+
+(defun package-handle-response ()
+  "Handle the response from a `url-retrieve-synchronously' call.
+Parse the HTTP response and throw if an error occurred.
+The url package seems to require extra processing for this.
+This should be called in a `save-excursion', in the download buffer.
+It will move point to somewhere in the headers."
+  ;; We assume HTTP here.
+  (require 'url-http)
+  (let ((response (url-http-parse-response)))
+    (when (or (< response 200) (>= response 300))
+      (error "Error during download request:%s"
+	     (buffer-substring-no-properties (point) (progn
+						       (end-of-line)
+						       (point)))))))
+
+(defun package-download-single (name version desc requires)
+  "Download and install a single-file package."
+  (let ((location (package-archive-base name))
+	(file (concat (symbol-name name) "-" version ".el")))
+    (package--with-work-buffer location file
+      (package-unpack-single (symbol-name name) version desc requires))))
+
+(defun package-download-tar (name version)
+  "Download and install a tar package."
+  (let ((location (package-archive-base name))
+	(file (concat (symbol-name name) "-" version ".tar")))
+    (package--with-work-buffer location file
+      (package-unpack name version))))
+
+(defvar package--initialized nil)
+
+(defun package-installed-p (package &optional min-version)
+  "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
+MIN-VERSION should be a version list."
+  (unless package--initialized (error "package.el is not yet initialized!"))
+  (let ((pkg-desc (assq package package-alist)))
+    (if pkg-desc
+	(version-list-<= min-version
+			 (package-desc-vers (cdr pkg-desc)))
+      ;; Also check built-in packages.
+      (package-built-in-p package min-version))))
+
+(defun package-compute-transaction (package-list requirements)
+  "Return a list of packages to be installed, including PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+
+REQUIREMENTS should be a list of additional requirements; each
+element in this list should have the form (PACKAGE VERSION-LIST),
+where PACKAGE is a package name and VERSION-LIST is the required
+version of that package.
+
+This function recursively computes the requirements of the
+packages in REQUIREMENTS, and returns a list of all the packages
+that must be installed.  Packages that are already installed are
+not included in this list."
+  (dolist (elt requirements)
+    (let* ((next-pkg (car elt))
+	   (next-version (cadr elt)))
+      (unless (package-installed-p next-pkg next-version)
+	;; A package is required, but not installed.  It might also be
+	;; blocked via `package-load-list'.
+	(let ((pkg-desc (assq next-pkg package-archive-contents))
+	      hold)
+	  (when (setq hold (assq next-pkg package-load-list))
+	    (setq hold (cadr hold))
+	    (cond ((eq hold t))
+		  ((eq hold nil)
+		   (error "Required package '%s' is disabled"
+			  (symbol-name next-pkg)))
+		  ((null (stringp hold))
+		   (error "Invalid element in `package-load-list'"))
+		  ((version-list-< (version-to-list hold) next-version)
+		   (error "Package `%s' held at version %s, \
+but version %s required"
+			  (symbol-name next-pkg) hold
+			  (package-version-join next-version)))))
+	  (unless pkg-desc
+	    (error "Package `%s-%s' is unavailable"
+		   (symbol-name next-pkg)
+		   (package-version-join next-version)))
+	  (unless (version-list-<= next-version
+				   (package-desc-vers (cdr pkg-desc)))
+	    (error
+	     "Need package `%s-%s', but only %s is available"
+	     (symbol-name next-pkg) (package-version-join next-version)
+	     (package-version-join (package-desc-vers (cdr pkg-desc)))))
+	  ;; Only add to the transaction if we don't already have it.
+	  (unless (memq next-pkg package-list)
+	    (push next-pkg package-list))
+	  (setq package-list
+		(package-compute-transaction package-list
+					     (package-desc-reqs
+					      (cdr pkg-desc))))))))
+  package-list)
+
+(defun package-read-from-string (str)
+  "Read a Lisp expression from STR.
+Signal an error if the entire string was not used."
+  (let* ((read-data (read-from-string str))
+	 (more-left
+	  (condition-case nil
+	      ;; The call to `ignore' suppresses a compiler warning.
+	      (progn (ignore (read-from-string
+			      (substring str (cdr read-data))))
+		     t)
+	    (end-of-file nil))))
+    (if more-left
+        (error "Can't read whole string")
+      (car read-data))))
+
+(defun package--read-archive-file (file)
+  "Re-read archive file FILE, if it exists.
+Will return the data from the file, or nil if the file does not exist.
+Will throw an error if the archive version is too new."
+  (let ((filename (expand-file-name file package-user-dir)))
+    (when (file-exists-p filename)
+      (with-temp-buffer
+	(insert-file-contents-literally filename)
+	(let ((contents (read (current-buffer))))
+	  (if (> (car contents) package-archive-version)
+	      (error "Package archive version %d is higher than %d"
+		     (car contents) package-archive-version))
+	  (cdr contents))))))
+
+(defun package-read-all-archive-contents ()
+  "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
+  (setq package-archive-contents nil)
+  (dolist (archive package-archives)
+    (package-read-archive-contents (car archive))))
+
+(defun package-read-archive-contents (archive)
+  "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
+If the archive version is too new, signal an error."
+  ;; Version 1 of 'archive-contents' is identical to our internal
+  ;; representation.
+  (let* ((dir (concat "archives/" archive))
+	 (contents-file (concat dir "/archive-contents"))
+	 contents)
+    (when (setq contents (package--read-archive-file contents-file))
+      (dolist (package contents)
+	(package--add-to-archive-contents package archive)))))
+
+(defun package--add-to-archive-contents (package archive)
+  "Add the PACKAGE from the given ARCHIVE if necessary.
+Also, add the originating archive to the end of the package vector."
+  (let* ((name    (car package))
+         (version (package-desc-vers (cdr package)))
+         (entry   (cons name
+			(vconcat (cdr package) (vector archive))))
+         (existing-package (assq name package-archive-contents)))
+    (cond ((not existing-package)
+	   (add-to-list 'package-archive-contents entry))
+	  ((version-list-< (package-desc-vers (cdr existing-package))
+			   version)
+	   ;; Replace the entry with this one.
+	   (setq package-archive-contents
+		 (cons entry
+		       (delq existing-package
+			     package-archive-contents)))))))
+
+(defun package-download-transaction (package-list)
+  "Download and install all the packages in PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+This function assumes that all package requirements in
+PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
+using `package-compute-transaction'."
+  (dolist (elt package-list)
+    (let* ((desc (cdr (assq elt package-archive-contents)))
+	   ;; As an exception, if package is "held" in
+	   ;; `package-load-list', download the held version.
+	   (hold (cadr (assq elt package-load-list)))
+	   (v-string (or (and (stringp hold) hold)
+			 (package-version-join (package-desc-vers desc))))
+	   (kind (package-desc-kind desc)))
+      (cond
+       ((eq kind 'tar)
+	(package-download-tar elt v-string))
+       ((eq kind 'single)
+	(package-download-single elt v-string
+				 (package-desc-doc desc)
+				 (package-desc-reqs desc)))
+       (t
+	(error "Unknown package kind: %s" (symbol-name kind))))
+      ;; If package A depends on package B, then A may `require' B
+      ;; during byte compilation.  So we need to activate B before
+      ;; unpacking A.
+      (package-maybe-load-descriptor (symbol-name elt) v-string
+				     package-user-dir)
+      (package-activate elt (version-to-list v-string)))))
+
+;;;###autoload
+(defun package-install (name)
+  "Install the package named NAME.
+NAME should be the name of one of the available packages in an
+archive in `package-archives'.  Interactively, prompt for NAME."
+  (interactive
+   (progn
+     ;; Initialize the package system to get the list of package
+     ;; symbols for completion.
+     (unless package--initialized
+       (package-initialize t))
+     (unless package-archive-contents
+       (package-refresh-contents))
+     (list (intern (completing-read
+		    "Install package: "
+		    (mapcar (lambda (elt)
+			      (cons (symbol-name (car elt))
+				    nil))
+			    package-archive-contents)
+		    nil t)))))
+  (let ((pkg-desc (assq name package-archive-contents)))
+    (unless pkg-desc
+      (error "Package `%s' is not available for installation"
+	     (symbol-name name)))
+    (package-download-transaction
+     (package-compute-transaction (list name)
+				  (package-desc-reqs (cdr pkg-desc))))))
+
+(defun package-strip-rcs-id (str)
+  "Strip RCS version ID from the version string STR.
+If the result looks like a dotted numeric version, return it.
+Otherwise return nil."
+  (when str
+    (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
+      (setq str (substring str (match-end 0))))
+    (condition-case nil
+	(if (version-to-list str)
+	    str)
+      (error nil))))
+
+(defun package-buffer-info ()
+  "Return a vector describing the package in the current buffer.
+The vector has the form
+
+   [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
+
+FILENAME is the file name, a string, sans the \".el\" extension.
+REQUIRES is a list of requirements, each requirement having the
+ form (NAME VER); NAME is a string and VER is a version list.
+DESCRIPTION is the package description, a string.
+VERSION is the version, a string.
+COMMENTARY is the commentary section, a string, or nil if none.
+
+If the buffer does not contain a conforming package, signal an
+error.  If there is a package, narrow the buffer to the file's
+boundaries."
+  (goto-char (point-min))
+  (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
+    (error "Packages lacks a file header"))
+  (let ((file-name (match-string-no-properties 1))
+	(desc      (match-string-no-properties 2))
+	(start     (line-beginning-position)))
+    (unless (search-forward (concat ";;; " file-name ".el ends here"))
+      (error "Package lacks a terminating comment"))
+    ;; Try to include a trailing newline.
+    (forward-line)
+    (narrow-to-region start (point))
+    (require 'lisp-mnt)
+    ;; Use some headers we've invented to drive the process.
+    (let* ((requires-str (lm-header "package-requires"))
+	   (requires (if requires-str
+			 (package-read-from-string requires-str)))
+	   ;; Prefer Package-Version; if defined, the package author
+	   ;; probably wants us to use it.  Otherwise try Version.
+	   (pkg-version
+	    (or (package-strip-rcs-id (lm-header "package-version"))
+		(package-strip-rcs-id (lm-header "version"))))
+	   (commentary (lm-commentary)))
+      (unless pkg-version
+	(error
+	 "Package lacks a \"Version\" or \"Package-Version\" header"))
+      ;; Turn string version numbers into list form.
+      (setq requires
+	    (mapcar
+	     (lambda (elt)
+	       (list (car elt)
+		     (version-to-list (car (cdr elt)))))
+	     requires))
+      (vector file-name requires desc pkg-version commentary))))
+
+(defun package-tar-file-info (file)
+  "Find package information for a tar file.
+FILE is the name of the tar file to examine.
+The return result is a vector like `package-buffer-info'."
+  (let ((default-directory (file-name-directory file))
+	(file (file-name-nondirectory file)))
+    (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'")
+			  file)
+      (error "Invalid package name `%s'" file))
+    (let* ((pkg-name (match-string-no-properties 1 file))
+	   (pkg-version (match-string-no-properties 2 file))
+	   ;; Extract the package descriptor.
+	   (pkg-def-contents (shell-command-to-string
+			      ;; Requires GNU tar.
+			      (concat "tar -xOf " file " "
+
+				      pkg-name "-" pkg-version "/"
+				      pkg-name "-pkg.el")))
+	   (pkg-def-parsed (package-read-from-string pkg-def-contents)))
+      (unless (eq (car pkg-def-parsed) 'define-package)
+	(error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
+      (let ((name-str       (nth 1 pkg-def-parsed))
+	    (version-string (nth 2 pkg-def-parsed))
+	    (docstring      (nth 3 pkg-def-parsed))
+	    (requires       (nth 4 pkg-def-parsed))
+	    (readme (shell-command-to-string
+		     ;; Requires GNU tar.
+		     (concat "tar -xOf " file " "
+			     pkg-name "-" pkg-version "/README"))))
+	(unless (equal pkg-version version-string)
+	  (error "Package has inconsistent versions"))
+	(unless (equal pkg-name name-str)
+	  (error "Package has inconsistent names"))
+	;; Kind of a hack.
+	(if (string-match ": Not found in archive" readme)
+	    (setq readme nil))
+	;; Turn string version numbers into list form.
+	(if (eq (car requires) 'quote)
+	    (setq requires (car (cdr requires))))
+	(setq requires
+	      (mapcar (lambda (elt)
+			(list (car elt)
+			      (version-to-list (cadr elt))))
+		      requires))
+	(vector pkg-name requires docstring version-string readme)))))
+
+;;;###autoload
+(defun package-install-from-buffer (pkg-info type)
+  "Install a package from the current buffer.
+When called interactively, the current buffer is assumed to be a
+single .el file that follows the packaging guidelines; see info
+node `(elisp)Packaging'.
+
+When called from Lisp, PKG-INFO is a vector describing the
+information, of the type returned by `package-buffer-info'; and
+TYPE is the package type (either `single' or `tar')."
+  (interactive (list (package-buffer-info) 'single))
+  (save-excursion
+    (save-restriction
+      (let* ((file-name (aref pkg-info 0))
+	     (requires  (aref pkg-info 1))
+	     (desc (if (string= (aref pkg-info 2) "")
+		       "No description available."
+		     (aref pkg-info 2)))
+	     (pkg-version (aref pkg-info 3)))
+	;; Download and install the dependencies.
+	(let ((transaction (package-compute-transaction nil requires)))
+	  (package-download-transaction transaction))
+	;; Install the package itself.
+	(cond
+	 ((eq type 'single)
+	  (package-unpack-single file-name pkg-version desc requires))
+	 ((eq type 'tar)
+	  (package-unpack (intern file-name) pkg-version))
+	 (t
+	  (error "Unknown type: %s" (symbol-name type))))
+	;; Try to activate it.
+	(package-initialize)))))
+
+;;;###autoload
+(defun package-install-file (file)
+  "Install a package from a file.
+The file can either be a tar file or an Emacs Lisp file."
+  (interactive "fPackage file name: ")
+  (with-temp-buffer
+    (insert-file-contents-literally file)
+    (cond
+     ((string-match "\\.el$" file)
+      (package-install-from-buffer (package-buffer-info) 'single))
+     ((string-match "\\.tar$" file)
+      (package-install-from-buffer (package-tar-file-info file) 'tar))
+     (t (error "Unrecognized extension `%s'" (file-name-extension file))))))
+
+(defun package-delete (name version)
+  (let ((dir (package--dir name version)))
+    (if (string-equal (file-name-directory dir)
+		      (file-name-as-directory
+		       (expand-file-name package-user-dir)))
+	(progn
+	  (delete-directory dir t t)
+	  (message "Package `%s-%s' deleted." name version))
+      ;; Don't delete "system" packages
+      (error "Package `%s-%s' is a system package, not deleting"
+	     name version))))
+
+(defun package-archive-base (name)
+  "Return the archive containing the package NAME."
+  (let ((desc (cdr (assq (intern-soft name) package-archive-contents))))
+    (cdr (assoc (aref desc (- (length desc) 1)) package-archives))))
+
+(defun package--download-one-archive (archive file)
+  "Retrieve an archive file FILE from ARCHIVE, and cache it.
+ARCHIVE should be a cons cell of the form (NAME . LOCATION),
+similar to an entry in `package-alist'.  Save the cached copy to
+\"archives/NAME/archive-contents\" in `package-user-dir'."
+  (let* ((dir (expand-file-name "archives" package-user-dir))
+	 (dir (expand-file-name (car archive) dir)))
+    (package--with-work-buffer (cdr archive) file
+      ;; Read the retrieved buffer to make sure it is valid (e.g. it
+      ;; may fetch a URL redirect page).
+      (when (listp (read buffer))
+	(make-directory dir t)
+	(setq buffer-file-name (expand-file-name file dir))
+	(let ((version-control 'never))
+	  (save-buffer))))))
+
+;;;###autoload
+(defun package-refresh-contents ()
+  "Download the ELPA archive description if needed.
+This informs Emacs about the latest versions of all packages, and
+makes them available for download."
+  (interactive)
+  (unless (file-exists-p package-user-dir)
+    (make-directory package-user-dir t))
+  (dolist (archive package-archives)
+    (condition-case-unless-debug nil
+	(package--download-one-archive archive "archive-contents")
+      (error (message "Failed to download `%s' archive."
+		      (car archive)))))
+  (package-read-all-archive-contents))
+
+;;;###autoload
+(defun package-initialize (&optional no-activate)
+  "Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages."
+  (interactive)
+  (setq package-alist nil
+	package-obsolete-alist nil)
+  (package-load-all-descriptors)
+  (package-read-all-archive-contents)
+  (unless no-activate
+    (dolist (elt package-alist)
+      (package-activate (car elt) (package-desc-vers (cdr elt)))))
+  (setq package--initialized t))
+
+
+;;;; Package description buffer.
+
+;;;###autoload
+(defun describe-package (package)
+  "Display the full documentation of PACKAGE (a symbol)."
+  (interactive
+   (let* ((guess (function-called-at-point))
+	  packages val)
+     (require 'finder-inf nil t)
+     ;; Load the package list if necessary (but don't activate them).
+     (unless package--initialized
+       (package-initialize t))
+     (setq packages (append (mapcar 'car package-alist)
+			    (mapcar 'car package-archive-contents)
+			    (mapcar 'car package--builtins)))
+     (unless (memq guess packages)
+       (setq guess nil))
+     (setq packages (mapcar 'symbol-name packages))
+     (setq val
+	   (completing-read (if guess
+				(format "Describe package (default %s): "
+					guess)
+			      "Describe package: ")
+			    packages nil t nil nil guess))
+     (list (if (equal val "") guess (intern val)))))
+  (if (or (null package) (not (symbolp package)))
+      (message "No package specified")
+    (help-setup-xref (list #'describe-package package)
+		     (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+	(describe-package-1 package)))))
+
+(defun describe-package-1 (package)
+  (require 'lisp-mnt)
+  (let ((package-name (symbol-name package))
+	(built-in (assq package package--builtins))
+	desc pkg-dir reqs version installable archive)
+    (prin1 package)
+    (princ " is ")
+    (cond
+     ;; Loaded packages are in `package-alist'.
+     ((setq desc (cdr (assq package package-alist)))
+      (setq version (package-version-join (package-desc-vers desc)))
+      (if (setq pkg-dir (package--dir package-name version))
+	  (insert "an installed package.\n\n")
+	;; This normally does not happen.
+	(insert "a deleted package.\n\n")))
+     ;; Available packages are in `package-archive-contents'.
+     ((setq desc (cdr (assq package package-archive-contents)))
+      (setq version (package-version-join (package-desc-vers desc))
+	    archive (aref desc (- (length desc) 1))
+	    installable t)
+      (if built-in
+	  (insert "a built-in package.\n\n")
+	(insert "an uninstalled package.\n\n")))
+     (built-in
+      (setq desc (cdr built-in)
+	    version (package-version-join (package-desc-vers desc)))
+      (insert "a built-in package.\n\n"))
+     (t
+      (insert "an orphan package.\n\n")))
+
+    (insert "     " (propertize "Status" 'font-lock-face 'bold) ": ")
+    (cond (pkg-dir
+	   (insert (propertize "Installed"
+			       'font-lock-face 'font-lock-comment-face))
+	   (insert " in `")
+	   ;; Todo: Add button for uninstalling.
+	   (help-insert-xref-button (file-name-as-directory pkg-dir)
+				    'help-package-def pkg-dir)
+	   (if built-in
+	       (insert "',\n             shadowing a "
+		       (propertize "built-in package"
+				   'font-lock-face 'font-lock-builtin-face)
+		       ".")
+	     (insert "'.")))
+	  (installable
+	   (if built-in
+	       (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face)
+		       "  Alternate version available")
+	     (insert "Available"))
+	   (insert " from " archive)
+	   (insert " -- ")
+	   (let ((button-text (if (display-graphic-p) "Install" "[Install]"))
+		 (button-face (if (display-graphic-p)
+				  '(:box (:line-width 2 :color "dark grey")
+					 :background "light grey"
+					 :foreground "black")
+				'link)))
+	     (insert-text-button button-text 'face button-face 'follow-link t
+				 'package-symbol package
+				 'action 'package-install-button-action)))
+	  (built-in
+	   (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face)))
+	  (t (insert "Deleted.")))
+    (insert "\n")
+    (and version (> (length version) 0)
+	 (insert "    "
+		 (propertize "Version" 'font-lock-face 'bold) ": " version "\n"))
+
+    (setq reqs (if desc (package-desc-reqs desc)))
+    (when reqs
+      (insert "   " (propertize "Requires" 'font-lock-face 'bold) ": ")
+      (let ((first t)
+	    name vers text)
+	(dolist (req reqs)
+	  (setq name (car req)
+		vers (cadr req)
+		text (format "%s-%s" (symbol-name name)
+			     (package-version-join vers)))
+	  (cond (first (setq first nil))
+		((>= (+ 2 (current-column) (length text))
+		     (window-width))
+		 (insert ",\n               "))
+		(t (insert ", ")))
+	  (help-insert-xref-button text 'help-package name))
+	(insert "\n")))
+    (insert "    " (propertize "Summary" 'font-lock-face 'bold)
+	    ": " (if desc (package-desc-doc desc)) "\n\n")
+
+    (if built-in
+	;; For built-in packages, insert the commentary.
+	(let ((fn (locate-file (concat package-name ".el") load-path
+			       load-file-rep-suffixes))
+	      (opoint (point)))
+	  (insert (or (lm-commentary fn) ""))
+	  (save-excursion
+	    (goto-char opoint)
+	    (when (re-search-forward "^;;; Commentary:\n" nil t)
+	      (replace-match ""))
+	    (while (re-search-forward "^\\(;+ ?\\)" nil t)
+	      (replace-match ""))))
+      (let ((readme (expand-file-name (concat package-name "-readme.txt")
+				      package-user-dir))
+	    readme-string)
+	;; For elpa packages, try downloading the commentary.  If that
+	;; fails, try an existing readme file in `package-user-dir'.
+	(cond ((condition-case nil
+		   (package--with-work-buffer (package-archive-base package)
+					      (concat package-name "-readme.txt")
+		     (setq buffer-file-name
+			   (expand-file-name readme package-user-dir))
+		     (let ((version-control 'never))
+		       (save-buffer))
+		     (setq readme-string (buffer-string))
+		     t)
+		 (error nil))
+	       (insert readme-string))
+	      ((file-readable-p readme)
+	       (insert-file-contents readme)
+	       (goto-char (point-max))))))))
+
+(defun package-install-button-action (button)
+  (let ((package (button-get button 'package-symbol)))
+    (when (y-or-n-p (format "Install package `%s'? " package))
+      (package-install package)
+      (revert-buffer nil t)
+      (goto-char (point-min)))))
+
+
+;;;; Package menu mode.
+
+(defvar package-menu-mode-map
+  (let ((map (make-sparse-keymap))
+	(menu-map (make-sparse-keymap "Package")))
+    (set-keymap-parent map tabulated-list-mode-map)
+    (define-key map "\C-m" 'package-menu-describe-package)
+    (define-key map "u" 'package-menu-mark-unmark)
+    (define-key map "\177" 'package-menu-backup-unmark)
+    (define-key map "d" 'package-menu-mark-delete)
+    (define-key map "i" 'package-menu-mark-install)
+    (define-key map "U" 'package-menu-mark-upgrades)
+    (define-key map "r" 'package-menu-refresh)
+    (define-key map "~" 'package-menu-mark-obsolete-for-deletion)
+    (define-key map "x" 'package-menu-execute)
+    (define-key map "h" 'package-menu-quick-help)
+    (define-key map "?" 'package-menu-describe-package)
+    (define-key map [menu-bar package-menu] (cons "Package" menu-map))
+    (define-key menu-map [mq]
+      '(menu-item "Quit" quit-window
+		  :help "Quit package selection"))
+    (define-key menu-map [s1] '("--"))
+    (define-key menu-map [mn]
+      '(menu-item "Next" next-line
+		  :help "Next Line"))
+    (define-key menu-map [mp]
+      '(menu-item "Previous" previous-line
+		  :help "Previous Line"))
+    (define-key menu-map [s2] '("--"))
+    (define-key menu-map [mu]
+      '(menu-item "Unmark" package-menu-mark-unmark
+		  :help "Clear any marks on a package and move to the next line"))
+    (define-key menu-map [munm]
+      '(menu-item "Unmark Backwards" package-menu-backup-unmark
+		  :help "Back up one line and clear any marks on that package"))
+    (define-key menu-map [md]
+      '(menu-item "Mark for Deletion" package-menu-mark-delete
+		  :help "Mark a package for deletion and move to the next line"))
+    (define-key menu-map [mi]
+      '(menu-item "Mark for Install" package-menu-mark-install
+		  :help "Mark a package for installation and move to the next line"))
+    (define-key menu-map [mupgrades]
+      '(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
+		  :help "Mark packages that have a newer version for upgrading"))
+    (define-key menu-map [s3] '("--"))
+    (define-key menu-map [mg]
+      '(menu-item "Update Package List" revert-buffer
+		  :help "Update the list of packages"))
+    (define-key menu-map [mr]
+      '(menu-item "Refresh Package List" package-menu-refresh
+		  :help "Download the ELPA archive"))
+    (define-key menu-map [s4] '("--"))
+    (define-key menu-map [mt]
+      '(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion
+		  :help "Mark all obsolete packages for deletion"))
+    (define-key menu-map [mx]
+      '(menu-item "Execute Actions" package-menu-execute
+		  :help "Perform all the marked actions"))
+    (define-key menu-map [s5] '("--"))
+    (define-key menu-map [mh]
+      '(menu-item "Help" package-menu-quick-help
+		  :help "Show short key binding help for package-menu-mode"))
+    (define-key menu-map [mc]
+      '(menu-item "View Commentary" package-menu-view-commentary
+		  :help "Display information about this package"))
+    map)
+  "Local keymap for `package-menu-mode' buffers.")
+
+(defvar package-menu--new-package-list nil
+  "List of newly-available packages since `list-packages' was last called.")
+
+(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
+  "Major mode for browsing a list of packages.
+Letters do not insert themselves; instead, they are commands.
+\\
+\\{package-menu-mode-map}"
+  (setq tabulated-list-format [("Package" 18 package-menu--name-predicate)
+			       ("Version" 12 nil)
+			       ("Status"  10 package-menu--status-predicate)
+			       ("Description" 0 nil)])
+  (setq tabulated-list-padding 2)
+  (setq tabulated-list-sort-key (cons "Status" nil))
+  (tabulated-list-init-header))
+
+(defmacro package--push (package desc status listname)
+  "Convenience macro for `package-menu--generate'.
+If the alist stored in the symbol LISTNAME lacks an entry for a
+package PACKAGE with descriptor DESC, add one.  The alist is
+keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is
+a symbol and VERSION-LIST is a version list."
+  `(let* ((version (package-desc-vers ,desc))
+	  (key (cons ,package version)))
+     (unless (assoc key ,listname)
+       (push (list key ,status (package-desc-doc ,desc)) ,listname))))
+
+(defun package-menu--generate (remember-pos packages)
+  "Populate the Package Menu.
+If REMEMBER-POS is non-nil, keep point on the same entry.
+PACKAGES should be t, which means to display all known packages,
+or a list of package names (symbols) to display."
+  ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
+  (let (info-list name)
+    ;; Installed packages:
+    (dolist (elt package-alist)
+      (setq name (car elt))
+      (when (or (eq packages t) (memq name packages))
+	(package--push name (cdr elt)
+		       (if (stringp (cadr (assq name package-load-list)))
+			   "held" "installed")
+		       info-list)))
+
+    ;; Built-in packages:
+    (dolist (elt package--builtins)
+      (setq name (car elt))
+      (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
+		 (or (eq packages t) (memq name packages)))
+    	(package--push name (cdr elt) "built-in" info-list)))
+
+    ;; Available and disabled packages:
+    (dolist (elt package-archive-contents)
+      (setq name (car elt))
+      (when (or (eq packages t) (memq name packages))
+	(let ((hold (assq name package-load-list)))
+	  (package--push name (cdr elt)
+			 (cond
+			  ((and hold (null (cadr hold))) "disabled")
+			  ((memq name package-menu--new-package-list) "new")
+			  (t "available"))
+			 info-list))))
+
+    ;; Obsolete packages:
+    (dolist (elt package-obsolete-alist)
+      (dolist (inner-elt (cdr elt))
+	(when (or (eq packages t) (memq (car elt) packages))
+	  (package--push (car elt) (cdr inner-elt) "obsolete" info-list))))
+
+    ;; Print the result.
+    (setq tabulated-list-entries (mapcar 'package-menu--print-info info-list))
+    (tabulated-list-print remember-pos)))
+
+(defun package-menu--print-info (pkg)
+  "Return a package entry suitable for `tabulated-list-entries'.
+PKG has the form ((PACKAGE . VERSION) STATUS DOC).
+Return (KEY [NAME VERSION STATUS DOC]), where KEY is the
+identifier (NAME . VERSION-LIST)."
+  (let* ((package (caar pkg))
+	 (version (cdr (car pkg)))
+	 (status  (nth 1 pkg))
+	 (doc (or (nth 2 pkg) ""))
+	 (face (cond
+		((string= status "built-in")  'font-lock-builtin-face)
+		((string= status "available") 'default)
+		((string= status "new") 'bold)
+		((string= status "held")      'font-lock-constant-face)
+		((string= status "disabled")  'font-lock-warning-face)
+		((string= status "installed") 'font-lock-comment-face)
+		(t 'font-lock-warning-face)))) ; obsolete.
+    (list (cons package version)
+	  (vector (list (symbol-name package)
+			'face 'link
+			'follow-link t
+			'package-symbol package
+			'action 'package-menu-describe-package)
+		  (propertize (package-version-join version)
+			      'font-lock-face face)
+		  (propertize status 'font-lock-face face)
+		  (propertize doc 'font-lock-face face)))))
+
+(defun package-menu-refresh ()
+  "Download the Emacs Lisp package archive.
+This fetches the contents of each archive specified in
+`package-archives', and then refreshes the package menu."
+  (interactive)
+  (unless (derived-mode-p 'package-menu-mode)
+    (error "The current buffer is not a Package Menu"))
+  (package-refresh-contents)
+  (package-menu--generate t t))
+
+(defun package-menu-describe-package (&optional button)
+  "Describe the current package.
+If optional arg BUTTON is non-nil, describe its associated package."
+  (interactive)
+  (let ((package (if button (button-get button 'package-symbol)
+		   (car (tabulated-list-get-id)))))
+    (if package
+	(describe-package package))))
+
+;; fixme numeric argument
+(defun package-menu-mark-delete (&optional _num)
+  "Mark a package for deletion and move to the next line."
+  (interactive "p")
+  (if (member (package-menu-get-status) '("installed" "obsolete"))
+      (tabulated-list-put-tag "D" t)
+    (forward-line)))
+
+(defun package-menu-mark-install (&optional _num)
+  "Mark a package for installation and move to the next line."
+  (interactive "p")
+  (if (member (package-menu-get-status) '("available" "new"))
+      (tabulated-list-put-tag "I" t)
+    (forward-line)))
+
+(defun package-menu-mark-unmark (&optional _num)
+  "Clear any marks on a package and move to the next line."
+  (interactive "p")
+  (tabulated-list-put-tag " " t))
+
+(defun package-menu-backup-unmark ()
+  "Back up one line and clear any marks on that package."
+  (interactive)
+  (forward-line -1)
+  (tabulated-list-put-tag " "))
+
+(defun package-menu-mark-obsolete-for-deletion ()
+  "Mark all obsolete packages for deletion."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (while (not (eobp))
+      (if (equal (package-menu-get-status) "obsolete")
+	  (tabulated-list-put-tag "D" t)
+	(forward-line 1)))))
+
+(defun package-menu-quick-help ()
+  "Show short key binding help for package-menu-mode."
+  (interactive)
+  (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp"))
+
+(define-obsolete-function-alias
+  'package-menu-view-commentary 'package-menu-describe-package "24.1")
+
+(defun package-menu-get-status ()
+  (let* ((pkg (tabulated-list-get-id))
+	 (entry (and pkg (assq pkg tabulated-list-entries))))
+    (if entry
+	(aref (cadr entry) 2)
+      "")))
+
+(defun package-menu--find-upgrades ()
+  (let (installed available upgrades)
+    ;; Build list of installed/available packages in this buffer.
+    (dolist (entry tabulated-list-entries)
+      ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
+      (let ((pkg (car entry))
+	    (status (aref (cadr entry) 2)))
+	(cond ((equal status "installed")
+	       (push pkg installed))
+	      ((member status '("available" "new"))
+	       (push pkg available)))))
+    ;; Loop through list of installed packages, finding upgrades
+    (dolist (pkg installed)
+      (let ((avail-pkg (assq (car pkg) available)))
+	(and avail-pkg
+	     (version-list-< (cdr pkg) (cdr avail-pkg))
+	     (push avail-pkg upgrades))))
+    upgrades))
+
+(defun package-menu-mark-upgrades ()
+  "Mark all upgradable packages in the Package Menu.
+For each installed package with a newer version available, place
+an (I)nstall flag on the available version and a (D)elete flag on
+the installed version.  A subsequent \\[package-menu-execute]
+call will upgrade the package."
+  (interactive)
+  (unless (derived-mode-p 'package-menu-mode)
+    (error "The current buffer is not a Package Menu"))
+  (let ((upgrades (package-menu--find-upgrades)))
+    (if (null upgrades)
+	(message "No packages to upgrade.")
+      (widen)
+      (save-excursion
+	(goto-char (point-min))
+	(while (not (eobp))
+	  (let* ((pkg (tabulated-list-get-id))
+		 (upgrade (assq (car pkg) upgrades)))
+	    (cond ((null upgrade)
+		   (forward-line 1))
+		  ((equal pkg upgrade)
+		   (package-menu-mark-install))
+		  (t
+		   (package-menu-mark-delete))))))
+      (message "%d package%s marked for upgrading."
+	       (length upgrades)
+	       (if (= (length upgrades) 1) "" "s")))))
+
+(defun package-menu-execute (&optional noquery)
+  "Perform marked Package Menu actions.
+Packages marked for installation are downloaded and installed;
+packages marked for deletion are removed.
+Optional argument NOQUERY non-nil means do not ask the user to confirm."
+  (interactive)
+  (unless (derived-mode-p 'package-menu-mode)
+    (error "The current buffer is not in Package Menu mode"))
+  (let (install-list delete-list cmd id)
+    (save-excursion
+      (goto-char (point-min))
+      (while (not (eobp))
+	(setq cmd (char-after))
+	(unless (eq cmd ?\s)
+	  ;; This is the key (PACKAGE . VERSION-LIST).
+	  (setq id (tabulated-list-get-id))
+	  (cond ((eq cmd ?D)
+		 (push (cons (symbol-name (car id))
+			     (package-version-join (cdr id)))
+		       delete-list))
+		((eq cmd ?I)
+		 (push (car id) install-list))))
+	(forward-line)))
+    (when install-list
+      (if (or
+           noquery
+           (yes-or-no-p
+	   (if (= (length install-list) 1)
+	       (format "Install package `%s'? " (car install-list))
+	     (format "Install these %d packages (%s)? "
+		     (length install-list)
+                      (mapconcat 'symbol-name install-list ", ")))))
+	  (mapc 'package-install install-list)))
+    ;; Delete packages, prompting if necessary.
+    (when delete-list
+      (if (or
+           noquery
+           (yes-or-no-p
+	   (if (= (length delete-list) 1)
+	       (format "Delete package `%s-%s'? "
+		       (caar delete-list)
+		       (cdr (car delete-list)))
+	     (format "Delete these %d packages (%s)? "
+		     (length delete-list)
+		     (mapconcat (lambda (elt)
+				  (concat (car elt) "-" (cdr elt)))
+				delete-list
+                                 ", ")))))
+	  (dolist (elt delete-list)
+	    (condition-case-unless-debug err
+		(package-delete (car elt) (cdr elt))
+	      (error (message (cadr err)))))
+	(error "Aborted")))
+    ;; If we deleted anything, regenerate `package-alist'.  This is done
+    ;; automatically if we installed a package.
+    (and delete-list (null install-list)
+	 (package-initialize))
+    (if (or delete-list install-list)
+	(package-menu--generate t t)
+      (message "No operations specified."))))
+
+(defun package-menu--version-predicate (A B)
+  (let ((vA (or (aref (cadr A) 1)  '(0)))
+	(vB (or (aref (cadr B) 1) '(0))))
+    (if (version-list-= vA vB)
+	(package-menu--name-predicate A B)
+      (version-list-< vA vB))))
+
+(defun package-menu--status-predicate (A B)
+  (let ((sA (aref (cadr A) 2))
+	(sB (aref (cadr B) 2)))
+    (cond ((string= sA sB)
+	   (package-menu--name-predicate A B))
+	  ((string= sA "new") t)
+	  ((string= sB "new") nil)
+	  ((string= sA "available") t)
+	  ((string= sB "available") nil)
+	  ((string= sA "installed") t)
+	  ((string= sB "installed") nil)
+	  ((string= sA "held") t)
+	  ((string= sB "held") nil)
+	  ((string= sA "built-in") t)
+	  ((string= sB "built-in") nil)
+	  ((string= sA "obsolete") t)
+	  ((string= sB "obsolete") nil)
+	  (t (string< sA sB)))))
+
+(defun package-menu--description-predicate (A B)
+  (let ((dA (aref (cadr A) 3))
+	(dB (aref (cadr B) 3)))
+    (if (string= dA dB)
+	(package-menu--name-predicate A B)
+      (string< dA dB))))
+
+(defun package-menu--name-predicate (A B)
+  (string< (symbol-name (caar A))
+	   (symbol-name (caar B))))
+
+;;;###autoload
+(defun list-packages (&optional no-fetch)
+  "Display a list of packages.
+This first fetches the updated list of packages before
+displaying, unless a prefix argument NO-FETCH is specified.
+The list is displayed in a buffer named `*Packages*'."
+  (interactive "P")
+  (require 'finder-inf nil t)
+  ;; Initialize the package system if necessary.
+  (unless package--initialized
+    (package-initialize t))
+  (let (old-archives new-packages)
+    (unless no-fetch
+      ;; Read the locally-cached archive-contents.
+      (package-read-all-archive-contents)
+      (setq old-archives package-archive-contents)
+      ;; Fetch the remote list of packages.
+      (package-refresh-contents)
+      ;; Find which packages are new.
+      (dolist (elt package-archive-contents)
+	(unless (assq (car elt) old-archives)
+	  (push (car elt) new-packages))))
+
+    ;; Generate the Package Menu.
+    (let ((buf (get-buffer-create "*Packages*")))
+      (with-current-buffer buf
+	(package-menu-mode)
+	(set (make-local-variable 'package-menu--new-package-list)
+	     new-packages)
+	(package-menu--generate nil t))
+      ;; The package menu buffer has keybindings.  If the user types
+      ;; `M-x list-packages', that suggests it should become current.
+      (switch-to-buffer buf))
+
+    (let ((upgrades (package-menu--find-upgrades)))
+      (if upgrades
+	  (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
+		   (length upgrades)
+		   (if (= (length upgrades) 1) "" "s")
+		   (substitute-command-keys "\\[package-menu-mark-upgrades]")
+		   (if (= (length upgrades) 1) "it" "them"))))))
+
+;;;###autoload
+(defalias 'package-list-packages 'list-packages)
+
+;; Used in finder.el
+(defun package-show-package-list (packages)
+  "Display PACKAGES in a *Packages* buffer.
+This is similar to `list-packages', but it does not fetch the
+updated list of packages, and it only displays packages with
+names in PACKAGES (which should be a list of symbols)."
+  (require 'finder-inf nil t)
+  (let ((buf (get-buffer-create "*Packages*")))
+    (with-current-buffer buf
+      (package-menu-mode)
+      (package-menu--generate nil packages))
+    (switch-to-buffer buf)))
+
+(defun package-list-packages-no-fetch ()
+  "Display a list of packages.
+Does not fetch the updated list of packages before displaying.
+The list is displayed in a buffer named `*Packages*'."
+  (interactive)
+  (list-packages t))
+
+(provide 'package)
+
+;;; package.el ends here
diff --git a/lisp/synonyms.el b/lisp/synonyms.el
new file mode 100644
index 00000000..8c226479
--- /dev/null
+++ b/lisp/synonyms.el
@@ -0,0 +1,1426 @@
+;;; synonyms.el --- Look up synonyms for a word or phrase in a thesaurus.
+;;
+;; Filename: synonyms.el
+;; Description: Look up synonyms for a word or phrase in a thesaurus.
+;; Author: Drew Adams
+;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
+;; Copyright (C) 2005-2014, Drew Adams, all rights reserved.
+;; Created: Tue Dec 20 14:39:26 2005
+;; Version: 0
+;; Package-Requires: ()
+;; Last-Updated: Thu Dec 26 09:51:41 2013 (-0800)
+;;           By: dradams
+;;     Update #: 2518
+;; URL: http://www.emacswiki.org/synonyms.el
+;; Doc URL: http://www.emacswiki.org/ThesauriAndSynonyms
+;; Keywords: text, dictionary, thesaurus, spelling, apropos, help
+;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x
+;;
+;; Features that might be required by this library:
+;;
+;;   `thingatpt', `thingatpt+'.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;;  Look up synonyms for a word or phrase in a thesaurus.
+;;
+;;
+;;  Getting Started
+;;  ---------------
+;;
+;;  To use library Synonyms, you will need the Moby Thesaurus II file,
+;;  `mthesaur.txt', available here:
+;;
+;;    ftp://ibiblio.org/pub/docs/books/gutenberg/etext02/mthes10.zip
+;;
+;;  Put this in your initialization file (~/.emacs):
+;;
+;;    ;; The file names are absolute, not relative, locations
+;;    ;;     - e.g. /foobar/mthesaur.txt.cache, not mthesaur.txt.cache
+;;    (setq synonyms-file        )
+;;    (setq synonyms-cache-file  )
+;;    (require 'synonyms)
+;;
+;;  As an alternative to the first two lines, you can use Customize to
+;;  set `synonyms-file' and `synonyms-cache-file' persistently.  The
+;;  second of these files is created by this library, to serve as a
+;;  synonym cache for completion.
+;;
+;;  The main command is `synonyms'.  It prompts you for a word or
+;;  phrase to look up in the thesaurus.  The synonyms found are then
+;;  displayed in buffer *Synonyms*.  For example, `M-x synonyms RET
+;;  democracy' displays synonyms for `democracy'.
+;;
+;;  If you do not define `synonyms-file' and `synonyms-cache-file'
+;;  prior to using command `synonyms', that command will prompt you to
+;;  define them.  If you want to use the same values during subsequent
+;;  Emacs sessions, then you should use `M-x customize-option' to save
+;;  those newly defined values.
+;;
+;;
+;;  Some Definitions
+;;  ----------------
+;;
+;;  The thesaurus is divided into "entries", which are like glossary
+;;  entries: each entry is followed by associated words and phrases,
+;;  which, for lack of a better word, I refer to as "synonyms".  For
+;;  example, `democracy' is an entry, and it is followed by its
+;;  synonyms.  Some synonyms are not also entries.  For example,
+;;  `patriarchy' is in the thesaurus as a synonym but not as an entry.
+;;
+;;  Note: What I call "synonyms" here are not necessarily synonyms, in
+;;  the sense of having the same or even similar meanings.  They are
+;;  simply terms collected together with the same thesaurus entry
+;;  because they are related in some way - the grouping is what
+;;  defines their relation.
+;;
+;;  In Moby Thesaurus II, the meanings of synonyms in the same group
+;;  do have something in common, but this might be simply the fact
+;;  that they are terms of a similar kind.  For example, the
+;;  "synonyms" following the `democracy' thesaurus entry are words
+;;  such as `dictatorship' and `autocracy'.  These are different forms
+;;  of the same general thing: government - they are certainly not
+;;  synonymous with each other or with the entry `democracy'.
+;;
+;;
+;;  Searching the Thesaurus
+;;  -----------------------
+;;
+;;  The default input value for command `synonyms' is the word under
+;;  the cursor.  Alternatively, if a region is active and you are in
+;;  Transient Mark mode (recommended), then it is the text in the
+;;  region (selection).
+;;
+;;  Your input is actually treated as a regular expression (regexp),
+;;  so you can also input patterns like `for.*ion', which will match
+;;  thesaurus entries `formation', `formulation', `fornication',
+;;  `fortification', and `forward motion'.  Note that the last of
+;;  these is a phrase rather than a single word.
+;;
+;;  Using a regexp as input is a powerful way to search, but be aware
+;;  that it can be costly in CPU time and computer memory if the
+;;  regexp is not appropriate.  The regexp `.*' will, for example,
+;;  likely use up available memory before being able to return the
+;;  entire thesaurus (it's very large).  You can always use `C-g' to
+;;  interrupt a thesaurus search if you mistakenly use an inefficient
+;;  regexp.
+;;
+;;
+;;  Using a Prefix Argument To Do More
+;;  ----------------------------------
+;;
+;;  You can use a prefix argument to modify searching and the
+;;  presentation of search results, as follows:
+;;
+;;    `C-u'     - Search for additional synonyms, in two senses:
+;;
+;;                1) Return also synonyms that are matched partially
+;;                   by the input.
+;;
+;;                2) Search the entire thesaurus for input matches,
+;;                   even if the input matches a thesaurus entry.
+;;
+;;    `M--'     - Append the search results to any previous search
+;;                results, in buffer *Synonyms*.  (Normally, the new
+;;                results replace any previous results.)
+;;
+;;    `C-u C-u' - `C-u' plus `M--': Search more and append results.
+;;
+;;  If you find yourself often using a particular prefix argument (for
+;;  example, to append results), then you might want to instead change
+;;  the default behavior to reflect this preference.  Options
+;;  `synonyms-match-more-flag' and `synonyms-append-result-flag'
+;;  correspond to using `C-u' and `M--', respectively.  In fact, a
+;;  prefix argument simply toggles the value of the corresponding
+;;  option for the duration of the command.  So, for example, if
+;;  `synonyms-append-result-flag' is t and you use `M--', then results
+;;  will not be appended.
+;;
+;;  When partially matching input (`C-u', sense #1), complete synonyms
+;;  are matched against your input.  This means that you generally
+;;  need not add a preceding or trailing `.*' to try to match a
+;;  complete synonym.  For example, input `format' will match the
+;;  complete synonyms `conformation', `efformation', `format',
+;;  `formation', `formative', `formational', `information',
+;;  `informative', `informational', `malformation', `deformation',
+;;  `reformation', `transformation', `reformatory', and so on - there
+;;  is no need to input `.*format.*' to match the same synonyms.
+;;
+;;  To better understand the meaning of #2 above for `C-u' (to
+;;  continue the search even if your input matches an entry), try, for
+;;  example, `C-u M-x synonyms RET widespread'.  You'll see not only
+;;  the main synonyms listed for `widespread' as an entry, but also
+;;  lots of different meanings of `widespread', judging by the entries
+;;  for which it is listed as a synonym:
+;;
+;;    `accepted', `ample', `broad', `broadcast', `capacious',
+;;    `catholic', `commodious', `commonness', `conventional',
+;;    `currency', `current', `customary', `deep', `deltoid',
+;;    `diffuse', `discrete', `dispersed', `disseminated',
+;;    `dissipated', `distributed', `epidemic', `established',
+;;    `everyday', `expansive', `extended', `extensive', `familiar',
+;;    `fan shaped', `far flung', `far reaching', `flaring', `full',
+;;    `general', `indiscriminate', `infinite', `large scale',
+;;    `liberal', `normal', `normality', `open', `ordinary',
+;;    `outstretched', `pervasive', `popular', `prescribed',
+;;    `prescriptive', `prevailing', `prevalence', `prevalent',
+;;    `public', `rampant', `received', `regnant', `regular',
+;;    `regulation', `reign', `rife', `roomy', `ruling', `run',
+;;    `scattered', `set', spacious`', `sparse', `splay', `sporadic',
+;;    `sprawling', `spread', `standard', `stock', `straggling',
+;;    `stretched out', `sweeping', `time-honored', `traditional',
+;;    `universal', `usual', `vast', `voluminous', `wholesale', `wide
+;;    open', `wide', and `wonted'.
+;;
+;;  These are just the entries! Each of these is of course followed by
+;;  its own synonyms - perhaps 100 or 300, including `widespread'.
+;;
+;;  This list of entries is not the same list as the synonyms for
+;;  entry `widespread'.  There are words and phrases here that are not
+;;  in the latter list, and vice versa.  For example, the former (but
+;;  not the latter) list includes `full'; the latter (but not the
+;;  former) list includes `wide-reaching'.
+;;
+;;  The latter are the words most closely related to `widespread'.
+;;  The list above are the other thesaurus entries (corresponding to
+;;  main categories) to which `widespread' is most closely related.
+;;  Looking at all of the synonym groups in which `widespread' appears
+;;  can tell you additional information about its meanings - and it
+;;  can provide additional synonyms for `widespread'.
+;;
+;;
+;;  Using Completion with Synonyms
+;;  ------------------------------
+;;
+;;  You can complete words and phrases in the minibuffer, as input to
+;;  command `synonyms'.  You can use library Synonyms together with
+;;  library `Icicles to complete a partial word in a text buffer into a
+;;  word or phrase in the thesaurus.  If you use both libraries then
+;;  load Icicles after Synonyms.  For more information on Icicles, see
+;;  `http://www.emacswiki.org/Icicles'.
+;;
+;;  ** Minibuffer Input Completion **
+;;
+;;  You can enter any text to match against thesaurus synonyms.  When
+;;  you are prompted by command `synonyms' to enter this text, you can
+;;  also use input completion to complete to a thesaurus synonym.
+;;  That is, even though you can enter any text (including a regexp),
+;;  completion will only complete to synonyms in the thesaurus.
+;;
+;;  If you load library Icicles, then a more powerful version of
+;;  command `synonyms' is used.  In particular, it lets you:
+;;
+;;   - Use `S-TAB' during completion to see the list of all synonyms
+;;     (thesaurus terms) that match your minibuffer input so far.
+;;
+;;   - Use `next' (or repeated `S-TAB'), and `prior' (usually keys
+;;     `Page Down' and `Page Up') during completion to cycle through
+;;     the completion candidates (synonyms) that match your input.
+;;
+;;   - Use `C-next' and `C-prior' during completion to display the
+;;     synonyms of the current completion candidate.
+;;
+;;  ** Completing Buffer Text Using the Thesaurus **
+;;
+;;  Icicles also provides two commands for using completion to insert
+;;  thesaurus entries in a buffer:
+;;
+;;   - `icicle-complete-thesaurus-entry' completes a word in a text
+;;     buffer to any word or phrase in the thesaurus.  I bind it to
+;;     `C-c /'.
+;;
+;;   - `icicle-insert-thesaurus-entry' inserts thesaurus words and
+;;     phrases in a text buffer.  It is a multi-command, which means
+;;     that, within a single call to it, you can insert any number of
+;;     thesaurus entries, in succession.  If you want to, you can
+;;     write an entire book using a single call to
+;;     `icicle-insert-thesaurus-entry'!
+;;
+;;
+;;  Browsing the Thesaurus
+;;  ----------------------
+;;
+;;  Besides using command `synonyms' to search for synonyms, you can
+;;  use Synonyms to browse the thesaurus.  This is really just the
+;;  same thing, but key and mouse bindings are provided in buffer
+;;  *Synonyms*, so you need not input anything - just point and click
+;;  the hyperlinks.  Buffer *Synonyms* is in Synonyms major mode,
+;;  which provides a few additional features.
+;;
+;;  You can still choose to search for additional synonyms or append
+;;  search results, without bothering with a prefix argument, by using
+;;  modifier keys (Control, Meta) with a mouse click.
+;;
+;;  Another way of browsing is to revisit previous search-result
+;;  pages.  You can do this using commands `synonyms-history-backward'
+;;  and `synonyms-history-forward'.  In buffer *Synonyms*, these are
+;;  bound to the following key sequences, for convenience:
+;;
+;;    `l', `p', `mouse-4' - `synonyms-history-backward'
+;;    `r', `n', `mouse-5' - `synonyms-history-forward'
+;;
+;;  The `l' and `r' bindings correspond to the history bindings in
+;;  Info.  The `p' and `n' bindings stand for "previous" and "next".
+;;  The bindings to additional mouse buttons correspond to typical
+;;  bindings for Back and Forward in Web browsers.
+;;
+;;  In addition to these bindings, the same history commands can be
+;;  accessed by clicking links [Back] and [Forward] with `mouse-2'.
+;;
+;;  If you have previously used the append option (via, for example,
+;;  `M-mouse2'), so that there are multiple search results in buffer
+;;  *Synonyms*, then using a history command simply takes you to the
+;;  preceding (for [Back]) or following (for [Forward]) result in the
+;;  buffer, measured from the current cursor position.  Depending on
+;;  the cursor position, this might be different from the previous or
+;;  next search made previously.
+;;
+;;  This is for convenience, but it is also more efficient in the case
+;;  of a regexp search that takes a long time.  Except for this
+;;  special treatment of appended results, whenever you navigate the
+;;  search-results history you are actually searching again for a
+;;  synonym you sought previously.  The case of appended results is
+;;  analogous to accessing a Web browser cache when navigating the
+;;  history.
+;;
+;;  You can of course use modifier keys (Control, Meta) while you
+;;  click links [Back] and [Forward], to impose their usual behavior:
+;;  search for additional synonyms or append search results, or both.
+;;
+;;  Finally, some people prefer menus, so there is a Synonyms menu-bar
+;;  menu when you are in Synonyms mode, complete with all of the
+;;  functionalities described above.
+;;
+;;  For more information on the browsing possibilities in buffer
+;;  *Synonyms*, use `?' in Synonyms mode.
+;;
+;;
+;;  Dictionary Definitions, Antonyms, etc.
+;;  --------------------------------------
+;;
+;;  Synonyms works with a large but simple database of groups of words
+;;  and phrases that are synonyms of each other.  This database does
+;;  not provide definitions of words or phrases; it simply groups
+;;  them.  Command `synonym-definition' (aka `dictionary-definition')
+;;  lets you look up a word or phrase (or a regexp) using one or more
+;;  dictionaries on the Web.  That is usually the best source for this
+;;  kind of information, but you obviously need an Internet connection
+;;  to use this command.
+;;
+;;  Options (variables) `synonyms-dictionary-url' and
+;;  `synonyms-dictionary-alternate-url' are URLs you can set to point
+;;  to the dictionaries of your choice.  The default value of
+;;  `synonyms-dictionary-alternate-url' looks up the search term in
+;;  multiple dictionaries, and it lets you use wildcards.  Use `C-h v
+;;  synonyms-dictionary-alternate-url' for more information.  The
+;;  default value of `synonyms-dictionary-url' usually provides a
+;;  quicker answer.  Both of these URLs also give you access to
+;;  additional information about the search term (antonyms, etymology,
+;;  even pronunciation).
+;;
+;;  In buffer *Synonyms*, you can simply hit `d' followed by `RET' or
+;;  `mouse-2' to look up a term that is in the buffer.  Just as for
+;;  looking up a synonym by clicking `mouse-2', if you select text
+;;  (region), then that text is looked up.
+;;
+;;
+;;  A Cache File of Synonyms
+;;  ------------------------
+;;
+;;  The very first time you use Synonyms, a large list of synonyms
+;;  will be compiled and written to a cache file.  This is slow - it
+;;  takes 2-3 minutes - but it is only a one-time cost.  From then on,
+;;  whenever you first use Synonyms during an Emacs session, the cache
+;;  file will be read (quickly), to create the list of synonyms that
+;;  are used for minibuffer completion.
+;;
+;;
+;;  Using Other Thesauri, Dictionaries, and so on - CSV data
+;;  --------------------------------------------------------
+;;
+;;  There is nothing in library Synonyms that ties it to the Moby
+;;  Thesaurus II thesaurus.  All of its functionality will work with
+;;  any file of comma-separated values.  Each line of such a file is
+;;  interpreted as a synonym group, as understood here, and the first
+;;  word or phrase on each line is interpreted as a thesaurus entry,
+;;  as understood here.  This means only that search results are
+;;  organized into sections with entry headers.
+;;
+;;  If, for example, you had a CSV file of personal contacts, where
+;;  the first term in each line was a last name or a company name,
+;;  then you could use library Synonyms to query it, producing the
+;;  same kind of output as for the thesaurus.
+;;
+;;  One thing to keep in mind if you try to use library Synonyms with
+;;  a different CSV file is that there are several different CSV-file
+;;  syntaxes.  The one that Synonyms is built to use is a simple one,
+;;  with no quote marks around entries and no embedded quote marks
+;;  within entries.
+;;
+;;  Similarly, there is nothing here that limits the functionality to
+;;  English.  If you had a thesaurus in another language, it should
+;;  work as well.
+;;
+;;  Currently, Synonyms works with a single raw synonyms file
+;;  (thesaurus) and a corresponding single cache file (for
+;;  completion).  However, it would be easy to extend the
+;;  functionality to use multiple thesauri or, in general, multiple
+;;  CSV files.  Suggestions of requirements (e.g. ways to select a
+;;  thesaurus for particular passages of text) are welcome.
+ 
+;;
+;;
+;;  Things Defined Here
+;;  -------------------
+;;
+;;  Faces defined here -
+;;
+;;    `synonyms-heading', `synonyms-search-text',
+;;    `synonyms-mouse-face'.
+;;
+;;
+;;  User options (variables) defined here -
+;;
+;;    `synonyms-append-result-flag', `synonyms-cache-file',
+;;    `synonyms-file', `synonyms-fill-column',
+;;    `synonyms-match-more-flag', `synonyms-mode-hook',
+;;    `synonyms-use-cygwin-flag'.
+;;
+;;  Commands defined here -
+;;
+;;    `dictionary-definition', `synonyms', `synonyms-append-result',
+;;    `synonyms-append-result-no-read', `synonyms-definition',
+;;    `synonyms-definition-mouse', `synonyms-definition-no-read',
+;;    `synonyms-ensure-synonyms-read-from-cache',
+;;    `synonyms-history-backward', `synonyms-history-forward',
+;;    `synonyms-make-obarray', `synonyms-match-more',
+;;    `synonyms-match-more-no-read',
+;;    `synonyms-match-more+append-result',
+;;    `synonyms-match-more+append-result-no-read', `synonyms-mode',
+;;    `synonyms-mouse', `synonyms-mouse-append-result',
+;;    `synonyms-mouse-match-more',
+;;    `synonyms-mouse-match-more+append-result', `synonyms-no-read',
+;;    `synonyms-write-synonyms-to-cache'.
+;;
+;;  Non-interactive functions defined here -
+;;
+;;    `synonyms-action', `synonyms-add-history-links',
+;;    `synonyms-default-regexp', `synonyms-define-cache-file',
+;;    `synonyms-define-synonyms-file', `synonyms-format-entries',
+;;    `synonyms-format-entry', `synonyms-format-finish',
+;;    `synonyms-format-synonyms',
+;;    `synonyms-hack-backslashes-if-cygwin', `synonyms-lookup',
+;;    `synonyms-nearest-word', `synonyms-file-readable-p',
+;;    `synonyms-search-entries', `synonyms-search-synonyms',
+;;    `synonyms-show-synonyms', `synonyms-file-writable-p'.
+;;
+;;  Internal variables defined here -
+;;
+;;    `synonyms-history', `synonyms-history-forward',
+;;    `synonyms-list-for-obarray', `synonyms-mode-map',
+;;    `synonyms-obarray', `synonyms-search-text'.
+;;
+;;  Key bindings made here - see `synonyms-mode'.  All key bindings
+;;  are local to Synonyms mode; no global bindings are made here.
+ 
+;;
+;;
+;;  Acknowledgements
+;;  ----------------
+;;
+;;  The basic functionality provided here was derived from library
+;;  `mthesaur.el', by Tad Ashlock .  That
+;;  library, in turn, was inspired by library `thesaurus.el', by Ray
+;;  Nickson.  Thanks also to those who sent helpful bug reports.
+;;
+;;
+;;  Note on MS Windows Emacs 20 and Cygwin `grep'
+;;  ---------------------------------------------
+;;
+;;  There is apparently a bug in the Emacs (at least versions 20-22) C
+;;  code that implements function `call-process' on MS Windows.  When
+;;  using native Windows Emacs with Cygwin commands, such as `grep',
+;;  the C code removes a level of backslashes in some cases, so string
+;;  arguments supplied to `call-process' need to have twice as many
+;;  backslashes as they should need in those cases.  It is for this
+;;  reason that option `synonyms-use-cygwin-flag' is supplied here.
+;;  When that option is non-nil, backslashes in regexps are hacked to
+;;  do the right thing.  (In Emacs 20, this means doubling the
+;;  backslashes; in Emacs 21-22, this means doubling them unless there
+;;  are spaces in the search string.)
+;;
+;;
+;;  Maybe To Do?
+;;  ------------
+;;
+;;  1. It would be ideal to have not only synonym information but also
+;;     definitions, antonyms, more general and more specific terms,
+;;     filtering by part of speech (verb vs adjective etc.), and so
+;;     on.  A good example of what I'd really like to have is provided
+;;     by the free Windows program WordWeb (available here:
+;;     http://wordweb.info/).  Combining that functionality with
+;;     Icicles completion features would provide a great tool, IMO.
+;;
+;;     `synonyms-definition*' goes a long way toward providing this,
+;;     and perhaps it is the best way to go, since there is so much
+;;     more definitional info on the Web.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Change Log:
+;;
+;; 2012/08/21 dadams
+;;     Call tap-put-thing-at-point-props after load thingatpt+.el.
+;; 2012/08/18 dadams
+;;     Invoke tap-define-aliases-wo-prefix if thingatpt+.el is loaded.
+;; 2012/03/02 dadams
+;;     Require cl.el at compile time only for Emacs 20.
+;; 2011/07/30 dadams
+;;     Moved Icicles code to icicles-cmd2.el.  Removed soft-require of icicles.el.
+;; 2011/02/11 dadams
+;;     Better defaults for faces, for dark backgrounds.
+;; 2011/01/04 dadams
+;;     Added autoload cookies (for defgroup, defface, defcustom, and commands).
+;; 2010/08/20 dadams
+;;     synonyms - non-Icicles version: Made ARG optional too.
+;;     synonyms(-no-read|-history-(backward|forward)):
+;;       Use ARG, not current-prefix-arg.
+;; 2010/01/12 dadams
+;;     synonyms-history-(backward|forward): save-excursion + set-buffer -> with-current-buffer.
+;; 2007/12/05 dadams
+;;     synonyms-obarray: Removed * doc-string prefix.
+;; 2007/02/10 dadams
+;;     icicle-sort-case-insensitively -> icicle-case-insensitive-string-less-p.
+;; 2006/12/22 dadams
+;;     Renamed group synonyms to Synonyms.  :group 'icicles -> :group 'Icicles.
+;; 2006/03/31 dadams
+;;     synonyms-write-synonyms-to-cache: Use prin1 instead of pp.
+;; 2006/03/17 dadams
+;;     synonyms-file-(read|writ)able-p: Put non-empty string condition first.
+;; 2006/03/14 dadams
+;;     synonyms-file-(read|writ)able-p: Make sure also not a directory.
+;; 2006/03/12 dadams
+;;     synonyms-ensure-synonyms-read-from-cache, synonyms-define-synonyms-file:
+;;       Set synonyms(-cache)-file to expanded version.
+;; 2006/03/01 dadams
+;;     Updated Commentary to mention Icicles completion of synonyms.
+;; 2006/02/02 dadams
+;;     synonyms-define-cache-file: Fixed typo.
+;; 2006/01/28 dadams
+;;     synonyms-define-cache-file: wrap file-name-directory in expand-file-name.
+;; 2006/01/19 dadams
+;;     synonyms-format-finish: Minor tweak to regexp: space and tab, but not newline or formfeed.
+;; 2006/01/18 dadams
+;;     Added dictionary definition lookup:
+;;       Added: synonyms-dictionary(-alternate)-url, synonyms-definition*.
+;;       Bound synonyms-definition-*.
+;; 2006/01/14 dadams
+;;     Bug fixes -
+;;     Make sure file name is expanded (thanks to Nikos Apostolakis):
+;;       synonyms-search-(entries|synonyms): Expand file name.
+;;       synonyms-define-*-file: Set variable after expanding file name.
+;;       synonyms-format-entry, synonyms-history-*, synonyms-add-history-links:
+;;         Raise error if search finds nothing.
+;;     synonyms-hack-backslashes-if-cygwin: Don't double if spaces and not Emacs 20.
+;;       Renamed synonyms-double-backslashes-if-cygwin to synonyms-hack-backslashes-if-cygwin.
+;;     synonyms-mode-map: swapped bindings for C-mouse-2 and C-down-mouse-2, for Emacs 22.
+;; 2006/01/11 dadams
+;;     Fixed typo: require 'synonyms. (Thanks to Nikos Apostolakis.)
+;; 2006/01/07 dadams
+;;     Added :link.
+;; 2006/01/04 dadams
+;;     synonyms-format-finish: Don't skip numbered header, so highlight multiple synonyms in entry.
+;; 2006/01/02 dadams
+;;     Added: synonyms-define-cache-file, synonyms-define-synonyms-file,
+;;            synonyms-file-readable-p, synonyms-file-writable-p.
+;;     synonyms-make-obarray: Use synonyms-define-synonyms-file.
+;;                            Use synonyms-mode, to get modified syntax (bug fix).
+;;     synonyms-write-synonyms-to-cache: Use synonyms-define-cache-file.
+;;     synonyms-ensure-synonyms-read-from-cache: Use synonyms-file-readable-p.
+;;     synonyms(-cache)-file: Use empty string as initial value.
+;;     Thanks to Alex Schroeder [alex@emacswiki.org] for suggestion to prompt for file names.
+;; 2005/12/31 dadams
+;;     Added menu-bar Synonyms menu.
+;;     Renamed synonyms-read-synonyms-from-cache to synonyms-ensure-synonyms-read-from-cache.
+;;       Call it from synonyms, not from synonyms-mode.
+;;     Defined synonyms-mode-map per convention.
+;;     synonyms-match-more, synonyms-append-result, synonyms-match-more+append-result:
+;;       Use synonyms, not synonyms-no-read.
+;;     Added: synonyms-*-no-read.  Bound those, not the new read versions.
+;; 2005/12/29 dadams
+;;     Treat modifiers with clicks on [Back] and [Forward] links.
+;;     synonyms-history-(backward|forward): Add prefix arg.  Bind options.
+;;     synonyms-mode, synonyms-lookup: Disable undo.
+;; 2005/12/28 dadams
+;;     Added: synonyms-history-(backward|forward), synonyms-add-history-links, synonyms-link.
+;;     Added: [Back] and [Forward] links.
+;;     synonyms-show-synonyms: Put cursor on first synonym.
+;;     synonyms-mouse, synonyms-lookup: Removed save-excursion.
+;;     synonyms-mouse: Treat clicks on [Back] and [Forward] links too.
+;;     synonyms-format-finish: Added save-excursion for last part: filling and adding mouse-face.
+;;     synonyms-nearest-word: Remove text properties.
+;;     synonyms: Use synonym-action.
+;;     synonyms-lookup: When no synonyms found, remove search-text from history.
+;;     Require cl.el when compile.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth
+;; ;; Floor, Boston, MA 02110-1301, USA.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Code:
+
+(eval-when-compile (when (< emacs-major-version 21) (require 'cl))) ;; push, pop
+
+(require 'thingatpt nil t)  ;; (no error if not found): word-at-point
+(when (and (require 'thingatpt+ nil t);; (no error if not found): word-nearest-point
+           (fboundp 'tap-put-thing-at-point-props)) ; >= 2012-08-21
+  (tap-define-aliases-wo-prefix)
+  (tap-put-thing-at-point-props))
+
+;; Quiet the byte-compiler.
+(defvar appendp)                        ; Here.
+(defvar morep)                          ; Here.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+ 
+;;; Faces (alphabetical) -----------------------------------
+
+;;;###autoload
+(defgroup Synonyms nil
+  "Commands to look up synonyms in a thesaurus."
+  :prefix "synonyms-"
+  :group 'convenience :group 'help :group 'apropos :group 'matching
+  :link `(url-link :tag "Send Bug Report"
+          ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
+synonyms.el bug: \
+&body=Describe bug here, starting with `emacs -q'.  \
+Don't forget to mention your Emacs and library versions."))
+  :link '(url-link :tag "Other Libraries by Drew"
+          "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
+  :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/synonyms.el")
+  :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/Synonyms")
+  :link '(emacs-commentary-link :tag "Commentary" "synonyms"))
+
+;;;###autoload
+(defface synonyms-heading '((((background dark)) (:foreground "Yellow"))
+                            (t (:foreground "Blue")))
+  "*Face for different synonym types."
+  :group 'Synonyms :group 'faces)
+
+;;;###autoload
+(defface synonyms-search-text '((t (:foreground "Red")))
+  "*Face for the term whose synonyms were sought."
+  :group 'Synonyms :group 'faces)
+
+;;;###autoload
+(defface synonyms-link '((((background dark)) (:foreground "Yellow" :underline t))
+                         (t (:foreground "Blue" :underline t)))
+  "*Face for history links."
+  :group 'Synonyms :group 'faces)
+
+;;;###autoload
+(defface synonyms-mouse-face '((((background dark)) (:background "DarkCyan"))
+                               (t (:background "Cyan")))
+  "*Mouse face for the term whose synonyms were sought."
+  :group 'Synonyms :group 'faces)
+
+
+
+ 
+;;; User Options (alphabetical) ----------------------------
+
+;;;###autoload
+(defcustom synonyms-append-result-flag nil
+  "*t means that `synonyms' appends search result to previous results.
+No other value, besides t, has this effect.
+
+This can be overridden by using a negative prefix argument,
+for example, `M--'.  If you use `C-u C-u', then both this and
+`synonyms-match-more-flag' are overridden."
+  :type 'boolean :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-cache-file ""
+  "*Location to write cache file containing synonyms.
+Written to save the list of synonyms used for completion.
+This is an absolute (complete-path) location, including the file name."
+  :type '(file :must-match t) :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-file ""
+  "*Location of thesaurus file `mthesaur.txt'.
+This is an absolute (complete-path) location, including the file name."
+  :type '(file :must-match t) :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-fill-column 80
+  "*Synonyms* buffer text is wrapped (filled) to this many columns."
+  :type 'integer :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-match-more-flag nil
+  "*t means additional thesaurus entries can be matched by `synonyms'.
+No other value, besides t, has this effect.
+
+A value of t means two things:
+ 1) Input can match parts of synonyms, in addition to whole synonyms.
+ 2) All synonyms are shown, even if input matches a thesaurus entry.
+
+This can be overridden by using a positive prefix argument,
+  for example, `C-u'.  If you use `C-u C-u', then both this and
+`synonyms-append-result-flag' are overridden."
+  :type 'boolean :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-mode-hook nil
+  "*Normal hook run when entering Thesaurus mode."
+  :type 'hook :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-use-cygwin-flag nil
+  "*Non-nil means to double backslashes in arguments to `call-process'.
+There is apparently a bug in the Emacs (at least versions 20-22) C
+code that implements function `call-process' on MS Windows.  When
+using native Windows Emacs with Cygwin commands, such as `grep', the C
+code removes a level of backslashes, so string arguments supplied to
+`call-process' need to have twice as many backslashes as they should
+need.  If you are using Emacs on Windows and Cygwin `grep', then you
+probably will want to use a non-nil value for
+`synonyms-use-cygwin-flag'."
+  :type 'boolean :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-dictionary-url "http://dictionary.reference.com/search?q="
+  "*URL of a Web dictionary lookup.  Text to look up is appended to this.
+See also `synonyms-dictionaries-url'."
+  :type 'string :group 'Synonyms)
+
+;;;###autoload
+(defcustom synonyms-dictionary-alternate-url "http://www.onelook.com/?ls=b&w="
+  "*URL of a Web dictionary lookup.  Text to look up is appended to this.
+The default value, \"http://www.onelook.com/?ls=b&w=\" lets you use `?'
+and `*' as wildcards in the terms you look up.  These are not used as
+regexp wildcards, however.  `?' stands for any single character, and
+`*' stands for any sequence of characters.  In terms of regexp syntax,
+`?' here is equivalent to the regexp `.', and `*' is equivalent to the
+regexp `.*'.  See http://www.onelook.com/?c=faq#patterns for more
+information on the allowed wildcard patterns.
+See also `synonyms-dictionary-url'."
+  :type 'string :group 'Synonyms)
+ 
+;;; Internal variables (alphabetical) ----------------------
+
+(defvar synonyms-history nil "Minibuffer history list for thesaurus lookup.")
+
+(defvar synonyms-history-forward nil
+  "Minibuffer history list for thesaurus lookup using `synonyms-history-backward'.")
+
+(defvar synonyms-list-for-obarray nil "List of synonyms to be used for completion")
+
+(defvar synonyms-mode-map nil "Keymap for `synonyms-mode'.")
+
+(unless synonyms-mode-map
+  (let ((map  (make-sparse-keymap "Synonyms")))
+    (define-key map [(?d) (mouse-2)] 'synonyms-definition-mouse)
+    (define-key map "d\r"            'synonyms-definition-no-read)
+    (define-key map "s"              'synonyms)
+    (define-key map [S-return]       'synonyms)
+    (define-key map "\r"             'synonyms-no-read)
+    (define-key map [C-return]       'synonyms-match-more-no-read)
+    (define-key map [M-return]       'synonyms-append-result-no-read)
+    (define-key map [C-M-return]     'synonyms-match-more+append-result-no-read)
+    (define-key map [mouse-2]        'synonyms-mouse)
+    (define-key map [C-mouse-2]      'undefined)
+    (define-key map [C-down-mouse-2] 'synonyms-mouse-match-more) ; Get rid of `facemenu-mouse-menu'
+    (define-key map [M-mouse-2]      'synonyms-mouse-append-result)
+    (define-key map [C-M-mouse-2]    'synonyms-mouse-match-more+append-result)
+    (define-key map "l"              'synonyms-history-backward) ; As in Info
+    (define-key map "p"              'synonyms-history-backward) ; As in previous
+    (define-key map "r"              'synonyms-history-forward) ; As in Info
+    (define-key map "n"              'synonyms-history-forward) ; As in next
+    (define-key map [mouse-4]        'synonyms-history-backward)
+    (define-key map [mouse-5]        'synonyms-history-forward)
+    (define-key map " "              'scroll-up) ; SPC
+    (define-key map "\^?"            'scroll-down) ; DEL
+    (define-key map "?"              'describe-mode)
+    (define-key map "q"              'quit-window)
+    (define-key map [menu-bar]             (make-sparse-keymap))
+    (define-key map [menu-bar synonyms]    (cons "Synonyms" map))
+    (define-key map [synonyms-help]        '("Help" . describe-mode))
+    (define-key map [synonyms-separator-2] '("--"))
+    (define-key map [synonyms-next]        '("Show Next" . synonyms-history-forward))
+    (put 'synonyms-history-forward 'menu-enable 'synonyms-history-forward)
+    (define-key map [synonyms-previous]    '("Show Previous" . synonyms-history-backward))
+    (put 'synonyms-history-backward 'menu-enable '(and synonyms-history (cdr synonyms-history)))
+    (define-key map [synonyms-separator]   '("--"))
+    (define-key map [synonyms-more-append]
+      '("Find (Max), Append Results" . synonyms-match-more+append-result))
+    (define-key map [synonyms-append]
+      '("Find, Append Results" . synonyms-append-result))
+    (define-key map [synonyms-more]        '("Find (Max)" . synonyms-match-more))
+    (define-key map [synonyms-synonyms]    '("Find" . synonyms))
+    (setq synonyms-mode-map  map)))
+
+;; 103307 is the smallest prime > 103304, which is the number of synonyms.
+(defvar synonyms-obarray (make-vector 103307 0)
+  "Obarray of synonyms.  Used for completion.")
+
+(defvar synonyms-search-text nil "Current text being looked up (matched).")
+
+
+
+ 
+;;; Functions ----------------------------------------------
+
+;;;###autoload
+(define-derived-mode synonyms-mode text-mode "Synonyms"
+  "Major mode for browsing thesaurus entries (synonyms).
+Like Text mode but with these additional key bindings:
+
+ \\\\[synonyms-mouse],     \\[synonyms-no-read],     \\[synonyms] - \
+Look up synonyms for a word or phrase
+ \\[synonyms-mouse-match-more],   \\[synonyms-match-more]   - Like \\[synonyms-no-read], but \
+try to match more terms
+ \\[synonyms-mouse-append-result],   \\[synonyms-append-result]   - Like \\[synonyms-no-read], but \
+add result to previous result
+ \\[synonyms-mouse-match-more+append-result], \\[synonyms-match-more+append-result] - Like \
+\\[synonyms-match-more] and \\[synonyms-append-result] combined
+
+ \\[scroll-up] - Scroll down through the buffer of synonyms
+ \\[scroll-down] - Scroll up through the buffer of synonyms
+ \\[describe-mode]   - Display this help
+ \\[quit-window]   - Quit Synonyms mode
+
+Of the various key bindings that look up synonyms, the most flexible
+is \\[synonyms] - it prompts you for the search string to match.  This
+can be a regular expression (regexp).  The other lookup bindings are
+for convenience - just click.
+
+In Synonyms mode, Transient Mark mode is enabled.
+
+Options `synonyms-match-more-flag' and `synonyms-append-result-flag'
+affect synonym matching and the results.  For convenience, \\[synonyms-mouse-match-more],
+\\[synonyms-mouse-append-result], and \\[synonyms-mouse-match-more+append-result] \
+toggle the effect of those options for the
+duration of the command.
+
+Note that even though Synonyms mode is similar to Text mode, buffer
+`*Synonyms*' is read-only, by default - use `C-x C-q' to toggle.
+
+Turning on Synonyms mode runs the normal hooks `text-mode-hook' and
+`synonyms-mode-hook' (in that order)."
+
+  ;; Synonyms to account for:
+  ;; `$', `1', `0': $100-a-plate dinner; `2': catch-22, V-2; `3': 3-D; `9': strontium 90.
+  ;; To match `$', you will of course need to escape it: `\$'.
+  (modify-syntax-entry ?- "w" synonyms-mode-syntax-table) ; Make hyphen (-) a word character.
+  (modify-syntax-entry ?1 "w" synonyms-mode-syntax-table) ; Make numerals 1,2,3,9,0 word characters.
+  (modify-syntax-entry ?2 "w" synonyms-mode-syntax-table)
+  (modify-syntax-entry ?3 "w" synonyms-mode-syntax-table)
+  (modify-syntax-entry ?9 "w" synonyms-mode-syntax-table)
+  (modify-syntax-entry ?0 "w" synonyms-mode-syntax-table)
+  (modify-syntax-entry ?$ "w" synonyms-mode-syntax-table) ; Make dollar ($) a word character.
+  (buffer-disable-undo)
+  (setq fill-column  synonyms-fill-column)
+  (set (make-local-variable 'transient-mark-mode) t))
+
+;;;###autoload
+(defun synonyms-ensure-synonyms-read-from-cache ()
+  "Ensure synonyms are in `synonyms-obarray', from `synonyms-cache-file'.
+If this file does not yet exist, then it and the obarray are created.
+Creating the obarray for the first time takes 2-3 minutes.
+This does nothing if the obarray is already complete."
+  (interactive)
+  (unless (intern-soft "synonym" synonyms-obarray) ; Do nothing if already complete.
+    (setq synonyms-list-for-obarray  () ; Just to make sure.
+          synonyms-cache-file        (expand-file-name synonyms-cache-file))
+    (if (synonyms-file-readable-p synonyms-cache-file)
+        (let ((list-buf  (find-file-noselect synonyms-cache-file 'nowarn 'raw))
+              (obarray   synonyms-obarray))
+          (unwind-protect
+               (setq synonyms-list-for-obarray  (read list-buf))
+            (kill-buffer list-buf)))
+      (synonyms-make-obarray)           ; Create obarray from scratch
+      (synonyms-write-synonyms-to-cache)))) ; and write it out, for next time.
+
+;;;###autoload
+(defun synonyms-make-obarray ()
+  "Fill `synonyms-obarray' with the available synonyms."
+  (interactive)
+  (unless (intern-soft "synonym" synonyms-obarray) ; Do nothing if already complete.
+    (synonyms-define-synonyms-file)
+    (with-temp-message "Building synonyms list for completion.  This will take a few minutes..."
+      (let ((thesaurus-buf  (find-file-noselect synonyms-file 'nowarn 'raw))
+            synonym)
+        (unwind-protect
+             (save-current-buffer
+               (set-buffer thesaurus-buf)
+               (goto-char (point-min))
+               (synonyms-mode)          ; To use the modified syntax table.
+               (while (re-search-forward "\\(\\(\\w\\|[ ]\\)+\\)\\(,\\|$\\)" nil t)
+                 (setq synonym  (buffer-substring (match-beginning 1) (match-end 1)))
+                 (intern synonym synonyms-obarray)))
+          (kill-buffer thesaurus-buf))))))
+
+(defun synonyms-define-synonyms-file ()
+  "Prompt user to define `synonyms-file', unless it is readable."
+  (setq synonyms-file  (expand-file-name synonyms-file))
+  (unless (synonyms-file-readable-p synonyms-file)
+    (while (not (synonyms-file-readable-p synonyms-file))
+      (setq synonyms-file  (read-file-name "Thesaurus file: " nil nil 'confirm "mthesaur.txt")))
+    (custom-set-variables (list 'synonyms-file
+                                (setq synonyms-file  (expand-file-name synonyms-file))
+                                'now))))
+
+;;;###autoload
+(defun synonyms-write-synonyms-to-cache ()
+  "Write synonyms in `synonyms-obarray' to file `synonyms-cache-file'."
+  (interactive)
+  (synonyms-define-cache-file)
+  (with-temp-message "Writing synonyms cache file..."
+    (with-temp-file synonyms-cache-file
+      (mapatoms (lambda (symb) (push symb synonyms-list-for-obarray)) synonyms-obarray)
+      (prin1 synonyms-list-for-obarray (current-buffer)))))
+
+(defun synonyms-define-cache-file ()
+  "Prompt user to define `synonyms-cache-file', unless it is writable."
+  (unless (synonyms-file-writable-p synonyms-cache-file)
+    (while (not (synonyms-file-writable-p synonyms-cache-file))
+      (setq synonyms-cache-file
+            (read-file-name "Cache file: "
+                            (expand-file-name (file-name-directory synonyms-file)) nil nil
+                            (concat (file-name-nondirectory synonyms-file) ".cache"))))
+    (custom-set-variables (list 'synonyms-cache-file
+                                (setq synonyms-cache-file  (expand-file-name synonyms-cache-file))
+                                'now))))
+
+(defun synonyms-file-readable-p (file)
+  "Return non-nil if FILE (a string) names a readable file."
+  (and (not (string= "" file)) (file-readable-p file) (not (file-directory-p file))))
+
+(defun synonyms-file-writable-p (file)
+  "Return non-nil if FILE (a string) names a writable file."
+  (and (not (string= "" file)) (file-writable-p file) (not (file-directory-p file))))
+
+(defun synonyms (&optional arg regexp)
+  "Show synonyms that match a regular expression (e.g. a word or phrase).
+You are prompted for the regexp.  By default, it is the text
+of the region, if it is active and `transient-mark-mode' is enabled,
+or the nearest word to the cursor, if not.
+
+Option `synonyms-match-more-flag' non-nil means additional thesaurus
+  entries can be matched.  This can be more time-consuming.  It means
+  two things:
+
+  1) Input can match parts of synonyms, in addition to whole synonyms.
+  2) All synonyms are shown, even if input matches a thesaurus entry.
+
+Option `synonyms-append-result-flag' non-nil means to append search
+  result to previous results.
+
+A prefix argument toggles the meaning of each of those options for the
+duration of the command:
+
+  If `C-u' or `C-u C-u', then toggle `synonyms-match-more-flag'.
+  If negative or `C-u C-u', then toggle `synonyms-append-result-flag'.
+
+\(`C-u C-u' thus means toggle both options.)
+
+When called from Lisp, optional second argument REGEXP is the regexp
+to match (no prompting)."
+  (interactive "P")
+  (synonyms-ensure-synonyms-read-from-cache) ; Fill `synonyms-obarray', for use in completion.
+  (let* ((num-arg              (prefix-numeric-value arg))
+         (morep                (eq synonyms-match-more-flag (atom arg)))
+         (appendp              (eq synonyms-append-result-flag (and (wholenump num-arg)
+                                                                    (/= 16 num-arg))))
+         (default-search-text  (or regexp (synonyms-default-regexp)))
+         (search-text          (or regexp
+                                   (let ((case-fold-search  t)) ; Case-insensitive completion.
+                                     (completing-read
+                                      "Show synonyms for word or phrase (regexp): "
+                                      synonyms-obarray nil nil nil 'synonyms-history
+                                      default-search-text)))))
+    (synonyms-action search-text)))
+
+(defun synonyms-action (search-text)
+  "Helper function for command `synonyms'.
+APPENDP and MOREP are free here."
+  (setq synonyms-search-text  search-text) ; Save it.
+  (when (string= "" search-text) (error "No text to look up"))
+  (unless (member search-text synonyms-history) (push search-text synonyms-history))
+  ;; Change `.' to `[^,]' in `search-text', so we don't mix terms.
+  (setq search-text  (replace-regexp-in-string "\\." "[^,]" search-text nil t))
+  (synonyms-lookup search-text (and (boundp 'appendp) appendp) (and (boundp 'morep) morep)))
+
+;;;###autoload
+(defun synonyms-no-read (arg)
+  "Same as command `synonyms', but uses the default input text (regexp)."
+  (interactive "P")
+  (let* ((num-arg      (prefix-numeric-value arg))
+         (morep        (eq synonyms-match-more-flag (atom arg)))
+         (appendp      (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg))))
+         (search-text  (synonyms-default-regexp)))
+    (setq synonyms-search-text  search-text) ; Save it.
+    (when (string= "" search-text) (error "No text to look up"))
+    (unless (member search-text synonyms-history) (push search-text synonyms-history))
+    ;; Change `.' to `[^,]' in `search-text', so we don't mix terms.
+    (setq search-text  (replace-regexp-in-string "\\." "[^,]" search-text nil t))
+    (synonyms-lookup search-text appendp morep)))
+
+;;;###autoload
+(defun synonyms-match-more ()
+  "Same as using `synonyms' with `synonyms-match-more-flag' = t."
+  (interactive)
+  (let ((synonyms-match-more-flag  t))
+    (synonyms)))
+
+;;;###autoload
+(defun synonyms-match-more-no-read (arg)
+  "Same as using `synonyms' with `synonyms-match-more-flag' = t."
+  (interactive "P")
+  (let ((synonyms-match-more-flag  t))
+    (synonyms-no-read arg)))
+
+;;;###autoload
+(defun synonyms-append-result ()
+  "Same as using `synonyms' with `synonyms-append-result-flag' = t."
+  (interactive)
+  (let ((synonyms-append-result-flag  t))
+    (synonyms)))
+
+;;;###autoload
+(defun synonyms-append-result-no-read (arg)
+  "Same as using `synonyms' with `synonyms-append-result-flag' = t."
+  (interactive "P")
+  (let ((synonyms-append-result-flag  t))
+    (synonyms-no-read arg)))
+
+;;;###autoload
+(defun synonyms-match-more+append-result ()
+  "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
+  (interactive)
+  (let ((synonyms-match-more-flag     t)
+        (synonyms-append-result-flag  t))
+    (synonyms)))
+
+;;;###autoload
+(defun synonyms-match-more+append-result-no-read (arg)
+  "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
+  (interactive "P")
+  (let ((synonyms-match-more-flag     t)
+        (synonyms-append-result-flag  t))
+    (synonyms-no-read arg)))
+
+;;;###autoload
+(defun synonyms-mouse (event arg)
+  "Show synonyms that match a regular expression (e.g. a word or phrase).
+The regexp to match is the synonym or region clicked with mouse-2.  If
+the region is active, but a synonym elsewhere is clicked, that synonym
+is used, not the selected text.
+
+You can either click a listed synonym, to see its synonyms, or select
+one or more words and click the selection, to see matching synonyms.
+To quickly select a series of words: double-click mouse-1 to select
+the first word, then click mouse-3 to extend the selection to the last
+word.
+
+Selection is useful when you want to see synonyms of a similar term.
+For example, instead of clicking the listed synonym `bleeding heart', you
+might select `heart' and click that.
+
+The prefix argument acts the same as for command `synonyms'.
+
+If you click a history link with mouse-2, previously retrieved search
+results are revisited."
+  (interactive "e\nP")
+  (set-buffer (window-buffer (posn-window (event-end event))))
+  (let ((beg     (region-beginning))
+        (end     (region-end))
+        (active  mark-active))
+    (goto-char (posn-point (event-end event)))
+    (cond ((get-text-property (point) 'back-link) (synonyms-history-backward nil))
+          ((get-text-property (point) 'forward-link) (synonyms-history-forward nil))
+          (t (if (and active (> (point) beg) (< (point) end))
+                 (goto-char end)
+               (deactivate-mark))       ; User did not click inside region, so deactivate it.
+             (synonyms-no-read arg)))))
+
+;;;###autoload
+(defun synonyms-mouse-match-more (event arg)
+  "Same as `synonyms-mouse' with `synonyms-match-more-flag' = t."
+  (interactive "e\nP")
+  (let ((synonyms-match-more-flag  t))
+    (synonyms-mouse event arg)))
+
+;;;###autoload
+(defun synonyms-mouse-append-result (event arg)
+  "Same as `synonyms-mouse' with `synonyms-append-result-flag' = t."
+  (interactive "e\nP")
+  (let ((synonyms-append-result-flag  t))
+    (synonyms-mouse event arg)))
+
+;;;###autoload
+(defun synonyms-mouse-match-more+append-result (event arg)
+  "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
+  (interactive "e\nP")
+  (let ((synonyms-match-more-flag     t)
+        (synonyms-append-result-flag  t))
+    (synonyms-mouse event arg)))
+
+(defun synonyms-default-regexp ()
+  "Return the default regexp for `synonym' and `synonyms-mouse'.
+If the region is active in `transient-mark-mode', use its text.
+Else, if this is *Synonyms* buffer, use the synonym under the cursor.
+Else use the word nearest the cursor.
+
+An active region has no effect except in `transient-mark-mode'."
+  (if (and mark-active transient-mark-mode) ; Use region text, if active.
+      (buffer-substring-no-properties (point) (mark))
+    (if (eq major-mode 'synonyms-mode)  ; Use mouse-face text, if in synonyms-mode.
+        (let (beg end)
+          (when (and (not (eobp)) (get-text-property (point) 'mouse-face))
+            (setq end  (point)
+                  beg  (1+ (point))))
+          (when (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
+            (setq end  (1- (point))
+                  beg  (point)))
+          (if (null beg)
+              (synonyms-nearest-word)   ; Punt - no mouse-face, for some reason.
+            (setq beg  (previous-single-property-change beg 'mouse-face)
+                  end  (or (next-single-property-change end 'mouse-face) (point-max)))
+            (replace-regexp-in-string   ; Replace newlines with spaces, except at the
+             "\\(^ \\| $\\)" ""         ; beginning and end.
+             (replace-regexp-in-string "[\n]" " " (buffer-substring-no-properties beg end) nil t)
+             nil t)))
+      (synonyms-nearest-word))))
+
+(defun synonyms-nearest-word ()
+  "Word nearest the cursor."
+  (let ((word  (if (fboundp 'word-nearest-point)
+                   (word-nearest-point) ; In `thingatpt+.el'.
+                 (word-at-point))))     ; In `thingatpt.el'.
+    (set-text-properties 0 (length word) nil word) ; Remove all text properties.
+    word))
+
+(defun synonyms-lookup (search-text appendp morep)
+  "Search the thesaurus for SEARCH-TEXT.
+APPEND-P non-nil means to append search result to previous results.
+MORE-P non-nil means additional thesaurus entries can be matched."
+  (save-selected-window
+    (with-temp-message
+        (format "Looking up %s synonyms for \"%s\"%s..." (if morep "(max)" "")
+                (replace-regexp-in-string (regexp-quote "[^,]") "." search-text nil t)
+                (if appendp " (appending)" ""))
+      (let ((temp-buf  (generate-new-buffer " *Temp*")))
+        (unwind-protect
+             (progn
+               (set-buffer temp-buf)
+               (buffer-disable-undo)    ; Make sure (should already be, because of *Temp* name).
+               (erase-buffer)
+               (let ((entry-p  (synonyms-search-entries search-text temp-buf morep)))
+                 ;; For `morep' search, we don't stop even if we find an entry.
+                 (unless (if morep
+                             (or (synonyms-search-synonyms search-text temp-buf t) entry-p)
+                           (or entry-p (synonyms-search-synonyms search-text temp-buf nil)))
+                   (pop synonyms-history) ; Remove it from search history, so we don't try again.
+                   (error "No synonyms found for `%s'" search-text))
+                 (let ((results-buf  (get-buffer-create "*Synonyms*")))
+                   (synonyms-format-synonyms search-text morep)
+                   (synonyms-show-synonyms temp-buf results-buf appendp)
+                   (message nil))))
+          (kill-buffer temp-buf))))))
+
+(defun synonyms-search-entries (search-text buf morep)
+  "Search thesaurus entries (headings) for SEARCH-TEXT.
+Put result in buffer BUF.
+MORE-P non-nil means additional thesaurus entries can be matched."
+  (call-process "grep" nil buf nil "-i" (synonyms-hack-backslashes-if-cygwin
+                                         (if morep
+                                             (format "^\\w*%s\\w*," search-text)
+                                           (format "^%s," search-text)))
+                (expand-file-name synonyms-file))
+  (not (zerop (count-lines (point-min) (point-max)))))
+
+(defun synonyms-search-synonyms (search-text buf morep)
+  "Search thesaurus body for SEARCH-TEXT.
+SEARCH-TEXT is a regexp that can match any part of a thesaurus term.
+Put result in buffer BUF.
+MORE-P non-nil means additional thesaurus entries can be matched."
+  (call-process "grep" nil buf nil "-i" (synonyms-hack-backslashes-if-cygwin
+                                         (if morep
+                                             (format ",\\w*%s\\w*\\(,\\|$\\)" search-text)
+                                           (format ",%s\\(,\\|$\\)" search-text)))
+                (expand-file-name synonyms-file))
+  (not (zerop (count-lines (point-min) (point-max)))))
+
+(defun synonyms-hack-backslashes-if-cygwin (string)
+  "Double each backslash in STRING, unless it contains SPC characters.
+More precisely, if `synonyms-use-cygwin-flag' is non-nil and this is
+Emacs 20 or there are no spaces in STRING, then double any backslashes
+in STRING.
+
+This is an ugly hack made necessary because of bugs in Emacs C code."
+  (when (and synonyms-use-cygwin-flag
+             (or (= emacs-major-version 20) (not (string-match " " string))))
+    (setq string  (replace-regexp-in-string "[\\]" "\\\\" string nil t)))
+  string)
+
+(defun synonyms-format-synonyms (search-text morep)
+  "Format synonyms that match SEARCH-TEXT.
+MORE-P non-nil means additional thesaurus entries can be matched."
+  (goto-char (point-min))
+  (let ((entries-count  (count-lines (point-min) (point-max))))
+    (if (= entries-count 1)
+        (synonyms-format-entry search-text t morep)
+      (synonyms-format-entries search-text entries-count morep))
+    (synonyms-format-finish search-text morep)))
+
+(defun synonyms-format-entry (search-text single-p morep)
+  "Format a single thesaurus entry that matches SEARCH-TEXT.
+SINGLE-P non-nil means there is only one entry."
+  (beginning-of-line)
+  (let ((beg      (point))
+        (orig     (if morep             ; Use saved search text.
+                      (format "\\w*\\(%s\\)\\w*" synonyms-search-text)
+                    (format "\\(%s\\)" synonyms-search-text)))
+        (entry-p  nil)
+        term end)
+    (when single-p (insert "Synonyms for "))
+    (setq term  (point))
+    (when (looking-at orig) (setq entry-p t))
+    (unless (search-forward "," nil t) (error "Bad thesaurus file - no commas"))
+    (setq end  (match-beginning 0))
+    (replace-match ":\n\n" nil t)
+    (cond (single-p
+           (add-text-properties beg term '(face synonyms-heading))
+           (add-text-properties term end (if entry-p
+                                             '(face synonyms-search-text
+                                               mouse-face synonyms-mouse-face)
+                                           '(face synonyms-heading)))
+           (add-text-properties end (+ 2 end) '(face synonyms-heading)))
+          (t
+           (add-text-properties beg (1+ end) '(face synonyms-heading))
+           (save-excursion
+             (forward-line -2)
+             (save-restriction
+               (narrow-to-region (point) (save-excursion (end-of-line) (backward-char) (point)))
+               (unless (search-forward ". " nil t)
+                 (error "Badly formatted numeric entry - no period"))
+               (add-text-properties (point) (point-max) '(mouse-face synonyms-mouse-face))
+               (when (looking-at orig)
+                 (add-text-properties (match-beginning 1) (match-end 1)
+                                      '(face synonyms-search-text)))))))
+    (forward-line)))
+
+(defun synonyms-format-entries (search-text entries-count morep)
+  "Format thesaurus entries that have synonyms matching SEARCH TEXT.
+ENTRIES-COUNT is the number of entries.
+MORE-P non-nil means additional thesaurus entries can be matched."
+  (let ((countdown  entries-count)
+        (beg        (point))
+        (part1      "Synonyms for ")
+        (part2      ":\n"))
+    (insert part1 synonyms-search-text part2)
+    (add-text-properties beg (setq beg  (+ beg (length part1))) '(face synonyms-heading))
+    (add-text-properties beg (setq beg  (+ beg (length synonyms-search-text)))
+                         '(face synonyms-search-text mouse-face synonyms-mouse-face))
+    (add-text-properties beg (+ beg (length part2)) '(face synonyms-heading))
+    (while (> countdown 0)
+      (setq countdown  (1- countdown))
+      (insert (format "\n\%s. " (- entries-count countdown)))
+      (synonyms-format-entry search-text nil morep))))
+
+(defun synonyms-format-finish (search-text morep)
+  "Finish formatting synonyms matching SEARCH-TEXT.
+MORE-P non-nil means additional thesaurus entries can be matched."
+  ;; Put a space after each comma.
+  (goto-char (point-min))
+  (forward-line)                        ; First line might have [^,] in it.
+  (while (search-forward "," nil t) (replace-match ", " nil t))
+  (goto-char (point-min))
+  (let ((case-fold-search       t)
+        (new-search-text        (if morep
+                                    (format "\\(^\\|, \\)\\w*\\(%s\\)\\w*\\($\\|,\\)" search-text)
+                                  (format "\\(^\\|, \\)\\(%s\\)\\($\\|,\\)" search-text)))
+        (no-numbered-headers-p  (not (re-search-forward "^[0-9]+[.]" nil t))))
+    (goto-char (point-min))
+    (forward-line)
+    (while (re-search-forward new-search-text nil t)
+      (add-text-properties (match-beginning 2) (match-end 2) '(face synonyms-search-text))
+      (goto-char (match-end 2)))
+    ;; Do `synonyms-mode' here too, so hyphen will be a word char.
+    ;; IS THERE A WAY TO DO A LET to change the syntax of hyphen, instead of entering mode?
+    (synonyms-mode)
+    (save-excursion
+      (goto-char (point-min))
+      (forward-line)
+      (while (re-search-forward "\\(^\\|, \\)\\(\\(\\w\\|[\\t ]\\)+\\)\\($\\|,\\)" nil t)
+        (add-text-properties (match-beginning 2) (match-end 2) '(mouse-face synonyms-mouse-face))
+        (goto-char (match-end 2)))
+      (fill-region (point-min) (point-max)))
+    (synonyms-add-history-links)))
+
+(defun synonyms-add-history-links ()
+  "Add Back and Forward chronological navigation links"
+  (save-excursion
+    (unless (re-search-backward "Synonyms for") (error "No \"Synonyms for\" text"))
+    (end-of-line)
+    (insert (make-string (- fill-column 16 (point)) ?\ ) "[")
+    (let ((beg      (point))
+          (Back     "Back")
+          (spacer   "]  [")
+          (Forward  "Forward"))
+      (insert Back)
+      (add-text-properties beg (point)
+                           '(face synonyms-link mouse-face synonyms-mouse-face back-link t
+                             help-echo "mouse-2, RET: Go backward in synonyms search history"))
+      (insert spacer Forward)
+      (add-text-properties (+ beg (length Back) (length spacer)) (point)
+                           '(face synonyms-link mouse-face synonyms-mouse-face forward-link t
+                             help-echo "mouse-2, RET: Go forward in synonyms search history"))
+      (insert "]"))))
+
+(defun synonyms-show-synonyms (temp-buf results-buf appendp)
+  "Display search results from buffer TEMP-BUF in buffer RESULTS-BUF.
+If APPEND-P is non-nil and RESULTS-BUF is not empty, then insert a
+separator line between previous search results and the current results."
+  (set-buffer results-buf)
+  (setq buffer-read-only  nil)
+  (unless (= (point-min) (point-max))
+    (if (not appendp)
+        (erase-buffer)
+      (goto-char (point-max))
+      (let ((beg  (point)))
+        (insert "\n" (make-string (1- (window-width)) ?_) "\n\n\n")
+        (add-text-properties beg (point) '(face synonyms-heading)))))
+  (let ((start-result  (point)))
+    (insert-buffer temp-buf)
+    (select-window (display-buffer results-buf))
+    (goto-char start-result)
+    (forward-line 2)                    ; Put cursor on first synonym.
+    (when (looking-at "^[0-9]. ") (goto-char (match-end 0)))
+    (recenter 2)
+    (synonyms-mode)
+    (setq buffer-read-only  t)))
+
+;;;###autoload
+(defun synonyms-history-backward (arg)
+  "Run `synonyms' on a previous argument, moving backward in the history.
+A prefix argument has the same meaning as for command `synonyms'."
+  (interactive "P")
+  (unless (cdr synonyms-history) (error "Cannot move backward in history"))
+  (push (pop synonyms-history) synonyms-history-forward) ; Put current on forward list.
+  (let* ((num-arg  (prefix-numeric-value arg))
+         (morep    (eq synonyms-match-more-flag (atom arg)))
+         (appendp  (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg)))))
+
+    ;; Visit last.  If *Synonyms* has appended search results, go to the previous one, from (point).
+    (if (not (get-buffer "*Synonyms*"))
+        (synonyms-action (car synonyms-history))
+      (let ((divider  (with-current-buffer "*Synonyms*" (re-search-backward "^___" nil t))))
+        (if (not divider)
+            (synonyms-action (car synonyms-history))
+          (set-buffer "*Synonyms*")
+          (goto-char divider)
+          (unless (re-search-backward "^Synonyms for \\([^:]+\\):" nil t)
+            (error "Cannot find previous synonyms page"))
+          (goto-char (match-beginning 1))
+          (recenter 0)
+          (message "%s" (buffer-substring (match-beginning 1) (match-end 1))))))))
+
+;;;###autoload
+(defun synonyms-history-forward (arg)
+  "Run `synonyms' on a previous argument, moving forward in the history.
+A prefix argument has the same meaning as for command `synonyms'."
+  (interactive "P")
+  (unless synonyms-history-forward (error "Cannot move forward in history"))
+  (push (pop synonyms-history-forward) synonyms-history) ; Put current on backward list.
+  (let* ((num-arg  (prefix-numeric-value arg))
+         (morep    (eq synonyms-match-more-flag (atom arg)))
+         (appendp  (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg)))))
+
+    ;; Visit current.  If *Synonyms* has appended search results, go to the next one, from (point).
+    (if (not (get-buffer "*Synonyms*"))
+        (synonyms-action (car synonyms-history))
+      (let ((divider  (with-current-buffer "*Synonyms*" (re-search-forward "^___" nil t))))
+        (if (not divider)
+            (synonyms-action (car synonyms-history))
+          (set-buffer "*Synonyms*")
+          (goto-char divider)
+          (unless (re-search-forward "^Synonyms for \\([^:]+\\):" nil t)
+            (error "Cannot find next synonyms page"))
+          (goto-char (match-beginning 1))
+          (recenter 0)
+          (message "%s" (buffer-substring (match-beginning 1) (match-end 1))))))))
+
+;;;###autoload
+(defalias 'dictionary-definition 'synonyms-definition)
+;;;###autoload
+(defun synonyms-definition (search-text alternate-p)
+  "Look up the definition of a word or phrase using online dictionaries.
+The dictionary used is `synonyms-dictionary-url'.
+With prefix arg, look up the definition in the alternate dictionary,
+`synonyms-dictionary-alternate-url'."
+  (interactive (list (completing-read "Look up definition of word or phrase (regexp): "
+                                      synonyms-obarray nil nil nil 'synonyms-history
+                                      (synonyms-default-regexp))
+                     current-prefix-arg))
+  (synonyms-ensure-synonyms-read-from-cache) ; Fill `synonyms-obarray', for use in completion.
+  (browse-url (concat  (if alternate-p synonyms-dictionary-alternate-url synonyms-dictionary-url)
+                       search-text)))
+
+;;;###autoload
+(defun synonyms-definition-no-read (alternate-p)
+  "Look up the definition of a word or phrase using online dictionaries.
+The dictionary used is `synonyms-dictionary-url'.
+With prefix arg, look up the definition in the alternate dictionary,
+`synonyms-dictionary-alternate-url'."
+  (interactive "P")
+  (synonyms-definition (synonyms-default-regexp) alternate-p))
+
+;;;###autoload
+(defun synonyms-definition-mouse (event alternate-p)
+  "Look up the definition of a word or phrase using online dictionaries.
+The dictionary used is `synonyms-dictionary-url'.
+With prefix arg, look up the definition in the alternate dictionary,
+`synonyms-dictionary-alternate-url'."
+  (interactive "e\nP")
+  (set-buffer (window-buffer (posn-window (event-end event))))
+  (let ((beg     (region-beginning))
+        (end     (region-end))
+        (active  mark-active))
+    (goto-char (posn-point (event-end event)))
+    (cond ((get-text-property (point) 'back-link) (synonyms-history-backward nil))
+          ((get-text-property (point) 'forward-link) (synonyms-history-forward nil))
+          (t (if (and active (> (point) beg) (< (point) end))
+                 (goto-char end)
+               (deactivate-mark))       ; User did not click inside region, so deactivate it.
+             (synonyms-definition (synonyms-default-regexp) alternate-p)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide 'synonyms)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; synonyms.el ends here
diff --git a/lisp/template.el b/lisp/template.el
new file mode 100644
index 00000000..ea36c4b5
--- /dev/null
+++ b/lisp/template.el
@@ -0,0 +1,2609 @@
+;;; template.el --- use templates, decorate comments, auto-update buffers
+
+;; Copyright (C) 1995-2003 Free Software Foundation, Inc.
+;;
+;; Author: Christoph Wedler 
+;; Version: (see `template-version' below)
+;; Keywords: template, comment decoration, auto-updating, data, tools
+;; X-URL: http://emacs-template.sourceforge.net/
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; When you create a new file with Emacs, package Template supplies an initial
+;; buffer content via a template: a file with normal text and expansion
+;; forms. There is a menu to easily create such templates. You can also use new
+;; commands to decorate comments and update the buffer contents.
+
+;; The main difference between Template and other similar packages is that you
+;; can define very flexible templates without having to learn Lisp or changing
+;; your Emacs init file. This package does not help Lisp programmers to define
+;; complex macros.
+
+;; For details, check  or, if you
+;; prefer the manual style, the documentation of the following commands and
+;; variables:
+;;
+;;  * for templates: \\[template-new-file], `template-auto-insert',
+;;    `template-derivation-alist', `template-default-expansion-alist' and
+;;    `template-definition-start',
+;;  * for comment decoration: \\[template-single-comment] and
+;;    \\[template-block-comment], `template-comment-specification-alist'
+;;  * for updating: \\[template-update-buffer], `template-auto-update',
+;;    `template-update-buffer-alist' and `template-header-regexp-alist'.
+
+;; Bug fixes, bug reports, improvements, and suggestions for the newest version
+;; are strongly appreciated.
+
+;;; Installation:
+
+;; This file requires Emacs-20.2, XEmacs-20.2 or higher.
+
+;; Put this file into your load-path and the following into your ~/.emacs:
+;;   (require 'template)
+;;   (template-initialize)
+
+;; You might want to add another item to the "File" menu by (in XEmacs):
+;;   (add-menu-button '("File")
+;;		      ["Insert and Expand Template..."
+;;                     template-expand-template
+;;                     :active (not buffer-read-only)]
+;;		      "Insert File...")
+
+;; To customize, use `M-x customize-group RET template RET' or the customize
+;; entry in menu Options.
+
+;;; Code:
+
+(provide 'template)
+(require 'custom)
+
+;; General Emacs/XEmacs-compatibility compile-time macros
+(eval-when-compile
+  (require 'cl)
+  (defmacro cond-emacs-xemacs (&rest args)
+    (cond-emacs-xemacs-macfn
+     args "`cond-emacs-xemacs' must return exactly one element"))
+  (defun cond-emacs-xemacs-macfn (args &optional msg)
+    (if (atom args) args
+      (and (eq (car args) :@) (null msg) ; (:@ ...spliced...)
+	   (setq args (cdr args)
+		 msg "(:@ ....) must return exactly one element"))
+      (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS))
+	    (mode :BOTH) code)
+	(while (consp args)
+	  (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args)))
+	  (if (atom args)
+	      (or args (error "Used selector %s without elements" mode))
+	    (or (eq ignore mode)
+		(push (cond-emacs-xemacs-macfn (car args)) code))
+	    (pop args)))
+	(cond (msg (if (or args (cdr code)) (error msg) (car code)))
+	      ((or (null args) (eq ignore mode)) (nreverse code))
+	      (t (nconc (nreverse code) args))))))
+  ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use
+  ;; existing functions when they are `fboundp', provide shortcuts if they are
+  ;; known to be defined in a specific Emacs branch (for short .elc)
+  (defmacro defunx (name arglist &rest definition)
+    (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses first)
+      (while (memq (setq first (car definition))
+		   '(:try :emacs-and-try :xemacs-and-try
+			  :emacs-only :xemacs-only))
+	(if (memq first (if xemacsp
+			    '(:xemacs-and-try :xemacs-only)
+			  '(:emacs-and-try :emacs-only)))
+	    (setq reuses (cadr definition)
+		  definition nil)
+	  (unless (memq first '(:emacs-only :xemacs-only))
+	    (push (cadr definition) reuses)))
+	(setq definition (cddr definition)))
+      (if (and reuses (symbolp reuses))
+	  `(defalias ',name ',reuses)
+	(let* ((docstring (if (stringp (car definition)) (pop definition)))
+	       (spec (and (not xemacsp)
+			  (eq (car-safe (car definition)) 'interactive)
+			  (null (cddar definition))
+			  (cadar definition))))
+	  (if (and (stringp spec)
+		   (not (string-equal spec ""))
+		   (eq (aref spec 0) ?_))
+	      (setq definition
+		    (cons (if (string-equal spec "_")
+			      '(interactive)
+			    `(interactive ,(substring spec 1)))
+			  (cdr definition))))
+	  (if (null reuses)
+	      `(defun ,name ,arglist ,docstring
+		 ,@(cond-emacs-xemacs-macfn definition))
+	    ;; no dynamic docstring in this case
+	    `(eval-and-compile		; no warnings in Emacs
+	       (defalias ',name
+		 (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func))
+				 (nreverse reuses))
+		       (t ,(if definition
+			       `(lambda ,arglist ,docstring
+				  ,@(cond-emacs-xemacs-macfn definition))
+			     'ignore)))))))))))
+
+(eval-when-compile
+  (require 'cl)
+  (defvar init-file-loaded)		; would be useful in Emacs, too...
+  (defvar file-name-buffer-file-type-alist))
+
+
+
+;;;;##########################################################################
+;;;;  User Options, Variables
+;;;;##########################################################################
+
+
+(defconst template-version "3.1c"
+  "Current version of package template.
+Check  for the newest.")
+
+
+;;;===========================================================================
+;;;  Customization and initialization
+;;;===========================================================================
+
+(defgroup template nil
+  "Use templates, decorate comments, auto-update buffers."
+  :group 'data
+  :link '(emacs-commentary-link "template.el")
+  :link '(url-link "http://emacs-template.sourceforge.net/")
+  :prefix "template-")
+
+(defgroup template-comments nil
+  "Comment decorations in package template."
+  :group 'template
+  :prefix "template-")
+
+(defgroup template-updating nil
+  "Updating with package template."
+  :group 'template
+  :prefix "template-")
+
+(defgroup template-derivation nil
+  "Deriving templates for new files."
+  :group 'template
+  :prefix "template-")
+
+(defgroup template-expansion nil
+  "Expanding the expansion forms in templates."
+  :group 'template
+  :prefix "template-")
+
+(defgroup template-miscellaneous nil
+  "Miscellaneous configurations of package template."
+  :group 'template
+  :prefix "template-")
+
+;; I could imagine that a future version of package custom could make this
+;; `PACKAGE-initialize' stuff easier
+(defcustom template-use-package nil
+  "Pseudo variable.  Used to initialize template in custom buffer.
+Put `(template-initialize)' into your ~/.emacs to initialize package
+template in future sessions.  See variable `template-initialize'."
+  :group 'template
+  :type '(boolean :format "%{%t%}: %[(template-initialize)%], %v\n"
+		  :on "in use" :off "not yet initialized"
+		  :help-echo "Initialize package Template."
+		  :action template-initialize))
+
+(defcustom template-initialize t
+  "Whether/what to initialize with `template-initialize'.
+If t, do full initialization.  Otherwise, the value should be a list
+with elements.  To enable, include
+
+ * `auto' to enable `template-auto-update' and `template-auto-insert',
+ * `ffap' to make sure that `auto' works with `find-file-at-point',
+ * `cc-mode' to enable correct C/C++/Java/Antlr comment filling, i.e.,
+   to add `template-c-init-fill-function' to `c-mode-common-hook',
+ * `de-html-helper' to disable `html-helper's template and time-stamps,
+ * `keys' to setup the default key bindings,
+ * `menus' to setup the menus."
+  :group 'template-miscellaneous
+  :type '(choice (const :tag "All" t)
+		 (set :value (auto cc-mode keys menus)
+		      (const :tag "Auto Updating/Inserting" auto)
+		      (const :tag "Correct Auto Inserting with Ffap" ffap)
+		      (const :tag "Correct C Comment Filling" cc-mode)
+		      (const :tag "Deactivate html-helper" de-html-helper)
+		      (const :tag "Setup Key Bindings" keys)
+		      (const :tag "Setup Menus" menus))))
+
+
+;;;===========================================================================
+;;;  Menu
+;;;===========================================================================
+
+(defvar template-comment-menu
+  '("Comment"
+    ["Decorate Comment Line" template-single-comment
+     :active (and (not buffer-read-only)
+		  (memq (template-comment-at-point)
+			'(none delimited single cont)))]
+    ["Decorate Comment Block" template-block-comment
+     :active (and (not buffer-read-only)
+		  (memq (template-comment-at-point)
+			'(single block)))]
+    "---"
+    ["Indent for Comment" indent-for-comment
+     :active (and comment-start (not buffer-read-only))]
+    ["Continue Comment" indent-new-comment-line
+     :active (and  comment-start (not buffer-read-only))]
+    ["Comment Region" comment-region
+     :active (and comment-start (not buffer-read-only) (mark))]
+    ["Comment Region 2" (comment-region 2)
+     :active (and comment-start (not buffer-read-only) (mark))]
+    ["Comment Region 3" (comment-region 3)
+     :active (and comment-start (not buffer-read-only) (mark))]
+    "---"
+    ["Update Buffer" template-update-buffer
+     :active (and template-update-buffer-alist (not buffer-read-only))])
+  "Menu for comment functions.")
+
+(defvar template-creation-menu
+  '("Template Creation"
+    :filter template-menu-filter
+    ["Open Template" template-open-template
+     :active (null (template-buffer-template-p))]
+    "--"
+    ["Define User Input" template-define-prompt t]
+    ["Define Text Register" template-define-register t]
+    ["Define Message" template-define-message t]
+    "---"
+    ["Insert Expansion Form" template-insert-form t])
+  "Menu for template creation.")
+
+
+;;;===========================================================================
+;;;  Commenting
+;;;===========================================================================
+
+(defcustom template-max-column -1
+  "*Width of the separator line, to use with an empty `comment-end'.
+If the value is zero or negative, it is added to `fill-column'.  See
+also `template-max-column-with-end'."
+  :group 'template-comments
+  :type 'integer)
+
+(defcustom template-max-column-with-end 0
+  "*Width of the separator line including a non-empty `comment-end'.
+If the value is zero or negative, it is added to `fill-column'.  See
+also `template-max-column'."
+  :group 'template-comments
+  :type 'integer)
+
+(defcustom template-alt-comment-syntax-alist
+  '((t "/* " " */"))
+  "Alternative comment syntax for languages with \"mixed\" comments.
+Used by function `template-comment-syntax'.  Elements look like
+  (MODES-OR-REGEXP COMMENT-START COMMENT-END)
+
+If the current `major-mode' has a empty `comment-end' and a commenting
+command does not work at `point' with the usual `comment-start', we
+search for the first matching alternative comment syntax in this alist.
+
+Each element must \"pass\" MODES-OR-REGEXP.  If this is a list, it must
+include the current major-mode, if this is a regexp, it must match the
+`buffer-file-name' without version, otherwise it must be non-nil.
+
+Then, COMMENT-START and COMMENT-END is used as the alternative comment
+syntax if `comment-start-skip' matches COMMENT-START."
+  :group 'template-comments
+  :type '(repeat (group (choice (repeat :tag "In major modes" :value nil
+					function)
+				(regexp :tag "Buffer matching" :value "")
+				(sexp :tag "Always" :value t))
+			(string :tag "Alt comment start" :value "/* ")
+			(string :tag "Alt comment end" :value " */"))))
+
+(defcustom template-comment-indent t
+  "Non-nil means, indent single-line/block comments.
+Commands \\[template-single-comment] and \\[template-block-comment]
+indent the comment lines if this value is non-nil and the current major
+mode is not a member of `template-indent-mode-disable-list' or if this
+value is nil and the current major mode is a member of
+`template-indent-mode-enable-list'."
+  :group 'template-comments
+  :type 'boolean)
+
+(defcustom template-indent-mode-disable-list '(sh-mode makefile-mode)
+  "Major modes not having indented single-line/block comments.
+Used if `template-comment-indent' is non-nil.  Major modes in which
+pressing TAB twice is different from pressing TAB once are good
+candidates for this list."
+  :group 'template-comments
+  :type '(repeat (function :tag "Major mode")))
+
+(defcustom template-indent-mode-enable-list nil
+  "Major modes having indented single-line/block comments.
+Used if `template-comment-indent' is nil."
+  :group 'template-comments
+  :type '(repeat (function :tag "Major mode")))
+
+(defcustom template-comment-specification-alist
+  '(("-" "" "" 0)
+    ("-" "" "" 0)
+    ("=" "\n\n" "\n" 1)
+    ("#" "\n\n\f\n" "\n\n" 2))
+  "List of specifications for comment functions.
+Each specification at LEVEL, starting at 1, is a list
+  (SEPARATOR BEFORE-BLOCK AFTER-BLOCK DELETE-LINES)
+
+SEPARATOR is the string which is inserted repeatedly by commands
+\\[template-single-comment] and \\[template-block-comment] up to
+`template-max-column'.
+
+After that, \\[template-block-comment] deletes DELETE-LINES after the
+comment block and inserts string AFTER-BLOCK at the end of the block and
+BEFORE-BLOCK at the front of the block.
+
+The specification LEVEL to use is determined by:
+ (1) If the prefix argument is non-nil and its numeric value is > 0,
+     this value is the LEVEL.
+ (2) If the prefix argument is nil, and there is an old comment style,
+     use old comment style.
+ (3) If `template-comment-specification-special' is a function or the
+     current major mode has a property with this name and its value is a
+     function, this function returns the specification.
+ (4) If `comment-end' is empty and `comment-start' is a string of length
+     1: LEVEL is number of repetitions of `comment-start' at the
+     beginning of the line.  Otherwise, if the correctly indented line
+     starts at the beginning of the line, LEVEL=3, else LEVEL=2."
+  :group 'template-comments
+  :type '(repeat (group (string :tag "Separator" :value "-")
+			(string :tag "Before block" :value "")
+			(string :tag "After block" :value "")
+			(integer :tag "Delete lines" :value 0))))
+
+(defcustom template-comment-specification-special nil
+  "Function used for special commenting styles or nil.
+See `template-comment-specification-alist' for details."
+  :group 'template-comments
+  :type '(choice (const nil) function))
+
+
+;;;===========================================================================
+;;;  Auto updating
+;;;===========================================================================
+
+(defcustom template-auto-update 'query
+  "*Whether to update parts of the file when saving the buffer.
+When non-nil and `template-auto-update-disable-regexp' does not match
+the file name, automatically updates parts of the buffer, see
+`template-update-buffer-alist'.  With value t or if the entry in the
+alist has no prompt, do not ask for confirmation.
+
+You should have called `template-initialize' to enable this feature."
+  :group 'template-updating
+  :type '(radio (const :tag "No" nil)
+		(const :tag "Without confirmation" t)
+		(sexp :tag "With confirmation" :format "%t" :value query)))
+
+(defcustom template-auto-update-disable-regexp nil
+  "*Regexp matching files not to automatically update.
+Value nil matches no file.  See `template-auto-update'."
+  :group 'template-updating
+  :type '(choice (const :tag "none" nil) regexp))
+
+(defcustom template-update-buffer-alist
+  '((t "Update header in %s? "
+       (template-update-header t)
+       (file-name-sans-versions (file-name-nondirectory buffer-file-name)))
+    ((html-mode) "Update date inside 
 in %s? "
+     (-2000
+      "\\([0-9]+[ \t]+[A-Za-z][A-Za-z][A-Za-z][ \t]+[0-9]+\\)[ \t\n]*
"
+      1)
+     (format-time-string "%d %b %Y")))
+  "Alist used how to update parts of the buffer.
+Used by function `template-update-buffer'.  Elements look like
+  (MODES-OR-REGEXP PROMPT TEST NEW REPLACEMENT-FUN)
+
+Each element must \"pass\" MODES-OR-REGEXP.  If this is a list, it must
+include the current major-mode, if this is a regexp, it must match the
+`buffer-file-name' without version, otherwise it must be non-nil.
+
+Then, TEST is `eval'd and must return the region = (BEG . END) to be
+replaced or nil if nothing should be updated according to the current
+element.  If TEST is a list and the `car' of TEST is not a function,
+`template-update-buffer-region' is used as the default function, i.e.,
+REPLACEMENT-FUN looks like (LIMIT REGEXP GROUP).  Then, check first/last
+LIMIT characters in buffer and return region according to GROUP's regexp
+group in REGEXP.
+
+Then, NEW is `eval'd.  If it is a string, it is considered as
+replacement for the region, otherwise REPLACE-FUN must be non-nil.
+
+Then, ask user for confirmation with PROMPT where %s is substituted by
+the buffer name if PROMPT is a string and `template-auto-update' is not
+t.
+
+Finally, REPLACEMENT-FUN is called the `eval'd NEW and the beginning and
+the end of the region returned by TEST.  If REPLACEMENT-FUN is nil, just
+replace the region by the `eval'd NEW."
+  :group 'template-updating
+  :type '(repeat (group (choice (repeat :tag "In major modes" :value nil
+					function)
+				(regexp :tag "Buffer matching" :value "")
+				(sexp :tag "Always" :value t))
+			(string :tag "Prompt" :value "Update in %s? ")
+			(choice (list :tag "Default test"
+				      (choice (const :tag "No limit" nil)
+					      (integer :tag "Limit" -1000))
+				      regexp
+				      (integer :tag "Regexp group" :value 0))
+				(sexp :tag "Eval sexp"))
+			(sexp :tag "Eval New string")
+			(option (function :tag "Replacement function")))))
+
+(defcustom template-header-lines 3
+  "*Last line number which is checked by \\[template-update-header]."
+  :group 'template-updating
+  :type 'integer)
+
+(put 'template-header-lines 'template-secure-value #'integerp)
+
+(defcustom template-header-regexp-alist
+  '(("@(#)\\([^ \t\n]+\\)" . 1)
+    ("^%s[ \t]*\\([^ \t\n%s][^ \t\n]*\\)[ \t]+--" . 1))
+  "Alist of regexps matching the file name in the header.
+The `car' of each element is the REGEXP with %s, if present, substituted
+by the comment start.  A second %s, if present, is substitud by a single
+letter non-alpha comment start, or the empty string otherwise.
+
+The `cdr' is the regexp group to be replaced.  Used by
+\\[template-update-header].
+
+The comment start is evaluated from `comment-start', the first character
+in the buffer or \"#\".  It is assumed that a non-alpha single character
+comment start may be repeated.  For example, the substituted regexp in
+`emacs-lisp-mode' is \"\;+\", in `c++-mode' \"//\"."
+  :group 'template-updating
+  :type '(repeat (cons :format "%v"
+		       regexp
+		       (integer :tag "Regexp group" :value 0))))
+
+
+;;;===========================================================================
+;;;  Templates: finding templates
+;;;===========================================================================
+
+(defcustom template-auto-insert 'query
+  "*Whether to automatically use template files for new files.
+Used if the user gave a non-existent file as argument to a command in
+`template-find-file-commands'.  When non-nil and a matching template
+file can be found, use a template like in `template-new-file'.  File
+name refinement is never performed, see `template-derivation-alist'.
+
+With value t, do not ask for confirmation.
+
+You should have called `template-initialize' to enable this feature."
+  :group 'template-derivation
+  :type '(radio (const :tag "No" nil)
+		(const :tag "Without confirmation" t)
+		(sexp :tag "With confirmation" :format "%t" :value query)))
+
+(defcustom template-find-file-commands
+  '(find-file find-file-other-frame find-file-other-screen
+	      find-file-other-window find-file-at-point ffap nil)
+  "*Commands which use templates as last resort, see `template-auto-insert'.
+See also `template-file-select-commands'.
+
+Include nil if you want to use templates for non-existing files as
+command line arguments when starting Emacs."
+  :group 'template-derivation
+  :type '(repeat (function :tag "Command")))
+
+(defcustom template-file-select-commands
+  '(exit-minibuffer minibuffer-complete-and-exit
+		    list-mode-item-mouse-selected
+		    list-mode-item-keyboard-selected)
+  "*Commands which select the file name via minibuffer/completions.
+Checked with commands in `template-find-file-commands'."
+  :group 'template-derivation
+  :type '(repeat (function :tag "Command")))
+
+(defface template-message-face
+  '((((class color) (background light)) (:background "pink"))
+    (t (:bold t)))
+  "Face for temporary message at point.  This only works with XEmacs."
+  :group 'template-miscellaneous)
+
+(defcustom template-extension ".tpl"
+  "*Extension used for template files."
+  :group 'template-derivation
+  :type 'string)
+
+(defcustom template-subdirectories '("./" "Templates/")
+  "*List of subdirectories for template files.
+See `template-derivation-alist' for details."
+  :group 'template-derivation
+  :type '(repeat directory))
+
+(defcustom template-stop-derivation
+  (cond ((fboundp 'file-remote-p) 'file-remote-p)
+	((fboundp 'efs-ftp-path) 'efs-ftp-path)
+	((fboundp 'ange-ftp-ftp-path) 'ange-ftp-ftp-path))
+  "If non-nil, function used to determine whether to stop derivation.
+If non-nil, function is called with argument DIR.  If it returns t,
+`template-derivation' stops to search for more project specific
+templates, i\.e\., just searches in `template-default-directories'."
+  :group 'template-derivation
+  :type '(choice (const :tag "Never" nil)
+		 function))
+
+(defcustom template-default-directories
+  (cons (if (and (not (file-directory-p "~/.templates/"))
+		 (file-directory-p "~/lib/templates"))
+	    (expand-file-name "~/lib/templates/")
+	  (expand-file-name "~/.templates/"))
+	(and (fboundp 'locate-data-directory)
+	     (let ((dir (locate-data-directory "template")))
+	       (and dir (list dir)))))
+  "*List of default directories for template files.
+See `template-derivation-alist' for details."
+  :group 'template-derivation
+  :type '(repeat directory))
+
+(defcustom template-derivation-alist
+  '(;;(("00readme" "" ".txt" "\\`00") . ("00readme" "" ".txt"))
+    ((t "" t))
+    ((t nil null) . (nil nil t 1))
+    (("TEMPLATE" "" t)))
+  "Alist for template file name derivation and file name refinement.
+Template derivation searches for the most specific readable template
+file.  By default, files with the same RAW part as the name of the new
+file are considered to be more specific than files with just the same
+EXT part.  Also files in the same directory are considered to be more
+specific than files in their parent directory or any default template
+directory.  This behavior can be changed by this alist.
+
+Each FORM in this alist has the form (TEMPLATE . REFINEMENT).  If
+TEMPLATE matches, we have found a valid template file and the
+corresponding REFINEMENT is used for the file name refinement.
+
+Before the derivation, the given file name is split into the directory
+part DIR, the file name without directory FILE, and the raw part RAW of
+FILE, the numbering NUM and the extension EXT.  The result is stored in
+`template-file'.
+
+TEMPLATE can have the form (FUNCTION ARG...).  If TEMPLATE matches,
+FUNCTION, called with arguments ARGs, should return the split template
+file name, see `template-split-filename'.
+
+TEMPLATE can also have the form (T-RAW T-NUM T-EXT F-REGEXP) where all
+elements are optional, i.e., have value nil as default.  For TEMPLATE to
+match, all conditions T-RAW, T-NUM and T-EXT must be met and F-REGEXP,
+if non-nil, should match FILE, the non-directory part of the given file
+name.  If a condition is a string, the corresponding part of the
+template file must be equal to it.  If t, the part must be equal to
+RAW/NUM/EXT of the given file name.  If nil, any value will do it.  Any
+other value acts like t when the part of the given file name is
+non-empty, as nil otherwise.
+
+REFINEMENT can have the form (FUNCTION ARG...).  FUNCTION, called with
+the list of the split template filename and ARGs as arguments, should
+set `template-file' if the file name should be refined.
+
+REFINEMENT can also have the form (F-RAW F-NUM F-EXT AUTO-NUM) where all
+elements are optional, i.e., have value nil as default.  If F-RAW, F-NUM
+and F-EXT are non-nil, they change RAW/NUM/EXT of `template-file'.  A
+string will be used as the new part.  If t, the corresponding part of
+the template name will be used.
+
+We will use auto numbering in the following two cases: if NUM is
+non-empty and the file exists already, or if NUM is empty and AUTO-NUM
+is non-nil.  Auto numbering looks at the file names in DIR to generate
+the next unique number which is at least as high as NUM in the first
+case and AUTO-NUM in the second.
+
+Let us use parts of the default value as examples:
+
+Use a template with the same RAW part of the given file name and the
+same EXT part if provided, e.g., for \"exercise2\" use template
+\"exercise.tex.tpl\".  Refine file name to use the extension of the
+template file, also use auto numbering, e.g., if files \"exercise2.tex\"
+and \"exercise3.tex\" exist, refine name to \"exercise4.tex\":
+  ((t nil null) \. (nil nil t 1))
+
+For a file with extension EXT, use TEMPLATE.EXT:
+  ((\"TEMPLATE\" \"\" t))
+
+We could define: If the given file name starts with \"00\", use template
+\"00readme.txt.tpl\".  Refine file name to \"00readme.txt\":
+  ((\"00readme\" \"\" \".txt\" \"\\\\`00\") \. (\"00readme\" \"\" \".txt\"))
+
+Since more than one template file could meet this conditions, the
+template derivation searches for first readable file with extension
+`template-extension' which is found by the following algorithm:
+
+  forall FORMs in `template-derivation-alist' do
+    for directory BASE from DIR
+           while not stopped according to `template-stop-derivation' do
+      forall subdirectories DIRs in `template-subdirectories'
+             relative to BASE do
+        forall TEMPLATEs in DIR do
+          if check_form (FORM, FULL, TEMPLATE) return TEMPLATE
+    forall directories DIRs in `template-default-directories' do
+      forall TEMPLATEs in DIR do
+        if check_form (FORM, FULL, TEMPLATE) return TEMPLATE
+  if not used via `template-auto-insert'
+    forall TEMPLATEs in `template-default-directories'
+           where name_nondir (TEMPLATE) = \"DEFAULT.tpl\" do
+      if readable (TEMPLATE) return TEMPLATE
+    return TEMPLATE in first (`template-default-directories')
+           where name_nondir (TEMPLATE) = \"DEFAULT.tpl\""
+  :group 'template-derivation
+  :type '(repeat (cons :format "%v"
+		       (sexp :tag "Derivation" :value ("TEMPLATE" nil t))
+		       (sexp :tag "Refinement" :value nil))))
+
+
+;;;===========================================================================
+;;;  Templates: expanding templates
+;;;===========================================================================
+
+(defcustom template-confirm-insecure t
+  "*Non-nil means, ask whether to use insecure template expansions.
+Only set this to nil if you ALWAYS check template files before using
+it!"
+  :group 'template-expansion
+  :type 'boolean)
+
+(put 'template-confirm-insecure 'risky-local-variable t)
+
+(defcustom template-message-buffer "*Template Message*"
+  "If non-nil, name of buffer where messages are shown.
+The following messages will be displayed in definition sequence before
+the expansion has taken place:
+ - :before messages, see `template-definition-start',
+ - user defined prompts if `template-message-prompt-format' is non-nil,
+ - user defined registers when there has been a :before message before,
+   see `template-message-register-format'.
+
+The following messages will be displayed in definition sequence after
+the expansion has taken place:
+ - :after messages, see `template-definition-start',
+ - user defined registers, display them at point if the value of this
+   variable is nil, see `template-message-register-format'."
+  :group 'template-miscellaneous
+  :type '(choice (const :tag "None" nil)
+		 (string :tag "Buffer Name")))
+
+(defcustom template-message-prompt-intro
+  "Template expansion will ask for input with the following prompts:"
+  "Default intro message used before listing user defined prompts.
+Used with :before messages, see `template-message-prompt-format'."
+  :group 'template-miscellaneous
+  :type '(choice (const :tag "None" nil)
+		 (string :tag "Intro text")))
+
+(defcustom template-message-prompt-format "   %s"
+  "If non-nil, format string for user defined prompts.
+If non-nil and `template-message-buffer' is non-nil, user defined
+prompts will be listed before starting the expansions.  Prompts can be
+defined as specified in the docstring of `template-definition-start'.
+For each PROMPT, this format string will be used with substitution
+PROMPT/%s.
+
+If no :before message has been defined before, use, if non-nil,
+`template-message-prompt-intro' as the first :before message."
+  :group 'template-miscellaneous
+  :type '(choice (const :tag "No prompt" nil)
+		 (string :tag "Format string")))
+
+(defcustom template-message-register-intro
+  "Template has defined the following registers:"
+  "Default intro message used before listing user defined prompts.
+Used with :after messages, see `template-message-register-format'."
+  :group 'template-miscellaneous
+  :type '(choice (const :tag "None" nil)
+		 (string :tag "Intro text")))
+
+(defcustom template-message-register-format "  %c:\t\"%s\"\t%s"
+  "If non-nil, format string for user defined registers.
+If non-nil, user defined text registers will be listed.  Registers can
+be defined as specified in the docstring of `template-definition-start'.
+For each register CHAR with contents CONTENTS and optional comment
+COMMENT, this format string will be used with substitution CHAR/%c,
+CONTENT/%s and \(COMMENT/%s or \"\"/%s).
+
+The list of register definitions will be displayed:
+ - at point if `template-message-buffer' is nil,
+ - with :before messages if there has been at least one :before message
+   defined before and if `template-message-buffer' is non-nil,
+ - with :after messages if `template-message-buffer' is non-nil.
+   If no :after message has been defined before, use, if non-nil,
+   `template-message-register-intro' as the first :after message."
+  :group 'template-miscellaneous
+  :type '(choice (const :tag "No register content" nil)
+		 (string :tag "Format string")))
+
+(defcustom template-message-timeout 600
+  "*Maximum duration the temporary message will be displayed at point.
+Any user event will also make the temporary message disappear.  The
+temporary message uses face in `template-message-face'."
+  :group 'template-miscellaneous
+  :type 'integer)
+
+(put 'template-message-timeout 'template-secure-value #'integerp)
+
+(defcustom template-date-format "%d %b %Y"
+  "*Date/time format used with the expansion form (>>>DATE<<<).
+See `template-default-expansion-alist' and `format-time-string'.  See
+also `template-time-format'."
+  :group 'template-expansion
+  :type 'string)
+
+(put 'template-date-format 'template-secure-value #'stringp)
+
+(defcustom template-time-format "%T"
+  "*Date/time format used with the expansion form (>>>TIME<<<).
+See `template-default-expansion-alist' and `format-time-string'.  See
+also `template-date-format'."
+  :group 'template-expansion
+  :type 'string)
+
+(put 'template-time-format 'template-secure-value #'stringp)
+
+(defcustom template-string-default "%0.0S"
+  "*Format string used for non-string variable extensions.
+If SYMBOL in (\"KEY\" \. SYMBOL) is not a string, use string with
+substitution SYMBOL/%S.  Default value \"%0.0S\" causes to print
+nothing.  See `template-definition-start'."
+  :group 'template-expansion
+  :type 'string)
+
+(put 'template-string-default 'template-secure-value #'stringp)
+
+(defcustom template-expansion-format "(>>>%s<<<)"
+  "Format string for expansion forms.
+Is a expansion form with substitution KEY/%s.  The value should
+correspond with `template-expansion-regexp'.  Used by
+`template-insert-form'."
+  :group 'template-expansion
+  :type 'string)
+
+(put 'template-expansion-format 'template-secure-value #'stringp)
+
+(defcustom template-expansion-regexp "(>>>\\([-A-Za-z0-9_]+\\)<<<)"
+  "Regexp matching strings which are replaced by their expansions.
+The first regexp group contains the KEY used by the per-template
+expansion, see `template-definition-start' and the global expansions in
+`template-expansion-alist' and `template-default-expansion-alist'.  The
+value should correspond with `template-expansion-alist'.
+
+If there is no defined expansion for the key, ask the user for a
+replacement, see `template-read'.  If the key is matched by
+`template-register-regexp', store buffer position in register, see
+`template-register', .
+
+If you want to use a text literally which is matched by this regexp, use
+the zero expansion form (>>>ZERO_FORM<<<)."
+  :group 'template-expansion
+  :type 'regexp)
+
+(put 'template-expansion-regexp 'template-secure-value #'stringp)
+
+(defcustom template-literal-environment '("LITERAL" . "/LITERAL")
+  "Environment for literal text in template.
+Looks like (OPEN . CLOSE).  Text between expansion forms with keys OPEN
+and CLOSE is not expanded.  If you change OPEN, you should change key
+\"LITERAL\" in `template-default-expansion-alist' accordingly."
+  :group 'template-expansion
+  :type '(cons (string :tag "Open tag") (string :tag "Close tag")))
+
+(defcustom template-register-regexp "\\`[0-9]\\'"
+  "*Regexp matching keys for storing point positions in registers.
+These keys use `template-register' as the default expansion instead of
+`template-read'.  See `template-expansion-regexp'.  If a register is used
+twice, it is marked by a \"*\" in the echo area after the expansion."
+  :group 'template-expansion
+  :type 'regexp)
+
+(put 'template-register-regexp 'template-secure-value #'stringp)
+
+(defcustom template-expansion-alist nil
+  "User defined expansions forms.
+Predefined expansion forms for `template-expansion-regexp'.  Each entry
+has the form (KEY . SEXP).  These expansion forms shadow those in
+`template-default-expansion-alist' and are shadowed by those in the
+per-template definition section.  See `template-definition-start'."
+  :group 'template-expansion
+  :type '(repeat (cons :format "%v"
+		       (string :tag "Key" :value "")
+		       (repeat :tag "Evaluate all" sexp))))
+
+(put 'template-expansion-alist 'risky-local-variable t)
+
+(defvar template-default-expansion-alist
+  '(("POINT" (setq template-point (point-marker))) ; point
+    ("MARK" (setq template-mark (point-marker))) ; mark
+    ("DIR" (insert (car template-file))) ; directory
+    ("FILE" (insert (cadr template-file))) ; file name without directory
+    ("FILE_SANS" (insert (nth 2 template-file)
+			 (nth 3 template-file)))
+    ("FILE_RAW" (insert (nth 2 template-file))) ; raw file name without number
+    ("FILE_NUM" (insert (nth 3 template-file))) ; number
+    ("FILE_UPCASE" (insert (upcase (nth 2 template-file))
+			   (nth 3 template-file)))
+    ("FILE_EXT" (or (string= (nth 4 template-file) "")	; extension
+		    (insert (substring (nth 4 template-file) 1))))
+    ("DATE" (template-insert-time template-date-format))
+    ("TIME" (template-insert-time template-time-format))
+    ("VC_DATE" (set-time-zone-rule "UTC")
+     (template-insert-time "%Y/%m/%d %T" "0000/00/00 00:00:00")
+     ;; using saved `current-time-zone' doesn't work, but nil does
+     (set-time-zone-rule nil))
+    ("YEAR" (template-insert-time "%Y" "0000"))
+    ("ISO_DATE" (template-insert-time "%Y-%m-%d" "0000-00-00"))
+    ("COMMENT" (template-read "Initial comment: ")) ; comment
+    ("AUTHOR" (insert (or user-mail-address	; author
+			  (and (fboundp 'user-mail-address)
+			       (user-mail-address))
+			  (concat (user-login-name) "@" (system-name)))))
+    ("USER_NAME" (insert (or (and (boundp 'user-full-name) ; user name
+				  user-full-name)
+			     (user-full-name))))
+    ("LOGIN_NAME" (insert (user-login-name)))	; login name
+    ("HOST_ADDR" (insert (or (and (boundp 'mail-host-address) ; host address
+				  (stringp mail-host-address)
+				  mail-host-address)
+			     (system-name))))
+    ("LITERAL" (if (search-forward (format template-expansion-format
+					   (cdr template-literal-environment))
+				   nil 'limit)
+		   (delete-region (match-beginning 0) (match-end 0))))
+    ("ZERO_FORM"))			; zero form
+  "Predefined default expansions forms.
+Predefined expansion forms for `template-expansion-regexp'.  Each entry
+has the form (KEY . SEXP).  These expansion forms are shadowed by those
+in `template-expansion-alist' and by those in the per-template
+definition section.  See `template-definition-start'.
+
+The default predefined expansion forms are --default is inserting--:
+  (>>>POINT<<<)       set point
+  (>>>MARK<<<)        set mark, jump to it with \\[exchange-point-and-mark]
+  (>>>DIR<<<)         directory: /home/clstaff/wedler/lib/
+  (>>>FILE<<<)        file w/o directory: text1.txt
+  (>>>FILE_SANS<<<)   file name w/o extension: text1
+  (>>>FILE_RAW<<<)    raw file name: text
+  (>>>FILE_NUM<<<)    number in name: 1
+  (>>>FILE_EXT<<<)    extension: txt
+  (>>>FILE_UPCASE<<<) upcase file name w/o extension: TEXT1
+  (>>>DATE<<<)        date using `template-date-format': 11 Jan 1999
+  (>>>TIME<<<)        time using `template-time-format': 11:58:49
+  (>>>YEAR<<<)        the year: 1999
+  (>>>ISO_DATE<<<)    ISO 8601 date: 1999-01-11
+  (>>>VC_DATE<<<)     UTC date/time for vc: 1999/01/11 10:58:49
+  (>>>COMMENT<<<)     ask user for initial comment
+  (>>>AUTHOR<<<)      author, i.e., `user-mail-address'
+  (>>>USER_NAME<<<)   user name: Christoph Wedler
+  (>>>LOGIN_NAME<<<)  login name: wedler
+  (>>>HOST_ADDR<<<)   Host address: fmi.uni-passau.de
+  (>>>LITERAL<<<)     literal text up to (>>>/LITERAL<<<)
+  (>>>ZERO_FORM<<<)   zero form, i.e., insert nothing.  Useful to insert
+      a text part matched by `template-expansion-regexp' literally.
+
+There are aliases with one-letter keys, see `template-key-alias-alist'.
+
+It is useful to follow the following conventions: upper case keys for
+predefined extensions, lower case and digits for per-template and the
+following default expansions:
+  (>>>0<<<) to (>>>9<<<)  set registers 0 to 9, jump to it with
+      \\[jump-to-register] 0 etc., see `template-register-regexp'
+  (>>>x<<<) where x is any unused letter sequence: ask user.")
+
+(put 'template-default-expansion-alist 'risky-local-variable t)
+
+(defvar template-key-alias-alist
+  '(("P" . "POINT")
+    ("M" . "MARK")
+    ("D" . "DIR")
+    ("F" . "FILE")
+    ("R" . "FILE_RAW")
+    ("N" . "FILE_NUM")
+    ("B" . "FILE_UPCASE")
+    ("E" . "FILE_EXT")
+    ("T" . "DATE")
+    ("V" . "VC_DATE")
+    ("Y" . "YEAR")
+    ("I" . "ISO_DATE")
+    ("C" . "COMMENT")
+    ("A" . "AUTHOR")
+    ("U" . "USER_NAME")
+    ("L" . "LOGIN_NAME")
+    ("H" . "HOST_ADDR")
+    ("Z" . "ZERO_FORM"))
+  "Alist to support the old one-letter predefined expansion forms.
+Used for `template-expansion-alist' and
+`template-default-expansion-alist'.")
+
+(defcustom template-definition-start
+  ">>>TEMPLATE-DEFINITION-SECTION<<<"
+  "Header for the per-template definition section.
+The region following the the first match of this regexp defines the
+per-template definition section.  The region will be deleted before the
+actual expansion, see `template-new-file'.  If you use the \"Local
+Variables:\" section, define it before this region.
+
+The definition section defines expansion forms for strings KEYs matched
+by `template-expansion-regexp' which might shadow those in
+`template-expansion-alist' and `template-default-expansion-alist':
+
+  (\"KEY\"): zero form, same as (>>>ZERO_FORM<<<) in default value of
+`template-default-expansion-alist', useful for inserting text matched by
+`template-expansion-regexp' literally.
+
+  (\"KEY\". CHAR): CHAR is the register where the current buffer
+position is stored, see `template-register-regexp'.
+
+  (\"KEY\" \"PROMPT\" \"PREFIX\" \"SUFFIX\" \"DEFAULT\" AGAIN-P) where
+the last four arguments are optional: ask user with PROMPT for a STRING.
+If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT.
+For AGAIN-P, see `template-read'.  To define, use
+\\[template-define-prompt].
+
+  (\"KEY\" \"PROMPT\" (\"ANSWER\" \. \"TEXT\")...): ask user with PROMPT
+for an input with completion over all ANSWERs and insert corresponding
+TEXT.  Expansion forms in TEXT will be expanded.
+
+  (\"KEY\" \"PROMPT\" (t \. \"TEXT-y\")  (nil \. \"TEXT-n\")): ask user
+with PROMPT a \"y or n\" question with `y-or-n-p' and insert TEXT-y or
+TEXT-n, correspondingly.  Expansion forms in TEXT-X will be expanded.
+The y-case and the n-case are optional and can be exchanged.
+
+  (\"KEY\" \. SYMBOL): insert value of SYMBOL; if value is no string at
+the time of the replacement, use `template-string-default' as format
+string for SYMBOL.
+
+  (\"KEY\" COMMAND \. PREFIX): COMMAND is a symbol or a vector and is
+called with `command-execute' after setting `prefix-arg' to PREFIX, not
+evaluated.  If COMMANDs symbol property `template-secure-command' is
+nil, the form is insecure.  If that symbol property is a function, it is
+called with PREFIX to check whether COMMAND could be called directly
+with PREFIX as remaining arguments.
+
+  (\"KEY\" SEXPR...): evaluate SEXPR during the expansion, see
+`template-expansion-alist' for examples.  This form is insecure.
+
+There are other per-template definitions:
+
+  \"MESSAGE\": additional line displayed at point until first user event
+or after `template-message-timeout' seconds.  The lines are displayed
+with face in `template-message-face'.  With active form selector
+:before, define a message which is displayed in
+`template-message-buffer' before the exansion has started.  With active
+form selector :after, define a message which is displayed in
+`template-message-buffer' after the exansion has taken place.  To
+define interactively, use \\[template-define-message].
+
+  (CHAR \. \"CONTENTS\"): Set register CHAR to have contents CONTENTS.
+CONTENTS can then be inserted into a buffer with \\[insert-register] CHAR.
+
+  (CHAR \"CONTENTS\" COMMENT) where COMMENT is optional: Set register
+CHAR to have contents CONTENTS.  CONTENTS can then be inserted into a
+buffer with \\[insert-register] CHAR.  Also display an additional line
+at point to show the contents with COMMENT.  To define, use
+\\[template-define-register].
+
+The following forms depend on the active form selector which is the last
+of the following expansion forms:
+ - :before: \"MESSAGE\" will be displayed before the expansion
+ - :after: \"MESSAGE\" will be displayed after the expansion
+ - :eval-before: execute COMMAND and SEXPR before expansion
+ - :eval-after: execute COMMAND and SEXPR after expansion
+ - nil, deprecated: with the first form, the active form selector is
+   :eval-before, with the second, it is :eval-after.
+
+  (VARIABLE . VALUE): set SYMBOL's local value to VALUE, not evaluated.
+This form is only secure if VARIABLE has a symbol property
+`template-secure-value' which returns non-nil when applied to VALUE, not
+evaluated.  This form is useful for variables which determine the
+expansion, like `template-time-format' and `template-date-format'.  For
+local variables in your new file, use the normal way via the \"Local
+Variables:\" section.  The active form selector must not be :eval-before
+or :eval-after.
+
+  COMMAND: COMMAND is a symbol or a vector and is called with
+`command-execute' before the expansion with form selector :eval-before,
+and after the expansion with form selector :eval-after.  If COMMANDs
+symbol property `template-secure-command' is nil, the form is insecure.
+You should use the safe command `normal-mode' in the pre-expansion forms
+if the expansion forms depend on the correct major mode.
+
+  SEXPR: evaluate SEXPR before the expansion with form selector
+:eval-before, and after the expansion with form selector :eval-after.
+This form is insecure.
+
+If any insecure forms have been used, the user of the template will be
+asked whether to use the template, see `template-confirm-insecure'."
+  :group 'template-expansion
+  :type 'string)
+
+
+
+;;;;##########################################################################
+;;;;  Commenting
+;;;;##########################################################################
+
+
+(defunx template-point-at-bol (&optional count)
+  :emacs-only line-beginning-position
+  :xemacs-only point-at-bol)
+
+(defunx template-point-at-eol (&optional count)
+  :emacs-only line-end-position
+  :xemacs-only point-at-eol)
+
+(defunx template-char-or-char-int-p (object)
+  :emacs-only integerp
+  :xemacs-only char-or-char-int-p)
+
+(defunx template-char-or-int-to-char (object)
+  :emacs-only identity
+  "Convert character or integer OBJECT into the equivalent character."
+  (if (characterp object) object (int-to-char object)))
+
+
+;;;===========================================================================
+;;;  Main functions
+;;;===========================================================================
+
+;;;###autoload
+(defun template-single-comment (&optional arg)
+  "Decorate the comment in the current line with dashes and alike.
+The line must be a comment-only line or must contain a comment ending by
+eol.  That is, jump to the end of the current line and insert the dashes
+and the final comment end-string up-to the fill position.  Prefix
+argument ARG and `template-comment-specification' determines the comment
+style to use.  The length of the resulting line is determined by
+`template-max-column' and `template-max-column-with-end'."
+  (interactive "*P")
+  (let* ((orig (point-marker))
+	 (syntax0 (and comment-start comment-start-skip
+		       (condition-case nil
+			   (template-comment-syntax orig 'boc)
+			 (error nil))))
+	 (syntax (cond ((cdr syntax0)
+			(template-comment-syntax orig))
+		       (syntax0
+			(condition-case nil
+			    (template-comment-syntax (point-marker))
+			  (error syntax0)))
+		       (t
+			(back-to-indentation)
+			nil)))
+	 (sep (template-comment-separator-regexp syntax))
+	 (end (template-point-at-eol))
+	 old)
+    (save-excursion
+      (cond ((re-search-forward sep end t)
+	     ;; with sep in current line
+	     (setq old (buffer-substring (match-beginning 1) (match-end 1)))
+	     (delete-region (match-beginning 0) (match-end 0)))
+	    ((cdr syntax)		; with start-end comment
+	     (if (looking-at (concat "[ \t]*\\(.+\\)?"
+				     (regexp-quote (cadr syntax))
+				     "[ \t]*\\(.+\\)?$"))
+		 (if (or (match-beginning 1) (match-beginning 2))
+		     (error "This line contains non-separator chars and %S"
+			    (cadr syntax))
+		   ;; Delete comment-end.  Don't delete its first char if it is
+		   ;; the same as the second of comment-start.
+		   (delete-region (if (and (= (length (car syntax)) 2)
+					   (= (length (cadr syntax)) 2)
+					   (eq (aref (car syntax) 1)
+					       (aref (cadr syntax) 0)))
+				      (1+ (match-beginning 0))
+				    (match-beginning 0))
+				  (match-end 0))))
+	     (goto-char (cddr syntax))
+	     (if (re-search-forward sep end t)
+		 ;; sep in line between comment-start and point-at-eol
+		 (setq old (buffer-substring (match-beginning 1)
+					     (match-end 1)))))))
+    (template-insert-separator
+     (car (template-comment-specification arg old syntax))
+     nil syntax)))
+(put 'template-single-comment 'template-secure-command t)
+
+;;;###autoload
+(defun template-block-comment (&optional arg)
+  "Decorate the current block of comment-only lines with dashes and alike.
+That is, surround the the contiguous comment-only lines around point
+with extra lines containing dashes and alike and to put the correct
+number of newlines around the block.
+
+Barf if the comment syntax at point has a non-empty `comment-end' or if
+point is not in a comment-only line.
+
+A block comment consists of all neighboring lines which start with
+spaces and `comment-start'.  If `comment-start' is a string of length 1,
+the number of repetitions of `comment-start' must be the same or larger
+than in the line where the command is invoked from, too.
+
+Prefix argument ARG and `template-comment-specification' determines the
+comment style to use.  The length of the separator line is determined by
+`template-max-column'.
+
+This command can also be used with point in an empty line after a block
+comment.  A second invocation of this command directly after a
+successful invocation deletes the remaining empty lines from the current
+line on."
+  (interactive "*P")
+  (let* ((orig (point-marker))
+	 (syntax (progn
+		   (end-of-line)
+		   (skip-chars-backward " \t\n\f")
+		   (template-comment-syntax orig))))
+    (when (cdr syntax)
+      (goto-char orig)
+      (error "Command only works with comments terminated by end-of-line"))
+    
+    (if (and (eq last-command 'template-block-comment-success)
+	     (looking-at "[ \t]*$"))
+	(template-insert-newline "" nil (1- (template-point-at-bol)))
+      (let* ((prefix (concat "[ \t]*" (regexp-quote (car syntax))))
+	     (sepline (concat prefix "[ \t]*"
+			      (template-comment-separator-regexp syntax)))
+	     old block-beg block-end def)
+	;; go to the first line with same comment prefix ---------------------
+	(beginning-of-line)
+	(while (and (not (bobp)) (looking-at prefix))
+	  (beginning-of-line 0))
+	(or (looking-at prefix) (beginning-of-line 2))
+	(while (looking-at sepline)
+	  (setq old (buffer-substring (1- (match-end 0)) (match-end 0)))
+	  (kill-line 1))
+	(setq block-beg (point-marker))
+	;; go to the last line with same comment prefix ----------------------
+	(while (looking-at prefix)
+	  (template-indent-according-to-mode)
+	  (beginning-of-line 2))
+	(if (eobp) (newline))
+	(setq block-end (copy-marker (point) t))
+	(while (progn (forward-line -1) (looking-at sepline))
+	  (setq old (buffer-substring (1- (match-end 0)) (match-end 0)))
+	  (kill-line 1))
+	;; insert separator lines --------------------------------------------
+	(goto-char block-beg)
+	(set-marker block-beg nil)
+	(back-to-indentation)
+	(setq def (template-comment-specification arg old syntax))
+	(beginning-of-line)
+	(template-insert-newline (cadr def))
+	(template-insert-separator (car def) (car syntax) syntax)
+	(goto-char block-end)
+	(set-marker block-end nil)
+	(template-insert-separator (car def) (car syntax) syntax)
+	(template-insert-newline (caddr def)
+				 (and (cadddr def)
+				      (save-excursion
+					(forward-line (cadddr def))
+					(point))))
+	(setq this-command 'template-block-comment-success)))
+    (template-indent-according-to-mode)
+    (back-to-indentation)))
+(put 'template-block-comment 'template-secure-command t)
+
+
+;;;===========================================================================
+;;;  Check comment start, return specification
+;;;===========================================================================
+
+(defun template-indent-according-to-mode ()
+  "Indent line according to `template-comment-indent'."
+  (if (if template-comment-indent
+	  (not (memq major-mode template-indent-mode-disable-list))
+	(memq major-mode template-indent-mode-enable-list))
+      (indent-according-to-mode)))
+
+(defun template-default-comment ()
+  "Return default comment according to current position."
+  (if comment-start
+      (substring comment-start 0 (string-match "[ \t]\\'" comment-start))
+    (if (eolp) "#"
+      (let ((default (buffer-substring (point) (1+ (point)))))
+	(if (string-match "[A-Za-z]" default) "#" default)))))
+
+(defun template-comment-at-point ()
+  "Return the comment syntax at the current position.
+Return nil, if no commenting command can be used, i.e., if point is not
+in a comment-only line.  Return `none' if the `major-mode' doesn't
+define a comment syntax.  Return `delimited' if point is between
+`comment-start' and a non-empty `comment-end'.  Return `single' if point
+is in a comment line where the comment syntax has a empty `comment-end',
+return `block' if point is in an empty line after such a comment line."
+  (if (and comment-start comment-start-skip)
+      (save-excursion
+	(let ((orig (point)))
+	  (condition-case nil
+	      (progn
+		(end-of-line)
+		(skip-chars-backward " \t\n\f")
+		(if (cdr (template-comment-syntax orig t)) 'delimited
+		  (if (< (template-point-at-eol) orig) 'block 'single)))
+	    (error
+	     (condition-case nil
+		 (progn
+		   (goto-char orig)
+		   (beginning-of-line)
+		   (when (re-search-forward comment-start-skip
+					    (template-point-at-eol) t)
+		     (goto-char (or (match-end 1) (match-beginning 0)))
+		     (unless (or (cdr (template-comment-syntax orig 'boc))
+				 (< (template-point-at-eol) orig))
+		       'cont)))
+	       (error nil))))))
+    'none))
+
+(defun template-comment-syntax (orig &optional no-indent)
+  "Return the comment syntax at ORIG.  Signal error if not in comment.
+Return (COMMENT-START) if the comment syntax has an empty `comment-end'.
+Return (COMMENT-START COMMENT-END . START-POS) if the comment syntax has
+a non-empty `comment-end' where START-POS is the position of the first
+character inside the comment.  Move point to first character after the
+comment start or the first non-whitespace character on this line.
+
+ORIG should be the same as `point' or in a empty line after `point'.
+
+If optional argument NO-INDENT is nil, indents the current line
+according to `template-comment-indent' and `indent-according-to-mode'.
+If NO-INDENT is `boc', move point to the beginning of the comment.
+
+COMMENT-START is stripped off its final spaces, COMMENT-END off its
+initial spaces."
+  (unless (and comment-start comment-start-skip)
+    (error "No comment syntax has been defined for %s" major-mode))
+  (if (eq no-indent 'boc)
+      (progn
+	(beginning-of-line)
+	(if (re-search-forward comment-start-skip (template-point-at-eol) t)
+	    (goto-char (or (match-end 1) (match-beginning 0)))))
+    (or no-indent (template-indent-according-to-mode))
+    (back-to-indentation))
+  (let* ((string (template-default-comment)))
+    (if (string= comment-end "")
+	(if (looking-at (concat (regexp-quote string)
+				(and (= (length string) 1)
+				     (not (eq no-indent 'boc))
+				     "+")))
+	    (progn
+	      (goto-char (match-end 0))
+	      (list (buffer-substring (match-beginning 0) (point))))
+	  (let ((alist template-alt-comment-syntax-alist)
+		elem c-start c-end)
+	    (while alist
+	      (setq elem (pop alist))
+	      (and (template-match-modes-or-regexp (car elem))
+		   (string-match comment-start-skip (cadr elem))
+		   (setq c-start (cadr elem)
+			 c-end   (caddr elem)
+			 alist   nil)))
+	    (template-comment-syntax-0 orig c-start c-end string)))
+      (template-comment-syntax-0 orig comment-start comment-end))))
+
+(defun template-comment-syntax-0 (orig c-start c-end &optional single)
+  ;; checkdoc-params: (orig c-start c-end single)
+  "Internal function for `template-comment-syntax'."
+  (unless (and (stringp c-start) (stringp c-end) (not (string= c-end "")))
+    (goto-char orig)
+    (error "Line does not start with %S"
+	   (or single (template-default-comment))))
+  (setq c-start (substring c-start 0 (string-match "[ \t]\\'" c-start))
+	c-end   (if (string-match "\\`[ \t]+" c-end)
+		    (substring c-end (match-end 0))
+		  c-end))
+  (cond ((looking-at (regexp-quote c-start))
+	 (goto-char (match-end 0))
+	 (cons c-start (cons c-end (point))))
+	((save-excursion
+	   (when (re-search-backward (concat "^[ \t]*" (regexp-quote c-start))
+				     nil t)
+	     (goto-char (match-end 0))
+	     (let ((match (point)))
+	       (unless (when (search-forward c-end orig t)
+			 (skip-chars-forward " \t")
+			 (< (point) orig))
+		 (cons c-start (cons c-end match)))))))
+	(t
+	 (goto-char orig)
+	 (if single
+	     (error "Not inside a comment (%S or %S-%S) starting in new line"
+		    single c-start c-end)
+	   (error "Not inside a comment (%S-%S) starting in new line"
+		  c-start c-end)))))
+
+
+;;;===========================================================================
+;;;  Comment specification
+;;;===========================================================================
+
+;; A simple `mapconcat' is likely to slow down Emacs' regexp search algorithm
+;; considerably (backtracking => near-infloop).
+(defun template-comment-separator-regexp (syntax)
+  "Return regexp matching separator comment lines.
+The regexp also matches if the lines ends with parts of COMMENT-END in
+argument SYNTAX, see `template-comment-syntax'."
+  (let ((estring (cadr syntax))
+	(alist template-comment-specification-alist)
+	(chars nil)
+	str i c)
+    (while alist
+      (setq str (car (pop alist)))
+      (when str
+	(setq i (length str))
+	(while (>= (decf i) 0)
+	  ;; (pushnew (aref str i) chars), but requires cl at runtime:
+	  (or (memq (setq c (aref str i)) chars) (push c chars)))))
+    (concat "\\("
+	    (mapconcat (lambda (c) (regexp-quote (char-to-string c)))
+		       (or chars "#")
+		       "\\|")
+	    (if estring
+		(concat "\\)+[ \t]*"
+			(mapconcat (lambda (c)
+				     (regexp-quote (char-to-string c)))
+				   estring
+				   "?")
+			"?[ \t]*$")
+	      "\\)+[ \t]*$"))))
+
+(defun template-comment-specification (arg old syntax)
+  "Return the comment specification to use.
+See `template-comment-specification-alist' for details.  ARG is the
+prefix argument, OLD the SEPARATOR of the old comment style and SYNTAX
+is the comment syntax returned by `template-comment-syntax'."
+  (and arg (setq arg (prefix-numeric-value arg)))
+  ;; assumes point-at-indentation
+  (or (and arg (> arg 0)
+	   (if (< (length template-comment-specification-alist) arg)
+	       (car (last template-comment-specification-alist))
+	     (nth (1- arg) template-comment-specification-alist)))
+      (and (null arg) old
+	   (assoc old template-comment-specification-alist))
+      (and (functionp template-comment-specification-special)
+	   (funcall template-comment-specification-special))
+      (and (functionp (get major-mode 'template-comment-specification-special))
+	   (funcall (get major-mode 'template-comment-specification-special)))
+      (and syntax
+	   (template-comment-specification
+	    (if (or (cdr syntax) (> (length comment-start) 1))
+		(save-excursion
+		  (if (cddr syntax) (goto-char (cddr syntax)))
+		  (beginning-of-line)
+		  (if (looking-at "[ \t]") 2 3))
+	      (length (car syntax)))
+	    nil nil))
+      '("-" "" "" 0)))
+
+
+;;;===========================================================================
+;;;  Inserting
+;;;===========================================================================
+
+(defun template-insert-newline (string &optional limit start-limit)
+  "Deletes blank lines around point and insert STRING.
+After optional LIMIT and before optional START-LIMIT, no character will
+be deleted."
+  (let ((start (save-excursion
+		 (skip-chars-backward " \t\n\f" start-limit)
+		 (or (bobp) (forward-line 1))
+		 (point)))
+	(end (save-excursion
+	       (skip-chars-forward " \t\n\f" limit)
+	       (beginning-of-line)
+	       (point))))
+    (if (> end start) (delete-region start end)))
+  (or (bobp) (insert string)))
+
+(defun template-insert-separator (separator &optional cstring syntax)
+  "Insert separator line at point.
+If CSTRING is not nil, insert in special line which starts with CSTRING.
+Insert SEPARATOR repeatedly.  End the line with COMMENT-END as specified
+in `template-comment-syntax'."
+  (when separator
+    (when cstring
+      (open-line 1)
+      (insert cstring)
+      (template-indent-according-to-mode))
+    (end-of-line)
+    (let* ((estring (cadr syntax))
+	   (max-column (if estring
+			   template-max-column-with-end
+			 template-max-column))
+	   (max (- (if (> max-column 0) max-column (+ fill-column max-column))
+		   (length separator)
+		   (length estring))))
+      (while (<= (current-column) max) (insert separator))
+      (if (>= (length separator) (- (current-column) max))
+	  (insert (substring separator 0 (- max (current-column)))))
+      (if estring (insert estring))
+      (if cstring (forward-line 1)))))
+
+
+;;;===========================================================================
+;;;  Adaptations: cc-mode
+;;;===========================================================================
+
+;; There isn't really anything I can do against the filling of "/**" in C, C++
+;; and Antlr mode (it is correct in Java), it should be done in the cc-mode
+;; package.  Similar for filling "*/" with the previous line...
+
+(defun template-c-fill-paragraph (&optional arg)
+  ;; checkdoc-params: (arg)
+  "Like \\[c-fill-paragraph] but handles comment separator lines."
+  (let* ((regexp (concat "\\|[ \t]*\\(/[*/]\\|\\*\\)[ \t]*"
+			 (template-comment-separator-regexp '("/*" "*/"))))
+	 (paragraph-start (concat paragraph-start regexp)) ;#dynamic
+	 (paragraph-separate (concat paragraph-separate regexp)))
+    (c-fill-paragraph arg)))
+
+(defun template-c-init-fill-function ()
+  "Set `fill-paragraph-function' to use `template-c-fill-paragraph'."
+  (when (boundp 'fill-paragraph-function)
+    (make-local-variable 'fill-paragraph-function)
+    (setq fill-paragraph-function 'template-c-fill-paragraph)))
+
+
+
+;;;;##########################################################################
+;;;;  Updating (File Name in Header)
+;;;;##########################################################################
+
+
+;;;===========================================================================
+;;;  General updating
+;;;===========================================================================
+
+(defun template-update-buffer-region (limit regexp group)
+  "Return region = (BEG . END) in buffer to be updated.
+If LIMIT is positive, check first LIMIT characters in buffer, otherwise
+check last -LIMIT characters in buffer for a text to be matched by
+REGEXP.  Return region according to GROUP's regexp group in REGEXP."
+  (let ((case-fold-search nil))
+    (goto-char (if limit
+		   (if (natnump limit) (point-min) (+ (point-max) limit))
+		 (point-min)))
+    (when (re-search-forward regexp
+			     (if (natnump limit)
+				 (+ (point-min) limit)
+			       (point-max))
+			     t)
+      (cons (match-beginning group) (match-end group)))))
+
+(defun template-match-modes-or-regexp (modes-or-regexp)
+  "Return non-nil, if the current buffer passes MODES-OR-REGEXP.
+If MODES-OR-REGEXP is a list, it must include the current `major-mode',
+if it is a regexp, it must match the `buffer-file-name' without version,
+otherwise it must be non-nil."
+  (if (stringp modes-or-regexp)
+      (and buffer-file-name
+	   (string-match modes-or-regexp
+			 (file-name-sans-versions buffer-file-name)))
+    (or (nlistp modes-or-regexp) (memq major-mode modes-or-regexp))))
+
+(defun template-update-buffer (&optional arg)
+  "Update buffer according to `template-update-buffer-alist'.
+Do not do anything if `template-auto-update-disable-regexp' matches the
+file name or if `template-auto-update' is nil.  When optional ARG is
+non-nil, i.e., if called interactively *without* prefix arg, always
+update."
+  (interactive (list (null current-prefix-arg)))
+  (when (or arg
+	    (and template-auto-update buffer-file-name
+		 (null (and template-auto-update-disable-regexp
+			    (string-match template-auto-update-disable-regexp
+					  buffer-file-name)))))
+    (save-excursion
+      (save-restriction
+	(widen)
+	(let ((alist template-update-buffer-alist)
+	      (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt)))
+	      stamp prompt region new)
+	  (while alist
+	    (setq stamp (pop alist))
+	    (condition-case nil
+		(and (template-match-modes-or-regexp (pop stamp))
+		     ;; Run TEST ---------------------------------------------
+		     (setq prompt (pop stamp)
+			   region (pop stamp) ; TEST
+			   region (eval (if (or (atom region)
+						(functionp (car region)))
+					    region
+					  (cons 'template-update-buffer-region
+						region))))
+		     (if (stringp (setq new (eval (pop stamp))))
+			 (null (string= (buffer-substring (car region)
+							  (cdr region))
+					new))
+		       (car stamp))
+		     ;; user confirmation, replacement -----------------------
+		     (or (null prompt)
+			 arg
+			 (eq template-auto-update t)
+			 (y-or-n-p (format prompt (buffer-name))))
+		     (progn
+		       (goto-char (car region))
+		       (if (car stamp)
+			   (funcall (car stamp) new (car region) (cdr region))
+			 (delete-region (car region) (cdr region))
+			 (insert new))))
+	      (error nil))))))))
+
+
+;;;===========================================================================
+;;;  Update header
+;;;===========================================================================
+
+;;;###autoload
+(defun template-update-header (&optional show)
+  "Replace old file name in header with current file name.
+If SHOW is t, just return region of the filename or nil.  Otherwise,
+replace filename if possible and signal an error if SHOW is nil and
+there is no filename in the header.  See `template-header-lines' and
+`template-header-regexp-alist'."
+  (interactive "*P")
+  (if buffer-file-name
+      (save-excursion
+	(goto-char (point-min))
+	(let ((case-fold-search nil)
+	      (comment-regexp (template-default-comment)) ; at `point-min'!
+	      (end (progn (forward-line template-header-lines) (point)))
+	      (alist template-header-regexp-alist)
+	      (disallowed "")
+	      group)
+	  (if (string-match "[A-Za-z]\\|.." comment-regexp)
+	      (setq comment-regexp (regexp-quote comment-regexp)
+		    disallowed "")
+	    (or (eq comment-regexp '(?\]))
+		(setq disallowed comment-regexp))
+	    (setq comment-regexp (concat (regexp-quote comment-regexp) "+")))
+	  (while alist
+	    (goto-char (point-min))
+	    (if (re-search-forward (format (caar alist)
+					   comment-regexp disallowed)
+				   end t)
+		(setq group (cdar alist)
+		      alist nil)
+	      (setq alist (cdr alist))))
+	  (if (and group (match-beginning group))
+	      (if (eq show t)
+		  (cons (match-beginning group) (match-end group))
+		(goto-char (match-beginning group))
+		(delete-region (point) (match-end group))
+		(insert (file-name-sans-versions
+			 (file-name-nondirectory buffer-file-name)))
+		t)
+	    (if show nil (error "No file name in header")))))
+    (if show nil (error "Buffer is not visiting a file"))))
+
+
+
+;;;;##########################################################################
+;;;;  Templates
+;;;;##########################################################################
+
+
+(defvar template-history nil
+  "History, used by `template-read'.")
+
+(defvar template-choice-history nil
+  "History, used by `template-choice'.")
+
+(put 'normal-mode 'template-secure-command t)
+
+(defvar template-all-templates nil
+  "Internal variable.  Template files used for template derivation.")
+(defvar template-file nil
+  "Partitioned name of new file: (DIR FILE RAW NUMBER EXT).
+Internal variable.  DIR is the directory part, FILE the file name
+without directory part.  FILE consists of its extension EXT, RAW and a
+numbering NUMBER just in front of the extension.  It is used by the
+expansions DIR, FILE, FILE_SANS, FILE_EXT and others in
+`template-expansion-alist'.  Also useful for user defined functions in
+`template-derivation-alist' and the per-template definition section.")
+
+(defvar template-modified nil
+  "Internal variable.  Whether user is asked during the expansion process.")
+(defvar template-secure t
+  "Internal variable.  Whether all per-template definitions are secure.")
+(defvar template-point-messages nil
+  "Internal variable.  List of lines for temporary message at point.")
+(defvar template-before-messages nil
+  "Internal variable.  List of lines for temporary message before expansion.")
+(defvar template-after-messages nil
+  "Internal variable.  List of lines for temporary message after expansion.")
+
+(defvar template-point nil
+  "Internal variable.  Position of point.  Set with expansion form P.")
+(defvar template-mark nil
+  "Internal variable.  Position of mark.  Set with expansion form M.")
+
+(defvar template-current nil
+  "Internal variable.  Current key of expansion form.")
+(defvar template-string-alist nil
+  "Internal variable.  Alist of user inputs for `template-read'.")
+(defvar template-register-alist nil
+  "Internal variable.  Alist of used registers.")
+(defvar template-local-alist nil
+  "Internal variable.  Alist of per-template defined expansions.")
+
+(defvar template-ffap-file-finder nil
+  "Value used inside `template-ffap-find-file'.
+If nil, initialize it to the value of `ffap-file-finder', i.e., this
+variable holds the original value of that variable which will be set to
+`template-ffap-find-file' in `template-initialize'.")
+
+
+;;;===========================================================================
+;;;  Functions: `find-file'/`insert-file-contents', hooking into `find-file'
+;;;===========================================================================
+
+(defun template-find-template (filename &optional replace)
+  "Switch to a buffer visiting template file FILENAME.
+If optional REPLACE is non-nil, replace the current buffer contents with
+the contents of file FILENAME.
+
+This function always considers template files as text files."
+  (let ((file-name-buffer-file-type-alist nil))	; Emacs on DOS/NT
+    (if replace
+	(insert-file-contents filename nil nil nil
+			      ;; 5th arg not t with empty accessible part
+			      ;; (XEmacs bug workaround: would infloop)
+			      (> (point-max) (point-min)))
+      (let ((template-auto-insert nil))
+	(switch-to-buffer (find-file-noselect filename))))))
+
+(defun template-not-found-function ()
+  "Use a template when visiting a non-existent file.
+See `template-auto-insert' and `template-find-file-commands'.  Function
+in `find-file-not-found-hooks'."
+  (and template-auto-insert (not buffer-read-only) (bobp) (eobp)
+       (or (memq this-command template-find-file-commands)
+	   (and (memq this-command template-file-select-commands)
+		;; thanks to Dave Love :
+		(memq (car-safe (car command-history))
+		      ;; To always include `find-file-at-point', use ffap
+		      ;; initialization (see `template-ffap-find-file')
+		      template-find-file-commands)))
+       (let ((template (cdr (template-derivation buffer-file-name t t))))
+	 (and template
+	      (file-readable-p template)
+	      (or (eq template-auto-insert t)
+		  (y-or-n-p
+		   (format "Use template %s? "
+			   (cond-emacs-xemacs
+			    (abbreviate-file-name template :XEMACS t)))))
+	      (progn
+		(template-new-file nil template)
+		(setq this-command 'session-disable)
+		t)))))
+
+(defun template-ffap-find-file (filename)
+  "Function to use in `ffap-file-finder'.
+Add an entry to `command-history' if necessary and call function in
+`template-ffap-file-finder' with argument FILENAME."
+  (or (memq (car-safe (car command-history))
+	    '(ffap find-file-at-point))
+      (setq command-history
+	    (cons (list 'find-file-at-point filename) command-history)))
+  (if (eq template-ffap-file-finder 'template-ffap-find-file)
+      (find-file filename)
+    (funcall template-ffap-file-finder filename)))
+
+
+;;;===========================================================================
+;;;  Main function
+;;;===========================================================================
+
+(defun template-expand-template-interactive ()
+  (let* ((use (template-derivation (expand-file-name
+				    (or buffer-file-name "NONE"))
+				   t))
+	 (tpl (read-file-name "Insert and expand template: "
+			      (file-name-directory (cdr use))
+			      (file-name-nondirectory (cdr use))
+			      t
+			      (file-name-nondirectory (cdr use)))))
+    (if (string= tpl "")
+	(error "No template file provided"))
+    (list (expand-file-name tpl (file-name-directory (cdr use))))))
+
+;;;###autoload
+(defun template-expand-template (template)
+  "Expand template file TEMPLATE and insert result in current buffer.
+Using a template for inserting some text consists of:
+  1. Template derivation: suggest a reasonable template file to the user
+     according to `buffer-file-name', see `template-derivation-alist'.
+  2. Template insertion: insert the template file at point into the
+     current buffer.
+  3.. as steps 6.. of `template-new-file'."
+  (interactive (template-expand-template-interactive))
+  (save-restriction
+    (narrow-to-region (point) (point))
+    (template-new-file nil template t)))
+
+(defun template-new-file-interactive ()
+  "Interactive specification for `template-new-file'.
+Return \(FILE TEMPLATE)."
+  (let* ((inp (read-file-name (if current-prefix-arg
+				  "New file (+template, no name change): "
+				"New file (+template): ")
+			      nil ""))
+	 (use (cond ((equal inp "")
+		     (error "Empty/no input"))
+		    ((file-directory-p inp)
+		     (error "%S is a directory" inp))
+		    (t (template-derivation (expand-file-name inp)
+					    current-prefix-arg))))
+	 (tpl (read-file-name (format "File %s uses template: "
+				      (file-name-nondirectory (car use)))
+			      (file-name-directory (cdr use))
+			      (file-name-nondirectory (cdr use))
+			      t
+			      (file-name-nondirectory (cdr use)))))
+    (list (car use)
+	  (if (string= tpl "")
+	      nil
+	    (expand-file-name tpl (file-name-directory (cdr use)))))))
+
+;;;###autoload
+(defun template-new-file (file template &optional with-undo)
+  "Open a new file FILE by using a TEMPLATE.
+Using a template for creating a new file consists of, steps 1 to 3 are
+only executed when called interactively:
+  1. Prompt for the name of the new file.
+  2. Template derivation: suggest a reasonable template file to the user
+     see `template-derivation-alist'.
+  3. File name refinement: e.g., if the given file name is \"exercise\"
+     and there are two files \"exercise1.tex\" and \"exercise2.tex\" in
+     the same directory and if we have a template \"exercise.tex.tpl\",
+     the file name is refined to \"exercise3.tex\".  This is turned off
+     when \\[template-new-file] is called with a prefix argument.
+  4. Template insertion: insert the template file into the empty buffer.
+  5. Read per-template expansion definition section starting at
+     `template-definition-start' and delete it.
+  6. Display :before message in `template-message-buffer'.
+  7. Execute pre-expansion commands defined in the definition section.
+  8. Set local variables defined in the definition section.
+  9. Expansion: expand the expansion forms (text matched by
+     `template-expansion-regexp') They are defined in the definition
+     section, in `template-expansion-alist', or provided by default, see
+     `template-expansion-regexp' and `template-register-regexp'.
+ 10. Execute post-expansion commands defined in the definition section.
+ 11. Run `normal-mode' and functions in `find-file-hooks'.
+ 12. Update header according to `template-update-header' with argument
+    `if-exists'.
+ 13. Display :after message in `template-message-buffer'.
+ 14. Report: display a temporary message at point defined in the
+     definition section and an automatically generated message in the
+     minibuffer area, see `template-message-timeout'.
+
+If optional WITH-UNDO is non-nil, store corresponding changes in
+`buffer-undo-list'.  If FILE is nil, the buffer for FILE has already
+been created and the accessible part will be replaced by the expanded
+template.  If TEMPLATE is nil (empty input when called interactively),
+do not use a template."
+  (interactive (template-new-file-interactive))
+  ;; check template and file name --------------------------------------------
+  (if template
+      (if (file-readable-p template)
+	  (if (file-directory-p template)
+	      (error "Template %s is a directory" template))
+	(if (null (yes-or-no-p (format "Template %s does not exist.  Create? "
+				       template)))
+	    (error "No template file to use")
+	  (template-make-directory (file-name-directory template))
+	  (template-find-template template)
+	  (error "You should create this template first"))))
+  (if (not file)
+      (switch-to-buffer (current-buffer))
+    (and (or (get-file-buffer file) (file-exists-p file))
+	 (null (yes-or-no-p (format "File %s exists.  Delete contents? " file)))
+	 (error "Cannot use templates for existing files"))
+    (let ((auto-mode-alist nil)
+	  (enable-local-variables nil)
+	  (find-file-not-found-hooks nil)
+	  (enable-local-eval nil))
+      (switch-to-buffer (find-file-noselect file))))
+  (when template
+    (or with-undo (setq buffer-undo-list t))
+    (template-find-template template t)
+    (template-new-file-0 with-undo)))
+
+(defun template-new-file-0 (with-undo)
+  "Perform template replacements in current buffer.
+If WITH-UNDO is non-nil, store corresponding changes in
+`buffer-undo-list'."
+  ;; start replacement -------------------------------------------------------
+  (or with-undo (set-buffer-modified-p nil))
+  (goto-char (point-min))
+  (setq template-secure t
+	template-point nil
+	template-mark nil
+	template-modified nil
+	template-point-messages nil
+	template-before-messages nil
+	template-after-messages nil
+	template-local-alist nil
+	template-register-alist nil
+	template-string-alist nil)
+  (let ((form-selector nil)
+	(pre-command-list nil)
+	(post-command-list nil)
+	(local-variable-list nil)
+	val)
+    ;; read per-template definition section ----------------------------------
+    (goto-char (point-min))
+    (when (re-search-forward
+	   (concat "^[ \t]*" template-definition-start "[ \t]*$") nil t)
+      (condition-case ()
+	  (while t
+	    (setq val (read (current-buffer)))
+	    (cond (;; ("KEY" . xxx): ask user --------------------------------
+		   (and (consp val) (stringp (car val)))
+		   (let* ((def (cdr val)) ; expansion forms
+			  (msg (cond ((null template-message-prompt-format)
+				      nil)
+				     ((stringp def) def)
+				     ((and (consp def) (stringp (car def)))
+				      (car def)))))
+		     (when msg		; list prompts in before-messages
+		       (or template-before-messages
+			   (null template-message-prompt-intro)
+			   (push template-message-prompt-intro
+				 template-before-messages))
+		       (push (format template-message-prompt-format msg)
+			     template-before-messages))
+		     (push (cons (car val) (template-translate-definition def))
+			   template-local-alist)))
+		  ;; :before, :after, :eval-before, :eval-after --------------
+		  ((null val)		; nil is deprecated
+		   (setq form-selector
+			 (cond ((null form-selector) :old-before)
+			       ((eq form-selector :old-before) :old-after)
+			       ((eq form-selector :old-after)
+				(error "More than two (obsolete) nil forms"))
+			       (t
+				(error "Used obsolete nil form with new form selectors")))))
+		  ((memq val '(:before :after :eval-before :eval-after))
+		   (setq form-selector val))
+		  ;; "MESSAGE" -----------------------------------------------
+		  ((stringp val)
+		   (cond ((eq form-selector :before)
+			  (push val template-before-messages))
+			 ((eq form-selector :after)
+			  (push val template-after-messages))
+			 (t
+			  (push val template-point-messages))))
+		  ;; (CHAR . xxx): set register ------------------------------
+		  ((and (consp val) (template-char-or-char-int-p (car val)))
+		   (let ((reg (template-char-or-int-to-char (car val))))
+		     (if (atom (cdr val))
+			 (set-register reg (cdr val))
+		       (set-register reg (cadr val))
+		       (when template-message-register-format
+			 (let ((msg (format template-message-register-format
+					    reg (cadr val)
+					    (or (caddr val) ""))))
+			   (if template-message-buffer
+			       (progn
+				 (if template-before-messages
+				     (push msg template-before-messages))
+				 (or template-after-messages
+				     (null template-message-register-intro)
+				     (push template-message-register-intro
+					   template-after-messages))
+				 (push msg template-after-messages))
+			     (push msg template-point-messages)))))))
+		  ;; set var, execute command and sexpr ----------------------
+		  ((and (memq form-selector '(nil :before :after))
+			(consp val)
+			(symbolp (car val)))
+		   (or (and (functionp (get (car val) 'template-secure-value))
+			    (funcall (get (car val) 'template-secure-value)
+				     (cdr val)))
+		       (setq template-secure nil))
+		   (push val local-variable-list))
+		  ((memq form-selector '(:eval-before :old-before))
+		   (push (template-elisp-in-definition val)
+			 pre-command-list))
+		  ((memq form-selector '(:eval-after :old-after))
+		   (push (template-elisp-in-definition val)
+			 post-command-list))
+		  (t
+		   (error "Illegal form"))))
+	(error nil))
+      (skip-chars-forward " \t\n\f")
+      (or (eobp)
+	  (error "Invalid definition in line %d (pos %d) of the template file"
+		 (count-lines 1 (point)) (point)))
+      (or template-secure
+	  (null (default-value template-confirm-insecure))
+	  (y-or-n-p "Have you checked the template functions? ")
+	  (error "Failed security check"))
+      (delete-region (match-beginning 0) (point-max)))
+    ;; expand ----------------------------------------------------------------
+    (template-display-messages template-before-messages)
+    (eval (cons 'progn (nreverse pre-command-list)))
+    (while local-variable-list
+      (make-local-variable (caar local-variable-list))
+      (set (caar local-variable-list) (cdar local-variable-list))
+      (setq local-variable-list (cdr local-variable-list)))
+    (goto-char (point-min))
+    (while (re-search-forward template-expansion-regexp nil t)
+      (setq template-current (buffer-substring (match-beginning 1)
+					       (match-end 1))
+	    val (assoc template-current template-local-alist))
+      (unless val
+	(if (setq val (assoc template-current template-key-alias-alist))
+	    (setq template-current (cdr val)))
+	(setq val (or (assoc template-current template-expansion-alist)
+		      (assoc template-current
+			     template-default-expansion-alist))))
+      (delete-region (match-beginning 0) (match-end 0))
+      (cond (val
+	     (eval (cons 'progn (cdr val))))
+	    ((string-match template-register-regexp template-current)
+	     (template-register))
+	    (t
+	     (template-read (format "Replacement for `%s': "
+				    template-current)))))
+    (eval (cons 'progn (nreverse post-command-list)))
+    (save-restriction
+      (widen)
+      (normal-mode t)
+      (or with-undo (template-update-header 'if-exists))
+      (run-hooks 'find-file-hooks))
+    ;; message ---------------------------------------------------------------
+    (template-display-messages template-after-messages)
+    (cond ((null template-register-alist)
+	   (message "%s, no buffer location in register"
+		    (if template-mark "Mark set" "No mark")))
+	  (t (message "%s, buffer location in register: %s"
+		      (if template-mark "Mark set" "No mark")
+		      (mapconcat (function
+				  (lambda (x)
+				    (if (cdr x)
+					(concat (char-to-string (car x)) "*")
+				      (char-to-string (car x)))))
+				 (nreverse template-register-alist)
+				 ", "))))
+    (or with-undo (set-buffer-modified-p template-modified))
+    (goto-char (point-min))
+    (when template-point
+      (goto-char template-point)
+      (set-marker template-point nil))
+    (when template-mark
+      (push-mark template-mark)
+      (set-marker template-mark nil)
+      (if (fboundp 'zmacs-activate-region) (zmacs-activate-region)))
+    (when (and template-point-messages
+	       (or (cdr template-point-messages)
+		   (not (string-equal (car template-point-messages) ""))))
+      (let ((beg (point))
+	    end)
+	(if (cdr template-point-messages)
+	    (insert (mapconcat 'identity
+			       (nreverse template-point-messages)
+			       "\n")
+		    "\n")
+	  (insert (car template-point-messages)))
+	(setq end (point))
+	(goto-char beg)
+	(and (fboundp 'make-extent) (fboundp 'set-extent-face)
+	     (set-extent-face (make-extent beg end) 'template-message-face))
+	(recenter)
+	(sit-for template-message-timeout)
+	(delete-region beg end))))
+  (recenter)
+  (unless with-undo
+    (setq buffer-undo-list nil)
+    (set-buffer-modified-p template-modified)))
+
+(defun template-display-messages (messages)
+  (when (and messages template-message-buffer)
+    (setq messages (nreverse messages))
+    (with-output-to-temp-buffer template-message-buffer
+      (while messages
+	(princ (pop messages))
+	(if messages (princ "\n"))))))
+
+
+;;;===========================================================================
+;;;  Determine name of the new file and the template
+;;;===========================================================================
+
+(defun template-derivation (full arg &optional no-default)
+  "Derive template file name and do file name refinement.
+Return (REFINED . TEMPLATE) where REFINED is the refined version of FULL
+and TEMPLATE and template file name, see `template-derivation-alist'.
+FULL is the initial file name given by the user.  File name refinement
+is turned off when ARG is non-nil.  If optional argument NO-DEFAULT is
+non-nil, return nil instead (FULL \. \"~/.templates/DEFAULT.tpl\") if no
+matching entry can be found in `template-derivation-alist'."
+  ;; Get all templates -------------------------------------------------------
+  (setq template-all-templates nil)
+  (let* ((dir (file-name-directory full))
+	 (len (length dir))
+	 (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt))))
+    (while (and dir
+		(not (and template-stop-derivation
+			  (fboundp template-stop-derivation)
+			  (funcall template-stop-derivation dir))))
+      (template-all-templates template-subdirectories dir)
+      (setq dir (file-name-directory (directory-file-name dir)))
+      (or (> len (setq len (length dir)))
+	  (setq dir nil)))
+    (template-all-templates template-default-directories)
+    (setq template-all-templates (nreverse template-all-templates)))
+  ;; Get template file -------------------------------------------------------
+  (if (string= (file-name-nondirectory full) "")
+      (error "You cannot use templates for directories"))
+  (setq template-file (template-split-filename full))
+  (let ((tests template-derivation-alist)
+	test template file)
+    (while tests
+      (setq test (caar tests)
+	    file (cdar tests))
+      (if (setq template
+		(if (functionp (car test))
+		    (apply (car test) (cdr test))
+		  (apply 'template-default-template test)))
+	  (setq tests nil)
+	(setq tests (cdr tests))))
+    (if template
+	(or arg
+	    (if (functionp (car file))
+		(apply (car file) template (cdr file))
+	      (apply 'template-unique-file template file)))
+      (or no-default
+	  (setq template (template-split-filename
+			  "DEFAULT"
+			  (template-default-directory)))))
+    (if template
+	(cons (expand-file-name (cadr template-file) (car template-file))
+	      (expand-file-name (concat (cadr template) template-extension)
+				(car template))))))
+
+(defun template-default-directory ()
+  "Return directory of file \"DEFAULT.tpl\"."
+  (let ((dirs template-default-directories)
+	(name (concat "DEFAULT" template-extension))
+	dir)
+    (while dirs
+      (setq dir (pop dirs))
+      (if (file-readable-p (expand-file-name name dir))
+	  (setq dirs nil)
+	(setq dir nil)))
+    (or dir
+	(car template-default-directories)
+	(expand-file-name "~/.templates/"))))
+
+
+;;;===========================================================================
+;;;  Small functions
+;;;===========================================================================
+
+(defun template-make-directory (dir)
+  "Create DIR if it does not exists yet."
+  (cond ((file-exists-p dir))
+	((yes-or-no-p (format "The directory %s does not exist.  Create? " dir))
+	 (make-directory dir t))
+	(t (error "You should create a directory \"%s\"" dir)))
+  dir)
+
+(defun template-split-filename (file &optional dir)
+  "Split file name into its parts.
+If DIR is nil, FILE is a fully expanded file name, otherwise FILE is a
+file name without its directory part DIR.  See `template-file'."
+  (or dir (setq dir (template-make-directory (file-name-directory file))
+		file (file-name-nondirectory file)))
+  (let* ((ext (string-match "\\.[^.]*\\'" file))
+	 (raw (substring file 0 ext))
+	 (num (string-match "[^0-9][0-9]+\\'" raw)))
+    (if num
+	(list dir file
+	      (substring raw 0 (1+ num))
+	      (substring raw (1+ num))
+	      (if ext (substring file ext) ""))
+      (list dir file raw "" (if ext (substring file ext) "")))))
+
+(defun template-translate-definition (def)
+  "Translate DEF of expansion and set `template-secure' accordingly."
+  (cond ((null def) ; zero form
+	 nil)
+	((template-char-or-char-int-p def)
+	 `((template-register ,def)))
+	((stringp def)
+	 `((template-read ,def nil nil nil t)))
+	((symbolp def)
+	 `((insert (if (stringp ,def) ,def template-string-default))))
+	((and (consp def) (stringp (car def)))
+	 (if (consp (car-safe (cdr def)))
+	     `((template-choice ,(car def) (quote ,(cdr def))))
+	   `((apply (quote template-read) (quote ,def)))))
+	((consp (car-safe def))
+	 (setq template-secure nil)
+	 def)
+	(t
+	 (list (template-elisp-in-definition (car def) (cdr def))))))
+
+(defun template-elisp-in-definition (def &optional prefix)
+  "Return valid elisp definition and set `template-secure' accordingly.
+DEF is the elisp form, PREFIX would be the prefix argument if DEF is a
+command."
+  (cond ((consp def)
+	 (setq template-secure nil)
+	 def)
+	((or (symbolp def) (vectorp def))
+	 (or (and (symbolp def) (get def 'template-secure-command))
+	     (setq template-secure nil))
+	 (if (and (symbolp def)
+		  (functionp (get def 'template-secure-command))
+		  (listp prefix)
+		  (funcall (get def 'template-secure-command) prefix))
+	     `(apply (quote ,def) (quote ,prefix))
+	   `(progn (setq prefix-arg (quote ,prefix))
+		   (command-execute (quote ,def)))))
+	(t
+	 (error "Illegal form"))))
+
+
+;;;===========================================================================
+;;;  Compute template name
+;;;===========================================================================
+
+(defun template-all-templates (dirs &optional base)
+  "Read names of template files in DIRS relatively to BASE.
+Insert the names to internal variable `template-all-templates'."
+  (let ((regexp (concat (regexp-quote template-extension) "\\'"))
+	(endpos (- (length template-extension)))
+	dir templates)
+    (while dirs
+      (setq dir (expand-file-name (car dirs) base)
+	    dirs (cdr dirs))
+      (cond-emacs-xemacs
+       (and (file-accessible-directory-p dir)
+	    (file-readable-p dir)
+	    (setq templates (directory-files dir t regexp :XEMACS nil t))
+	    (while templates
+	      (and :EMACS
+		   (not (file-directory-p (car templates)))
+		   :BOTH
+		   (file-readable-p (car templates))
+		   (push (template-split-filename (substring (car templates)
+							     0
+							     endpos))
+			 template-all-templates))
+	      (setq templates (cdr templates))))))))
+
+(defun template-set-template-part (part file-part)
+  "Set template part according to definition PART and FILE-PART.
+See `template-derivation-alist' for details."
+  (when part
+    (cond ((stringp part) part)
+	  ((eq part t) file-part)
+	  ((null (string= file-part "")) file-part))))
+
+(defun template-default-template (&optional raw num ext regexp)
+  "Return template according to RAW, NUM, EXT and REGEXP.
+See `template-derivation-alist' for details."
+  (if (or (null regexp) (string-match regexp (cadr template-file)))
+      (let ((templates template-all-templates)
+	    (file-rne (cddr template-file))
+	    result template-rne)
+	(setq raw (template-set-template-part raw (car file-rne))
+	      num (template-set-template-part num (cadr file-rne))
+	      ext (template-set-template-part ext (caddr file-rne)))
+	(while templates
+	  (setq template-rne (cddar templates))
+	  (if (and (or (null raw) (string= (car template-rne) raw))
+		   (or (null num) (string= (cadr template-rne) num))
+		   (or (null ext) (string= (caddr template-rne) ext)))
+	      (setq result (car templates)
+		    templates nil)
+	    (setq templates (cdr templates))))
+	result)))
+
+
+;;;===========================================================================
+;;;  File name refinement
+;;;===========================================================================
+
+(defun template-default-file (template &optional raw num ext)
+  "Refine file name according to TEMPLATE, RAW, NUM and EXT.
+The result is in `template-file'.  See `template-derivation-alist'."
+  (let ((template-rne (cddr template))
+	(file-rne (cddr template-file)))
+    (if raw
+	(if (eq raw t) (setq raw (car template-rne)))
+      (setq raw (car file-rne)))
+    (if num
+	(if (eq num t) (setq num (cadr template-rne)))
+      (setq num (cadr file-rne)))
+    (if ext
+	(if (eq ext t) (setq ext (caddr template-rne)))
+      (setq ext (caddr file-rne)))
+    (setcdr template-file (list (concat raw num ext) raw num ext))))
+
+(defunx template-unique-file (template &optional raw num ext auto-num)
+  "Refine file name according to TEMPLATE, RAW, NUM, EXT and AUTO-NUM.
+Use auto numbering if NUM is not \"\" or AUTO-NUM is non-nil.  The
+result is in `template-file'.  See `template-derivation-alist'."
+  (template-default-file template raw num ext)
+  (let* ((dir (car template-file))
+	 (full (expand-file-name (cadr template-file) dir)))
+    (when (if (string= (fourth template-file) "")
+	      auto-num
+	    (setq auto-num
+		  (and (or (get-file-buffer full)
+			   (file-readable-p full))
+		       (string-to-int (fourth template-file)))))
+      (setq auto-num (1- auto-num)
+	    raw (third template-file)
+	    ext (fifth template-file))
+      (let ((list (buffer-list))
+	    file1 dir1)
+	(while list
+	  (and (setq file1 (buffer-file-name (car list)))
+	       (setq dir1 (file-name-directory file1))
+	       (string= dir1 dir)
+	       (setq auto-num
+		     (max (template-filename-number
+			   (cddr (template-split-filename
+				  (file-name-nondirectory file1)
+				  dir1))
+			   raw ext)
+			  auto-num)))
+	  (setq list (cdr list)))
+	(setq list (directory-files dir nil nil t :XEMACS t))
+	(while list
+	  (unless (:EMACS file-directory-p (car list))
+	    (setq auto-num
+		  (max (template-filename-number
+			(cddr (template-split-filename (car list) dir))
+			raw ext)
+		       auto-num)
+		  list (cdr list))))
+	(template-default-file template raw
+			       (int-to-string (1+ auto-num))
+			       ext)))))
+
+(defun template-filename-number (file-rne raw ext)
+  "Return numbering in FILE-RNE if the RAW and EXT parts are equal."
+  (or (and (string= (car file-rne) raw)
+	   (string= (caddr file-rne) ext)
+	   (string-to-int (cadr file-rne)))
+      0))
+
+
+;;;===========================================================================
+;;;  Safe commands for per-template expansions
+;;;===========================================================================
+
+(defun template-insert-time (&optional format default)
+  "Insert time into current buffer using time format FORMAT.
+If FORMAT is not a string, it uses DEFAULT or `current-time-string'."
+  (interactive)
+  (insert (if (and (stringp format) (fboundp 'format-time-string))
+	      (format-time-string format (current-time))
+	    (or default (current-time-string)))))
+(put 'template-insert-time 'template-secure-command
+     (lambda (args)
+       (or (null args) (and (stringp (car args)) (null (cdr args))))))
+
+
+;;;===========================================================================
+;;;  Functions for the predefined expansions
+;;;===========================================================================
+
+(defun template-register (&optional register)
+  "Set current location in register REGISTER.
+That is, \\[jump-to-register] REGISTER jumps to the current position.
+If REGISTER is nil, use register corresponding to the last character in
+`template-current'."
+  (let* ((char (if register
+		   (template-char-or-int-to-char register)
+		 (aref template-current (1- (length template-current)))))
+	 (elem (assoc char template-register-alist)))
+    (point-to-register char)
+    (if elem
+	(setcdr elem t)
+      (push (list char) template-register-alist))))
+
+(defun template-read (prompt &optional prefix suffix default again-p)
+  "Ask user with PROMPT for a STRING to be inserted.
+If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT.
+If AGAIN-P is nil, do not ask if `template-current' appears another time
+as key in a expansion form.  If AGAIN-P is `expand', the inserted region
+is searched for expansion forms where STRING is marked as a literal
+environment, see `template-literal-environment'."
+  (setq template-modified t)
+  (let ((pos (point))
+	(elem (and (null again-p)
+		   (assoc template-current template-string-alist))))
+    (if elem
+	(setq elem (cdr elem))
+      (setq elem (read-from-minibuffer prompt nil nil nil
+				       'template-history)
+	    elem (cond ((string= elem "") (or default ""))
+		       ((eq again-p 'expand)
+			(concat prefix
+				(format template-expansion-format
+					(car template-literal-environment))
+				elem
+				(format template-expansion-format
+					(cdr template-literal-environment))
+				suffix
+				(format template-expansion-format
+					(car template-literal-environment))
+				(format template-expansion-format
+					(cdr template-literal-environment))))
+		       (t
+			(concat prefix elem suffix))))
+      (or again-p (push (cons template-current elem) template-string-alist)))
+    (insert elem)
+    (if (eq again-p 'expand) (goto-char pos))))
+
+(defun template-choice (prompt table)
+  "Ask user with PROMPT for a choice and insert it.
+Each element in TABLE looks like (ANSWER . TEXT).  Ask for an input with
+completion over all ANSWERs and insert corresponding TEXT if ANSWER is a
+string, otherwise ask a \"y or n\" question and use the result of
+`y-or-n-p' as ANSWER.  Expansion forms in TEXT will be expanded."
+  (setq template-modified t)
+  (let ((pos (point)))
+    (insert (or (cdr (assoc (if (stringp (caar table))
+				(completing-read prompt table nil t nil
+						 'template-choice-history)
+			      (y-or-n-p prompt))
+			    table))
+		"")
+	    (format template-expansion-format
+		    (car template-literal-environment))
+	    (format template-expansion-format
+		    (cdr template-literal-environment)))
+    (goto-char pos)))
+
+
+;;;===========================================================================
+;;;  Menu filter
+;;;===========================================================================
+
+(defun template-menu-filter (menu-items)
+  ;; checkdoc-params: (menu-items)
+  "Menu filter for `template-creation-menu'."
+  (let ((alist (append template-expansion-alist
+		       template-default-expansion-alist))
+	menu used key)
+    (while alist
+      (unless (member (setq key (car (pop alist))) used)
+	(push key used)
+	(push (vector (concat "Insert " key)
+		      (list 'template-insert-form current-prefix-arg key)
+		      t)
+	      menu)))
+    (append menu-items (nreverse menu))))
+
+
+;;;===========================================================================
+;;;  Insert and define forms
+;;;===========================================================================
+
+(defun template-buffer-template-p ()
+  "Return non-nil, if current buffer is likely to be a template file."
+  (and buffer-file-name
+       (string-match (concat (regexp-quote template-extension) "\\'")
+		     (file-name-sans-versions buffer-file-name))))
+
+(defun template-open-template ()
+  "If current buffer is no template file, open a new one."
+  (interactive)
+  (if (template-buffer-template-p)
+      (barf-if-buffer-read-only)
+    (let (name
+	  (dir (and (car template-subdirectories)
+		    (expand-file-name (car template-subdirectories)))))
+      (if (null buffer-file-name)
+	  (setq name (concat "TEMPLATE" template-extension))
+	(setq name (file-name-sans-versions
+		    (file-name-nondirectory buffer-file-name)))
+	(if (string-match ".\\.[^.]*\\'" name)
+	    (setq name (concat "TEMPLATE"
+			       (substring name (1+ (match-beginning 0)))
+			       template-extension))
+	  (setq name (concat name template-extension)
+		;; dot file => template not specific for directory
+		dir (car template-default-directories))))
+      (setq name (read-file-name "Open template file (empty=none): "
+				 dir nil nil name))
+      (or (string= name "")
+	  (template-find-template name)))))
+
+(defun template-insert-form (arg key)
+  "Insert an expansion form according to KEY into template.
+When called interactively, allow completion over all keys in
+`template-expansion-alist' and `template-default-expansion-alist'.
+If prefix ARG is nil, run `template-open-template' first."
+  (interactive
+   (list current-prefix-arg
+	 (completing-read "Insert key (0-9 for register position): "
+			  (append template-expansion-alist
+				  template-default-expansion-alist))))
+  (or arg (template-open-template))
+  (insert (format template-expansion-format key))
+  (if (equal key (car template-literal-environment))
+      (let ((pos (point)))
+	(insert (format template-expansion-format
+			(cdr template-literal-environment)))
+	(goto-char pos))))
+
+(defun template-define-start (arg &rest args)
+  "Insert a definition section and definition into template.
+See `template-definition-start'.  If ARGS is non-nil, pass ARGS to
+`format' for a new definition.  If prefix ARG is nil, run
+`template-open-template' first."
+  (interactive "P")
+  (or arg (template-open-template))
+  (save-excursion
+    (goto-char (point-min))
+    (unless (re-search-forward (concat "^[ \t]*"
+				       template-definition-start
+				       "[ \t]*$") nil t)
+      (goto-char (point-max))
+      (or (bolp) (insert "\n"))
+      (insert template-definition-start))
+    (goto-char (point-max))
+    (or (bolp) (insert "\n"))
+    (if args (insert (apply 'format args) "\n")))
+  (message "Put definition at the end of the template"))
+
+(defun template-define-message (arg message)
+  "Insert a temporary message MESSAGE definition into template.
+For ARG, see `template-define-start'."
+  (interactive "P\nsTemporary message: ")
+  (template-define-start arg "%S" message))
+
+(defun template-define-prompt (arg key prompt &optional prefix suffix default)
+  "Insert a definition for KEY as PROMPT into template.
+For ARG, see `template-define-start'."
+  (interactive "P\nsExpansion key: \nsExpansion prompt: \nsPrefix for non-empty input: \nsSuffix for non-empty input: \nsDefault for empty input: ")
+  (template-define-start arg "(%S %S %S %S %S)"
+			 key prompt prefix suffix default))
+
+(defun template-define-register (arg register)
+  "Insert a setting of REGISTER into template.
+For ARG, see `template-define-start'."
+  (interactive "P\ncDefine register: ")
+  (let* ((old (get-register register))
+	 (contents (read-from-minibuffer "Register contents: "
+				    (and (stringp old)
+					 (not (string-match "\n" old))
+					 old)))
+	 (comment (read-from-minibuffer "Comment (empty=none): ")))
+    (if (string= comment "")
+	(template-define-start arg "(%S %S)" register contents)
+      (template-define-start arg "(%S %S %S)" register contents comment))))
+  
+
+;;;===========================================================================
+;;;  Initialization
+;;;===========================================================================
+
+;; easymenu.el is for top-level menus only...
+(defunx template-add-submenu (menu &optional where)
+  "Add the submenu MENU to the end of a menu in WHERE in the menubar.
+WHERE is a list of menus tried to add MENU to.  If no such menu exist,
+no menu is added.  When using Emacs, always add to the \"Edit\" menu.
+See `easy-menu-define' for the format of MENU."
+  (and menu
+       :EMACS
+       (>= emacs-major-version 21)
+       (boundp 'menu-bar-edit-menu)
+       (let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
+	 ;; `easy-menu-get-map' doesn't get the right one => use hard-coded
+	 (define-key-after menu-bar-edit-menu (vector (intern (car menu)))
+	   (cons 'menu-item
+		 (cons (car menu)
+		       (if (not (symbolp keymap))
+			   (list keymap)
+			 (cons (symbol-function keymap)
+			       (get keymap 'menu-prop)))))))
+       :XEMACS
+       (featurep 'menubar)
+       (let ((current-menubar default-menubar) path)
+	 (while where
+	   (setq path (list (pop where)))
+	   (if (find-menu-item default-menubar path)
+	       (setq where nil)
+	     (setq path nil)))
+	 (when path (add-submenu path menu)))))
+
+;;;###autoload
+(defunx template-initialize (&rest dummies)
+  ;; checkdoc-params: (dummies)
+  "Initialized package template.  See variable `template-initialize'."
+  (interactive)
+  (setq template-use-package t)
+  (let ((regexp (concat (regexp-quote template-extension) "\\'")))
+    (or (assoc regexp auto-mode-alist)
+	(push (list regexp nil 'template-new-file) auto-mode-alist)))
+  (when (or (eq template-initialize t)
+	    (memq 'cc-mode template-initialize))
+    (add-hook 'c-mode-common-hook 'template-c-init-fill-function)
+    (add-hook 'antlr-mode-hook 'template-c-init-fill-function))
+  (when (or (eq template-initialize t)
+	    (memq 'de-html-helper template-initialize))
+    (setq html-helper-build-new-buffer nil)
+    (setq html-helper-do-write-file-hooks nil))
+  (when (or (eq template-initialize t)
+	    (memq 'keys template-initialize))
+    (condition-case nil			; older Emacses don't understand all
+	(progn
+	  (define-key ctl-x-map "t" 'template-new-file)
+	  (define-key ctl-x-map [(control =)] 'template-single-comment)
+	  (define-key ctl-x-map [(control ?\;)] 'template-block-comment))
+      (error nil)))
+  (when (or (eq template-initialize t)
+	    (memq 'menus template-initialize))
+    (template-add-submenu template-comment-menu :XEMACS '("Edit"))
+    (template-add-submenu template-creation-menu :XEMACS '("Cmds" "Edit"))
+    :EMACS
+    (and (boundp 'menu-bar-files-menu)
+	 (define-key-after menu-bar-files-menu [template-new-file]
+	   '(menu-item "New File Using Template..." template-new-file
+		       :enable (not (window-minibuffer-p
+				     (frame-selected-window
+				      menu-updating-frame)))
+		       :help "Create a new file, using a template")
+	   'dired))
+    :XEMACS
+    (and (featurep 'menubar)
+	 (find-menu-item default-menubar '("File"))
+	 (let ((current-menubar default-menubar))
+	   ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU
+	   (add-menu-button '("File")
+			    ["New File Using Template..." template-new-file
+			     :active t]
+			    "Insert File..."))))
+    (if (and (boundp 'init-file-loaded) init-file-loaded)
+      ;; doesn't exist in Emacs
+      (template-after-init)
+    (add-hook 'after-init-hook 'template-after-init t)))
+
+(defun template-after-init ()
+  "Late initialization for package template.
+See function and variable `template-initialize'."
+  (when (or (eq template-initialize t)
+	    (memq 'auto template-initialize))
+    (add-hook 'write-file-hooks 'template-update-buffer)
+    (add-hook 'find-file-not-found-hooks 'template-not-found-function t))
+  (when (or (eq template-initialize t)
+	    (memq 'ffap template-initialize))
+    (or template-ffap-file-finder
+	(setq template-ffap-file-finder
+	      (if (boundp 'ffap-file-finder)
+		  ffap-file-finder
+		(or (get 'ffap-file-finder 'saved-value) 'find-file))))
+    (setq ffap-file-finder 'template-ffap-find-file)))
+
+;;; Local IspellPersDict: .ispell_template
+;;; template.el ends here
diff --git a/malyon.el b/malyon.el
deleted file mode 100644
index 03ef759c..00000000
--- a/malyon.el
+++ /dev/null
@@ -1,3236 +0,0 @@
-; malyon.el --- mode to execute z code files version 3, 5, 8
-
-;; Maintainer: Peter Ilberg 
-;; (I am unable to continue supporting malyon.el. Please send me an
-;;  email if you are interested in taking over the project. Thanks.)
-
-;; Copyright (C) 1999-2011 Peter Ilberg
-
-;; 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.
-
-;;; Credits:
-
-;;   The author would like to thank the following people for reporting
-;;   bugs, testing, suggesting and/or contributing improvements:
-;;     Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko
-
-;;; Commentary:
-
-;; This package provides a basic interpreter for version 3, 5, 8 z code
-;; story files as generated by Inform (C) Graham Nelson and Infocom.
-
-;; If you encounter a bug please send a report to Peter Ilberg at 
-;; peter.ilberg@gmail.com. Thank you!
-
-;; To play a story file simple type M-x malyon and enter the path to the
-;; story file. If anything goes wrong and you want to manually clean
-;; up type M-x malyon-quit. In addition, you can switch back to a game in
-;; progress by typing M-x malyon-restore.
-
-;; A note on the format of saved game states:
-
-;; As of version 1.0, Malyon supports the quetzal file format for saved 
-;; games. Support for this format required changes to several internal
-;; data structures (stack frames and catch-throw) that are incompatible
-;; with the old implementation. Unfortunately, the old file format for
-;; saved games cannot be converted into quetzal.
-
-;; For backwards compatibility, however, Malyon still supports the old
-;; file format. And you can continue to play your old game states.
-
-;; Because of the incompatibility of the two file formats, Malyon now 
-;; runs, as follows, in either of two modes: quetzal and compatibility.
-
-;; - in quetzal mode, game states are saved in quetzal format
-;; - in compatibility mode, games states are saved in the old format
-;; - loading a game state in quetzal format switches to quetzal mode
-;; - loading an old game state switches to compatibility mode
-;; - quetzal mode is the default setting
-
-;; In other words, Malyon will only use the old file format if you've
-;; restored a game state saved in the old file format.
-
-;; Enjoy!
-
-;;; Code:
-
-;; global variables - moved here to appease the byte-code compiler
-
-;; story file information
-
-(defvar malyon-story-file-name nil
-  "The name of the story file being executed.")
-
-(defvar malyon-story-file nil
-  "The story file which is currently being run.")
-
-(defvar malyon-story-version nil
-  "The story file version.")
-
-(defvar malyon-supported-versions '(3 5 8)
-  "A list of supported story file versions.")
-
-;; status and transcript buffers
-
-(defvar malyon-transcript-buffer nil
-  "The main transcript buffer of the story file execution.")
-
-(defvar malyon-transcript-buffer-buffered nil
-  "Is output in the transcript buffer buffered?")
-
-(defvar malyon-status-buffer nil
-  "The status bar buffer of the story file execution.")
-
-(defvar malyon-status-buffer-lines nil
-  "The number of lines in the status bar buffer.")
-
-(defvar malyon-status-buffer-delayed-split nil
-  "If the number of lines in the status buffer is reduced,
-the window configuration is not changed immediately. It
-is changed after the next turn (read or read_char).")
-
-(defvar malyon-status-buffer-point nil
-  "The point location in the status bar buffer.")
-
-(defvar malyon-max-column 72
-  "Maximum column for text display.")
-
-;; window management
-
-(defvar malyon-window-configuration nil
-  "The current window configuration of the malyon interpreter.")
-
-(defvar malyon-current-window nil
-  "The currently active window for text output.")
-
-;; z machine registers
-
-(defvar malyon-stack nil
-  "The stack of the z machine.")
-
-(defvar malyon-stack-pointer nil
-  "The stack pointer of the z machine.")
-
-(defvar malyon-frame-pointer nil
-  "The frame pointer of the z machine.")
-
-(defvar malyon-instruction-pointer nil
-  "The instruction pointer of the z machine.")
-
-;; game file related global variables
-
-(defvar malyon-score-game nil
-  "A flag indicating whether this story uses score or time.")
-
-(defvar malyon-packed-multiplier nil
-  "The amount by which packed addresses are multiplied to get byte
-addresses.")
-
-(defvar malyon-global-variables nil
-  "A pointer to the global variable section in the story file.")
-
-(defvar malyon-abbreviations nil
-  "A pointer to the abbreviations in the story file.")
-
-(defvar malyon-alphabet nil
-  "The z machine's text alphabet.")
-
-(defvar malyon-whitespace nil
-  "A string of whitespace characters recognized by the interpreter.")
-
-;; object tables
-
-(defvar malyon-object-table nil
-  "A pointer to the object table in the story file.")
-
-(defvar malyon-object-table-entry-size nil
-  "The size of one entry in the object table.")
-
-(defvar malyon-object-properties nil
-  "The number of properties per object minus one.")
-
-(defvar malyon-object-property-offset nil
-  "The byte offset of the properties table in the object.")
-
-;; dictionaries
-
-(defvar malyon-dictionary nil
-  "A pointer to the dictionary of the story file.")
-
-(defvar malyon-dictionary-entry-length nil
-  "The length of a dictionary entry.")
-
-(defvar malyon-dictionary-num-entries nil
-  "The number of dictionary entries.")
-
-(defvar malyon-dictionary-entries nil
-  "A pointer to the first dictionary entry.")
-
-(defvar malyon-dictionary-word-length nil
-  "The length of a dictionary word.")
-
-;; game state information
-
-(defvar malyon-game-state-restart nil
-  "The machine state for implementing restart.")
-
-(defvar malyon-game-state-undo nil
-  "The machine state for implementing undo.")
-
-(defvar malyon-game-state-quetzal t
-  "Store game state information for quetzal.")
-
-;; various
-
-(defvar malyon-current-face nil
-  "The current face in which to display text.")
-
-(defvar malyon-last-cursor-position-after-input nil
-  "The last cursor position after reading input from the keyboard.")
-
-;; interactive functions
-
-(defun malyon (file-name)
-  "Major mode for playing z3/5/8 story files.
-This mode allows execution of version 3, 5, 8 z code story files."
-  (interactive "fStory file name: ")
-  (if malyon-story-file
-      (message "You are already playing a game.")
-    (if (not (string-match ".*\.z[358]$" file-name))
-	(message "%s is not a version 3, 5, or 8 story file." file-name)
-      (condition-case nil
-	  (malyon-load-story-file file-name)
-	(error
-	 (malyon-fatal-error "loading of story file failed.")))
-      (setq malyon-story-version (aref malyon-story-file 0))
-      (cond ((memq malyon-story-version malyon-supported-versions)
-	     (condition-case nil
-		 (malyon-initialize)
-	       (error
-		(malyon-fatal-error "initialization of interpreter failed.")))
-	     (malyon-interpreter))
-	    (t
-	     (message "%s is not a version 3, 5, or 8 story file." file-name)
-	     (malyon-cleanup))))))
-
-(defun malyon-restore ()
-  "Restore the save window configuration for the interpreter."
-  (interactive)
-  (condition-case nil
-      (progn
-	(malyon-restore-window-configuration)
-	(malyon-adjust-transcript))
-    (error
-     (malyon-fatal-error "restoring window configuration failed."))))
-
-(defun malyon-quit ()
-  "Exit the malyon interpreter."
-  (interactive)
-  (if malyon-story-file
-      (progn
-	(malyon-restore)
-	(if (malyon-yes-or-no-p-minibuf "Do you really want to quit? ")
-	    (malyon-cleanup)))))
-
-(defun malyon-mode ()
-  "This mode provides a basic interpreter for version 3, 5, 8 z code
-story files as generated by Inform (C) Graham Nelson and Infocom. 
-
-Note that this package is by no means complete and bug free.
-If you encounter a bug please send a report to Peter Ilberg at 
-peter.ilberg@natinst.com. Thank you!
-
-To play a story file simple type M-x malyon and enter the path to the
-story file. If anything goes wrong and you want to manually clean
-up type M-x malyon-quit. In addition, you can switch back to a game in
-progress by typing M-x malyon-restore.
-
-The author would like to thank the following people for reporting
-bugs, testing, suggesting and/or contributing improvements:
-    Bernhard Barde, Jonathan Craven, Alberto Petrofsky, Alan Shutko"
-  (message "Use M-x malyon if you want to play a zcode game."))
-
-;; compatibility functions for GNU emacs
-
-(if (fboundp 'cadr)
-    (defalias 'malyon-cadr 'cadr)
-  (defun malyon-cadr (list)
-    "Take the cadr of the list."
-    (car (cdr list))))
-
-(if (fboundp 'caddr)
-    (defalias 'malyon-caddr 'caddr)
-  (defun malyon-caddr (list)
-    "Take the caddr of the list."
-    (car (cdr (cdr list)))))
-
-(if (fboundp 'cdddr)
-    (defalias 'malyon-cdddr 'cdddr)
-  (defun malyon-cdddr (list)
-    "Take the cdddr of the list."
-    (cdr (cdr (cdr list)))))
-
-(if (fboundp 'char-before)
-    (defalias 'malyon-char-before 'char-before)
-  (defun malyon-char-before ()
-    "Return the character before the point."
-    (char-after (- (point) 1))))
-
-(if (fboundp 'char-to-int)
-    (defalias 'malyon-char-to-int 'char-to-int)
-  (defun malyon-char-to-int (c)
-    "Convert a character into an integer."
-    c))
-
-(if (fboundp 'characterp)
-    (defalias 'malyon-characterp 'characterp)
-  (defun malyon-characterp (x)
-    "Test for a character."
-    (and (numberp x) (<= 0 x) (< x 256))))
-
-(defun malyon-disable-multibyte ()
-  "Disable multibyte support in the current buffer."
-  (condition-case nil (set-buffer-multibyte nil) (error)))
-
-(defun malyon-erase-buffer (&optional buffer)
-  "Erase the given buffer."
-  (save-excursion
-    (if buffer (set-buffer buffer))
-    (if (and buffer (eq buffer malyon-transcript-buffer))
-	(malyon-begin-section)
-      (erase-buffer))))
-
-(if (fboundp 'int-to-char)
-    (defalias 'malyon-int-to-char 'int-to-char)
-  (defun malyon-int-to-char (i)
-    "Convert an integer into a character."
-    i))
-
-(if (fboundp 'mapc)
-    (defalias 'malyon-mapc 'mapc)
-  (defun malyon-mapc (function list)
-    "Apply fun to every element of args ignoring the results."
-    (if (null list)
-	'()
-      (funcall function (car list))
-      (malyon-mapc function (cdr list)))))
-
-(if (fboundp 'mapcan)
-    (defalias 'malyon-mapcan 'mapcan)
-  (defun malyon-mapcan (function list)
-    "Apply fun to every element of args nconc'ing the result."
-    (if (null list)
-	'()
-      (nconc (funcall function (car list))
-	     (malyon-mapcan function (cdr list))))))
-
-; Do not use the built-in conversion via 'multibyte-char-to-unibyte.
-(defun malyon-multibyte-char-to-unibyte (char)
-  "Convert a multibyte character to unibyte."
-  char)
-
-(defun malyon-point-max (&optional buffer)
-  "Get the point-max of the given buffer."
-  (save-excursion
-    (if buffer (set-buffer buffer))
-    (point-max)))
-
-(if (fboundp 'redisplay-frame)
-    (defalias 'malyon-redisplay-frame 'redisplay-frame)
-  (defun malyon-redisplay-frame (frame &rest ignore)
-    "Redisplay the given frame."))
-
-(if (fboundp 'remove)
-    (defalias 'malyon-remove 'remove)
-  (defun malyon-remove (element list)
-    "Remove the element from the list."
-    (cond ((null list)
-	   '())
-	  ((eq element (car list))
-	   (malyon-remove element (cdr list)))
-	  ((equal element (car list))
-	   (malyon-remove element (cdr list)))
-	  (t
-	   (cons (car list)
-		 (malyon-remove element (cdr list)))))))
-
-(if (fboundp 'set-keymap-name)
-    (defalias 'malyon-set-keymap-name 'set-keymap-name)
-  (defun malyon-set-keymap-name (keymap name)
-    "Set the name of the keymap."))
-
-(if (fboundp 'string-to-list)
-    (defalias 'malyon-string-to-list 'string-to-list)
-  (defun malyon-string-to-list (s)
-    "Convert a string into a list of characters."
-    (let ((i (- (length s) 1)) (l '()))
-      (while (<= 0 i)
-	(setq l (cons (aref s i) l)
-	      i (- i 1)))
-      l)))
-
-(if (fboundp 'string-to-vector)
-    (defalias 'malyon-string-to-vector 'string-to-vector)
-  (defun malyon-string-to-vector (s)
-    "Convert a string into a vector of characters."
-    (let* ((i 0) (l (length s)) (v (make-vector l 0)))
-      (while (< i l)
-	(aset v i (aref s i))
-	(setq i (+ 1 i)))
-      v)))
-
-; Do not use the built-in conversion via 'unibyte-char-to-multibyte.
-(defun malyon-unibyte-char-to-multibyte (char)
-  "Convert a unibyte character to multibyte."
-  char)
-
-(defun malyon-vector-to-list (v begin end)
-  "Return a list of elements in v in the range [begin, end)."
-  (let ((result '()))
-    (while (< begin end)
-      (setq result (cons (aref v begin) result))
-      (setq begin (+ 1 begin)))
-    (reverse result)))
-
-(if (fboundp 'window-displayed-height)
-    (defalias 'malyon-window-displayed-height 'window-displayed-height)
-  (defun malyon-window-displayed-height (&optional window)
-    "Get the height of the window's displayed region."
-    (- (window-height) 1)))
-
-(if (fboundp 'yes-or-no-p-minibuf)
-    (defalias 'malyon-yes-or-no-p-minibuf 'yes-or-no-p-minibuf)
-  (defun malyon-yes-or-no-p-minibuf (prompt)
-    "Ask a yes or no question."
-    (yes-or-no-p prompt)))
-
-;; global variables for the malyon mode
-
-(defvar malyon-syntax-table nil
-  "Syntax table used while in malyon mode (same as in text-mode).")
-
-(if malyon-syntax-table
-    '()
-  (setq malyon-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\" ".   " malyon-syntax-table)
-  (modify-syntax-entry ?\\ ".   " malyon-syntax-table)
-  (modify-syntax-entry ?'  "w   " malyon-syntax-table))
-
-(defvar malyon-keymap-read nil
-  "Keymap for malyon mode for reading input into a buffer.")
-
-(defvar malyon-history-saved-up nil
-  "The saved binding for the up arrow key.")
-
-(defvar malyon-history-saved-down nil
-  "The saved binding for the down arrow key.")
-
-(if malyon-keymap-read
-    '()
-  (setq malyon-keymap-read (make-sparse-keymap))
-  (malyon-set-keymap-name malyon-keymap-read 'malyon-keymap-read)
-  (setq malyon-history-saved-up   (global-key-binding [up]))
-  (setq malyon-history-saved-down (global-key-binding [down]))
-  (define-key malyon-keymap-read "\r"        'malyon-end-input)
-  (define-key malyon-keymap-read [up]        'malyon-history-previous-char)
-  (define-key malyon-keymap-read [down]      'malyon-history-next-char)
-  (define-key malyon-keymap-read "\M-p"      'malyon-history-previous-char)
-  (define-key malyon-keymap-read "\M-n"      'malyon-history-next-char)
-  (define-key malyon-keymap-read "\C-a"      'malyon-beginning-of-line)
-  (define-key malyon-keymap-read "\C-w"      'malyon-kill-region)
-  (define-key malyon-keymap-read "\C-k"      'malyon-kill-line)
-  (define-key malyon-keymap-read "\M-d"      'malyon-kill-word)
-  (define-key malyon-keymap-read "\C-y"      'malyon-yank)
-  (define-key malyon-keymap-read "\M-y"      'malyon-yank-pop)
-  (define-key malyon-keymap-read "\C-d"      'malyon-delete-char)
-  (define-key malyon-keymap-read "\d"        'malyon-backward-delete-char)
-  (define-key malyon-keymap-read [del]       'malyon-delete-char)
-  (define-key malyon-keymap-read [backspace] 'malyon-backward-delete-char)
-  (substitute-key-definition (lookup-key (current-global-map) "a")
-			     'malyon-self-insert-command
-			     malyon-keymap-read (current-global-map)))
-
-(defvar malyon-keymap-readchar nil
-  "Keymap for malyon mode for waiting for input.")
-
-(if malyon-keymap-readchar
-    '()
-  (setq malyon-keymap-readchar (make-sparse-keymap))
-  (malyon-set-keymap-name malyon-keymap-readchar 'malyon-keymap-readchar)
-  (define-key malyon-keymap-readchar "\r" 'malyon-wait-char)
-  (substitute-key-definition (lookup-key (current-global-map) "a")
-			     'malyon-wait-char
-			     malyon-keymap-readchar (current-global-map)))
-
-(defvar malyon-keymap-more nil
-  "Keymap for malyon mode for browsing through text.")
-
-(if malyon-keymap-more
-    '()
-  (setq malyon-keymap-more (make-sparse-keymap))
-  (malyon-set-keymap-name malyon-keymap-more 'malyon-keymap-more)
-  (define-key malyon-keymap-more "\r" 'malyon-more-char)
-  (substitute-key-definition (lookup-key (current-global-map) "a")
-			     'malyon-more-char
-			     malyon-keymap-more (current-global-map)))
-
-(defvar malyon-keymap-more-status nil
-  "Keymap for malyon mode for browsing through the status buffer.")
-
-(if malyon-keymap-more-status
-    '()
-  (setq malyon-keymap-more-status (make-sparse-keymap))
-  (malyon-set-keymap-name malyon-keymap-more-status 'malyon-keymap-more-status)
-  (define-key malyon-keymap-more-status "\r" 'malyon-more-char-status)
-  (substitute-key-definition (lookup-key (current-global-map) "a")
-			     'malyon-more-char-status
-			     malyon-keymap-more-status (current-global-map)))
-
-(defvar malyon-faces nil
-  "An association list of text faces used by the malyon mode.")
-
-(defun malyon-initialize-faces ()
-  (copy-face 'default  'malyon-face-plain)
-  (copy-face 'bold     'malyon-face-reverse)
-  (copy-face 'bold     'malyon-face-bold)
-  (copy-face 'italic   'malyon-face-italic)
-  (copy-face 'default  'malyon-face-error)
-  (set-face-foreground 'malyon-face-error "red")
-  (setq malyon-faces '((0 . malyon-face-plain)
-		       (1 . malyon-face-reverse)
-		       (2 . malyon-face-bold)
-		       (4 . malyon-face-italic)
-		       (8 . malyon-face-plain))))
-
-(defvar malyon-print-separator nil
-  "A flag indicating whether to print the * * * separator.")
-
-(defun malyon-begin-section ()
-  "Print a section divider and begin a new section."
-  (if malyon-print-separator
-      (progn
-	(malyon-mapc 'malyon-putchar-transcript '(?\n ?\n ?* ?  ?* ?  ?*))
-	(center-line)
-	(malyon-mapc 'malyon-putchar-transcript '(?\n ?\n))
-	(setq malyon-print-separator nil)))
-  (narrow-to-region (point-max) (point-max)))
-
-(if malyon-whitespace
-    '()
-  (setq malyon-whitespace (list (malyon-char-to-int ? )
-				(malyon-char-to-int ?\t)
-				(malyon-char-to-int ?\n)
-				(malyon-char-to-int ?\r))))
-
-;; memory utilities
-
-(defsubst malyon-read-byte (address)
-  "Read a byte at address in the story file."
-  (if (<= 0 address)
-      (aref malyon-story-file address)
-    (aref malyon-story-file (+ 65536 address))))
-
-(defsubst malyon-store-byte (address value)
-  "Store a byte at address in the story file."
-  (if (<= 0 address)
-      (aset malyon-story-file address (logand 255 value))
-    (aset malyon-story-file (+ 65536 address) (logand 255 value))))
-
-(defsubst malyon-read-word (address)
-  "Read a word at address in the story file."
-  (if (<= 0 address)
-      (logior (lsh (aref malyon-story-file address) 8)
-	      (aref malyon-story-file (+ 1 address)))
-    (logior (lsh (aref malyon-story-file (+ 65536 address)) 8)
-	    (aref malyon-story-file (+ 65537 address)))))
-	
-(defsubst malyon-store-word (address value)
-  "Store a word at address in the story file."
-  (if (<= 0 address)
-      (progn
-	(aset malyon-story-file address (logand 255 (lsh value -8)))
-	(aset malyon-story-file (+ 1 address) (logand 255 value)))
-    (aset malyon-story-file (+ 65536 address) (logand 255 (lsh value -8)))
-    (aset malyon-story-file (+ 65537 address) (logand 255 value))))
-
-(defsubst malyon-read-code-byte ()
-  "Read the next byte at the program counter location."
-  (setq malyon-instruction-pointer (+ malyon-instruction-pointer 1))
-  (malyon-read-byte (- malyon-instruction-pointer 1)))
-
-(defsubst malyon-read-code-word ()
-  "Read the next word at the program counter location."
-  (setq malyon-instruction-pointer (+ malyon-instruction-pointer 2))
-  (malyon-read-word (- malyon-instruction-pointer 2)))
-
-(defsubst malyon-pop-stack ()
-  "Pop a value off the stack."
-  (if (> 0 malyon-stack-pointer)
-      (malyon-fatal-error "stack underflow."))
-  (setq malyon-stack-pointer (- malyon-stack-pointer 1))
-  (aref malyon-stack (+ malyon-stack-pointer 1)))
-
-(defsubst malyon-read-local-variable (variable)
-  "Read a local variable."
-  (aref malyon-stack (+ variable malyon-frame-pointer)))
-
-(defsubst malyon-read-global-variable (variable)
-  "Read a global variable."
-  (malyon-read-word (+ malyon-global-variables (* 2 variable))))
-
-(defsubst malyon-read-variable (variable)
-  "Read a variable."
-  (cond ((= variable 0)  (malyon-pop-stack))
-	((< variable 16) (malyon-read-local-variable variable))
-	(t               (malyon-read-global-variable (- variable 16)))))
-
-(defsubst malyon-push-stack (value)
-  "Push a value onto the stack."
-  (setq malyon-stack-pointer (+ malyon-stack-pointer 1))
-  (aset malyon-stack malyon-stack-pointer value))
-
-(defsubst malyon-store-local-variable (variable value)
-  "Store a value in a local variable."
-  (aset malyon-stack (+ variable malyon-frame-pointer) value))
-
-(defsubst malyon-store-global-variable (variable value)
-  "Store a value in a global variable."
-  (malyon-store-word (+ malyon-global-variables (* 2 variable)) value))
-
-(defsubst malyon-store-variable (var value)
-  "Store the value in a variable."
-  (setq value (logand 65535 value))
-  (cond ((= var 0)  (malyon-push-stack value))
-	((< var 16) (malyon-store-local-variable var value))
-	(t          (malyon-store-global-variable (- var 16) value))))
-
-;; list of opcodes
-
-(defvar malyon-opcodes
-  [malyon-opcode-nop
-   malyon-opcode-je	         malyon-opcode-jl
-   malyon-opcode-jg              malyon-opcode-dec-chk
-   malyon-opcode-inc-chk         malyon-opcode-jin
-   malyon-opcode-test            malyon-opcode-or
-   malyon-opcode-and             malyon-opcode-test-attr
-   malyon-opcode-set-attr        malyon-opcode-clear-attr
-   malyon-opcode-store           malyon-opcode-insert-obj
-   malyon-opcode-loadw           malyon-opcode-loadb
-   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
-   malyon-opcode-get-next-prop   malyon-opcode-add
-   malyon-opcode-sub             malyon-opcode-mul
-   malyon-opcode-div             malyon-opcode-mod
-   malyon-opcode-calls           malyon-opcode-calln
-   malyon-opcode-set-color       malyon-opcode-throw
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-je              malyon-opcode-jl
-   malyon-opcode-jg              malyon-opcode-dec-chk
-   malyon-opcode-inc-chk         malyon-opcode-jin
-   malyon-opcode-test            malyon-opcode-or
-   malyon-opcode-and             malyon-opcode-test-attr
-   malyon-opcode-set-attr        malyon-opcode-clear-attr
-   malyon-opcode-store           malyon-opcode-insert-obj
-   malyon-opcode-loadw           malyon-opcode-loadb
-   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
-   malyon-opcode-get-next-prop   malyon-opcode-add
-   malyon-opcode-sub             malyon-opcode-mul
-   malyon-opcode-div             malyon-opcode-mod
-   malyon-opcode-calls           malyon-opcode-calln
-   malyon-opcode-set-color       malyon-opcode-throw
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-je              malyon-opcode-jl 
-   malyon-opcode-jg              malyon-opcode-dec-chk
-   malyon-opcode-inc-chk         malyon-opcode-jin
-   malyon-opcode-test            malyon-opcode-or
-   malyon-opcode-and             malyon-opcode-test-attr
-   malyon-opcode-set-attr        malyon-opcode-clear-attr
-   malyon-opcode-store           malyon-opcode-insert-obj
-   malyon-opcode-loadw           malyon-opcode-loadb
-   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
-   malyon-opcode-get-next-prop   malyon-opcode-add
-   malyon-opcode-sub             malyon-opcode-mul
-   malyon-opcode-div             malyon-opcode-mod
-   malyon-opcode-calls           malyon-opcode-calln
-   malyon-opcode-set-color       malyon-opcode-throw
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-je              malyon-opcode-jl
-   malyon-opcode-jg              malyon-opcode-dec-chk
-   malyon-opcode-inc-chk         malyon-opcode-jin
-   malyon-opcode-test            malyon-opcode-or
-   malyon-opcode-and             malyon-opcode-test-attr
-   malyon-opcode-set-attr        malyon-opcode-clear-attr
-   malyon-opcode-store           malyon-opcode-insert-obj
-   malyon-opcode-loadw           malyon-opcode-loadb
-   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
-   malyon-opcode-get-next-prop   malyon-opcode-add
-   malyon-opcode-sub             malyon-opcode-mul
-   malyon-opcode-div             malyon-opcode-mod
-   malyon-opcode-calls           malyon-opcode-calln
-   malyon-opcode-set-color       malyon-opcode-throw
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-nop             malyon-opcode-jz
-   malyon-opcode-get-sibling     malyon-opcode-get-child
-   malyon-opcode-get-parent      malyon-opcode-get-prop-len
-   malyon-opcode-inc             malyon-opcode-dec
-   malyon-opcode-print-addr      malyon-opcode-calls
-   malyon-opcode-remove-obj      malyon-opcode-print-obj
-   malyon-opcode-ret             malyon-opcode-jump
-   malyon-opcode-print-paddr     malyon-opcode-load
-   malyon-opcode-calln           malyon-opcode-jz
-   malyon-opcode-get-sibling     malyon-opcode-get-child
-   malyon-opcode-get-parent      malyon-opcode-get-prop-len
-   malyon-opcode-inc             malyon-opcode-dec
-   malyon-opcode-print-addr      malyon-opcode-calls
-   malyon-opcode-remove-obj      malyon-opcode-print-obj
-   malyon-opcode-ret             malyon-opcode-jump
-   malyon-opcode-print-paddr     malyon-opcode-load
-   malyon-opcode-calln           malyon-opcode-jz
-   malyon-opcode-get-sibling     malyon-opcode-get-child
-   malyon-opcode-get-parent      malyon-opcode-get-prop-len
-   malyon-opcode-inc             malyon-opcode-dec
-   malyon-opcode-print-addr      malyon-opcode-calls
-   malyon-opcode-remove-obj      malyon-opcode-print-obj
-   malyon-opcode-ret             malyon-opcode-jump
-   malyon-opcode-print-paddr     malyon-opcode-load
-   malyon-opcode-calln           malyon-opcode-rtrue
-   malyon-opcode-rfalse          malyon-opcode-print
-   malyon-opcode-print-ret       malyon-opcode-nop
-   malyon-opcode-illegal         malyon-opcode-illegal
-   malyon-opcode-restart         malyon-opcode-ret-popped
-   malyon-opcode-catch           malyon-opcode-quit
-   malyon-opcode-new-line        malyon-opcode-illegal
-   malyon-opcode-verify          malyon-opcode-illegal
-   malyon-opcode-piracy          malyon-opcode-nop
-   malyon-opcode-je              malyon-opcode-jl
-   malyon-opcode-jg              malyon-opcode-dec-chk
-   malyon-opcode-inc-chk         malyon-opcode-jin
-   malyon-opcode-test            malyon-opcode-or
-   malyon-opcode-and             malyon-opcode-test-attr
-   malyon-opcode-set-attr        malyon-opcode-clear-attr
-   malyon-opcode-store           malyon-opcode-insert-obj
-   malyon-opcode-loadw           malyon-opcode-loadb
-   malyon-opcode-get-prop        malyon-opcode-get-prop-addr
-   malyon-opcode-get-next-prop   malyon-opcode-add
-   malyon-opcode-sub             malyon-opcode-mul
-   malyon-opcode-div             malyon-opcode-mod
-   malyon-opcode-calls           malyon-opcode-calln
-   malyon-opcode-set-color       malyon-opcode-throw
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-nop             malyon-opcode-calls
-   malyon-opcode-storew          malyon-opcode-storeb
-   malyon-opcode-put-prop        malyon-opcode-aread
-   malyon-opcode-print-char      malyon-opcode-print-num
-   malyon-opcode-random          malyon-opcode-push
-   malyon-opcode-pull            malyon-opcode-split-window
-   malyon-opcode-set-window      malyon-opcode-calls
-   malyon-opcode-erase-window    malyon-opcode-erase-line
-   malyon-opcode-set-cursor      malyon-opcode-get-cursor
-   malyon-opcode-set-text-style  malyon-opcode-buffer-mode
-   malyon-opcode-output-stream   malyon-opcode-input-stream
-   malyon-opcode-nop             malyon-opcode-read-char
-   malyon-opcode-scan-table      malyon-opcode-not
-   malyon-opcode-calln           malyon-opcode-calln
-   malyon-opcode-tokenise        malyon-opcode-encode-text
-   malyon-opcode-copy-table      malyon-opcode-print-table
-   malyon-opcode-check-arg-count malyon-opcode-save
-   malyon-opcode-restore         malyon-opcode-log-shift
-   malyon-opcode-art-shift       malyon-opcode-set-font
-   malyon-opcode-illegal         malyon-opcode-illegal
-   malyon-opcode-illegal         malyon-opcode-illegal
-   malyon-opcode-save-undo       malyon-opcode-restore-undo
-   malyon-opcode-print-unicode   malyon-opcode-check-unicode
-   malyon-opcode-nop             malyon-opcode-nop
-   malyon-opcode-nop]
-  "A vector of all known legal z code opcodes.")
-
-;; initialization
-
-(defun malyon-load-story-file (file-name)
-  "Load a z code story file into an internal vector."
-  (save-excursion
-    (set-buffer (create-file-buffer file-name))
-    (malyon-disable-multibyte)
-    (malyon-erase-buffer)
-    (let ((coding-system-for-read 'binary))
-      (insert-file-contents file-name))
-    (setq malyon-story-file-name file-name)
-    (setq malyon-story-file (buffer-substring-no-properties (point-min)
-							    (point-max)))
-    (setq malyon-story-file (malyon-string-to-vector malyon-story-file))
-    (if (not (eq ?\^A 1))
-	(let ((i 0))
-	  (while (< i (length malyon-story-file))
-	    (aset malyon-story-file
-		  i
-		  (malyon-char-to-int (aref malyon-story-file i)))
-	    (setq i (+ 1 i)))))
-    (kill-buffer nil)))
-
-(defun malyon-initialize ()
-  "Initialize the z code interpreter."
-;  (malyon-trace-file)
-  (setq malyon-game-state-quetzal t)
-  (malyon-initialize-faces)
-  (malyon-initialize-status)
-  (malyon-initialize-transcript)
-  (malyon-initialize-windows)
-  (malyon-initialize-story-header)
-  (malyon-initialize-registers)
-  (malyon-initialize-opcodes)
-  (malyon-history-clear)
-  (setq malyon-game-state-restart (malyon-current-game-state))
-  (malyon-print-header))
-
-(defun malyon-initialize-status ()
-  "Initialize the status buffer."
-  (setq malyon-status-buffer (get-buffer-create "Malyon Status"))
-  (switch-to-buffer malyon-status-buffer)
-  (malyon-erase-buffer)
-  (kill-all-local-variables)
-  (setq malyon-status-buffer-point (point))
-  (setq malyon-status-buffer-lines 0)
-  (setq malyon-status-buffer-delayed-split nil)
-  (use-local-map malyon-keymap-read)
-  (set-syntax-table malyon-syntax-table)
-  (setq mode-name "Malyon")
-  (setq major-mode 'malyon-mode)
-  (run-hooks 'malyon-mode-hook))
-
-(defun malyon-initialize-transcript ()
-  "Initialize the transcript buffer."
-  (setq malyon-transcript-buffer (get-buffer-create "Malyon Transcript"))
-  (switch-to-buffer malyon-transcript-buffer)
-  (malyon-erase-buffer)
-  (kill-all-local-variables)
-  (setq malyon-last-cursor-position-after-input
-	(malyon-point-max malyon-transcript-buffer))
-  (use-local-map malyon-keymap-read)
-  (set-syntax-table malyon-syntax-table)
-  (setq fill-column malyon-max-column)
-  (auto-fill-mode 1)
-  (setq mode-name "Malyon")
-  (setq major-mode 'malyon-mode)
-  (run-hooks 'malyon-mode-hook))
-
-(defun malyon-initialize-windows ()
-  "Initialize the window configuration for the z machine."
-  (setq window-min-height 3)
-  (setq malyon-transcript-buffer-buffered t)
-  (malyon-set-window-configuration 0)
-  (malyon-opcode-set-window 0))
-
-(defun malyon-initialize-story-header ()
-  "Initializes the header section of the story file."
-  (malyon-store-byte 1  
-		     (if (>= malyon-story-version 5)
-			 28
-		       (logior 48 (malyon-read-byte 1))))
-  (malyon-store-byte 16 (logand 440 (malyon-read-byte 16)))
-  (malyon-store-byte 30 1)
-  (malyon-store-byte 31 65)
-  (malyon-store-byte 32 255)
-  (malyon-store-byte 33 (- malyon-max-column 1))
-  (malyon-store-word 34 (- malyon-max-column 1))
-  (malyon-store-word 36 255)
-  (malyon-store-word 38 1)
-  (malyon-store-word 39 1)
-  (malyon-store-byte 44 0)
-  (malyon-store-byte 45 0)
-  (malyon-store-byte 50 1)
-  (malyon-store-byte 51 0))
-
-(defun malyon-initialize-registers ()
-  "Initialize the interpreter's internal registers."
-  (setq malyon-stack (make-vector 1024 0))
-  (setq malyon-stack-pointer -1)
-  (malyon-push-initial-frame)
-  (setq malyon-frame-pointer malyon-stack-pointer)
-  (setq malyon-instruction-pointer (malyon-read-word 6))
-  (setq malyon-global-variables (malyon-read-word 12))
-  (setq malyon-object-table (malyon-read-word 10))
-  (cond ((< malyon-story-version 5)
-	 (setq malyon-object-table-entry-size 9)
-	 (setq malyon-object-properties       31)
-	 (setq malyon-object-property-offset  7))
-	(t
-	 (setq malyon-object-table-entry-size 14)
-	 (setq malyon-object-properties       63)
-	 (setq malyon-object-property-offset  12)))
-  (setq malyon-abbreviations (malyon-read-word 24))
-  (if (< malyon-story-version 5)
-      (setq malyon-score-game (zerop (logand 2 (malyon-read-byte 1)))))
-  (setq malyon-packed-multiplier
-	(malyon-cadr (assq malyon-story-version '((3 2) (5 4) (8 8)))))
-  (if (or (< malyon-story-version 5) (zerop (malyon-read-word 52)))
-      (setq malyon-alphabet (concat "abcdefghijklmnopqrstuvwxyz"
-				    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-				    " \n0123456789.,!?_#'\"/\\-:()"))
-    (setq malyon-alphabet (make-string 78 ? ))
-    (let ((i 0))
-      (while (< i 78)
-	(aset malyon-alphabet i
-	      (malyon-read-byte (+ i (malyon-read-word 52))))
-	(setq i (+ 1 i)))))
-  (malyon-initialize-unicode-table)
-  (setq malyon-dictionary (malyon-read-word 8))
-  (setq malyon-dictionary-entry-length
-	(malyon-read-byte
-	 (+ 1 malyon-dictionary (malyon-read-byte malyon-dictionary))))
-  (setq malyon-dictionary-num-entries
-	(malyon-read-word
-	 (+ 2 malyon-dictionary (malyon-read-byte malyon-dictionary))))
-  (setq malyon-dictionary-entries
-	(+ 4 malyon-dictionary (malyon-read-byte malyon-dictionary)))
-  (setq malyon-dictionary-word-length (if (< malyon-story-version 5) 3 5))
-  (setq malyon-current-face 'malyon-face-plain)
-  (setq malyon-print-separator nil)
-  (malyon-initialize-output-streams))
-
-(defun malyon-initialize-opcodes ()
-  "Initialize the opcode table used by the story file."
-  (cond ((< malyon-story-version 5)
-	 (aset malyon-opcodes 143 'malyon-opcode-not)
-	 (aset malyon-opcodes 181 'malyon-opcode-save)
-	 (aset malyon-opcodes 182 'malyon-opcode-restore)
-	 (aset malyon-opcodes 185 'malyon-opcode-pop)
-	 (aset malyon-opcodes 188 'malyon-opcode-show-status))
-	(t
-	 (aset malyon-opcodes 143 'malyon-opcode-calln)
-	 (aset malyon-opcodes 181 'malyon-opcode-illegal)
-	 (aset malyon-opcodes 182 'malyon-opcode-illegal)
- 	 (aset malyon-opcodes 185 'malyon-opcode-catch)
-	 (aset malyon-opcodes 188 'malyon-opcode-illegal))))
-
-(defun malyon-print-header ()
-  "Print malyon mode header information."
-  (malyon-opcode-set-text-style 2)
-  (malyon-print "Malyon V 1.0.3")
-  (malyon-opcode-set-text-style 0)
-  (malyon-newline)
-  (malyon-print "A z-code interpreter for version 3, 5, and 8 games.")
-  (malyon-newline)
-  (malyon-print "(c) 1999-2011 by Peter Ilberg ")
-  (malyon-newline)
-  (malyon-newline))
-
-;; cleanup
-
-(defun malyon-cleanup ()
-  "Clean up the z code interpreter."
-  (condition-case nil
-      (progn
-	(setq malyon-story-file nil)
-	(setq malyon-window-configuration nil)
-	(setq malyon-game-state-restart nil)
-	(setq malyon-game-state-undo nil)
-	(if (get-buffer "Malyon Status")
-	    (kill-buffer (get-buffer "Malyon Status")))
-	(if (get-buffer "Malyon Transcript")
-	    (progn
-	      (switch-to-buffer (get-buffer "Malyon Transcript"))
-	      (malyon-redisplay-frame (selected-frame) t)
-	      (delete-other-windows (get-buffer-window (current-buffer)))
-	      (widen)
-	      (text-mode)))
-	(setq malyon-status-buffer nil)
-	(setq malyon-transcript-buffer nil))
-    (error
-     (malyon-fatal-error "cleanup failed."))))
-
-;; error handling
-
-(defun malyon-fatal-error (message)
-  "Print error message and abort."
-  (setq message (concat "Malyon fatal error: " message))
-  (unwind-protect
-      (save-excursion
-	(set-buffer malyon-transcript-buffer)
-	(goto-char (point-max))
-	(newline)
-	(newline)
-	(put-text-property 0
-			   (length message)
-			   'face
-			   'malyon-face-error
-			   message)
-	(insert message)
-	(newline))
-    (malyon-cleanup)
-    (malyon-redisplay-frame (selected-frame) t)
-    (error message)))
-
-;; conversion of zscii to ascii
-
-(defvar malyon-unicode-table nil
-  "An array mapping zscii characters to latin-1 ones.")
-
-(defvar malyon-default-unicode-table nil
-  "The default array mapping zscii characters to latin-1 ones.")
-
-(if malyon-default-unicode-table
-    '()
-  (setq malyon-default-unicode-table
-	[32 
-	 0   0   0   0   0   0   0       ;   1 -   7
-	 8   0   0   0   0   10  0   0   ;   8 -  15
-	 0   0   0   0   0   0   0   0   ;  16 -  23
-	 0   0   0   39  0   0   0   0   ;  24 -  31
-	 32  33  34  35  36  37  38  39  ;  32 -  39
-	 40  41  42  43  44  45  46  47  ;  40 -  47
-	 48  49  50  51  52  53  54  55  ;  48 -  55
-	 56  57  58  59  60  61  62  63  ;  56 -  63
-	 64  65  66  67  68  69  70  71  ;  64 -  71
-	 72  73  74  75  76  77  78  79  ;  72 -  79
-	 80  81  82  83  84  85  86  87  ;  80 -  87
-	 88  89  90  91  92  93  94  95  ;  88 -  95
-	 96  97  98  99  100 101 102 103 ;  96 - 103
-	 104 105 106 107 108 109 110 111 ; 104 - 111
-	 112 113 114 115 116 117 118 119 ; 112 - 119
-	 120 121 122 123 124 125 126 0   ; 120 - 127
-	 0   0   0   0   0   0   0   0   ; 128 - 135
-	 0   0   0   0   0   0   0   0   ; 136 - 143
-	 0   48  49  50  51  52  53  54  ; 144 - 151
-	 55  56  57  228 246 252 196 214 ; 152 - 159
-	 220 223 187 171 235 239 255 203 ; 160 - 167
-	 207 225 233 237 243 250 253 193 ; 168 - 175
-	 201 205 211 218 221 224 232 236 ; 176 - 183
-	 242 249 192 200 204 210 217 226 ; 184 - 191
-	 234 238 244 251 194 202 206 212 ; 192 - 199
-	 219 229 197 248 216 227 241 245 ; 200 - 207
-	 195 209 213 230 198 231 199 254 ; 208 - 215
-	 240 222 208 163 63  63  161 191 ; 216 - 223
-	 0   0   0   0   0   0   0   0   ; 224 - 231
-	 0   0   0   0   0   0   0   0   ; 232 - 239
-	 0   0   0   0   0   0   0   0   ; 240 - 247
-	 0   0   0   0   0   0   0   0   ; 248 - 255
-	 ]))
-
-(defun malyon-initialize-unicode-table ()
-  "Initializes the zscii-to-unicode conversion table."
-  (setq malyon-unicode-table
-	(copy-sequence malyon-default-unicode-table))
-  (let* ((ext   (malyon-read-word 54))
-	 (len   (if (zerop ext) 0 (malyon-read-word ext)))
-	 (table (if (< len 3)   0 (malyon-read-word (+ ext 6)))))
-    (if (or (< malyon-story-version 5) (zerop table))
-	'()
-      (let ((i 0))
-	(while (< i 96)
-	  (aset malyon-unicode-table (+ 155 i) (malyon-char-to-int ??))
-	  (setq i (+ 1 i))))
-      (setq len (malyon-read-byte table))
-      (let ((i 0))
-	(while (< i len)
-	  (aset malyon-unicode-table (+ 155 i)
-		(malyon-read-word (+ table 1 i)))
-	  (setq i (+ 1 i)))))))
-
-(defsubst malyon-zscii-to-unicode (char)
-  "Converts a zscii character to unicode."
-  (if (or (< char 0) (> char 255))
-      ??
-    (let ((uni (aref malyon-unicode-table char)))
-      (if (zerop uni)
-	  ??
-	(malyon-unibyte-char-to-multibyte (malyon-int-to-char uni))))))
-
-(defsubst malyon-unicode-to-zscii (char)
-  "Converts a unicode character to zscii."
-  (setq char (malyon-multibyte-char-to-unibyte char))
-  (setq char (if (malyon-characterp char) (malyon-char-to-int char) char))
-  (if (= 13 char)
-      ?\r
-    (let ((i 1) (found 0))
-      (while (and (< i 255) (zerop found))
-	(if (= char (aref malyon-unicode-table i))
-	    (setq found i))
-	(setq i (+ i 1)))
-      (malyon-int-to-char found))))
-
-;; output streams
-
-(defvar malyon-output-streams nil
-  "Valid output streams for the interpreter.")
-
-(defvar malyon-output-streams-tables nil
-  "A list of active tables for stream 3.")
-
-(defun malyon-initialize-output-streams ()
-  "Initializes the output streams."
-  (setq malyon-output-streams '())
-  (setq malyon-output-streams-tables '())
-  (malyon-add-output-stream 1 0))
-
-(defun malyon-output-stream-function (stream)
-  "Returns the output function representing the given stream."
-  (cond ((= 1 stream) (if (zerop malyon-current-window)
-			  'malyon-putchar-transcript
-			'malyon-putchar-status))
-	((= 2 stream) 'malyon-putchar-printer)))
-
-(defun malyon-add-output-stream (stream table)
-  "Add a new output stream."
-  (if (= stream 3)
-      (progn
-	(setq malyon-output-streams-tables
-	      (cons table malyon-output-streams-tables))
-	(malyon-store-word table 0))
-    (let ((function (malyon-output-stream-function stream)))
-      (setq malyon-output-streams
-	    (if (member function malyon-output-streams)
-		malyon-output-streams
-	      (cons function malyon-output-streams))))))
-
-(defun malyon-remove-output-stream (stream)
-  "Remove an output stream."
-  (if (= stream 3)
-      (setq malyon-output-streams-tables (cdr malyon-output-streams-tables))
-    (setq malyon-output-streams
-	  (malyon-remove (malyon-output-stream-function stream)
-			 malyon-output-streams))))
-
-(defun malyon-update-output-streams ()
-  "Update output streams when the output window has changed."
-  (let ((one (or (member 'malyon-putchar-transcript malyon-output-streams)
-		 (member 'malyon-putchar-status     malyon-output-streams))))
-    (setq malyon-output-streams
-	  (malyon-remove 'malyon-putchar-transcript
-			 (malyon-remove 'malyon-putchar-status
-					malyon-output-streams)))
-    (if one
-	(malyon-add-output-stream 1 0))))
-
-(defsubst malyon-output-character (char)
-  "Output a single character on all active streams."
-  (setq char (malyon-zscii-to-unicode char))
-  (if malyon-output-streams-tables
-      (malyon-putchar-table char (car malyon-output-streams-tables))
-    (malyon-mapc (lambda (s) (funcall s char)) malyon-output-streams)))
-
-;; printing text
-
-(defsubst malyon-abbrev (abbrev x)
-  "Print an abbreviation."
-  (malyon-print-ztext
-   (* 2 (malyon-read-word (+ malyon-abbreviations
-			     (* 2 (+ x (* 32 (1- abbrev)))))))))
-
-(defun malyon-newline ()
-  "Print a newline."
-  (if (eq malyon-status-buffer (current-buffer))
-      (goto-char malyon-status-buffer-point)
-    (goto-char (point-max)))
-  (malyon-output-character ?\r)
-  (if (eq malyon-status-buffer (current-buffer))
-      (setq malyon-status-buffer-point (point))
-    (goto-char malyon-last-cursor-position-after-input))
-  (malyon-redisplay-frame (selected-frame) nil))
-
-(defun malyon-print (object)
-  "Print text." 
-  (let ((text (if (malyon-characterp object) (char-to-string object) object))
-	(start))
-    (if (eq malyon-transcript-buffer (current-buffer))
-	(goto-char (point-max))
-      (goto-char malyon-status-buffer-point))
-    (setq start (point))
-    (malyon-print-characters (malyon-string-to-list text))
-    (put-text-property start (point) 'face malyon-current-face)
-    (if (eq malyon-status-buffer (current-buffer))
-	(setq malyon-status-buffer-point (point))
-      (goto-char malyon-last-cursor-position-after-input))))
-
-(defun malyon-print-characters (text)
-  "Print a list of characters."
-  (malyon-mapc 'malyon-output-character text))
-
-(defsubst malyon-print-state-new (char shift abbr zscii zcode)
-  "Generate a new print state."
-  (list char shift abbr zscii zcode))
-
-(defsubst malyon-print-state-initial ()
-  "Returns an initial state for the ztext decoder."
-  (malyon-print-state-new nil -6 0 0 0))
-
-(defsubst malyon-print-state-next (x ignore shift abbr zscii z)
-  "Print state transition function."
-  (cond ((= zscii 2)
-	 (malyon-print-state-new (+ z x) -6 0 0 0))
-	((= zscii 1)
-	 (malyon-print-state-new nil     -6 0 2 (* 32 x)))
-	((> abbr 0)
-	 (malyon-abbrev abbr x)
-	 (malyon-print-state-initial))
-	((= x 0)
-	 (malyon-print-state-new ?       -6 0 0 0))
-	((< x 4)
-	 (malyon-print-state-new nil     -6 x 0 0))
-	((= x 4)
-	 (malyon-print-state-new nil     20 0 0 0))
-	((= x 5)
-	 (malyon-print-state-new nil     46 0 0 0))
-	((and (= shift 46) (= x 6))
-	 (malyon-print-state-new nil     -6 0 1 0))
-	((and (= shift 46) (= x 7))
-	 (malyon-print-state-new ?\r     -6 0 0 0))
-	(t
-	 (malyon-print-state-new
-	  (aref malyon-alphabet (+ shift x)) -6 0 0 0))))
-
-(defun malyon-print-text (address)
-  "Print text at address and return the address of the following byte."
-  (let ((start))
-    (if (eq malyon-transcript-buffer (current-buffer))
-	(goto-char (point-max))
-      (goto-char malyon-status-buffer-point))
-    (setq start (point))
-    (setq address (malyon-print-ztext address))
-    (put-text-property start (point) 'face malyon-current-face)
-    (if (eq malyon-status-buffer (current-buffer))
-	(setq malyon-status-buffer-point (point))
-      (goto-char malyon-last-cursor-position-after-input))
-    (malyon-redisplay-frame (selected-frame) nil)
-    address))
-
-(defun malyon-print-ztext (address)
-  "Print the ztext stored at the given address."
-  (let ((high 0) (low) (a) (b) (c) (state (malyon-print-state-initial)))
-    (while (zerop (logand 128 high))
-      (setq high (malyon-read-byte address))
-      (setq low  (malyon-read-byte (+ 1 address)))
-      (setq a    (logand 31 (lsh high -2)))
-      (setq b    (logand 31 (logior (lsh high 3) (lsh low -5))))
-      (setq c    (logand 31 low))
-      (setq state (apply 'malyon-print-state-next a state))
-      (if (car state) (malyon-output-character (car state)))
-      (setq state (apply 'malyon-print-state-next b state))
-      (if (car state) (malyon-output-character (car state)))
-      (setq state (apply 'malyon-print-state-next c state))
-      (if (car state) (malyon-output-character (car state)))
-      (setq address (+ 2 address)))
-    address))
-
-(defun malyon-putchar-transcript (char)
-  "Print a single character in the transcript window."
-  (if (char-equal char ?\n)
-      (newline 1)
-    (insert char)
-    (setq malyon-print-separator (null (member char malyon-whitespace))))
-  (if (and malyon-transcript-buffer-buffered
-	   (> (current-column) (current-fill-column)))
-      (progn
-	(end-of-line)
-	(forward-word -1)
-	(if (< 0 (current-column))
-	    (newline 1))
-	(end-of-line))))
-
-(defun malyon-putchar-status (char)
-  "Print a single character in the status window."
-  (if malyon-status-buffer-delayed-split
-      (progn
-	(malyon-split-buffer-windows malyon-status-buffer-delayed-split)
-	(other-window 1)))
-  (if (char-equal char ?\n)
-      (progn
-	(beginning-of-line)
-	(forward-line 1)
-	(if (= (point) (point-max))
-	    (forward-line -1)))
-    (if (> (current-column) (current-fill-column))
-	'()
-      (insert char)
-      (delete-char 1))))
-
-(defun malyon-putchar-table (char table)
-  "Print a single character into a table."
-  (setq char (malyon-unicode-to-zscii char))
-  (malyon-store-byte (+ 2 table (malyon-read-word table)) char)
-  (malyon-store-word table (+ 1 (malyon-read-word table))))
-
-(defun malyon-putchar-printer (char)
-  "Print a single character onto a printer."); not yet implemented
-
-;; more
-
-(defvar malyon-more-continue-keymap nil
-  "The keymap with which to continue after More has finished.")
-
-(defun malyon-more (keymap)
-  "Enter More mode."
-  (if (eq malyon-status-buffer (current-buffer))
-      (use-local-map keymap)
-    (if (< malyon-story-version 5) (malyon-opcode-show-status))
-    (if (< (count-lines malyon-last-cursor-position-after-input (point-max))
-	   (malyon-window-displayed-height))
-	(progn
-	  (malyon-adjust-transcript)
-	  (use-local-map keymap))
-      (goto-char malyon-last-cursor-position-after-input)
-      (beginning-of-line)
-      (recenter 1)
-      (setq malyon-more-continue-keymap keymap)
-      (use-local-map malyon-keymap-more)
-      (message "[More]"))))
-
-(defun malyon-more-status-buffer ()
-  "Enter More mode for the status buffer."
-  (setq malyon-more-continue-keymap (current-local-map))
-  (use-local-map malyon-keymap-more-status)
-  (message "[More]")
-  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
-
-;; input history
-
-(defvar malyon-history nil
-  "The input history.")
-
-(defun malyon-history-previous ()
-  "Move one entry up in the input history."
-  (let ((prev (aref malyon-history 0))
-	(curr (aref malyon-history 1))
-	(next (aref malyon-history 2)))
-    (if (null prev)
-	curr
-      (aset malyon-history 2 (if curr (cons curr next) next))
-      (aset malyon-history 0 (cdr prev))
-      (aset malyon-history 1 (car prev)))))
-
-(defun malyon-history-next ()
-  "Move one entry down in the input history."
-  (let ((prev (aref malyon-history 0))
-	(curr (aref malyon-history 1))
-	(next (aref malyon-history 2)))
-    (if (null next)
-	curr
-      (aset malyon-history 0 (if curr (cons curr prev) prev))
-      (aset malyon-history 2 (cdr next))
-      (aset malyon-history 1 (car next)))))
-
-(defun malyon-history-clear ()
-  "Clear the input history."
-  (setq malyon-history (vector '() nil '())))
-
-(defun malyon-history-insert (entry)
-  "Insert an entry into the input history."
-  (let* ((prev (aref malyon-history 0))
-	 (curr (aref malyon-history 1))
-	 (next (aref malyon-history 2))
-	 (l    (malyon-remove entry
-			      (append (nreverse prev)
-				      (if curr (cons curr next) next))))
-	 (cut  (- (length l) 19)))
-    (while (> cut 0)
-      (setq l   (cdr l)
-	    cut (- cut 1)))
-    (aset malyon-history 0
-	  (malyon-remove nil (malyon-remove "" (cons entry (nreverse l)))))
-    (aset malyon-history 1 nil)
-    (aset malyon-history 2 '())))
-
-;; dictionary lookup
-
-(defun malyon-dictionary-word (chars)
-  "Convert a list of characters into a dictionary word."
-  (list (car (car chars))
-	(length chars)
-	(malyon-encode-dictionary-word (append (malyon-mapcan 'cdr chars)
-					       '(5 5 5 5 5 5 5 5)))))
-
-(defsubst malyon-join-characters (stop list)
-  "Joins three ztext characters into two bytes."
-  (let ((a (car          list))
-	(b (malyon-cadr  list))
-	(c (malyon-caddr list))
-	(x (if (zerop stop) 0 128)))
-    (list (logior x (logand 255 (logior (lsh a 2) (lsh b -3))))
-	  (logand 255 (logior (lsh b 5) c)))))
-
-(defun malyon-encode-dictionary-word (l)
-  "Converts a list of ztext characters into a dictionary word."
-  (let* ((first  l)
-	 (second (malyon-cdddr first))
-	 (third  (malyon-cdddr second)))
-    (apply 'vector
-	   (if (< malyon-story-version 5)
-	       (append (malyon-join-characters 0 first)
-		       (malyon-join-characters 1 second))
-	     (append (malyon-join-characters 0 first)
-		     (malyon-join-characters 0 second)
-		     (malyon-join-characters 1 third))))))
-
-(defun malyon-lookup (dict code)
-  "Look for the given code in the dictionary and return its address."
-  (cond ((not code)                 0)
-	((not dict)                 (malyon-binary-search code))
-	((= dict malyon-dictionary) (malyon-binary-search code))
-	(t                          (malyon-linear-search dict code))))
-
-(defsubst malyon-compare-words (word address)
-  "Compares the given word to the word stored at address."
-  (let* ((i 0)
-	 (j address)
-	 (x (aref word i))
-	 (y (malyon-read-byte j)))
-    (while (not (or (/= x y) (= i malyon-dictionary-word-length)))
-      (setq i (+ 1 i)
-	    j (+ 1 j)
-	    x (aref word i)
-	    y (malyon-read-byte j)))
-    (- x y)))
-
-;; search functions
-
-(defun malyon-binary-search (code)
-  "Binary search through the main dictionary."
-  (let* ((lower   0)
-	 (upper   (- malyon-dictionary-num-entries 1))
-	 (median  (/ (+ lower upper) 2))
-	 (entry   (+ malyon-dictionary-entries
-		     (* malyon-dictionary-entry-length median)))
-	 (looking (malyon-compare-words code entry)))
-    (while (not (or (> lower upper) (zerop looking)))
-      (setq lower   (if (< 0 looking) (+ median 1) lower)
-            upper   (if (> 0 looking) (- median 1) upper)
-	    median  (/ (+ lower upper) 2)
-	    entry   (+ malyon-dictionary-entries
-		       (* malyon-dictionary-entry-length median))
-	    looking (malyon-compare-words code entry)))
-    (if (zerop looking) entry 0)))
-
-(defun malyon-linear-search (dictionary code)
-  "Linear search through the given dictionary."
-  (let* ((length  (malyon-read-byte (+ dictionary 1
-				       (malyon-read-byte dictionary))))
-	 (number  (malyon-read-word (+ dictionary 2
-				       (malyon-read-byte dictionary))))
-	 (entries (+ dictionary 4 (malyon-read-byte dictionary)))
-	 (i       0)
-	 (entry   (+ entries (* length i)))
-	 (looking (malyon-compare-words code entry)))
-    (while (not (or (>= i number) (zerop looking)))
-      (setq i       (+ 1 i)
-	    entry   (+ entries (* length i))
-	    looking (malyon-compare-words code entry)))
-    (if (zerop looking) entry 0)))
-
-;; encoding text and lexical analysis
-
-(defun malyon-split-list (sep list &optional x)
-  "Split a list into sublists as indicated by the separators."
-  (cond ((null list)
-	 (list (nreverse x)))
-	((eq sep (car list))
-	 (cons (nreverse x) (malyon-split-list sep (cdr list) '())))
-	(t
-	 (malyon-split-list sep (cdr list) (cons (car list) x)))))
-
-(defun malyon-characters-to-words (list)
-  "Turn the list of characters into a list of words."
-  (mapcar 'malyon-dictionary-word
-	  (delete '() (malyon-split-list 'malyon-word-separator list))))
-
-(defsubst malyon-char-in-string (c s)
-  "Returns the index of c in s if found, or length of s."
-  (let ((i 0))
-    (while (not (or (= i (length s)) (= c (aref s i))))
-      (setq i (+ 1 i)))
-    i))
-
-(defsubst malyon-encode-into-ztext (c)
-  "Convert a character into ztext."
-  (let* ((index (malyon-char-in-string c malyon-alphabet))
-	 (shift (floor index 26))
-	 (char  (+ 6 (mod index 26))))
-    (cond ((> shift 2) (list 5 6 (logand 31 (lsh c -5)) (logand 31 c)))
-	  ((= shift 2) (list 5 char))
-	  ((= shift 1) (list 4 char))
-	  (t           (list char)))))
-
-(defun malyon-encode-single-character (terminating-characters char)
-  "Encode a character into ztext."
-  (let ((pos (car char))
-	(c   (cdr char)))
-    (cond ((member c malyon-whitespace)
-	   (list 'malyon-word-separator))
-	  ((member c terminating-characters)
-	   (list 'malyon-word-separator
-		 (cons pos (malyon-encode-into-ztext c))
-		 'malyon-word-separator))
-	  (t (list (cons pos (malyon-encode-into-ztext c)))))))
-
-(defun malyon-encode-character-list (dict list)
-  "Encode the list of characters into ztext."
-  (let ((l '())
-	(i 0))
-    (while (< i (malyon-read-byte dict))
-      (setq l (cons (malyon-read-byte (+ dict 1 i)) l)
-	    i (+ 1 i)))
-    (malyon-mapcan (lambda (x) (malyon-encode-single-character l x)) list)))
-
-(defun malyon-text-length (address)
-  "Return the length of the input text."
-  (if (>= malyon-story-version 5)
-      (malyon-read-byte (+ 1 address))
-    (let ((i 0))
-      (while (not (zerop (malyon-read-byte (+ i 1 address))))
-	(setq i (+ i 1)))
-      i)))
-
-(defun malyon-text-to-character-list (address)
-  "Convert the input text into a list of characters."
-  (let ((i    (malyon-text-length address))
-	(text '()))
-    (while (< 0 i)
-      (setq text (cons
-		  (cons (if (< malyon-story-version 5) i (+ 1 i))
-			(malyon-read-byte
-			 (+ i address (if (< malyon-story-version 5) 0 1))))
-		  text)
-	    i    (- i 1)))
-    text))
-
-(defun malyon-text-to-words (address dictionary)
-  "Turn ztext into a list of dictionary words."
-  (malyon-characters-to-words
-   (malyon-encode-character-list (if dictionary dictionary malyon-dictionary)
-				 (malyon-text-to-character-list address))))
-
-;; window management
-
-(defvar malyon-status-buffer-grew-this-turn nil
-  "A flag signalling if the status buffer grew this turn.")
-
-(defun malyon-adjust-transcript ()
-  "Adjust the position of the transcript text."
-  (save-excursion
-    (setq malyon-status-buffer-grew-this-turn nil)
-    (set-buffer malyon-transcript-buffer)
-    (goto-char (point-max))
-    (recenter (- (malyon-window-displayed-height) 2))))
-
-(defun malyon-prepare-status-buffer (status)
-  "Fill the status buffer with empty lines."
-  (save-excursion
-    (set-buffer malyon-status-buffer)
-    (let ((lines (count-lines (point-min) (point-max)))
-	  (new   status))
-      (if (zerop lines)
-	  (newline 1))
-      (goto-char (point-max))
-      (setq status (- status lines -1))
-      (while (> status 0)
-	(insert (make-string (+ 3 malyon-max-column) ? ))
-	(newline 1)
-	(setq status (- status 1)))
-      (goto-char (point-min))
-      (forward-line (+ 1 new))
-      (kill-region (point) (point-max))
-      (insert (make-string (+ 3 malyon-max-column) ? ))
-      (newline 1))))
-
-(defun malyon-restore-window-configuration ()
-  "Restore the saved window configuration."
-  (let ((buffer (window-buffer (selected-window))))
-    (if malyon-window-configuration
-	(set-window-configuration malyon-window-configuration))
-    (cond ((eq malyon-status-buffer buffer)     (other-window 1))
-	  ((eq malyon-transcript-buffer buffer) (goto-char (point-max))))))
-
-(defun malyon-set-window-configuration (status)
-  "Set up the new window configuration."
-  (cond ((< status malyon-status-buffer-lines)
-	 (setq malyon-status-buffer-delayed-split status)
-	 (if malyon-status-buffer-grew-this-turn
-	     (malyon-more-status-buffer)))
-	((> status malyon-status-buffer-lines)
-	 (malyon-split-buffer-windows status)
-	 (setq malyon-status-buffer-grew-this-turn t))
-	((not malyon-window-configuration)
-	 (malyon-split-buffer-windows status))))
-
-(defun malyon-split-buffer-windows (status)
-  "Split the buffer windows.
-The status buffer gets 'status' lines while the transcript buffer
-gets the remaining lines."
-  (delete-other-windows (get-buffer-window (current-buffer)))
-  (setq malyon-status-buffer-lines status)
-  (setq malyon-status-buffer-delayed-split nil)
-  (if (zerop status)
-      '()
-    (split-window (get-buffer-window (current-buffer)) (+ status 3))
-    (switch-to-buffer malyon-status-buffer)
-    (malyon-prepare-status-buffer status)
-    (malyon-opcode-set-cursor 1 1)
-    (other-window 1))
-  (switch-to-buffer malyon-transcript-buffer)
-  (setq malyon-window-configuration (current-window-configuration)))
-
-;; getting and setting the machine state
-
-(defun malyon-current-game-state ()
-  "Return the current state of the interpreter."
-  (vector malyon-instruction-pointer
-	  malyon-stack-pointer
-          malyon-frame-pointer
-	  (copy-sequence malyon-stack)
-	  (copy-sequence malyon-story-file)
-	  malyon-game-state-quetzal))
-
-(defun malyon-set-game-state (state)
-  "Installs the given state as the new state of the interpreter."
-  (setq malyon-instruction-pointer       (aref state 0))
-  (setq malyon-stack-pointer             (aref state 1))
-  (setq malyon-frame-pointer             (aref state 2))
-  (setq malyon-stack (copy-sequence      (aref state 3)))
-  (setq malyon-story-file (copy-sequence (aref state 4)))
-  (setq malyon-game-state-quetzal        (aref state 5))
-  (save-excursion
-    (malyon-erase-buffer malyon-status-buffer)
-    (malyon-split-buffer-windows 0)
-    (setq malyon-last-cursor-position-after-input
-	  (malyon-point-max malyon-transcript-buffer))))
-
-;; file utilities
-
-(defsubst malyon-write-byte-to-file (byte)
-  "Write a byte to a file."
-  (insert-char (logand 255 byte) 1))
-
-(defsubst malyon-write-word-to-file (word)
-  "Write a word to the last opened file."
-  (insert-char (logand 255 (lsh word -8)) 1)
-  (insert-char (logand 255 word) 1))
-
-(defsubst malyon-write-dword-to-file (dword)
-  "Write a dword to the last opened file."
-  (insert-char (logand 255 (lsh dword -24)) 1)
-  (insert-char (logand 255 (lsh dword -16)) 1)
-  (insert-char (logand 255 (lsh dword -8)) 1)
-  (insert-char (logand 255 dword) 1))
-
-(defsubst malyon-write-chunk-id-to-file (id)
-  "Write a quetzal chunk id to the last opened file."
-  (insert id))
-
-(defsubst malyon-read-byte-from-file ()
-  "Read the next byte from a file."
-  (if (= (point) (point-max))
-      0
-    (forward-char 1)
-    (malyon-char-to-int (malyon-char-before))))
-
-(defsubst malyon-read-word-from-file ()
-  "Read the next word from the last opened file."
-  (logior (lsh (malyon-read-byte-from-file) 8) (malyon-read-byte-from-file)))
-
-(defsubst malyon-read-dword-from-file ()
-  "Read the next dword from the last opened file."
-  (logior (lsh (malyon-read-byte-from-file) 24)
-	  (lsh (malyon-read-byte-from-file) 16)
-	  (lsh (malyon-read-byte-from-file) 8)
-	  (malyon-read-byte-from-file)))
-
-(defsubst malyon-read-chunk-id-from-file ()
-  "Read a quetzal chunk id from the last opened file."
-  (string (malyon-int-to-char (malyon-read-byte-from-file))
-	  (malyon-int-to-char (malyon-read-byte-from-file))
-	  (malyon-int-to-char (malyon-read-byte-from-file))
-	  (malyon-int-to-char (malyon-read-byte-from-file))))
-
-(defun malyon-get-file-name (address)
-  "Retrieves the file name stored at address."
-  (let ((name (make-string (malyon-read-byte address) ? ))
-	(i    0))
-    (while (< i (length name))
-      (aset name i (malyon-read-byte (+ address 1 i)))
-      (setq i (+ 1 i)))
-    name))
-
-;; saving data to disk
-
-(defun malyon-save-file (file &optional table length)
-  "Save the current game state or a memory section to disk."
-  (interactive "FSave file: ")
-  (condition-case nil
-      (save-excursion
-	(set-buffer (create-file-buffer file))
-	(malyon-disable-multibyte)
-	(malyon-erase-buffer)
-	(cond (table (malyon-save-table table length))
-	      (malyon-game-state-quetzal
-	       (malyon-save-quetzal-state (malyon-current-game-state)))
-	      (t
-	       (malyon-save-game-state (malyon-current-game-state))))
-	(let ((coding-system-for-write 'binary))
-	  (write-file file))
-	(kill-buffer nil)
-	1)
-    (error 0)))
-
-(defun malyon-save-table (table length)
-  "Save the given section of memory to the file."
-  (let ((i 0)
-	(j table))
-    (while (< i length)
-      (malyon-write-byte-to-file (malyon-read-byte j))
-      (setq i (+ 1 i)
-	    j (+ 1 j)))))
-
-(defun malyon-save-game-state (state)
-  "Saves the game state to disk."
-  (let ((ip    (aref state 0))
-	(sp    (aref state 1))
-	(fp    (aref state 2))
-	(stack (aref state 3))
-	(mem   (aref state 4))
-	(dyn   (malyon-read-word 14))
-	(i     0))
-    (malyon-write-word-to-file (length malyon-story-file-name))
-    (while (< i (length malyon-story-file-name))
-      (malyon-write-byte-to-file (aref malyon-story-file-name i))
-      (setq i (+ 1 i)))
-    (malyon-write-dword-to-file ip)
-    (malyon-write-word-to-file  sp)
-    (malyon-write-word-to-file  fp)
-    (malyon-write-word-to-file  dyn)
-    (setq i 0)
-    (while (<= i sp)
-      (malyon-write-dword-to-file (aref stack i))
-      (setq i (+ 1 i)))
-    (setq i 0)
-    (while (< i dyn)
-      (malyon-write-byte-to-file (aref mem i))
-      (setq i (+ 1 i)))))
-
-(defun malyon-save-quetzal-state (state)
-  "Saves the game state to disk in quetzal format."
-  (goto-char (point-min))
-  (malyon-save-quetzal-ifhd state)
-  (malyon-save-quetzal-cmem state)
-  (malyon-save-quetzal-stks state)
-  (goto-char (point-min))
-  (malyon-write-chunk-id-to-file "IFZS")
-  (goto-char (point-min))
-  (malyon-write-dword-to-file (- (point-max) (point-min)))
-  (goto-char (point-min))
-  (malyon-write-chunk-id-to-file "FORM"))
-
-(defun malyon-save-quetzal-ifhd (state)
-  "Saves the IFhd chunk of the quetzal format."
-  (malyon-write-chunk-id-to-file "IFhd")
-  (malyon-write-dword-to-file 13)
-  (malyon-write-word-to-file (malyon-read-word 2))
-  (malyon-write-word-to-file (malyon-read-word 18))
-  (malyon-write-word-to-file (malyon-read-word 20))
-  (malyon-write-word-to-file (malyon-read-word 22))
-  (malyon-write-word-to-file (malyon-read-word 28))
-  (malyon-write-byte-to-file (lsh (aref state 0) -16))
-  (malyon-write-byte-to-file (lsh (aref state 0) -8))
-  (malyon-write-byte-to-file (aref state 0))
-  (malyon-write-byte-to-file 0))
-
-(defun malyon-save-quetzal-cmem (state)
-  "Saves the CMem chunk of the quetzal format."
-  (let ((beginning (point-max))
-	(original  (aref malyon-game-state-restart 4))
-	(current   (aref state 4))
-	(size      (malyon-read-word 14))
-	(byte      0)
-	(count     0)
-	(i         0))
-    (goto-char (point-max))
-    (while (< i size)
-      (setq byte (logxor (aref current i) (aref original i)))
-      (if (zerop byte)
-	  (setq count (+ 1 count))
-	(while (> count 0)
-	  (malyon-write-byte-to-file 0)
-	  (setq count (- count 1))
-	  (malyon-write-byte-to-file (min 255 count))
-	  (setq count (- count (min 255 count))))
-	(malyon-write-byte-to-file byte))
-      (setq i (+ 1 i)))
-    (setq size (- (point-max) beginning))
-    (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
-    (goto-char beginning)
-    (malyon-write-chunk-id-to-file "CMem")
-    (malyon-write-dword-to-file size)))
-
-(defun malyon-save-quetzal-stks (state)
-  "Saves the Stks chunk of the quetzal format."
-  (let ((beginning (point-max))
-	(size      0))
-    (goto-char (point-max))
-    (malyon-save-quetzal-stack-frame (- (aref state 2) 4)
-				     (aref state 1)
-				     (aref state 3))
-    (setq size (- (point-max) beginning))
-    (if (zerop (mod size 2)) '() (malyon-write-byte-to-file 0))
-    (goto-char beginning)
-    (malyon-write-chunk-id-to-file "Stks")
-    (malyon-write-dword-to-file size)))
-
-(defun malyon-save-quetzal-stack-frame (fp sp stack)
-  "Saves the stack frames for the Stks chunk."
-  (let* ((frame       (malyon-get-stack-frame fp sp stack))
-	 (frame-id    (aref frame 0))
-	 (previous-fp (aref frame 1))
-	 (previous-sp (aref frame 2))
-	 (return-addr (aref frame 3))
-	 (result-addr (aref frame 4))
-	 (local-vars  (aref frame 5))
-	 (num-args    (aref frame 6))
-	 (eval-stack  (aref frame 7)))
-    (if (> frame-id 0)
-	(malyon-save-quetzal-stack-frame previous-fp previous-sp stack))
-    (malyon-write-byte-to-file (lsh return-addr -16))
-    (malyon-write-byte-to-file (lsh return-addr -8))
-    (malyon-write-byte-to-file return-addr)
-    (if (zerop frame-id)
-	(malyon-write-byte-to-file 0)
-      (malyon-write-byte-to-file (logior (if result-addr 0 16)
-					 (length local-vars))))
-    (malyon-write-byte-to-file (if result-addr result-addr 0))
-    (malyon-write-byte-to-file (- (lsh 1 num-args) 1))
-    (malyon-write-word-to-file (length eval-stack))
-    (while (not (null local-vars))
-      (malyon-write-word-to-file (car local-vars))
-      (setq local-vars (cdr local-vars)))
-    (while (not (null eval-stack))
-      (malyon-write-word-to-file (car eval-stack))
-      (setq eval-stack (cdr eval-stack)))))
-
-;; restoring data from disk
-
-(defvar malyon-restore-data-error nil
-  "An error message if restoring data from a file failed.")
-
-(defvar malyon-restore-quetzal-stack nil
-  "A temporary stack for restoring quetzal game states.")
-
-(defvar malyon-restore-quetzal-stack-pointer nil
-  "A temporary stack pointer for restoring quetzal game states.")
-
-(defvar malyon-restore-quetzal-frame-pointer nil
-  "A temporary frame-pointer for restoring quetzal game states.")
-
-(defun malyon-restore-file (file &optional table length)
-  "Restore a game state or a memory section from disk."
-  (interactive "fLoad file: ")
-  (if (not (and (file-exists-p file) (file-readable-p file)))
-      0
-    (condition-case nil
-	(save-excursion
-	  (setq malyon-restore-data-error nil)
-	  (set-buffer (create-file-buffer file))
-	  (malyon-disable-multibyte)
-	  (malyon-erase-buffer)
-	  (let ((coding-system-for-read 'binary))
-	    (insert-file-contents file))
-	  (goto-char (point-min))
-	  (if table
-	      (malyon-restore-table table length)
-	    (let* ((first  (malyon-read-chunk-id-from-file))
-		   (second (malyon-read-dword-from-file))
-		   (third  (malyon-read-chunk-id-from-file)))
-	      (if (and (string= "FORM" first) (string= "IFZS" third))
-		  (malyon-restore-quetzal-state (+ 8 second))
-		(goto-char (point-min))
-		(malyon-restore-game-state))))
-	  (kill-buffer nil)
-	  (if (null malyon-restore-data-error)
-	      2
-	    (message malyon-restore-data-error)
-	    0))
-      (error 0))))
-
-(defun malyon-restore-table (table length)
-  "Restore the given section of memory from a file."
-  (let ((i 0)
-	(j table))
-    (while (< i length)
-      (malyon-store-byte j (malyon-read-byte-from-file))
-      (setq i (+ 1 i)
-	    j (+ 1 j)))))
-
-(defun malyon-restore-game-state ()
-  "Restore a saved game state from disk."
-  (let ((len   0)
-	(name  0)
-	(story 0)
-	(ip    0)
-	(sp    0)
-	(fp    0)
-	(dyn   0)
-	(stack (copy-sequence malyon-stack))
-	(mem   (copy-sequence malyon-story-file))
-	(i     0))
-    (setq len (malyon-read-word-from-file))
-    (setq name (make-string len ? ))
-    (while (< i len)
-      (aset name i (malyon-read-byte-from-file))
-      (setq i (+ 1 i)))
-    (setq ip  (malyon-read-dword-from-file))
-    (setq sp  (malyon-read-word-from-file))
-    (setq fp  (malyon-read-word-from-file))
-    (setq dyn (malyon-read-word-from-file))
-    (setq i 0)
-    (while (<= i sp)
-      (aset stack i (malyon-read-dword-from-file))
-      (setq i (+ 1 i)))
-    (setq i 0)
-    (while (< i dyn)
-      (aset mem i (malyon-read-byte-from-file))
-      (setq i (+ 1 i)))
-    (setq name  (file-name-nondirectory name))
-    (setq story (file-name-nondirectory malyon-story-file-name))
-    (if (or (string-match name story) (string-match story name))
-	(malyon-set-game-state (vector ip sp fp stack mem nil))
-      (setq malyon-restore-data-error "Invalid save file."))))
-
-(defun malyon-restore-quetzal-state (size)
-  "Restore a saved quetzal game state from disk."
-  (let ((chunk-id  nil)
-	(chunk-len 0)
-	(ip        0)
-	(memory    nil)
-	(stack     nil)
-	(beginning 0))
-    (while (< (point) size)
-      (setq chunk-id  (malyon-read-chunk-id-from-file))
-      (setq chunk-len (malyon-read-dword-from-file))
-      (setq beginning (point))
-      (cond ((string= chunk-id "IFhd")
-	     (setq ip (malyon-restore-quetzal-ifhd chunk-len)))
-	    ((string= chunk-id "CMem")
-	     (setq memory (malyon-restore-quetzal-cmem chunk-len)))
-	    ((string= chunk-id "UMem")
-	     (setq memory (malyon-restore-quetzal-umem chunk-len)))
-	    ((string= chunk-id "Stks")
-	     (setq stack (malyon-restore-quetzal-stks chunk-len))))
-      (if (zerop (mod chunk-len 2)) '() (setq chunk-len (+ 1 chunk-len)))
-      (goto-char (+ beginning chunk-len)))
-    (cond ((and ip memory stack)
-	   (malyon-set-game-state (vector ip
-					  (aref stack 0)
-					  (aref stack 1)
-					  (aref stack 2)
-					  memory
-					  t)))
-	  ((null malyon-restore-data-error)
-	   (setq malyon-restore-data-error "invalid quetzal file.")))))
-
-(defun malyon-restore-quetzal-ifhd (size)
-  "Restore an IFhd chunk from disk. Return the instruction pointer."
-  (if (and (= (malyon-read-word-from-file) (malyon-read-word 2))
-	   (= (malyon-read-word-from-file) (malyon-read-word 18))
-	   (= (malyon-read-word-from-file) (malyon-read-word 20))
-	   (= (malyon-read-word-from-file) (malyon-read-word 22))
-	   (= (malyon-read-word-from-file) (malyon-read-word 28)))
-      (logior (lsh (malyon-read-byte-from-file) 16)
-	      (lsh (malyon-read-byte-from-file) 8)
-	      (malyon-read-byte-from-file))
-    (setq malyon-restore-data-error "quetzal file doesn't belong to game.")
-    nil))
-
-(defun malyon-restore-quetzal-cmem (size)
-  "Restore a CMem chunk from disk. Return the entire memory layout."
-  (let ((memory   (copy-sequence (aref malyon-game-state-restart 4)))
-	(max-size (+ (point) size))
-	(byte     0)
-	(i        0))
-    (while (< (point) max-size)
-      (setq byte (malyon-read-byte-from-file))
-      (if (zerop byte)
-	  (setq i (+ 1 i (malyon-read-byte-from-file)))
-	(aset memory i (logxor byte (aref memory i)))
-	(setq i (+ 1 i))))
-    memory))
-
-(defun malyon-restore-quetzal-umem (size)
-  "Restore a UMem chunk from disk. Return the entire memory layout."
-  (let ((memory (copy-sequence (aref malyon-game-state-restart 4)))
-	(i      0))
-    (while (< i size)
-      (aset memory i (malyon-read-byte-from-file))
-      (setq i (+ 1 i)))
-    memory))
-
-(defun malyon-restore-quetzal-stks (size)
-  "Restore a Stks chunk from disk. Return a vector containing the 
-stack pointer, the frame pointer, and the stack itself."
-  (let ((i 0) (frame-id 0))
-    (setq malyon-restore-quetzal-stack
-	  (copy-sequence (aref malyon-game-state-restart 3)))
-    (setq malyon-restore-quetzal-stack-pointer -1)
-    (setq malyon-restore-quetzal-frame-pointer 2)
-    (while (< i size)
-      (let* ((beginning     (point))
-	     (return3       (malyon-read-byte-from-file))
-	     (return2       (malyon-read-byte-from-file))
-	     (return1       (malyon-read-byte-from-file))
-	     (return-addr   (logior (lsh return3 16) (lsh return2 8) return1))
-	     (result-locals (malyon-read-byte-from-file))
-	     (has-result    (zerop (logand 16 result-locals)))
-	     (num-locals    (logand 15 result-locals))
-	     (result-addr   (malyon-read-byte-from-file))
-	     (arg-flags     (+ 1 (malyon-read-byte-from-file)))
-	     (num-args      0)
-	     (eval-size     (malyon-read-word-from-file))
-	     (local-vars    '())
-	     (eval-stack    '()))
-	(while (> num-locals 0)
-	  (setq local-vars (cons (malyon-read-word-from-file) local-vars))
-	  (setq num-locals (- num-locals 1)))
-	(while (> eval-size 0)
-	  (setq eval-stack (cons (malyon-read-word-from-file) eval-stack))
-	  (setq eval-size (- eval-size 1)))
-	(while (> arg-flags 1)
-	  (setq arg-flags (lsh arg-flags -1))
-	  (setq num-args (+ num-args 1)))
-	(malyon-push-stack-frame frame-id
-				 return-addr
-				 (if (zerop frame-id)
-				     nil
-				   (if has-result result-addr nil))
-				 (reverse local-vars)
-				 num-args
-				 (reverse eval-stack))
-	(setq frame-id (+ 1 frame-id))
-	(setq i (+ i (- (point) beginning)))))
-    (vector malyon-restore-quetzal-stack-pointer
-	    malyon-restore-quetzal-frame-pointer
-	    malyon-restore-quetzal-stack)))
-
-;; object table management
-
-(defsubst malyon-object-address (object)
-  "Compute the address at which the object is stored."
-  (+ malyon-object-table
-     (* 2 malyon-object-properties)
-     (* malyon-object-table-entry-size (- object 1))))
-
-(defsubst malyon-object-read-parent (address)
-  "Return the parent."
-  (if (< malyon-story-version 5)
-      (malyon-read-byte (+ 4 address))
-    (malyon-read-word (+ 6 address))))
-
-(defsubst malyon-object-read-sibling (address)
-  "Return the next sibling."
-  (if (< malyon-story-version 5)
-      (malyon-read-byte (+ 5 address))
-    (malyon-read-word (+ 8 address))))
-
-(defsubst malyon-object-read-child (address)
-  "Return the first child."
-  (if (< malyon-story-version 5)
-      (malyon-read-byte (+ 6 address))
-    (malyon-read-word (+ 10 address))))
-
-(defsubst malyon-object-store-parent (address value)
-  "Set the parent."
-  (if (< malyon-story-version 5)
-      (malyon-store-byte (+ 4 address) value)
-    (malyon-store-word (+ 6 address) value)))
-
-(defsubst malyon-object-store-sibling (address value)
-  "Set the next sibling."
-  (if (< malyon-story-version 5)
-      (malyon-store-byte (+ 5 address) value)
-    (malyon-store-word (+ 8 address) value)))
-
-(defsubst malyon-object-store-child (address value)
-  "Set the first child."
-  (if (< malyon-story-version 5)
-      (malyon-store-byte (+ 6 address) value)
-    (malyon-store-word (+ 10 address) value)))
-
-(defun malyon-find-property (object property)
-  "Return the address of the object's property, or 0 if it doesn't exist."
-  (let ((next (malyon-first-property object))
-	(number 0))
-    (setq number (logand (malyon-read-byte next) malyon-object-properties))
-    (while (> number property)
-      (setq next (malyon-next-property next))
-      (setq number (logand (malyon-read-byte next) malyon-object-properties)))
-    (if (= number property) next 0)))
-
-(defun malyon-first-property (object)
-  "Get the address of the object's first property."
-  (let ((header (malyon-read-word (+ malyon-object-property-offset
-				     (malyon-object-address object)))))
-    (+ header 1 (* 2 (malyon-read-byte header)))))
-
-(defun malyon-next-property (property)
-  "Get the address of the following property."
-  (let ((size (malyon-read-byte property))
-	(addr (+ property 1)))
-    (+ 1 addr (cond ((< malyon-story-version 5) (lsh size -5))
-		    ((zerop (logand 128 size))  (lsh size -6))
-		    (t
-		     (let ((second (logand 63 (malyon-read-byte addr))))
-		       (if (= 0 second) 64 second)))))))
-
-(defun malyon-remove-object (object)
-  "Remove the object from the children list of its parent."
-  (let* ((address (malyon-object-address object))
-	 (parent  (malyon-object-read-parent address))
-	 (sibling (malyon-object-read-sibling address)))
-    (malyon-object-store-parent address 0)
-    (malyon-object-store-sibling address 0)
-    (if (/= parent 0)
-	(let ((parent-addr (malyon-object-address parent)))
-	  (let ((children (malyon-object-read-child parent-addr)))
-	    (if (or (= children 0) (= children object))
-		(malyon-object-store-child parent-addr sibling)
-	      (let ((this (malyon-object-address children)))
-		(let ((next (malyon-object-read-sibling this)))
-		  (while (/= next object)
-		    (setq this (malyon-object-address next))
-		    (setq next (malyon-object-read-sibling this)))
-		  (malyon-object-store-sibling this sibling)))))))))
-
-;; function calls and code branches
-
-(defun malyon-call-routine (routine arguments &optional result)
-  "Call a routine with the given arguments and return its result."
-  (if (= routine 0)
-      (if result (malyon-store-variable result 0) 0)
-    (malyon-push-stack (if result 0 1))
-    (malyon-push-stack (if result result 0))
-    (malyon-push-stack malyon-instruction-pointer)
-    (malyon-push-stack
-     (logior (lsh (- malyon-stack-pointer malyon-frame-pointer) 8)
-	     (length arguments)))
-    (setq malyon-instruction-pointer (* malyon-packed-multiplier routine))
-    (let ((args (malyon-read-code-byte)) (value nil))
-      (if malyon-game-state-quetzal
-	  (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
-	    (malyon-push-stack (logior (lsh (+ 1 id) 8) args))))
-      (setq malyon-frame-pointer malyon-stack-pointer)
-      (while (> args 0)
-	(setq value (if (< malyon-story-version 5) (malyon-read-code-word) 0))
-	(malyon-push-stack (if (null arguments) value (car arguments)))
-	(setq arguments (cdr arguments))
-	(setq args (- args 1))))))
-
-(defun malyon-jump-if (condition)
-  "Jump depending on the condition and the following jump data."
-  (let ((byte   (malyon-read-code-byte))
-	(offset nil)
-	(iftrue nil))
-    (setq iftrue (/= 0 (logand byte 128)))
-    (setq offset (logand byte 63))
-    (if (= 0 (logand byte 64)) 
-	(progn
-	  (setq offset (logior (lsh offset 8) (malyon-read-code-byte)))
-	  (if (>= offset 8192) (setq offset (- offset 16384)))))
-    (if (or (and iftrue condition) (and (not iftrue) (not condition)))
-	(progn
-	  (cond ((= offset 0) (malyon-opcode-rfalse))
-		((= offset 1) (malyon-opcode-rtrue))
-		(t            (setq
-			       malyon-instruction-pointer 
-			       (+ malyon-instruction-pointer offset -2))))))))
-
-(defun malyon-return (value)
-  "Return from a routine."
-  (setq malyon-stack-pointer malyon-frame-pointer)
-  (if malyon-game-state-quetzal (malyon-pop-stack))
-  (setq malyon-frame-pointer
-	(- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
-  (setq malyon-instruction-pointer (malyon-pop-stack))
-  (let ((result (malyon-pop-stack))
-	(store  (malyon-pop-stack)))
-    (if (zerop store)
-	(malyon-return-store result value)
-      (malyon-return-ignore result value))))
-
-(defun malyon-return-ignore (where value)
-  "Return from a routine ignoring the result.")
-
-(defun malyon-return-store (where value)
-  "Return from a routine storing the result."
-  (malyon-store-variable where value))
-
-(defun malyon-push-initial-frame ()
-  "Push the initial stack frame required in quetzal mode."
-  (if malyon-game-state-quetzal
-      (progn
-	(malyon-push-stack 1)
-	(malyon-push-stack 0)
-	(malyon-push-stack 0)
-	(malyon-push-stack 0)
-	(malyon-push-stack 0))))
-
-(defun malyon-get-stack-frame (fp sp stack)
-  "Return a decoded stack frame in quetzal mode.
-The result is a vector containing the frame id, the fp of the
-previous frame, the sp of the previous frame, the return address,
-the result variable if any, a list of local variables, the number
-of arguments, and a list of the evaluation stack elements."
-  (let* ((has-result   (zerop (aref stack fp)))
-	 (result-addr  (if has-result (aref stack (+ 1 fp)) nil))
-	 (return-addr  (aref stack (+ 2 fp)))
-	 (offset       (lsh (aref stack (+ 3 fp)) -8))
-	 (num-args     (logand 255 (aref stack (+ 3 fp))))
-	 (frame-id     (lsh (aref stack (+ 4 fp)) -8))
-	 (num-locals   (logand 255 (aref stack (+ 4 fp))))
-	 (start-locals (+ 5 fp))
-	 (start-eval   (+ 5 fp num-locals))
-	 (local-vars   '())
-	 (eval-stack   '()))
-    (if (not (zerop num-locals))
-	(setq local-vars 
-	      (malyon-vector-to-list stack start-locals start-eval)))
-    (if (> sp start-eval)
-	(setq eval-stack 
-	      (malyon-vector-to-list stack start-eval (+ 1 sp))))
-    (vector frame-id
-	    (- fp offset 2)
-	    (- fp 1)
-	    return-addr
-	    result-addr
-	    local-vars
-	    num-args
-	    eval-stack)))
-
-(defsubst malyon-restore-quetzal-push-stack (value)
-  "Push a value onto the restore quetzal stack."
-  (setq malyon-restore-quetzal-stack-pointer
-	(+ malyon-restore-quetzal-stack-pointer 1))
-  (aset malyon-restore-quetzal-stack
-	malyon-restore-quetzal-stack-pointer
-	value))
-
-(defun malyon-push-stack-frame
-  (frame-id return-addr result local-vars num-args eval-stack)
-  "Pushes a new stack frame in quetzal mode."
-  (malyon-restore-quetzal-push-stack (if result 0 1))
-  (malyon-restore-quetzal-push-stack (if result result 0))
-  (malyon-restore-quetzal-push-stack return-addr)
-  (malyon-restore-quetzal-push-stack
-   (logior (lsh (- malyon-restore-quetzal-stack-pointer
-		   malyon-restore-quetzal-frame-pointer) 8)
-	   num-args))
-  (malyon-restore-quetzal-push-stack
-   (logior (lsh frame-id 8) (length local-vars)))
-  (setq malyon-restore-quetzal-frame-pointer
-	malyon-restore-quetzal-stack-pointer)
-  (while (not (null local-vars))
-    (malyon-restore-quetzal-push-stack (car local-vars))
-    (setq local-vars (cdr local-vars)))
-  (while (not (null eval-stack))
-    (malyon-restore-quetzal-push-stack (car eval-stack))
-    (setq eval-stack (cdr eval-stack))))
-
-;; other stuff
-
-(defvar malyon-aread-text nil
-  "Text buffer for user input.")
-
-(defvar malyon-aread-parse nil
-  "Parse buffer for user input.")
-
-(defvar malyon-aread-beginning-of-line nil
-  "The beginning of the input line.")
-
-;; execution
-
-(defun malyon-interpreter ()
-  "Run the z code interpreter on the given story file."
-  (condition-case nil
-      (progn
-	(malyon-restore-window-configuration)
-	(if malyon-story-file
-	    (catch 'malyon-end-of-interpreter-loop
-	      (setq malyon-last-cursor-position-after-input
-		    (malyon-point-max malyon-transcript-buffer))
-	      (malyon-execute))))
-    (error
-     (malyon-fatal-error "unspecified internal runtime error."))))
-
-(defsubst malyon-fetch-variable-operands (specifier)
-  "Fetch a variable number of operands based on the specifier argument."
-  (let ((var  (logand specifier 49152))
-	(op   '()))
-    (setq specifier (logand 65535 specifier))
-    (while (/= 0 specifier)
-      (cond ((= var 0)     (setq op (cons (malyon-read-code-word) op)))
-	    ((= var 16384) (setq op (cons (malyon-read-code-byte) op)))
-	    ((= var 32768) (setq op (cons (malyon-read-variable
-					   (malyon-read-code-byte)) op)))
-	    (t             (setq specifier 0)))
-      (setq specifier (logand 65535 (lsh specifier 2)))
-      (setq var  (logand specifier 49152)))
-    (nreverse op)))
-
-(defsubst malyon-fetch-extended (opcode)
-  "Fetch operands for an extended instruction."
-  (malyon-fetch-variable-operands
-   (logior (lsh (malyon-read-code-byte) 8) 255)))
-
-(defsubst malyon-fetch-variable (opcode)
-  "Fetch operands for a variable instruction."
-  (malyon-fetch-variable-operands
-   (if (or (= opcode 236) (= opcode 250))
-       (malyon-read-code-word)
-     (logior (lsh (malyon-read-code-byte) 8) 255))))
-
-(defsubst malyon-fetch-short (opcode)
-  "Fetch operands for a short instruction."
-  (let ((op (logand opcode 48)))
-    (cond ((= op 0)  (list (malyon-read-code-word)))
-	  ((= op 16) (list (malyon-read-code-byte)))
-	  ((= op 32) (list (malyon-read-variable (malyon-read-code-byte)))))))
-
-(defsubst malyon-fetch-long (instr)
-  "Fetch operands for a long instruction."
-  (let ((byte1 (malyon-read-code-byte))
-	(byte2 (malyon-read-code-byte)))
-    (list (if (= (logand instr 64) 0) byte1 (malyon-read-variable byte1))
-	  (if (= (logand instr 32) 0) byte2 (malyon-read-variable byte2)))))
-
-(defun malyon-execute ()
-  "Execute z code instructions.
-Load the next instruction opcode and its operands and execute it.
-Repeat ad infinitum."
-  (let ((opcode) (operands)); (pc))
-    (while t
-;      (setq pc malyon-instruction-pointer)
-      (setq opcode (malyon-read-code-byte))
-      (setq operands (cond ((=  opcode 190) 
-			    (setq opcode (+ 256 (malyon-read-code-byte)))
-			    (malyon-fetch-extended opcode))
-			   ((>= opcode 192)
-			    (malyon-fetch-variable opcode))
-			   ((>= opcode 128)
-			    (malyon-fetch-short opcode))
-			   (t
-			    (malyon-fetch-long opcode))))
-;      (malyon-trace-opcode pc opcode operands)
-      (apply (aref malyon-opcodes opcode) operands))))
-
-;; opcodes
-
-(defsubst malyon-number (n)
-  "Convert an unsigned number into a signed one."
-  (if (< n 32768) n (- n 65536)))
-
-(defun malyon-opcode-add (a b)
-  "Addition."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (+ (malyon-number a) (malyon-number b))))
-
-(defun malyon-opcode-and (a b)
-  "Bitwise and."
-  (malyon-store-variable (malyon-read-code-byte) (logand a b)))
-
-(defun malyon-opcode-aread (text parse &optional time routine)
-  "Read input text."
-  (setq malyon-aread-text text)
-  (setq malyon-aread-parse parse)
-  (goto-char (point-max))
-  (setq malyon-aread-beginning-of-line (point))
-; Some games violate these assumptions for the "Quit" question.
-;  (if (> 3 (malyon-read-byte text))
-;      (malyon-fatal-error "text buffer less than 3 bytes."))
-;  (if (and (not (zerop parse)) (> 2 (malyon-read-byte parse)))
-;      (malyon-fatal-error "parse buffer less than 2 bytes."))
-  (malyon-more malyon-keymap-read)
-  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-input))
-
-(defun malyon-opcode-art-shift (value places)
-  "Arithmetic shift."
-  (malyon-store-variable (malyon-read-code-byte) (ash value places)))
-
-(defun malyon-opcode-buffer-mode (mode)
-  "Toggles buffering of text in the transcript window."
-  (setq malyon-transcript-buffer-buffered (/= 0 mode)))
-
-(defun malyon-opcode-calln (routine &rest arguments)
-  "Call a routine and ignore the result."
-  (malyon-call-routine routine arguments))
-
-(defun malyon-opcode-calls (routine &rest arguments)
-  "Call a routine and store the result."
-  (malyon-call-routine routine arguments (malyon-read-code-byte)))
-
-(defun malyon-opcode-catch ()
-  "Return the current stack frame."
-  (malyon-store-variable
-   (malyon-read-code-byte)
-   (if malyon-game-state-quetzal
-       (lsh (aref malyon-stack malyon-frame-pointer) -8)
-     malyon-frame-pointer)))
-
-(defun malyon-opcode-check-arg-count (count)
-  "Tests the number of arguments passed to routine."
-  (malyon-jump-if
-   (<= count (logand 255 (aref malyon-stack 
-			       (if malyon-game-state-quetzal
-				   (- malyon-frame-pointer 1)
-				 malyon-frame-pointer))))))
-
-(defun malyon-opcode-check-unicode (char)
-  "Check whether the given character is valid for input/output."
-  (malyon-store-variable (malyon-read-code-byte) 0))
-
-(defun malyon-opcode-clear-attr (object attribute)
-  "Clear the given attribute in the given object."
-  (let ((attributes (malyon-object-address object))
-	(byte       (lsh attribute -3)))
-    (malyon-store-byte (+ attributes byte)
-		       (logand (malyon-read-byte (+ attributes byte))
-			       (logxor (lsh 128 (- (logand attribute 7)))
-				       255)))))
-
-(defun malyon-opcode-copy-table (first second size)
-  "Copies first table onto second one."
-  (let* ((length  (abs (malyon-number size)))
-	 (zero    (zerop second))
-	 (forward (or (< (malyon-number size) 0) (> first second)))
-	 (i       0)
-	 (a       (if forward first (+ first length -1)))
-	 (b       (if forward (if zero first second) (+ second length -1))))
-    (while (< i length)
-      (malyon-store-byte b (if zero 0 (malyon-read-byte a)))
-      (setq i (+ i 1)
-	    a (if forward (+ a 1) (- a 1))
-	    b (if forward (+ b 1) (- b 1))))))
-
-(defun malyon-opcode-dec (var)
-  "Decrement variable."
-  (malyon-store-variable var
-			 (- (malyon-number (malyon-read-variable var)) 1)))
-
-(defun malyon-opcode-dec-chk (variable threshold)
-  "Decrement variable and jump if it's less than the given value."
-  (let ((value (malyon-number (malyon-read-variable variable))))
-    (malyon-store-variable variable (- value 1))
-    (malyon-jump-if (< (- value 1) (malyon-number threshold)))))
-
-(defun malyon-opcode-div (a b)
-  "Division."
-  (if (zerop b) (malyon-fatal-error "division by 0."))
-  (malyon-store-variable (malyon-read-code-byte)
-			 (/ (malyon-number a) (malyon-number b))))
-
-(defun malyon-opcode-encode-text (text length from encoded)
-  "Encode the zscii text starting at from with the given length.
-The result is stored at encoded."
-  (let* ((i     length)
-	 (j     encoded)
-	 (l     '())
-	 (word  '()))
-    (while (< 0 i)
-      (setq l (cons (malyon-read-byte (+ text from i -1)) l)
-	    i (- i 1)))
-    (setq word (malyon-encode-dictionary-word
-		(append (malyon-mapcan 'malyon-encode-into-ztext l)
-			'(5 5 5 5 5 5 5 5))))
-    (while (< i 6)
-      (malyon-store-byte j (car l))
-      (setq i (+ 1 i)
-	    j (+ 1 j)
-	    l (cdr word)))))
-
-(defun malyon-opcode-erase-line (value)
-  "Erases the rest of the line."
-  (if (= value 1)
-      (if (eq malyon-transcript-buffer (current-buffer))
-	  (kill-line nil)
-	(save-excursion
-	  (let ((i (current-column)))
-	    (while (<= i malyon-max-column)
-	      (insert ? )
-	      (delete-char 1)
-	      (setq i (+ 1 i))))))))
-
-(defun malyon-opcode-erase-window (window)
-  "Erase the contents of the given window."
-  (save-excursion
-    (let ((w (malyon-number window)))
-      (if (or (= w 0) (= w -1) (= w -2))
-	  (malyon-erase-buffer malyon-transcript-buffer))
-      (if (or (= w 1) (= w -1) (= w -2))
-	  (malyon-erase-buffer malyon-status-buffer))
-      (if (= w -1)
-	  (malyon-split-buffer-windows 0)))
-    (setq malyon-last-cursor-position-after-input
-	  (malyon-point-max malyon-transcript-buffer))))
-
-(defun malyon-opcode-get-child (object)
-  "Get the first child of the given object and jump."
-  (let ((child (malyon-object-read-child (malyon-object-address object))))
-    (malyon-store-variable (malyon-read-code-byte) child)
-    (malyon-jump-if (/= 0 child))))
-
-(defun malyon-opcode-get-cursor (array)
-  "Retrieves the current cursor position."
-  (save-excursion
-    (set-buffer malyon-status-buffer)
-    (malyon-store-word array (- (count-lines (point-min) (point)) 1))
-    (malyon-store-word (+ 2 array) (+ 1 (current-column)))))
-
-(defun malyon-opcode-get-next-prop (object property)
-  "Retrieve the first or next property id of object."
-  (let ((next (malyon-first-property object))
-	(number 0))
-    (if (zerop property)
-	'()
-      (setq number (logand (malyon-read-byte next)
-			   malyon-object-properties))
-      (setq next (malyon-next-property next))
-      (while (> number property)
-	(setq number (logand (malyon-read-byte next)
-			     malyon-object-properties))
-	(setq next (malyon-next-property next)))
-      (if (/= number property)
-	  (malyon-fatal-error "property does not exist.")))
-    (setq number (logand (malyon-read-byte next) malyon-object-properties))
-    (malyon-store-variable (malyon-read-code-byte) number)))
-    
-(defun malyon-opcode-get-parent (object)
-  "Get the parent of the given object."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (malyon-object-read-parent
-			  (malyon-object-address object))))
-
-(defun malyon-opcode-get-prop (object property)
-  "Get the value of the object's property."
-  (let* ((address (malyon-find-property object property))
-	 (size    (malyon-read-byte address)))
-    (malyon-store-variable 
-     (malyon-read-code-byte)
-     (cond ((zerop address)
-	    (malyon-read-word (+ malyon-object-table (* 2 (- property 1)))))
-	   ((and (<  malyon-story-version 5) (zerop (lsh size -5)))
-	    (malyon-read-byte (+ address 1)))
-	   ((and (>= malyon-story-version 5) (zerop (logand 192 size)))
-	    (malyon-read-byte (+ address 1)))
-	   (t
-	    (malyon-read-word (+ address 1)))))))
-
-(defun malyon-opcode-get-prop-addr (object property)
-  "Get the address of the object's property."
-  (let* ((address (malyon-find-property object property))
-	 (size    (malyon-read-byte address))
-	 (offset  (if (< malyon-story-version 5)
-		      1
-		    (if (zerop (logand 128 size)) 1 2))))
-    (malyon-store-variable (malyon-read-code-byte)
-			   (if (zerop address) 0 (+ address offset)))))
-
-(defun malyon-opcode-get-prop-len (property)
-  "Get the length of the object's property."
-  (let ((size (malyon-read-byte (- property 1))))
-    (malyon-store-variable
-     (malyon-read-code-byte)
-     (cond ((< malyon-story-version 5) (+ 1 (lsh size -5)))
-	   ((zerop (logand 128 size))  (+ 1 (lsh size -6)))
-	   ((zerop (logand  63 size))  64)
-	   (t                          (logand 63 size))))))
-
-(defun malyon-opcode-get-sibling (object)
-  "Get the next object in the tree and jump."
-  (let ((sibling (malyon-object-read-sibling (malyon-object-address object))))
-    (malyon-store-variable (malyon-read-code-byte) sibling)
-    (malyon-jump-if (/= 0 sibling))))
-
-(defun malyon-opcode-illegal (&rest ignore)
-  "Print an error message and exit the interpreter."
-  (malyon-fatal-error "illegal opcode."))
-
-(defun malyon-opcode-inc (var)
-  "Increment variable."
-  (malyon-store-variable var
-			 (+ (malyon-number (malyon-read-variable var)) 1)))
-
-(defun malyon-opcode-inc-chk (variable threshold)
-  "Increment variable and jump if it's greater than the given value."
-  (let ((value (malyon-number (malyon-read-variable variable))))
-    (malyon-store-variable variable (+ value 1))
-    (malyon-jump-if (> (+ value 1) (malyon-number threshold)))))
-
-(defun malyon-opcode-input-stream (number)
-  "Select the given input stream. Only the keyboard is supported."
-  (if (zerop (malyon-number number))
-      '()
-    (message "Only the keyboard is supported as an input stream.")))
-
-(defun malyon-opcode-insert-obj (object destination)
-  "Insert an object into the children list of another."
-  (let ((child  (malyon-object-address object))
-	(parent (malyon-object-address destination)))
-    (malyon-remove-object object)
-    (malyon-object-store-parent  child destination)
-    (malyon-object-store-sibling child (malyon-object-read-child parent))
-    (malyon-object-store-child   parent object)))
-
-(defun malyon-opcode-je (a &rest rest)
-  "Jump if first operand equals any of the following."
-  (malyon-jump-if (member (malyon-number a) (mapcar 'malyon-number rest))))
-
-(defun malyon-opcode-jg (a b)
-  "Jump if first operand > second operand."
-  (malyon-jump-if (> (malyon-number a) (malyon-number b))))
-
-(defun malyon-opcode-jin (child parent)
-  "Jump if second object is parent of the first one."
-    (malyon-jump-if
-     (= parent (malyon-object-read-parent (malyon-object-address child)))))
-
-(defun malyon-opcode-jl (a b)
-  "Jump if first operand < second operand."
-  (malyon-jump-if (< (malyon-number a) (malyon-number b))))
-
-(defun malyon-opcode-jump (offset)
-  "Jump unconditionally."
-  (setq malyon-instruction-pointer (+ malyon-instruction-pointer
-				      (malyon-number offset) -2)))
-
-(defun malyon-opcode-jz (a)
-  "Jump if operand = 0."
-  (malyon-jump-if (zerop a)))
-
-(defun malyon-opcode-load (variable)
-  "Load a variable."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (malyon-read-variable variable)))
-
-(defun malyon-opcode-loadb (array index)
-  "Load an array element into a variable."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (malyon-read-byte (+ array index))))
-
-(defun malyon-opcode-loadw (array index)
-  "Load an array element into a variable."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (malyon-read-word (+ array (* 2 index)))))
-
-(defun malyon-opcode-log-shift (value places)
-  "Logical shift."
-  (malyon-store-variable (malyon-read-code-byte) (lsh value places)))
-
-(defun malyon-opcode-mod (a b)
-  "Modulo."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (mod (malyon-number a) (malyon-number b))))
-
-(defun malyon-opcode-mul (a b)
-  "Multiplication."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (* (malyon-number a) (malyon-number b))))
-
-(defun malyon-opcode-new-line ()
-  "Print a newline."
-  (malyon-newline))
-
-(defun malyon-opcode-nop (&rest ignore)
-  "Do nothing.")
-
-(defun malyon-opcode-not (a)
-  "Bitwise not."
-  (malyon-store-variable (malyon-read-code-byte) (logand 65535 (lognot a))))
-
-(defun malyon-opcode-or (a b)
-  "Bitwise or."
-  (malyon-store-variable (malyon-read-code-byte) (logior a b)))
-
-(defun malyon-opcode-output-stream (stream &optional table)
-  "Select an output stream."
-  (let ((stream (malyon-number stream)))
-    (cond ((< 0 stream) (malyon-add-output-stream stream table))
-	  ((> 0 stream) (malyon-remove-output-stream (- stream))))))
-
-(defun malyon-opcode-piracy ()
-  "Piracy check, effectively an unconditional jump."
-  (malyon-jump-if 1))
-
-(defun malyon-opcode-pop ()
-  "Pop a value off the stack."
-  (malyon-pop-stack))
-
-(defun malyon-opcode-print ()
-  "Print a string."
-  (setq malyon-instruction-pointer
-	(malyon-print-text malyon-instruction-pointer)))
-
-(defun malyon-opcode-print-addr (address)
-  "Print a string."
-  (malyon-print-text address))
-
-(defun malyon-opcode-print-char (c)
-  "Print a character."
-  (malyon-print (char-to-string c)))
-
-(defun malyon-opcode-print-num (n)
-  "Print a number."
-  (malyon-print (number-to-string (malyon-number n))))
-
-(defun malyon-opcode-print-obj (obj)
-  "Print the short name of the object."
-  (malyon-print-text
-   (+ 1 (malyon-read-word (+ malyon-object-property-offset
-			     (malyon-object-address obj))))))
-
-(defun malyon-opcode-print-paddr (address)
-  "Print a string."
-  (malyon-print-text (* malyon-packed-multiplier address)))
-
-(defun malyon-opcode-print-ret ()
-  "Print a string, print a newline, return true/1."
-  (setq malyon-instruction-pointer
-	(malyon-print-text malyon-instruction-pointer))
-  (malyon-newline)
-  (malyon-return 1))
-
-(defun malyon-opcode-print-table (text width &optional height skip)
-  "Print the given table."
-  (if (not height) (setq height 1))
-  (if (not skip)   (setq skip 0))
-  (let ((column  (current-column))
-	(address text)
-	(y       0)
-	(x       0))
-    (while (< y height)
-      (if (zerop y)
-	  '()
-	(malyon-newline)
-	(malyon-print-characters (make-string column ? )))
-      (setq x 0)
-      (while (< x width)
-	(malyon-output-character (malyon-read-byte address))
-	(setq address (+ 1 address))
-	(setq x (+ 1 x)))
-      (setq address (+ skip address))
-      (setq y (+ 1 y)))))
-
-(defun malyon-opcode-print-unicode (char)
-  "Prints a unicode character.")
-
-(defun malyon-opcode-pull (variable)
-  "Pull value off stack."
-  (malyon-store-variable variable (malyon-pop-stack)))
-
-(defun malyon-opcode-push (value)
-  "Push value onto stack."
-  (malyon-push-stack value))
-
-(defun malyon-opcode-put-prop (object property value)
-  "Set the object's property to the given value."
-  (let* ((address (malyon-find-property object property))
-	 (size    (malyon-read-byte address)))
-    (cond ((= address 0)
-	   (malyon-fatal-error "property does not exist."))
-	  ((and (<  malyon-story-version 5) (zerop (lsh size -5)))
-	   (malyon-store-byte (+ 1 address) (logand 255 value)))
-	  ((and (>= malyon-story-version 5) (zerop (logand size 192)))
-	   (malyon-store-byte (+ 1 address) (logand 255 value)))
-	  (t
-	   (malyon-store-word (+ 1 address) value)))))
-
-(defun malyon-opcode-quit ()
-  "End the game immediately."
-  (malyon-adjust-transcript)
-  (malyon-cleanup)
-  (throw 'malyon-end-of-interpreter-loop 'malyon-opcode-quit))
-
-(defun malyon-opcode-random (limit)
-  "Generate a random number or set the seed value."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (if (>= 0 (malyon-number limit))
-			     0
-			   (+ 1 (random (malyon-number limit))))))
-
-(defun malyon-opcode-read-char (&optional device &rest ignore)
-  "Read a character."
-  (if (and device (/= 1 device))
-      (malyon-fatal-error "illegal device specified in read_char."))
-  (if (eq malyon-transcript-buffer (current-buffer))
-      (goto-char (point-max)))
-  (message "[Press a key.]")
-  (malyon-more malyon-keymap-readchar)
-  (throw 'malyon-end-of-interpreter-loop 'malyon-waiting-for-character))
-
-(defun malyon-opcode-remove-obj (object)
-  "Remove an object from its parent's children list."
-  (malyon-remove-object object))
-
-(defun malyon-opcode-restart ()
-  "Restart the game."
-  (malyon-set-game-state malyon-game-state-restart))
-
-(defun malyon-opcode-restore (&optional table bytes name)
-  "Restore a saved game state or a section of memory from a file."
-  (let ((result (if name
-		    (malyon-restore-file
-		     (malyon-get-file-name name) table bytes)
-		  (call-interactively 'malyon-restore-file))))
-    (if (< malyon-story-version 5)
-	(malyon-jump-if (not (zerop result)))
-      (malyon-store-variable (malyon-read-code-byte) result))))
-
-(defun malyon-opcode-restore-undo ()
-  "Restore game state for undo."
-  (if malyon-game-state-undo
-      (malyon-set-game-state malyon-game-state-undo))
-  (malyon-store-variable (malyon-read-code-byte) 2))
-
-(defun malyon-opcode-ret (value)
-  "Return a value."
-  (malyon-return value))
-
-(defun malyon-opcode-ret-popped ()
-  "Return top of stack."
-  (malyon-return (malyon-pop-stack)))
-
-(defun malyon-opcode-rfalse ()
-  "Return false/0."
-  (malyon-return 0))
-
-(defun malyon-opcode-rtrue ()
-  "Return true/1."
-  (malyon-return 1))
-
-(defun malyon-opcode-save (&optional table bytes name)
-  "Save the current game state or a section of memory to a file."
-  (let ((result (if name
-		    (malyon-save-file (malyon-get-file-name name) table bytes)
-		  (call-interactively 'malyon-save-file))))
-    (if (< malyon-story-version 5)
-	(malyon-jump-if (not (zerop result)))
-      (malyon-store-variable (malyon-read-code-byte) result))))
-
-(defun malyon-opcode-save-undo ()
-  "Save game state for undo."
-  (setq malyon-game-state-undo (malyon-current-game-state))
-  (malyon-store-byte (malyon-read-code-byte) 1))
-
-(defun malyon-opcode-scan-table (x table len &optional form)
-  "Scan the given table for the first occurrence of x."
-  (if (not form) (setq form 130))
-  (let ((inc (logand 127 form))
-	(byte (zerop (logand 128 form)))
-	(addr table)
-	(found 0)
-	(index 0))
-    (while (and (zerop found) (< index len))
-      (setq found
-	    (if byte
-		(if (= x (malyon-read-byte addr)) addr 0)
-	      (if (= x (malyon-read-word addr)) addr 0)))
-      (setq addr (+ addr inc))
-      (setq index (+ index 1)))
-    (malyon-store-variable (malyon-read-code-byte) found)
-    (malyon-jump-if (not (zerop found)))))
-
-(defun malyon-opcode-set-attr (object attribute)
-  "Set the given attribute in the given object."
-  (let ((attributes (malyon-object-address object))
-	(byte       (lsh attribute -3)))
-    (malyon-store-byte (+ attributes byte)
-		       (logior (malyon-read-byte (+ attributes byte))
-			       (lsh 128 (- (logand attribute 7)))))))
-
-(defun malyon-opcode-set-color (foreground background)
-  "Sets the fore- and background colors ie. does nothing.")
-
-(defun malyon-opcode-set-cursor (&optional line column)
-  "Set the cursor."
-  (if (eq malyon-transcript-buffer (current-buffer))
-      (goto-char (point-max))
-    (if malyon-status-buffer-delayed-split
-	(progn
-	  (malyon-split-buffer-windows malyon-status-buffer-delayed-split)
-	  (other-window 1)))
-    (if line   '() (setq line   (count-lines (point-min) (point))))
-    (if column '() (setq column (current-column)))
-    (if (> line malyon-status-buffer-lines)
-	(progn
-	  (malyon-split-buffer-windows line)
-	  (other-window 1)))
-    (goto-char (point-min))
-    (if (and (<= 1 line) (<= line malyon-status-buffer-lines))
-	(forward-line line)
-      (beginning-of-line))
-    (if (and (<= 1 column) (<= column malyon-max-column))
-	(forward-char (- column 1))
-      (beginning-of-line))
-    (setq malyon-status-buffer-point (point))))
-
-(defun malyon-opcode-set-font (font)
-  "Sets the font if available or 0 otherwise."
-  (malyon-store-variable (malyon-read-code-byte) 0))
-
-(defun malyon-opcode-set-text-style (style)
-  "Set the text style/face."
-  (let ((face (assq style malyon-faces)))
-    (setq malyon-current-face (if face (cdr face) 'malyon-face-plain))))
-
-(defun malyon-opcode-set-window (window)
-  "Set the current window."
-  (malyon-restore-window-configuration)
-  (setq malyon-current-window window)
-  (malyon-update-output-streams)
-  (if (zerop window)
-      (if (not (eq malyon-transcript-buffer (current-buffer)))
-	  (other-window 1))
-    (if (not (eq malyon-status-buffer (current-buffer)))
-	(other-window 1))
-    (malyon-opcode-set-cursor 1 1)))
-
-(defun malyon-opcode-show-status ()
-  "Display the status line."
-  (save-excursion
-    (malyon-opcode-split-window 1)
-    (malyon-restore-window-configuration)
-    (malyon-opcode-set-window 1)
-    (malyon-prepare-status-buffer 1)
-    (malyon-opcode-set-cursor 1 1)
-    (malyon-opcode-print-obj (malyon-read-global-variable 0))
-    (if (<= (current-column) (- (current-fill-column) 10))
-	(let* ((x     (malyon-read-global-variable 1))
-	       (y     (malyon-read-global-variable 2))
-	       (hours (if (> x 12) (- x 12) x))
-	       (ampm  (if (> x 12) "PM" "AM"))
-	       (score (format "%4d/%4d" x y))
-	       (time  (format "%02d:%02d%s" hours y ampm)))
-	  (malyon-opcode-set-cursor 1 (- (current-fill-column) 10))
-	  (malyon-print (if malyon-score-game score time))))
-    (malyon-opcode-set-window 0)
-    (malyon-adjust-transcript)))
-
-(defun malyon-opcode-split-window (size)
-  "Split upper and lower window."
-  (malyon-set-window-configuration size))
-
-(defun malyon-opcode-store (variable value)
-  "Store a value in a variable."
-  (malyon-store-variable variable value))
-
-(defun malyon-opcode-storeb (array index value)
-  "Store a value in an array at the given index."
-  (malyon-store-byte (+ array index) value))
-
-(defun malyon-opcode-storew (array index value)
-  "Store a value in an array at the given index."
-  (malyon-store-word (+ array (* 2 index)) value))
-
-(defun malyon-opcode-sub (a b)
-  "Subtraction."
-  (malyon-store-variable (malyon-read-code-byte)
-			 (- (malyon-number a) (malyon-number b))))
-
-(defun malyon-opcode-test (bitmap flags)
-  "Test if all of the flags are set in the bitmap."
-  (malyon-jump-if (= flags (logand bitmap flags))))
-
-(defun malyon-opcode-test-attr (object attribute)
-  "Jump depending on the given attribute in the given object."
-  (malyon-jump-if 
-   (/= 0 (logand (malyon-read-byte (+ (malyon-object-address object)
-				      (lsh attribute -3)))
-		 (lsh 128 (- (logand attribute 7)))))))
-
-(defun malyon-opcode-throw (value frame)
-  "Return from the given stack frame."
-  (if malyon-game-state-quetzal
-      (let ((id (lsh (aref malyon-stack malyon-frame-pointer) -8)))
-	(while (/= frame id)
-	  (setq malyon-stack-pointer malyon-frame-pointer)
-	  (malyon-pop-stack)
-	  (setq malyon-frame-pointer
-		(- malyon-stack-pointer 1 (lsh (malyon-pop-stack) -8)))
-	  (malyon-pop-stack)
-	  (malyon-pop-stack)
-	  (setq id (lsh (aref malyon-stack malyon-frame-pointer) -8))))
-    (setq malyon-frame-pointer frame))
-  (malyon-return value))
-
-(defun malyon-opcode-tokenise (text parse &optional dict flag)
-  "Perform lexical analysis on the text buffer."
-  (let* ((words (malyon-text-to-words text dict))
-	 (word  (car           words))
-	 (start (car           word))
-	 (len   (malyon-cadr   word))
-	 (code  (malyon-caddr  word))
-	 (entry (malyon-lookup dict code))
-	 (i     0))
-    (while (not (or (null words) (= i (malyon-read-byte parse))))
-      (if (and (zerop entry) flag (/= 0 flag))
-	  '()
-	(malyon-store-word (+ 2 parse (* 4 i)) entry)
-	(malyon-store-byte (+ 4 parse (* 4 i)) len)
-	(malyon-store-byte (+ 5 parse (* 4 i)) start))
-      (setq words (cdr           words)
-	    word  (car           words)
-	    start (car           word)
-	    len   (malyon-cadr   word)
-	    code  (malyon-caddr  word)
-	    entry (malyon-lookup dict code)
-	    i     (+ 1 i)))
-    (malyon-store-byte (+ 1 parse) i)))
-
-(defun malyon-opcode-verify ()
-  "Verify the correctness of the story file."
-  (let ((length (+ 1 (* malyon-packed-multiplier (malyon-read-word 26))))
-	(sum    0)
-	(i      64))
-    (while (< i length)
-      (setq sum (mod (+ sum (malyon-read-byte i)) 65536)
-	    i   (+ 1 i)))
-    (malyon-jump-if (= (malyon-read-word 28) sum))))
-
-;; keymap utilities
-
-(defun malyon-end-input ()
-  "Store the input line in a text buffer and perform lexical analysis."
-  (interactive)
-  (condition-case nil
-      (progn
-	(malyon-adjust-transcript)
-	(switch-to-buffer malyon-transcript-buffer)
-	(goto-char (point-max))
-	(let* ((input (downcase
-		       (buffer-substring-no-properties
-			(if (< malyon-aread-beginning-of-line (point))
-			    malyon-aread-beginning-of-line
-			  (point))
-			(point))))
-	       (vec  (malyon-string-to-vector input))
-	       (text (apply 'vector (mapcar 'malyon-unicode-to-zscii vec)))
-	       (len  (min (malyon-read-byte malyon-aread-text) (length text)))
-	       (i    0))
-	  (malyon-history-insert input)
-	  (if (>= malyon-story-version 5)
-	      (malyon-store-byte (+ malyon-aread-text 1) len))
-	  (while (< i len)
-	    (malyon-store-byte
-	     (+ malyon-aread-text (if (< malyon-story-version 5) 1 2) i)
-	     (malyon-char-to-int (aref text i)))
-	    (setq i (+ 1 i)))
-	  (if (< malyon-story-version 5)
-	      (malyon-store-byte (+ malyon-aread-text 1 len) 0)))
-	(if (/= 0 malyon-aread-parse)
-	    (malyon-opcode-tokenise malyon-aread-text malyon-aread-parse))
-	(newline)
-	(if (>= malyon-story-version 5)
-	    (malyon-store-variable (malyon-read-code-byte) 10))
-	(malyon-interpreter))
-    (error
-     (malyon-fatal-error "unspecified internal runtime error."))))
-
-(defun malyon-more-char ()
-  "Page down in More mode."
-  (interactive)
-  (condition-case nil
-      (scroll-up)
-    (error))
-  (if (>= (count-lines (point) (point-max))
-          (malyon-window-displayed-height))
-      (message "[More]")
-    (goto-char (point-max))
-    (malyon-adjust-transcript)
-    (use-local-map malyon-more-continue-keymap)))
-
-(defun malyon-more-char-status ()
-  "Wait for a key then continue."
-  (interactive)
-  (condition-case nil
-      (progn
-	(malyon-adjust-transcript)
-	(use-local-map malyon-more-continue-keymap)
-	(malyon-interpreter))
-    (error
-     (malyon-fatal-error "unspecified internal runtime error."))))
-
-(defun malyon-wait-char ()
-  "Store the input character in a variable and resume execution."
-  (interactive)
-  (condition-case nil
-      (progn
-	(malyon-store-variable 
-	 (malyon-read-code-byte)
-	 (malyon-char-to-int (malyon-unicode-to-zscii last-command-char)))
-	(use-local-map malyon-keymap-read)
-	(malyon-interpreter))
-    (error
-     (malyon-fatal-error "unspecified internal runtime error."))))
-
-(defun malyon-history-previous-char (arg)
-  "Display the previous item in the input history."
-  (interactive "p")
-  (let ((input (malyon-history-previous)))
-    (cond ((> malyon-aread-beginning-of-line (point))
-	   (funcall malyon-history-saved-up arg))
-	  (input
-	   (save-excursion
-	     (set-buffer malyon-transcript-buffer)
-	     (delete-region malyon-aread-beginning-of-line (point-max)))
-	   (goto-char (point-max))
-	   (insert input)
-	   (malyon-adjust-transcript)))))
-
-(defun malyon-history-next-char (arg)
-  "Display the next item in the input history."
-  (interactive "p")
-  (let ((input (malyon-history-next)))
-    (cond ((> malyon-aread-beginning-of-line (point))
-	   (funcall malyon-history-saved-down arg))
-	  (input
-	   (save-excursion
-	     (set-buffer malyon-transcript-buffer)
-	     (delete-region malyon-aread-beginning-of-line (point-max)))
-	   (goto-char (point-max))
-	   (insert input)
-	   (malyon-adjust-transcript)))))
-
-(defun malyon-beginning-of-line (arg)
-  "Go to the beginning of the line."
-  (interactive "p")
-  (if (> malyon-aread-beginning-of-line (point))
-      (beginning-of-line)
-    (goto-char malyon-aread-beginning-of-line)))
-
-(defun malyon-kill-region (arg)
-  "Kill region."
-  (interactive "p")
-  (if (<= malyon-aread-beginning-of-line (point))
-      (kill-region (point) (mark))
-    (message "Editing is restricted to the input prompt.")))
-
-(defun malyon-kill-line (arg)
-  "Kill rest of the current line."
-  (interactive "p")
-  (if (<= malyon-aread-beginning-of-line (point))
-      (kill-line)
-    (message "Editing is restricted to the input prompt.")))
-
-(defun malyon-kill-word (arg)
-  "Kill the current word."
-  (interactive "p")
-  (if (<= malyon-aread-beginning-of-line (point))
-      (kill-word 1)
-    (message "Editing is restricted to the input prompt.")))
-
-(defun malyon-yank (arg)
-  "Yank."
-  (interactive "p")
-  (if (<= malyon-aread-beginning-of-line (point))
-      (yank)
-    (message "Editing is restricted to the input prompt.")))
-
-(defun malyon-yank-pop (arg)
-  "Yank pop."
-  (interactive "p")
-  (if (<= malyon-aread-beginning-of-line (point))
-      (yank-pop 1)
-    (message "Editing is restricted to the input prompt.")))
-
-(defun malyon-delete-char (arg)
-  "Delete a character."
-  (interactive "p")
-  (if (<= malyon-aread-beginning-of-line (point))
-      (delete-char 1)
-    (message "Editing is restricted to the input prompt.")))
-
-(defun malyon-backward-delete-char (arg)
-  "Delete a character backwards."
-  (interactive "p")
-  (if (< malyon-aread-beginning-of-line (point))
-      (backward-delete-char-untabify 1)
-    (message "Editing is restricted to the input prompt.")))
-
-(defun malyon-self-insert-command (arg)
-  "Insert a character."
-  (interactive "p")
-  (if (> malyon-aread-beginning-of-line (point))
-      (goto-char (point-max)))
-  (self-insert-command 1))
-
-;; tracing utility
-
-(defun malyon-trace-file ()
-  "Turn tracing on for a particular file."
-  (let ((trace
-	 (get-buffer-create
-	  (concat "Malyon Trace " malyon-story-file-name))))
-    (if trace
-	(save-excursion
-	  (set-buffer trace)
-	  (malyon-erase-buffer)
-	  (insert (concat "Tracing " malyon-story-file-name "..."))
-	  (newline)))))
-  
-(defun malyon-trace-newline ()
-  "Output tracing newline."
-  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
-    (if trace
-	(save-excursion
-	  (set-buffer trace)
-	  (goto-char (point-max))
-	  (newline)))))
-
-(defun malyon-trace-opcode (pc opcode operands)
-  "Output a z code instruction."
-  (malyon-trace-string
-   (format "%8d   %-3d %-25s %s\n"
-	   pc
-	   opcode
-	   (symbol-name (aref malyon-opcodes opcode))
-	   (apply 'concat (malyon-mapcan
-			   (lambda (x)
-			     (list " "
-				   (number-to-string
-				    (if (malyon-characterp x)
-					(malyon-char-to-int x)
-				      x))))
-			   operands)))))
-
-(defun malyon-trace-string (s)
-  "Output tracing string."
-  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
-    (if (and trace s)
-	(save-excursion
-	  (set-buffer trace)
-	  (goto-char (point-max))
-	  (insert s)))))
-
-(defun malyon-trace-object (o)
-  "Output tracing object."
-  (let ((trace (get-buffer (concat "Malyon Trace " malyon-story-file-name))))
-    (if (and trace o)
-	(save-excursion
-	  (set-buffer trace)
-	  (goto-char (point-max))
-	  (prin1 o trace)))))
-
-;;; announce malyon-mode
-
-(provide 'malyon-mode)
-(provide 'malyon)
-
-;;; malyon-mode.el ends here
diff --git a/org-mac-protocol.el b/org-mac-protocol.el
deleted file mode 100755
index 32619d47..00000000
--- a/org-mac-protocol.el
+++ /dev/null
@@ -1,408 +0,0 @@
-;;; org-mac-protocol.el -- process events triggered by the
-;;; org-mac-protocol suite of AppleScripts
-
-;; Copyright (C) 2009, 2010 Christopher Suckling
-
-;; Authors: Christopher Suckling 
-
-;; 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.
-
-;; It 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.
-
-;; Version: 0.634
-;; Keywords: outlines, hyperlinks, wp
-
-;;; Commentary
-;;
-;; This file provides org-protocol handlers and various hacks to
-;; produce a nicely centered, pop-up remember frame for links passed
-;; to emacsclient by the org-mac-protocol suite of AppleScripts. It
-;; also defines new org-mode hyperlink types for opening files in
-;; various OS X applications.
-
-;;; Installation and Usage
-;;
-;; Please see org-mac-protocol.org
-
-;;; Credit
-;;
-;; Portions of this code are developed from a blog post by Jack Moffitt:
-;; http://metajack.im/2008/12/30/gtd-capture-with-emacs-orgmode/
-
-(require 'cl)
-(require 'org-protocol)
-(require 'org-bibtex)
-
-;;; Define org-mode hyperlink types
-;;
-;; BibDesk
-
-(org-add-link-type "bibdesk" 'org-mac-bibdesk-open)
-
-(defun org-mac-bibdesk-open (uri)
-  "Visit bibtex entry in BibDesk"
-  (let* ((key (when (string-match "::\\(.+\\)\\'" uri)
-		(match-string 1 uri)))
-	 (document (substring uri 0 (match-beginning 0))))    
-    (do-applescript
-     (concat
-      "tell application \"BibDesk.app\"\n"
-         "activate\n"
-         "set theDoc to \"" document "\"\n"
-         "set theKey to \"" key "\"\n"
-         "open theDoc\n"
-         "tell document 1 of application \"BibDesk\"\n"
-            "set somePubs to (publications whose cite key contains theKey)\n"
-            "set the selection to somePubs\n"
-            "set theSelection to the selection\n"
-            "set thePub to get item 1 of theSelection\n"
-            "show thePub\n"
-         "end tell\n"
-      "end tell"))))
-
-;; Skim
-
-(org-add-link-type "skim" 'org-mac-skim-open)
-
-(defun org-mac-skim-open (uri)
-  "Visit page of pdf in Skim"
-  (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
-		 (match-string 1 uri)))
-	 (document (substring uri 0 (match-beginning 0))))
-    (do-applescript
-     (concat
-      "tell application \"Skim\"\n"
-         "activate\n"
-	 "set theDoc to \"" document "\"\n"
-		     "set thePage to " page "\n"
-	 "open theDoc\n"
-	 "go document 1 to page thePage of document 1\n"
-      "end tell"))))
-
-;; Pages
-
-(org-add-link-type "pages" 'org-mac-pages-open)
-
-(defun org-mac-pages-open (uri)
-  "Visit page of document in Pages. Reliant on character offset
-from start of document, so link may degrade if document is
-edited"
-  (let* ((charoff (when (string-match "::\\(.+\\)\\'" uri)
-		 (match-string 1 uri)))
-	 (document (substring uri 0 (match-beginning 0))))
-    (do-applescript
-     (concat
-      "tell application \"Pages\"\n"
-         "activate\n"
-	 "set theDoc to \"" document "\"\n"
-	 "set theCharOff to " charoff "\n"
-	 "open theDoc\n"
-	 "select character theCharOff of document 1\n"
-      "end tell"))))
-
-;; Numbers
-
-(org-add-link-type "numbers" 'org-mac-numbers-open)
-
-(defun org-mac-numbers-open (uri)
-  "Visit range of spreadsheet in Numbers. Although the correct
-cells will be selected, it may be necessary to change sheets
-manually"
-  (let* ((sheet (when (string-match "::\\(.+\\)::\\(.+\\)::\\(.+\\)\\'" uri)
-		  (match-string 1 uri)))
-	 (table (when (string-match "::\\(.+\\)::\\(.+\\)::\\(.+\\)\\'" uri)
-		  (org-protocol-unhex-string (match-string 2 uri))))
-	 (range (when (string-match "::\\(.+\\)::\\(.+\\)::\\(.+\\)\\'" uri)
-		  (match-string 3 uri)))
-	 (document (substring uri 0 (match-beginning 0))))
-    (do-applescript
-     (concat
-      "tell application \"Numbers\"\n"
-         "activate\n"
-	 "set theDoc to \"" document "\"\n"
-	 "set theSheet to \"" sheet "\"\n"
-	 "set theTable to \"" table "\"\n"
-	 "set theRange to \"" range "\"\n"
-	 "open theDoc\n"
-	 "tell document 1\n"
-	    "tell sheet (theSheet as integer)\n"
-	       "tell table theTable\n"
-	          "set selection range to range theRange\n"
-	       "end tell\n"
-	    "end tell\n"
-	 "end tell\n"   
-       "end tell"))))
-
-
-;; Keynote
-
-(org-add-link-type "keynote" 'org-mac-keynote-open)
-
-(defun org-mac-keynote-open (uri)
-  "Visit slide in Keynote"
-  (let* ((slide (when (string-match "::\\(.+\\)\\'" uri)
-		  (match-string 1 uri)))
-	 (document (substring uri 0 (match-beginning 0))))
-    (do-applescript
-     (concat
-      "tell application \"Keynote\"\n"
-          "activate\n"
-          "set theDoc to \"" document "\"\n"
-          "set theSlide to " slide "\n"
-          "open theDoc\n"
-          "show slide theSlide of slideshow 1\n"
-      "end tell"))))
-
-
-;; iTunes
-
-(org-add-link-type "iTunes" 'org-mac-iTunes-open)
-
-(defun org-mac-iTunes-open (uri)
-  "Visit track in iTunes"
-  (let* ((track (when (string-match "[0-9a-zA-Z]+\\'" uri)
-		  (match-string 0 uri))))
-    (do-applescript
-     (concat
-      "tell application \"iTunes\"\n"
-         "activate\n"
-	 "set theTrack to \"" track "\"\n"
-	 "set view of front browser window to user playlist \"Music\" of source \"Library\"\n"
-	 "play (some track of playlist \"Music\" of source \"Library\" whose persistent ID is theTrack)\n"
-	 "playpause\n"
-      "end tell"
-	 ))))
-
-
-;; Address Book
-;; Support based on code by Alexander Poslavsky
-
-(org-add-link-type "address" 'org-mac-addressbook-open)
-
-(defun org-mac-addressbook-open (uri)
-  "Applescript to open correct address-book entry"
-  (do-applescript
-   (concat
-    "set theID to \"" uri "\"\n"
-
-    "tell application \"System Events\"\n"
-        "activate\n"
-        "try\n"
-            "open location \"addressbook\:\/\/\" \& theID\n"
-            "on error\n"
-            "display dialog \"no matching contact found\"\n"
-        "end try\n"
-    "end tell"
-    )))
-
-
-;;; Variables and advice for managing *remember* frames
-
-;; updated for org-capture hooks
-
-(defvar width-of-display (x-display-pixel-width)
-  "For some reason, (x-display-pixel-width) returns corrupted
-values when called during (org-mac-protocol-remember); this
-ensures that correct value is returned")
-(setq width-of-display (x-display-pixel-width))
-
-(defvar height-of-display (x-display-pixel-height)
-  "For some reason, (x-display-pixel-height) returns corrupted
-values when called during (org-mac-protocol-remember); this
-ensures that correct value is returned")
-(setq height-of-display (x-display-pixel-height))
-
-(defvar org-mac-protocol-app nil
-  "The application that AppleScript will activate
-after the *remember* buffer is killed")
-
-(defadvice remember-finalize (after delete-remember-frame activate)  
-  "Advise remember-finalize to close the frame if it is the mac-remember frame"  
-  (when (equal "*mac-remember*" (frame-parameter nil 'name))
-    (mapc
-     (lambda (x)
-       (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
-	 (make-frame-visible x)))
-     (frame-list))
-    (mapc
-     (lambda (x)
-       (when (equal (frame-parameter x 'name) "*mac-remember*")
-	 (delete-frame x)))
-     (frame-list))
-    (do-applescript
-     (concat
-      "tell application \"" org-mac-protocol-app "\"\n"
-      "activate\n"
-      "end tell"))))  
-
-(defadvice remember-destroy (after delete-remember-frame activate)  
-  "Advise remember-destroy to close the frame if it is the
-mac-rememeber frame"
-  (when (equal "*mac-remember*" (frame-parameter nil 'name))
-    (mapc
-     (lambda (x)
-       (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
-	 (make-frame-visible x)))
-     (frame-list))
-    (mapc
-     (lambda (x)
-       (when (equal (frame-parameter x 'name) "*mac-remember*")
-	 (delete-frame x)))
-     (frame-list))
-    (do-applescript
-     (concat
-      "tell application \"" org-mac-protocol-app "\"\n"
-      "activate\n"
-      "end tell"))))  
-
-(defadvice org-remember-apply-template (before delete-non-remember-windows activate)
-  "Advise org-remember to delete non-remember windows if it is in
-the remember frame"
-  (when (equal "*mac-remember*" (frame-parameter nil 'name))
-    (delete-other-windows)))
-
-(add-hook 'org-capture-mode-hook
-	  '(lambda ()
-	     (when (equal "*mac-remember*" (frame-parameter nil 'name))
-	       (delete-other-windows))))  
-
-(add-hook 'org-capture-after-finalize-hook
-	  '(lambda ()	     
-	     (unless (boundp 'org-refile-for-capture)
-	       (when (equal "*mac-remember*" (frame-parameter nil 'name))
-		 (mapc
-		  (lambda (x)
-		    (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
-		      (make-frame-visible x)))
-		  (frame-list))
-		 (mapc
-		  (lambda (x)
-		    (when (equal (frame-parameter x 'name) "*mac-remember*")
-		      (delete-frame x)))
-		  (frame-list))
-		 (do-applescript
-		  (concat
-		   "tell application \"" org-mac-protocol-app "\"\n"
-		   "activate\n"
-		   "end tell"))))))
-
-(add-hook 'org-after-refile-insert-hook
-	  '(lambda ()
-	     (when (boundp 'org-refile-for-capture)
-	       (when (equal "*mac-remember*" (frame-parameter nil 'name))
-		 (mapc
-		  (lambda (x)
-		    (when (not (equal (frame-parameter x 'name) "*mac-remember*"))
-		      (make-frame-visible x)))
-		  (frame-list))
-		 (mapc
-		  (lambda (x)
-		    (when (equal (frame-parameter x 'name) "*mac-remember*")
-		      (delete-frame x)))
-		  (frame-list))
-		 (do-applescript
-		  (concat
-		   "tell application \"" org-mac-protocol-app "\"\n"
-		   "activate\n"
-		   "end tell"))))))
-
-;;; Define org-protocol protocols
-
-(add-to-list 'org-protocol-protocol-alist
-	     '("org-mac-remember"
-	       :protocol "mac-remember"
-	       :function org-mac-protocol-remember
-	       :kill-client t))
-
-(add-to-list 'org-protocol-protocol-alist
-	     '("org-mac-safari-tabs"
-	       :protocol "safari-tabs"
-	       :function org-mac-safari-tabs
-	       :kill-client t))
-
-(defun org-mac-protocol-remember (data)
-  "Process an org-protocol://mac-remember:// scheme URL.
-Pop up a small, centred Emacs frame containing a remember
-buffer. Destroys the frame after the remember buffer is filed and
-return to originating application. This code is
-essentially (org-protocol-remember) with an additional :shortdesc
-link property"
-
-  (let* ((elements (org-protocol-split-data data nil ":"))
-	 (info (car elements))
-	 (app (org-protocol-unhex-string (cadr elements)))
-	 (parts (org-protocol-split-data info t))
-	 (template (or (and (= 1 (length (car parts))) (pop parts))
-		       org-protocol-default-template-key))
-	 (url (org-protocol-sanitize-uri (car parts)))
-	 (type (if (string-match "^\\([a-z]+\\):" url)
-		   (match-string 1 url)))
-	 (title (or (cadr parts) ""))
-	 (shorttitle (or (caddr parts) ""))
-	 (region (or (cadddr parts) ""))
-	 (orglink (org-make-link-string
-		   url (if (string-match "[^[:space:]]" title) title url)))
-	 (org-capture-link-is-already-stored t)
-	 remember-annotation-functions)
-    
-    (setq org-mac-protocol-app app)
-
-    (do-applescript
-     (concat
-      "tell application \"Emacs\"\n"
-      "activate\n"
-      "end tell"))
-
-    (make-frame '((name . "*mac-remember*") (width . 80) (height . 20)))
-    (mapc (lambda (x)
-	    (if (not (equal (frame-parameter x 'name) "*mac-remember*"))
-		(make-frame-invisible x)
-	      (let ((center-left
-		     (/ (- width-of-display (frame-pixel-width)) 2))
-		    (center-top
-		     (/ (- (- height-of-display 22) (frame-pixel-height)) 2)))
-		(set-frame-parameter nil 'top center-top)
-		(set-frame-parameter nil 'left center-left))))
-	  (frame-list))
-    (select-frame-by-name "*mac-remember*")
-
-    (setq org-stored-links
-	  (cons (list url title) org-stored-links))
-    (kill-new orglink)    
-    (org-store-link-props :type type
-			  :link url
-			  :description title
-			  :shortdesc shorttitle
-			  :initial region)
-    (message "protocol: %s" (plist-get org-store-link-plist :shortdesc))
-    
-    (if (boundp 'org-capture-templates)
-	(org-capture nil template)
-      (org-remember nil (string-to-char template))))
-  nil) 
-
-(defun org-mac-safari-tabs (data)
-  "Process an org-protocol://safari-tabs:// scheme URL.
-Inserts a formatted list of hyperlinks to the tabs open in the
-front Safari window"  
-  (let* ((elements (org-protocol-split-data data nil "::"))	 
-	 ;; discard the last element, as it is blank
-	 (links (butlast elements)))
-    (mapc (lambda (x)
-	    (org-protocol-store-link x))
-	  links))
-  nil)
-
-
-(provide 'org-mac-protocol)
diff --git a/synonyms.el b/synonyms.el
deleted file mode 100644
index 8c226479..00000000
--- a/synonyms.el
+++ /dev/null
@@ -1,1426 +0,0 @@
-;;; synonyms.el --- Look up synonyms for a word or phrase in a thesaurus.
-;;
-;; Filename: synonyms.el
-;; Description: Look up synonyms for a word or phrase in a thesaurus.
-;; Author: Drew Adams
-;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
-;; Copyright (C) 2005-2014, Drew Adams, all rights reserved.
-;; Created: Tue Dec 20 14:39:26 2005
-;; Version: 0
-;; Package-Requires: ()
-;; Last-Updated: Thu Dec 26 09:51:41 2013 (-0800)
-;;           By: dradams
-;;     Update #: 2518
-;; URL: http://www.emacswiki.org/synonyms.el
-;; Doc URL: http://www.emacswiki.org/ThesauriAndSynonyms
-;; Keywords: text, dictionary, thesaurus, spelling, apropos, help
-;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x
-;;
-;; Features that might be required by this library:
-;;
-;;   `thingatpt', `thingatpt+'.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;;  Look up synonyms for a word or phrase in a thesaurus.
-;;
-;;
-;;  Getting Started
-;;  ---------------
-;;
-;;  To use library Synonyms, you will need the Moby Thesaurus II file,
-;;  `mthesaur.txt', available here:
-;;
-;;    ftp://ibiblio.org/pub/docs/books/gutenberg/etext02/mthes10.zip
-;;
-;;  Put this in your initialization file (~/.emacs):
-;;
-;;    ;; The file names are absolute, not relative, locations
-;;    ;;     - e.g. /foobar/mthesaur.txt.cache, not mthesaur.txt.cache
-;;    (setq synonyms-file        )
-;;    (setq synonyms-cache-file  )
-;;    (require 'synonyms)
-;;
-;;  As an alternative to the first two lines, you can use Customize to
-;;  set `synonyms-file' and `synonyms-cache-file' persistently.  The
-;;  second of these files is created by this library, to serve as a
-;;  synonym cache for completion.
-;;
-;;  The main command is `synonyms'.  It prompts you for a word or
-;;  phrase to look up in the thesaurus.  The synonyms found are then
-;;  displayed in buffer *Synonyms*.  For example, `M-x synonyms RET
-;;  democracy' displays synonyms for `democracy'.
-;;
-;;  If you do not define `synonyms-file' and `synonyms-cache-file'
-;;  prior to using command `synonyms', that command will prompt you to
-;;  define them.  If you want to use the same values during subsequent
-;;  Emacs sessions, then you should use `M-x customize-option' to save
-;;  those newly defined values.
-;;
-;;
-;;  Some Definitions
-;;  ----------------
-;;
-;;  The thesaurus is divided into "entries", which are like glossary
-;;  entries: each entry is followed by associated words and phrases,
-;;  which, for lack of a better word, I refer to as "synonyms".  For
-;;  example, `democracy' is an entry, and it is followed by its
-;;  synonyms.  Some synonyms are not also entries.  For example,
-;;  `patriarchy' is in the thesaurus as a synonym but not as an entry.
-;;
-;;  Note: What I call "synonyms" here are not necessarily synonyms, in
-;;  the sense of having the same or even similar meanings.  They are
-;;  simply terms collected together with the same thesaurus entry
-;;  because they are related in some way - the grouping is what
-;;  defines their relation.
-;;
-;;  In Moby Thesaurus II, the meanings of synonyms in the same group
-;;  do have something in common, but this might be simply the fact
-;;  that they are terms of a similar kind.  For example, the
-;;  "synonyms" following the `democracy' thesaurus entry are words
-;;  such as `dictatorship' and `autocracy'.  These are different forms
-;;  of the same general thing: government - they are certainly not
-;;  synonymous with each other or with the entry `democracy'.
-;;
-;;
-;;  Searching the Thesaurus
-;;  -----------------------
-;;
-;;  The default input value for command `synonyms' is the word under
-;;  the cursor.  Alternatively, if a region is active and you are in
-;;  Transient Mark mode (recommended), then it is the text in the
-;;  region (selection).
-;;
-;;  Your input is actually treated as a regular expression (regexp),
-;;  so you can also input patterns like `for.*ion', which will match
-;;  thesaurus entries `formation', `formulation', `fornication',
-;;  `fortification', and `forward motion'.  Note that the last of
-;;  these is a phrase rather than a single word.
-;;
-;;  Using a regexp as input is a powerful way to search, but be aware
-;;  that it can be costly in CPU time and computer memory if the
-;;  regexp is not appropriate.  The regexp `.*' will, for example,
-;;  likely use up available memory before being able to return the
-;;  entire thesaurus (it's very large).  You can always use `C-g' to
-;;  interrupt a thesaurus search if you mistakenly use an inefficient
-;;  regexp.
-;;
-;;
-;;  Using a Prefix Argument To Do More
-;;  ----------------------------------
-;;
-;;  You can use a prefix argument to modify searching and the
-;;  presentation of search results, as follows:
-;;
-;;    `C-u'     - Search for additional synonyms, in two senses:
-;;
-;;                1) Return also synonyms that are matched partially
-;;                   by the input.
-;;
-;;                2) Search the entire thesaurus for input matches,
-;;                   even if the input matches a thesaurus entry.
-;;
-;;    `M--'     - Append the search results to any previous search
-;;                results, in buffer *Synonyms*.  (Normally, the new
-;;                results replace any previous results.)
-;;
-;;    `C-u C-u' - `C-u' plus `M--': Search more and append results.
-;;
-;;  If you find yourself often using a particular prefix argument (for
-;;  example, to append results), then you might want to instead change
-;;  the default behavior to reflect this preference.  Options
-;;  `synonyms-match-more-flag' and `synonyms-append-result-flag'
-;;  correspond to using `C-u' and `M--', respectively.  In fact, a
-;;  prefix argument simply toggles the value of the corresponding
-;;  option for the duration of the command.  So, for example, if
-;;  `synonyms-append-result-flag' is t and you use `M--', then results
-;;  will not be appended.
-;;
-;;  When partially matching input (`C-u', sense #1), complete synonyms
-;;  are matched against your input.  This means that you generally
-;;  need not add a preceding or trailing `.*' to try to match a
-;;  complete synonym.  For example, input `format' will match the
-;;  complete synonyms `conformation', `efformation', `format',
-;;  `formation', `formative', `formational', `information',
-;;  `informative', `informational', `malformation', `deformation',
-;;  `reformation', `transformation', `reformatory', and so on - there
-;;  is no need to input `.*format.*' to match the same synonyms.
-;;
-;;  To better understand the meaning of #2 above for `C-u' (to
-;;  continue the search even if your input matches an entry), try, for
-;;  example, `C-u M-x synonyms RET widespread'.  You'll see not only
-;;  the main synonyms listed for `widespread' as an entry, but also
-;;  lots of different meanings of `widespread', judging by the entries
-;;  for which it is listed as a synonym:
-;;
-;;    `accepted', `ample', `broad', `broadcast', `capacious',
-;;    `catholic', `commodious', `commonness', `conventional',
-;;    `currency', `current', `customary', `deep', `deltoid',
-;;    `diffuse', `discrete', `dispersed', `disseminated',
-;;    `dissipated', `distributed', `epidemic', `established',
-;;    `everyday', `expansive', `extended', `extensive', `familiar',
-;;    `fan shaped', `far flung', `far reaching', `flaring', `full',
-;;    `general', `indiscriminate', `infinite', `large scale',
-;;    `liberal', `normal', `normality', `open', `ordinary',
-;;    `outstretched', `pervasive', `popular', `prescribed',
-;;    `prescriptive', `prevailing', `prevalence', `prevalent',
-;;    `public', `rampant', `received', `regnant', `regular',
-;;    `regulation', `reign', `rife', `roomy', `ruling', `run',
-;;    `scattered', `set', spacious`', `sparse', `splay', `sporadic',
-;;    `sprawling', `spread', `standard', `stock', `straggling',
-;;    `stretched out', `sweeping', `time-honored', `traditional',
-;;    `universal', `usual', `vast', `voluminous', `wholesale', `wide
-;;    open', `wide', and `wonted'.
-;;
-;;  These are just the entries! Each of these is of course followed by
-;;  its own synonyms - perhaps 100 or 300, including `widespread'.
-;;
-;;  This list of entries is not the same list as the synonyms for
-;;  entry `widespread'.  There are words and phrases here that are not
-;;  in the latter list, and vice versa.  For example, the former (but
-;;  not the latter) list includes `full'; the latter (but not the
-;;  former) list includes `wide-reaching'.
-;;
-;;  The latter are the words most closely related to `widespread'.
-;;  The list above are the other thesaurus entries (corresponding to
-;;  main categories) to which `widespread' is most closely related.
-;;  Looking at all of the synonym groups in which `widespread' appears
-;;  can tell you additional information about its meanings - and it
-;;  can provide additional synonyms for `widespread'.
-;;
-;;
-;;  Using Completion with Synonyms
-;;  ------------------------------
-;;
-;;  You can complete words and phrases in the minibuffer, as input to
-;;  command `synonyms'.  You can use library Synonyms together with
-;;  library `Icicles to complete a partial word in a text buffer into a
-;;  word or phrase in the thesaurus.  If you use both libraries then
-;;  load Icicles after Synonyms.  For more information on Icicles, see
-;;  `http://www.emacswiki.org/Icicles'.
-;;
-;;  ** Minibuffer Input Completion **
-;;
-;;  You can enter any text to match against thesaurus synonyms.  When
-;;  you are prompted by command `synonyms' to enter this text, you can
-;;  also use input completion to complete to a thesaurus synonym.
-;;  That is, even though you can enter any text (including a regexp),
-;;  completion will only complete to synonyms in the thesaurus.
-;;
-;;  If you load library Icicles, then a more powerful version of
-;;  command `synonyms' is used.  In particular, it lets you:
-;;
-;;   - Use `S-TAB' during completion to see the list of all synonyms
-;;     (thesaurus terms) that match your minibuffer input so far.
-;;
-;;   - Use `next' (or repeated `S-TAB'), and `prior' (usually keys
-;;     `Page Down' and `Page Up') during completion to cycle through
-;;     the completion candidates (synonyms) that match your input.
-;;
-;;   - Use `C-next' and `C-prior' during completion to display the
-;;     synonyms of the current completion candidate.
-;;
-;;  ** Completing Buffer Text Using the Thesaurus **
-;;
-;;  Icicles also provides two commands for using completion to insert
-;;  thesaurus entries in a buffer:
-;;
-;;   - `icicle-complete-thesaurus-entry' completes a word in a text
-;;     buffer to any word or phrase in the thesaurus.  I bind it to
-;;     `C-c /'.
-;;
-;;   - `icicle-insert-thesaurus-entry' inserts thesaurus words and
-;;     phrases in a text buffer.  It is a multi-command, which means
-;;     that, within a single call to it, you can insert any number of
-;;     thesaurus entries, in succession.  If you want to, you can
-;;     write an entire book using a single call to
-;;     `icicle-insert-thesaurus-entry'!
-;;
-;;
-;;  Browsing the Thesaurus
-;;  ----------------------
-;;
-;;  Besides using command `synonyms' to search for synonyms, you can
-;;  use Synonyms to browse the thesaurus.  This is really just the
-;;  same thing, but key and mouse bindings are provided in buffer
-;;  *Synonyms*, so you need not input anything - just point and click
-;;  the hyperlinks.  Buffer *Synonyms* is in Synonyms major mode,
-;;  which provides a few additional features.
-;;
-;;  You can still choose to search for additional synonyms or append
-;;  search results, without bothering with a prefix argument, by using
-;;  modifier keys (Control, Meta) with a mouse click.
-;;
-;;  Another way of browsing is to revisit previous search-result
-;;  pages.  You can do this using commands `synonyms-history-backward'
-;;  and `synonyms-history-forward'.  In buffer *Synonyms*, these are
-;;  bound to the following key sequences, for convenience:
-;;
-;;    `l', `p', `mouse-4' - `synonyms-history-backward'
-;;    `r', `n', `mouse-5' - `synonyms-history-forward'
-;;
-;;  The `l' and `r' bindings correspond to the history bindings in
-;;  Info.  The `p' and `n' bindings stand for "previous" and "next".
-;;  The bindings to additional mouse buttons correspond to typical
-;;  bindings for Back and Forward in Web browsers.
-;;
-;;  In addition to these bindings, the same history commands can be
-;;  accessed by clicking links [Back] and [Forward] with `mouse-2'.
-;;
-;;  If you have previously used the append option (via, for example,
-;;  `M-mouse2'), so that there are multiple search results in buffer
-;;  *Synonyms*, then using a history command simply takes you to the
-;;  preceding (for [Back]) or following (for [Forward]) result in the
-;;  buffer, measured from the current cursor position.  Depending on
-;;  the cursor position, this might be different from the previous or
-;;  next search made previously.
-;;
-;;  This is for convenience, but it is also more efficient in the case
-;;  of a regexp search that takes a long time.  Except for this
-;;  special treatment of appended results, whenever you navigate the
-;;  search-results history you are actually searching again for a
-;;  synonym you sought previously.  The case of appended results is
-;;  analogous to accessing a Web browser cache when navigating the
-;;  history.
-;;
-;;  You can of course use modifier keys (Control, Meta) while you
-;;  click links [Back] and [Forward], to impose their usual behavior:
-;;  search for additional synonyms or append search results, or both.
-;;
-;;  Finally, some people prefer menus, so there is a Synonyms menu-bar
-;;  menu when you are in Synonyms mode, complete with all of the
-;;  functionalities described above.
-;;
-;;  For more information on the browsing possibilities in buffer
-;;  *Synonyms*, use `?' in Synonyms mode.
-;;
-;;
-;;  Dictionary Definitions, Antonyms, etc.
-;;  --------------------------------------
-;;
-;;  Synonyms works with a large but simple database of groups of words
-;;  and phrases that are synonyms of each other.  This database does
-;;  not provide definitions of words or phrases; it simply groups
-;;  them.  Command `synonym-definition' (aka `dictionary-definition')
-;;  lets you look up a word or phrase (or a regexp) using one or more
-;;  dictionaries on the Web.  That is usually the best source for this
-;;  kind of information, but you obviously need an Internet connection
-;;  to use this command.
-;;
-;;  Options (variables) `synonyms-dictionary-url' and
-;;  `synonyms-dictionary-alternate-url' are URLs you can set to point
-;;  to the dictionaries of your choice.  The default value of
-;;  `synonyms-dictionary-alternate-url' looks up the search term in
-;;  multiple dictionaries, and it lets you use wildcards.  Use `C-h v
-;;  synonyms-dictionary-alternate-url' for more information.  The
-;;  default value of `synonyms-dictionary-url' usually provides a
-;;  quicker answer.  Both of these URLs also give you access to
-;;  additional information about the search term (antonyms, etymology,
-;;  even pronunciation).
-;;
-;;  In buffer *Synonyms*, you can simply hit `d' followed by `RET' or
-;;  `mouse-2' to look up a term that is in the buffer.  Just as for
-;;  looking up a synonym by clicking `mouse-2', if you select text
-;;  (region), then that text is looked up.
-;;
-;;
-;;  A Cache File of Synonyms
-;;  ------------------------
-;;
-;;  The very first time you use Synonyms, a large list of synonyms
-;;  will be compiled and written to a cache file.  This is slow - it
-;;  takes 2-3 minutes - but it is only a one-time cost.  From then on,
-;;  whenever you first use Synonyms during an Emacs session, the cache
-;;  file will be read (quickly), to create the list of synonyms that
-;;  are used for minibuffer completion.
-;;
-;;
-;;  Using Other Thesauri, Dictionaries, and so on - CSV data
-;;  --------------------------------------------------------
-;;
-;;  There is nothing in library Synonyms that ties it to the Moby
-;;  Thesaurus II thesaurus.  All of its functionality will work with
-;;  any file of comma-separated values.  Each line of such a file is
-;;  interpreted as a synonym group, as understood here, and the first
-;;  word or phrase on each line is interpreted as a thesaurus entry,
-;;  as understood here.  This means only that search results are
-;;  organized into sections with entry headers.
-;;
-;;  If, for example, you had a CSV file of personal contacts, where
-;;  the first term in each line was a last name or a company name,
-;;  then you could use library Synonyms to query it, producing the
-;;  same kind of output as for the thesaurus.
-;;
-;;  One thing to keep in mind if you try to use library Synonyms with
-;;  a different CSV file is that there are several different CSV-file
-;;  syntaxes.  The one that Synonyms is built to use is a simple one,
-;;  with no quote marks around entries and no embedded quote marks
-;;  within entries.
-;;
-;;  Similarly, there is nothing here that limits the functionality to
-;;  English.  If you had a thesaurus in another language, it should
-;;  work as well.
-;;
-;;  Currently, Synonyms works with a single raw synonyms file
-;;  (thesaurus) and a corresponding single cache file (for
-;;  completion).  However, it would be easy to extend the
-;;  functionality to use multiple thesauri or, in general, multiple
-;;  CSV files.  Suggestions of requirements (e.g. ways to select a
-;;  thesaurus for particular passages of text) are welcome.
- 
-;;
-;;
-;;  Things Defined Here
-;;  -------------------
-;;
-;;  Faces defined here -
-;;
-;;    `synonyms-heading', `synonyms-search-text',
-;;    `synonyms-mouse-face'.
-;;
-;;
-;;  User options (variables) defined here -
-;;
-;;    `synonyms-append-result-flag', `synonyms-cache-file',
-;;    `synonyms-file', `synonyms-fill-column',
-;;    `synonyms-match-more-flag', `synonyms-mode-hook',
-;;    `synonyms-use-cygwin-flag'.
-;;
-;;  Commands defined here -
-;;
-;;    `dictionary-definition', `synonyms', `synonyms-append-result',
-;;    `synonyms-append-result-no-read', `synonyms-definition',
-;;    `synonyms-definition-mouse', `synonyms-definition-no-read',
-;;    `synonyms-ensure-synonyms-read-from-cache',
-;;    `synonyms-history-backward', `synonyms-history-forward',
-;;    `synonyms-make-obarray', `synonyms-match-more',
-;;    `synonyms-match-more-no-read',
-;;    `synonyms-match-more+append-result',
-;;    `synonyms-match-more+append-result-no-read', `synonyms-mode',
-;;    `synonyms-mouse', `synonyms-mouse-append-result',
-;;    `synonyms-mouse-match-more',
-;;    `synonyms-mouse-match-more+append-result', `synonyms-no-read',
-;;    `synonyms-write-synonyms-to-cache'.
-;;
-;;  Non-interactive functions defined here -
-;;
-;;    `synonyms-action', `synonyms-add-history-links',
-;;    `synonyms-default-regexp', `synonyms-define-cache-file',
-;;    `synonyms-define-synonyms-file', `synonyms-format-entries',
-;;    `synonyms-format-entry', `synonyms-format-finish',
-;;    `synonyms-format-synonyms',
-;;    `synonyms-hack-backslashes-if-cygwin', `synonyms-lookup',
-;;    `synonyms-nearest-word', `synonyms-file-readable-p',
-;;    `synonyms-search-entries', `synonyms-search-synonyms',
-;;    `synonyms-show-synonyms', `synonyms-file-writable-p'.
-;;
-;;  Internal variables defined here -
-;;
-;;    `synonyms-history', `synonyms-history-forward',
-;;    `synonyms-list-for-obarray', `synonyms-mode-map',
-;;    `synonyms-obarray', `synonyms-search-text'.
-;;
-;;  Key bindings made here - see `synonyms-mode'.  All key bindings
-;;  are local to Synonyms mode; no global bindings are made here.
- 
-;;
-;;
-;;  Acknowledgements
-;;  ----------------
-;;
-;;  The basic functionality provided here was derived from library
-;;  `mthesaur.el', by Tad Ashlock .  That
-;;  library, in turn, was inspired by library `thesaurus.el', by Ray
-;;  Nickson.  Thanks also to those who sent helpful bug reports.
-;;
-;;
-;;  Note on MS Windows Emacs 20 and Cygwin `grep'
-;;  ---------------------------------------------
-;;
-;;  There is apparently a bug in the Emacs (at least versions 20-22) C
-;;  code that implements function `call-process' on MS Windows.  When
-;;  using native Windows Emacs with Cygwin commands, such as `grep',
-;;  the C code removes a level of backslashes in some cases, so string
-;;  arguments supplied to `call-process' need to have twice as many
-;;  backslashes as they should need in those cases.  It is for this
-;;  reason that option `synonyms-use-cygwin-flag' is supplied here.
-;;  When that option is non-nil, backslashes in regexps are hacked to
-;;  do the right thing.  (In Emacs 20, this means doubling the
-;;  backslashes; in Emacs 21-22, this means doubling them unless there
-;;  are spaces in the search string.)
-;;
-;;
-;;  Maybe To Do?
-;;  ------------
-;;
-;;  1. It would be ideal to have not only synonym information but also
-;;     definitions, antonyms, more general and more specific terms,
-;;     filtering by part of speech (verb vs adjective etc.), and so
-;;     on.  A good example of what I'd really like to have is provided
-;;     by the free Windows program WordWeb (available here:
-;;     http://wordweb.info/).  Combining that functionality with
-;;     Icicles completion features would provide a great tool, IMO.
-;;
-;;     `synonyms-definition*' goes a long way toward providing this,
-;;     and perhaps it is the best way to go, since there is so much
-;;     more definitional info on the Web.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Change Log:
-;;
-;; 2012/08/21 dadams
-;;     Call tap-put-thing-at-point-props after load thingatpt+.el.
-;; 2012/08/18 dadams
-;;     Invoke tap-define-aliases-wo-prefix if thingatpt+.el is loaded.
-;; 2012/03/02 dadams
-;;     Require cl.el at compile time only for Emacs 20.
-;; 2011/07/30 dadams
-;;     Moved Icicles code to icicles-cmd2.el.  Removed soft-require of icicles.el.
-;; 2011/02/11 dadams
-;;     Better defaults for faces, for dark backgrounds.
-;; 2011/01/04 dadams
-;;     Added autoload cookies (for defgroup, defface, defcustom, and commands).
-;; 2010/08/20 dadams
-;;     synonyms - non-Icicles version: Made ARG optional too.
-;;     synonyms(-no-read|-history-(backward|forward)):
-;;       Use ARG, not current-prefix-arg.
-;; 2010/01/12 dadams
-;;     synonyms-history-(backward|forward): save-excursion + set-buffer -> with-current-buffer.
-;; 2007/12/05 dadams
-;;     synonyms-obarray: Removed * doc-string prefix.
-;; 2007/02/10 dadams
-;;     icicle-sort-case-insensitively -> icicle-case-insensitive-string-less-p.
-;; 2006/12/22 dadams
-;;     Renamed group synonyms to Synonyms.  :group 'icicles -> :group 'Icicles.
-;; 2006/03/31 dadams
-;;     synonyms-write-synonyms-to-cache: Use prin1 instead of pp.
-;; 2006/03/17 dadams
-;;     synonyms-file-(read|writ)able-p: Put non-empty string condition first.
-;; 2006/03/14 dadams
-;;     synonyms-file-(read|writ)able-p: Make sure also not a directory.
-;; 2006/03/12 dadams
-;;     synonyms-ensure-synonyms-read-from-cache, synonyms-define-synonyms-file:
-;;       Set synonyms(-cache)-file to expanded version.
-;; 2006/03/01 dadams
-;;     Updated Commentary to mention Icicles completion of synonyms.
-;; 2006/02/02 dadams
-;;     synonyms-define-cache-file: Fixed typo.
-;; 2006/01/28 dadams
-;;     synonyms-define-cache-file: wrap file-name-directory in expand-file-name.
-;; 2006/01/19 dadams
-;;     synonyms-format-finish: Minor tweak to regexp: space and tab, but not newline or formfeed.
-;; 2006/01/18 dadams
-;;     Added dictionary definition lookup:
-;;       Added: synonyms-dictionary(-alternate)-url, synonyms-definition*.
-;;       Bound synonyms-definition-*.
-;; 2006/01/14 dadams
-;;     Bug fixes -
-;;     Make sure file name is expanded (thanks to Nikos Apostolakis):
-;;       synonyms-search-(entries|synonyms): Expand file name.
-;;       synonyms-define-*-file: Set variable after expanding file name.
-;;       synonyms-format-entry, synonyms-history-*, synonyms-add-history-links:
-;;         Raise error if search finds nothing.
-;;     synonyms-hack-backslashes-if-cygwin: Don't double if spaces and not Emacs 20.
-;;       Renamed synonyms-double-backslashes-if-cygwin to synonyms-hack-backslashes-if-cygwin.
-;;     synonyms-mode-map: swapped bindings for C-mouse-2 and C-down-mouse-2, for Emacs 22.
-;; 2006/01/11 dadams
-;;     Fixed typo: require 'synonyms. (Thanks to Nikos Apostolakis.)
-;; 2006/01/07 dadams
-;;     Added :link.
-;; 2006/01/04 dadams
-;;     synonyms-format-finish: Don't skip numbered header, so highlight multiple synonyms in entry.
-;; 2006/01/02 dadams
-;;     Added: synonyms-define-cache-file, synonyms-define-synonyms-file,
-;;            synonyms-file-readable-p, synonyms-file-writable-p.
-;;     synonyms-make-obarray: Use synonyms-define-synonyms-file.
-;;                            Use synonyms-mode, to get modified syntax (bug fix).
-;;     synonyms-write-synonyms-to-cache: Use synonyms-define-cache-file.
-;;     synonyms-ensure-synonyms-read-from-cache: Use synonyms-file-readable-p.
-;;     synonyms(-cache)-file: Use empty string as initial value.
-;;     Thanks to Alex Schroeder [alex@emacswiki.org] for suggestion to prompt for file names.
-;; 2005/12/31 dadams
-;;     Added menu-bar Synonyms menu.
-;;     Renamed synonyms-read-synonyms-from-cache to synonyms-ensure-synonyms-read-from-cache.
-;;       Call it from synonyms, not from synonyms-mode.
-;;     Defined synonyms-mode-map per convention.
-;;     synonyms-match-more, synonyms-append-result, synonyms-match-more+append-result:
-;;       Use synonyms, not synonyms-no-read.
-;;     Added: synonyms-*-no-read.  Bound those, not the new read versions.
-;; 2005/12/29 dadams
-;;     Treat modifiers with clicks on [Back] and [Forward] links.
-;;     synonyms-history-(backward|forward): Add prefix arg.  Bind options.
-;;     synonyms-mode, synonyms-lookup: Disable undo.
-;; 2005/12/28 dadams
-;;     Added: synonyms-history-(backward|forward), synonyms-add-history-links, synonyms-link.
-;;     Added: [Back] and [Forward] links.
-;;     synonyms-show-synonyms: Put cursor on first synonym.
-;;     synonyms-mouse, synonyms-lookup: Removed save-excursion.
-;;     synonyms-mouse: Treat clicks on [Back] and [Forward] links too.
-;;     synonyms-format-finish: Added save-excursion for last part: filling and adding mouse-face.
-;;     synonyms-nearest-word: Remove text properties.
-;;     synonyms: Use synonym-action.
-;;     synonyms-lookup: When no synonyms found, remove search-text from history.
-;;     Require cl.el when compile.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth
-;; ;; Floor, Boston, MA 02110-1301, USA.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Code:
-
-(eval-when-compile (when (< emacs-major-version 21) (require 'cl))) ;; push, pop
-
-(require 'thingatpt nil t)  ;; (no error if not found): word-at-point
-(when (and (require 'thingatpt+ nil t);; (no error if not found): word-nearest-point
-           (fboundp 'tap-put-thing-at-point-props)) ; >= 2012-08-21
-  (tap-define-aliases-wo-prefix)
-  (tap-put-thing-at-point-props))
-
-;; Quiet the byte-compiler.
-(defvar appendp)                        ; Here.
-(defvar morep)                          ; Here.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
- 
-;;; Faces (alphabetical) -----------------------------------
-
-;;;###autoload
-(defgroup Synonyms nil
-  "Commands to look up synonyms in a thesaurus."
-  :prefix "synonyms-"
-  :group 'convenience :group 'help :group 'apropos :group 'matching
-  :link `(url-link :tag "Send Bug Report"
-          ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
-synonyms.el bug: \
-&body=Describe bug here, starting with `emacs -q'.  \
-Don't forget to mention your Emacs and library versions."))
-  :link '(url-link :tag "Other Libraries by Drew"
-          "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
-  :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/synonyms.el")
-  :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/Synonyms")
-  :link '(emacs-commentary-link :tag "Commentary" "synonyms"))
-
-;;;###autoload
-(defface synonyms-heading '((((background dark)) (:foreground "Yellow"))
-                            (t (:foreground "Blue")))
-  "*Face for different synonym types."
-  :group 'Synonyms :group 'faces)
-
-;;;###autoload
-(defface synonyms-search-text '((t (:foreground "Red")))
-  "*Face for the term whose synonyms were sought."
-  :group 'Synonyms :group 'faces)
-
-;;;###autoload
-(defface synonyms-link '((((background dark)) (:foreground "Yellow" :underline t))
-                         (t (:foreground "Blue" :underline t)))
-  "*Face for history links."
-  :group 'Synonyms :group 'faces)
-
-;;;###autoload
-(defface synonyms-mouse-face '((((background dark)) (:background "DarkCyan"))
-                               (t (:background "Cyan")))
-  "*Mouse face for the term whose synonyms were sought."
-  :group 'Synonyms :group 'faces)
-
-
-
- 
-;;; User Options (alphabetical) ----------------------------
-
-;;;###autoload
-(defcustom synonyms-append-result-flag nil
-  "*t means that `synonyms' appends search result to previous results.
-No other value, besides t, has this effect.
-
-This can be overridden by using a negative prefix argument,
-for example, `M--'.  If you use `C-u C-u', then both this and
-`synonyms-match-more-flag' are overridden."
-  :type 'boolean :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-cache-file ""
-  "*Location to write cache file containing synonyms.
-Written to save the list of synonyms used for completion.
-This is an absolute (complete-path) location, including the file name."
-  :type '(file :must-match t) :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-file ""
-  "*Location of thesaurus file `mthesaur.txt'.
-This is an absolute (complete-path) location, including the file name."
-  :type '(file :must-match t) :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-fill-column 80
-  "*Synonyms* buffer text is wrapped (filled) to this many columns."
-  :type 'integer :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-match-more-flag nil
-  "*t means additional thesaurus entries can be matched by `synonyms'.
-No other value, besides t, has this effect.
-
-A value of t means two things:
- 1) Input can match parts of synonyms, in addition to whole synonyms.
- 2) All synonyms are shown, even if input matches a thesaurus entry.
-
-This can be overridden by using a positive prefix argument,
-  for example, `C-u'.  If you use `C-u C-u', then both this and
-`synonyms-append-result-flag' are overridden."
-  :type 'boolean :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-mode-hook nil
-  "*Normal hook run when entering Thesaurus mode."
-  :type 'hook :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-use-cygwin-flag nil
-  "*Non-nil means to double backslashes in arguments to `call-process'.
-There is apparently a bug in the Emacs (at least versions 20-22) C
-code that implements function `call-process' on MS Windows.  When
-using native Windows Emacs with Cygwin commands, such as `grep', the C
-code removes a level of backslashes, so string arguments supplied to
-`call-process' need to have twice as many backslashes as they should
-need.  If you are using Emacs on Windows and Cygwin `grep', then you
-probably will want to use a non-nil value for
-`synonyms-use-cygwin-flag'."
-  :type 'boolean :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-dictionary-url "http://dictionary.reference.com/search?q="
-  "*URL of a Web dictionary lookup.  Text to look up is appended to this.
-See also `synonyms-dictionaries-url'."
-  :type 'string :group 'Synonyms)
-
-;;;###autoload
-(defcustom synonyms-dictionary-alternate-url "http://www.onelook.com/?ls=b&w="
-  "*URL of a Web dictionary lookup.  Text to look up is appended to this.
-The default value, \"http://www.onelook.com/?ls=b&w=\" lets you use `?'
-and `*' as wildcards in the terms you look up.  These are not used as
-regexp wildcards, however.  `?' stands for any single character, and
-`*' stands for any sequence of characters.  In terms of regexp syntax,
-`?' here is equivalent to the regexp `.', and `*' is equivalent to the
-regexp `.*'.  See http://www.onelook.com/?c=faq#patterns for more
-information on the allowed wildcard patterns.
-See also `synonyms-dictionary-url'."
-  :type 'string :group 'Synonyms)
- 
-;;; Internal variables (alphabetical) ----------------------
-
-(defvar synonyms-history nil "Minibuffer history list for thesaurus lookup.")
-
-(defvar synonyms-history-forward nil
-  "Minibuffer history list for thesaurus lookup using `synonyms-history-backward'.")
-
-(defvar synonyms-list-for-obarray nil "List of synonyms to be used for completion")
-
-(defvar synonyms-mode-map nil "Keymap for `synonyms-mode'.")
-
-(unless synonyms-mode-map
-  (let ((map  (make-sparse-keymap "Synonyms")))
-    (define-key map [(?d) (mouse-2)] 'synonyms-definition-mouse)
-    (define-key map "d\r"            'synonyms-definition-no-read)
-    (define-key map "s"              'synonyms)
-    (define-key map [S-return]       'synonyms)
-    (define-key map "\r"             'synonyms-no-read)
-    (define-key map [C-return]       'synonyms-match-more-no-read)
-    (define-key map [M-return]       'synonyms-append-result-no-read)
-    (define-key map [C-M-return]     'synonyms-match-more+append-result-no-read)
-    (define-key map [mouse-2]        'synonyms-mouse)
-    (define-key map [C-mouse-2]      'undefined)
-    (define-key map [C-down-mouse-2] 'synonyms-mouse-match-more) ; Get rid of `facemenu-mouse-menu'
-    (define-key map [M-mouse-2]      'synonyms-mouse-append-result)
-    (define-key map [C-M-mouse-2]    'synonyms-mouse-match-more+append-result)
-    (define-key map "l"              'synonyms-history-backward) ; As in Info
-    (define-key map "p"              'synonyms-history-backward) ; As in previous
-    (define-key map "r"              'synonyms-history-forward) ; As in Info
-    (define-key map "n"              'synonyms-history-forward) ; As in next
-    (define-key map [mouse-4]        'synonyms-history-backward)
-    (define-key map [mouse-5]        'synonyms-history-forward)
-    (define-key map " "              'scroll-up) ; SPC
-    (define-key map "\^?"            'scroll-down) ; DEL
-    (define-key map "?"              'describe-mode)
-    (define-key map "q"              'quit-window)
-    (define-key map [menu-bar]             (make-sparse-keymap))
-    (define-key map [menu-bar synonyms]    (cons "Synonyms" map))
-    (define-key map [synonyms-help]        '("Help" . describe-mode))
-    (define-key map [synonyms-separator-2] '("--"))
-    (define-key map [synonyms-next]        '("Show Next" . synonyms-history-forward))
-    (put 'synonyms-history-forward 'menu-enable 'synonyms-history-forward)
-    (define-key map [synonyms-previous]    '("Show Previous" . synonyms-history-backward))
-    (put 'synonyms-history-backward 'menu-enable '(and synonyms-history (cdr synonyms-history)))
-    (define-key map [synonyms-separator]   '("--"))
-    (define-key map [synonyms-more-append]
-      '("Find (Max), Append Results" . synonyms-match-more+append-result))
-    (define-key map [synonyms-append]
-      '("Find, Append Results" . synonyms-append-result))
-    (define-key map [synonyms-more]        '("Find (Max)" . synonyms-match-more))
-    (define-key map [synonyms-synonyms]    '("Find" . synonyms))
-    (setq synonyms-mode-map  map)))
-
-;; 103307 is the smallest prime > 103304, which is the number of synonyms.
-(defvar synonyms-obarray (make-vector 103307 0)
-  "Obarray of synonyms.  Used for completion.")
-
-(defvar synonyms-search-text nil "Current text being looked up (matched).")
-
-
-
- 
-;;; Functions ----------------------------------------------
-
-;;;###autoload
-(define-derived-mode synonyms-mode text-mode "Synonyms"
-  "Major mode for browsing thesaurus entries (synonyms).
-Like Text mode but with these additional key bindings:
-
- \\\\[synonyms-mouse],     \\[synonyms-no-read],     \\[synonyms] - \
-Look up synonyms for a word or phrase
- \\[synonyms-mouse-match-more],   \\[synonyms-match-more]   - Like \\[synonyms-no-read], but \
-try to match more terms
- \\[synonyms-mouse-append-result],   \\[synonyms-append-result]   - Like \\[synonyms-no-read], but \
-add result to previous result
- \\[synonyms-mouse-match-more+append-result], \\[synonyms-match-more+append-result] - Like \
-\\[synonyms-match-more] and \\[synonyms-append-result] combined
-
- \\[scroll-up] - Scroll down through the buffer of synonyms
- \\[scroll-down] - Scroll up through the buffer of synonyms
- \\[describe-mode]   - Display this help
- \\[quit-window]   - Quit Synonyms mode
-
-Of the various key bindings that look up synonyms, the most flexible
-is \\[synonyms] - it prompts you for the search string to match.  This
-can be a regular expression (regexp).  The other lookup bindings are
-for convenience - just click.
-
-In Synonyms mode, Transient Mark mode is enabled.
-
-Options `synonyms-match-more-flag' and `synonyms-append-result-flag'
-affect synonym matching and the results.  For convenience, \\[synonyms-mouse-match-more],
-\\[synonyms-mouse-append-result], and \\[synonyms-mouse-match-more+append-result] \
-toggle the effect of those options for the
-duration of the command.
-
-Note that even though Synonyms mode is similar to Text mode, buffer
-`*Synonyms*' is read-only, by default - use `C-x C-q' to toggle.
-
-Turning on Synonyms mode runs the normal hooks `text-mode-hook' and
-`synonyms-mode-hook' (in that order)."
-
-  ;; Synonyms to account for:
-  ;; `$', `1', `0': $100-a-plate dinner; `2': catch-22, V-2; `3': 3-D; `9': strontium 90.
-  ;; To match `$', you will of course need to escape it: `\$'.
-  (modify-syntax-entry ?- "w" synonyms-mode-syntax-table) ; Make hyphen (-) a word character.
-  (modify-syntax-entry ?1 "w" synonyms-mode-syntax-table) ; Make numerals 1,2,3,9,0 word characters.
-  (modify-syntax-entry ?2 "w" synonyms-mode-syntax-table)
-  (modify-syntax-entry ?3 "w" synonyms-mode-syntax-table)
-  (modify-syntax-entry ?9 "w" synonyms-mode-syntax-table)
-  (modify-syntax-entry ?0 "w" synonyms-mode-syntax-table)
-  (modify-syntax-entry ?$ "w" synonyms-mode-syntax-table) ; Make dollar ($) a word character.
-  (buffer-disable-undo)
-  (setq fill-column  synonyms-fill-column)
-  (set (make-local-variable 'transient-mark-mode) t))
-
-;;;###autoload
-(defun synonyms-ensure-synonyms-read-from-cache ()
-  "Ensure synonyms are in `synonyms-obarray', from `synonyms-cache-file'.
-If this file does not yet exist, then it and the obarray are created.
-Creating the obarray for the first time takes 2-3 minutes.
-This does nothing if the obarray is already complete."
-  (interactive)
-  (unless (intern-soft "synonym" synonyms-obarray) ; Do nothing if already complete.
-    (setq synonyms-list-for-obarray  () ; Just to make sure.
-          synonyms-cache-file        (expand-file-name synonyms-cache-file))
-    (if (synonyms-file-readable-p synonyms-cache-file)
-        (let ((list-buf  (find-file-noselect synonyms-cache-file 'nowarn 'raw))
-              (obarray   synonyms-obarray))
-          (unwind-protect
-               (setq synonyms-list-for-obarray  (read list-buf))
-            (kill-buffer list-buf)))
-      (synonyms-make-obarray)           ; Create obarray from scratch
-      (synonyms-write-synonyms-to-cache)))) ; and write it out, for next time.
-
-;;;###autoload
-(defun synonyms-make-obarray ()
-  "Fill `synonyms-obarray' with the available synonyms."
-  (interactive)
-  (unless (intern-soft "synonym" synonyms-obarray) ; Do nothing if already complete.
-    (synonyms-define-synonyms-file)
-    (with-temp-message "Building synonyms list for completion.  This will take a few minutes..."
-      (let ((thesaurus-buf  (find-file-noselect synonyms-file 'nowarn 'raw))
-            synonym)
-        (unwind-protect
-             (save-current-buffer
-               (set-buffer thesaurus-buf)
-               (goto-char (point-min))
-               (synonyms-mode)          ; To use the modified syntax table.
-               (while (re-search-forward "\\(\\(\\w\\|[ ]\\)+\\)\\(,\\|$\\)" nil t)
-                 (setq synonym  (buffer-substring (match-beginning 1) (match-end 1)))
-                 (intern synonym synonyms-obarray)))
-          (kill-buffer thesaurus-buf))))))
-
-(defun synonyms-define-synonyms-file ()
-  "Prompt user to define `synonyms-file', unless it is readable."
-  (setq synonyms-file  (expand-file-name synonyms-file))
-  (unless (synonyms-file-readable-p synonyms-file)
-    (while (not (synonyms-file-readable-p synonyms-file))
-      (setq synonyms-file  (read-file-name "Thesaurus file: " nil nil 'confirm "mthesaur.txt")))
-    (custom-set-variables (list 'synonyms-file
-                                (setq synonyms-file  (expand-file-name synonyms-file))
-                                'now))))
-
-;;;###autoload
-(defun synonyms-write-synonyms-to-cache ()
-  "Write synonyms in `synonyms-obarray' to file `synonyms-cache-file'."
-  (interactive)
-  (synonyms-define-cache-file)
-  (with-temp-message "Writing synonyms cache file..."
-    (with-temp-file synonyms-cache-file
-      (mapatoms (lambda (symb) (push symb synonyms-list-for-obarray)) synonyms-obarray)
-      (prin1 synonyms-list-for-obarray (current-buffer)))))
-
-(defun synonyms-define-cache-file ()
-  "Prompt user to define `synonyms-cache-file', unless it is writable."
-  (unless (synonyms-file-writable-p synonyms-cache-file)
-    (while (not (synonyms-file-writable-p synonyms-cache-file))
-      (setq synonyms-cache-file
-            (read-file-name "Cache file: "
-                            (expand-file-name (file-name-directory synonyms-file)) nil nil
-                            (concat (file-name-nondirectory synonyms-file) ".cache"))))
-    (custom-set-variables (list 'synonyms-cache-file
-                                (setq synonyms-cache-file  (expand-file-name synonyms-cache-file))
-                                'now))))
-
-(defun synonyms-file-readable-p (file)
-  "Return non-nil if FILE (a string) names a readable file."
-  (and (not (string= "" file)) (file-readable-p file) (not (file-directory-p file))))
-
-(defun synonyms-file-writable-p (file)
-  "Return non-nil if FILE (a string) names a writable file."
-  (and (not (string= "" file)) (file-writable-p file) (not (file-directory-p file))))
-
-(defun synonyms (&optional arg regexp)
-  "Show synonyms that match a regular expression (e.g. a word or phrase).
-You are prompted for the regexp.  By default, it is the text
-of the region, if it is active and `transient-mark-mode' is enabled,
-or the nearest word to the cursor, if not.
-
-Option `synonyms-match-more-flag' non-nil means additional thesaurus
-  entries can be matched.  This can be more time-consuming.  It means
-  two things:
-
-  1) Input can match parts of synonyms, in addition to whole synonyms.
-  2) All synonyms are shown, even if input matches a thesaurus entry.
-
-Option `synonyms-append-result-flag' non-nil means to append search
-  result to previous results.
-
-A prefix argument toggles the meaning of each of those options for the
-duration of the command:
-
-  If `C-u' or `C-u C-u', then toggle `synonyms-match-more-flag'.
-  If negative or `C-u C-u', then toggle `synonyms-append-result-flag'.
-
-\(`C-u C-u' thus means toggle both options.)
-
-When called from Lisp, optional second argument REGEXP is the regexp
-to match (no prompting)."
-  (interactive "P")
-  (synonyms-ensure-synonyms-read-from-cache) ; Fill `synonyms-obarray', for use in completion.
-  (let* ((num-arg              (prefix-numeric-value arg))
-         (morep                (eq synonyms-match-more-flag (atom arg)))
-         (appendp              (eq synonyms-append-result-flag (and (wholenump num-arg)
-                                                                    (/= 16 num-arg))))
-         (default-search-text  (or regexp (synonyms-default-regexp)))
-         (search-text          (or regexp
-                                   (let ((case-fold-search  t)) ; Case-insensitive completion.
-                                     (completing-read
-                                      "Show synonyms for word or phrase (regexp): "
-                                      synonyms-obarray nil nil nil 'synonyms-history
-                                      default-search-text)))))
-    (synonyms-action search-text)))
-
-(defun synonyms-action (search-text)
-  "Helper function for command `synonyms'.
-APPENDP and MOREP are free here."
-  (setq synonyms-search-text  search-text) ; Save it.
-  (when (string= "" search-text) (error "No text to look up"))
-  (unless (member search-text synonyms-history) (push search-text synonyms-history))
-  ;; Change `.' to `[^,]' in `search-text', so we don't mix terms.
-  (setq search-text  (replace-regexp-in-string "\\." "[^,]" search-text nil t))
-  (synonyms-lookup search-text (and (boundp 'appendp) appendp) (and (boundp 'morep) morep)))
-
-;;;###autoload
-(defun synonyms-no-read (arg)
-  "Same as command `synonyms', but uses the default input text (regexp)."
-  (interactive "P")
-  (let* ((num-arg      (prefix-numeric-value arg))
-         (morep        (eq synonyms-match-more-flag (atom arg)))
-         (appendp      (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg))))
-         (search-text  (synonyms-default-regexp)))
-    (setq synonyms-search-text  search-text) ; Save it.
-    (when (string= "" search-text) (error "No text to look up"))
-    (unless (member search-text synonyms-history) (push search-text synonyms-history))
-    ;; Change `.' to `[^,]' in `search-text', so we don't mix terms.
-    (setq search-text  (replace-regexp-in-string "\\." "[^,]" search-text nil t))
-    (synonyms-lookup search-text appendp morep)))
-
-;;;###autoload
-(defun synonyms-match-more ()
-  "Same as using `synonyms' with `synonyms-match-more-flag' = t."
-  (interactive)
-  (let ((synonyms-match-more-flag  t))
-    (synonyms)))
-
-;;;###autoload
-(defun synonyms-match-more-no-read (arg)
-  "Same as using `synonyms' with `synonyms-match-more-flag' = t."
-  (interactive "P")
-  (let ((synonyms-match-more-flag  t))
-    (synonyms-no-read arg)))
-
-;;;###autoload
-(defun synonyms-append-result ()
-  "Same as using `synonyms' with `synonyms-append-result-flag' = t."
-  (interactive)
-  (let ((synonyms-append-result-flag  t))
-    (synonyms)))
-
-;;;###autoload
-(defun synonyms-append-result-no-read (arg)
-  "Same as using `synonyms' with `synonyms-append-result-flag' = t."
-  (interactive "P")
-  (let ((synonyms-append-result-flag  t))
-    (synonyms-no-read arg)))
-
-;;;###autoload
-(defun synonyms-match-more+append-result ()
-  "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
-  (interactive)
-  (let ((synonyms-match-more-flag     t)
-        (synonyms-append-result-flag  t))
-    (synonyms)))
-
-;;;###autoload
-(defun synonyms-match-more+append-result-no-read (arg)
-  "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
-  (interactive "P")
-  (let ((synonyms-match-more-flag     t)
-        (synonyms-append-result-flag  t))
-    (synonyms-no-read arg)))
-
-;;;###autoload
-(defun synonyms-mouse (event arg)
-  "Show synonyms that match a regular expression (e.g. a word or phrase).
-The regexp to match is the synonym or region clicked with mouse-2.  If
-the region is active, but a synonym elsewhere is clicked, that synonym
-is used, not the selected text.
-
-You can either click a listed synonym, to see its synonyms, or select
-one or more words and click the selection, to see matching synonyms.
-To quickly select a series of words: double-click mouse-1 to select
-the first word, then click mouse-3 to extend the selection to the last
-word.
-
-Selection is useful when you want to see synonyms of a similar term.
-For example, instead of clicking the listed synonym `bleeding heart', you
-might select `heart' and click that.
-
-The prefix argument acts the same as for command `synonyms'.
-
-If you click a history link with mouse-2, previously retrieved search
-results are revisited."
-  (interactive "e\nP")
-  (set-buffer (window-buffer (posn-window (event-end event))))
-  (let ((beg     (region-beginning))
-        (end     (region-end))
-        (active  mark-active))
-    (goto-char (posn-point (event-end event)))
-    (cond ((get-text-property (point) 'back-link) (synonyms-history-backward nil))
-          ((get-text-property (point) 'forward-link) (synonyms-history-forward nil))
-          (t (if (and active (> (point) beg) (< (point) end))
-                 (goto-char end)
-               (deactivate-mark))       ; User did not click inside region, so deactivate it.
-             (synonyms-no-read arg)))))
-
-;;;###autoload
-(defun synonyms-mouse-match-more (event arg)
-  "Same as `synonyms-mouse' with `synonyms-match-more-flag' = t."
-  (interactive "e\nP")
-  (let ((synonyms-match-more-flag  t))
-    (synonyms-mouse event arg)))
-
-;;;###autoload
-(defun synonyms-mouse-append-result (event arg)
-  "Same as `synonyms-mouse' with `synonyms-append-result-flag' = t."
-  (interactive "e\nP")
-  (let ((synonyms-append-result-flag  t))
-    (synonyms-mouse event arg)))
-
-;;;###autoload
-(defun synonyms-mouse-match-more+append-result (event arg)
-  "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
-  (interactive "e\nP")
-  (let ((synonyms-match-more-flag     t)
-        (synonyms-append-result-flag  t))
-    (synonyms-mouse event arg)))
-
-(defun synonyms-default-regexp ()
-  "Return the default regexp for `synonym' and `synonyms-mouse'.
-If the region is active in `transient-mark-mode', use its text.
-Else, if this is *Synonyms* buffer, use the synonym under the cursor.
-Else use the word nearest the cursor.
-
-An active region has no effect except in `transient-mark-mode'."
-  (if (and mark-active transient-mark-mode) ; Use region text, if active.
-      (buffer-substring-no-properties (point) (mark))
-    (if (eq major-mode 'synonyms-mode)  ; Use mouse-face text, if in synonyms-mode.
-        (let (beg end)
-          (when (and (not (eobp)) (get-text-property (point) 'mouse-face))
-            (setq end  (point)
-                  beg  (1+ (point))))
-          (when (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
-            (setq end  (1- (point))
-                  beg  (point)))
-          (if (null beg)
-              (synonyms-nearest-word)   ; Punt - no mouse-face, for some reason.
-            (setq beg  (previous-single-property-change beg 'mouse-face)
-                  end  (or (next-single-property-change end 'mouse-face) (point-max)))
-            (replace-regexp-in-string   ; Replace newlines with spaces, except at the
-             "\\(^ \\| $\\)" ""         ; beginning and end.
-             (replace-regexp-in-string "[\n]" " " (buffer-substring-no-properties beg end) nil t)
-             nil t)))
-      (synonyms-nearest-word))))
-
-(defun synonyms-nearest-word ()
-  "Word nearest the cursor."
-  (let ((word  (if (fboundp 'word-nearest-point)
-                   (word-nearest-point) ; In `thingatpt+.el'.
-                 (word-at-point))))     ; In `thingatpt.el'.
-    (set-text-properties 0 (length word) nil word) ; Remove all text properties.
-    word))
-
-(defun synonyms-lookup (search-text appendp morep)
-  "Search the thesaurus for SEARCH-TEXT.
-APPEND-P non-nil means to append search result to previous results.
-MORE-P non-nil means additional thesaurus entries can be matched."
-  (save-selected-window
-    (with-temp-message
-        (format "Looking up %s synonyms for \"%s\"%s..." (if morep "(max)" "")
-                (replace-regexp-in-string (regexp-quote "[^,]") "." search-text nil t)
-                (if appendp " (appending)" ""))
-      (let ((temp-buf  (generate-new-buffer " *Temp*")))
-        (unwind-protect
-             (progn
-               (set-buffer temp-buf)
-               (buffer-disable-undo)    ; Make sure (should already be, because of *Temp* name).
-               (erase-buffer)
-               (let ((entry-p  (synonyms-search-entries search-text temp-buf morep)))
-                 ;; For `morep' search, we don't stop even if we find an entry.
-                 (unless (if morep
-                             (or (synonyms-search-synonyms search-text temp-buf t) entry-p)
-                           (or entry-p (synonyms-search-synonyms search-text temp-buf nil)))
-                   (pop synonyms-history) ; Remove it from search history, so we don't try again.
-                   (error "No synonyms found for `%s'" search-text))
-                 (let ((results-buf  (get-buffer-create "*Synonyms*")))
-                   (synonyms-format-synonyms search-text morep)
-                   (synonyms-show-synonyms temp-buf results-buf appendp)
-                   (message nil))))
-          (kill-buffer temp-buf))))))
-
-(defun synonyms-search-entries (search-text buf morep)
-  "Search thesaurus entries (headings) for SEARCH-TEXT.
-Put result in buffer BUF.
-MORE-P non-nil means additional thesaurus entries can be matched."
-  (call-process "grep" nil buf nil "-i" (synonyms-hack-backslashes-if-cygwin
-                                         (if morep
-                                             (format "^\\w*%s\\w*," search-text)
-                                           (format "^%s," search-text)))
-                (expand-file-name synonyms-file))
-  (not (zerop (count-lines (point-min) (point-max)))))
-
-(defun synonyms-search-synonyms (search-text buf morep)
-  "Search thesaurus body for SEARCH-TEXT.
-SEARCH-TEXT is a regexp that can match any part of a thesaurus term.
-Put result in buffer BUF.
-MORE-P non-nil means additional thesaurus entries can be matched."
-  (call-process "grep" nil buf nil "-i" (synonyms-hack-backslashes-if-cygwin
-                                         (if morep
-                                             (format ",\\w*%s\\w*\\(,\\|$\\)" search-text)
-                                           (format ",%s\\(,\\|$\\)" search-text)))
-                (expand-file-name synonyms-file))
-  (not (zerop (count-lines (point-min) (point-max)))))
-
-(defun synonyms-hack-backslashes-if-cygwin (string)
-  "Double each backslash in STRING, unless it contains SPC characters.
-More precisely, if `synonyms-use-cygwin-flag' is non-nil and this is
-Emacs 20 or there are no spaces in STRING, then double any backslashes
-in STRING.
-
-This is an ugly hack made necessary because of bugs in Emacs C code."
-  (when (and synonyms-use-cygwin-flag
-             (or (= emacs-major-version 20) (not (string-match " " string))))
-    (setq string  (replace-regexp-in-string "[\\]" "\\\\" string nil t)))
-  string)
-
-(defun synonyms-format-synonyms (search-text morep)
-  "Format synonyms that match SEARCH-TEXT.
-MORE-P non-nil means additional thesaurus entries can be matched."
-  (goto-char (point-min))
-  (let ((entries-count  (count-lines (point-min) (point-max))))
-    (if (= entries-count 1)
-        (synonyms-format-entry search-text t morep)
-      (synonyms-format-entries search-text entries-count morep))
-    (synonyms-format-finish search-text morep)))
-
-(defun synonyms-format-entry (search-text single-p morep)
-  "Format a single thesaurus entry that matches SEARCH-TEXT.
-SINGLE-P non-nil means there is only one entry."
-  (beginning-of-line)
-  (let ((beg      (point))
-        (orig     (if morep             ; Use saved search text.
-                      (format "\\w*\\(%s\\)\\w*" synonyms-search-text)
-                    (format "\\(%s\\)" synonyms-search-text)))
-        (entry-p  nil)
-        term end)
-    (when single-p (insert "Synonyms for "))
-    (setq term  (point))
-    (when (looking-at orig) (setq entry-p t))
-    (unless (search-forward "," nil t) (error "Bad thesaurus file - no commas"))
-    (setq end  (match-beginning 0))
-    (replace-match ":\n\n" nil t)
-    (cond (single-p
-           (add-text-properties beg term '(face synonyms-heading))
-           (add-text-properties term end (if entry-p
-                                             '(face synonyms-search-text
-                                               mouse-face synonyms-mouse-face)
-                                           '(face synonyms-heading)))
-           (add-text-properties end (+ 2 end) '(face synonyms-heading)))
-          (t
-           (add-text-properties beg (1+ end) '(face synonyms-heading))
-           (save-excursion
-             (forward-line -2)
-             (save-restriction
-               (narrow-to-region (point) (save-excursion (end-of-line) (backward-char) (point)))
-               (unless (search-forward ". " nil t)
-                 (error "Badly formatted numeric entry - no period"))
-               (add-text-properties (point) (point-max) '(mouse-face synonyms-mouse-face))
-               (when (looking-at orig)
-                 (add-text-properties (match-beginning 1) (match-end 1)
-                                      '(face synonyms-search-text)))))))
-    (forward-line)))
-
-(defun synonyms-format-entries (search-text entries-count morep)
-  "Format thesaurus entries that have synonyms matching SEARCH TEXT.
-ENTRIES-COUNT is the number of entries.
-MORE-P non-nil means additional thesaurus entries can be matched."
-  (let ((countdown  entries-count)
-        (beg        (point))
-        (part1      "Synonyms for ")
-        (part2      ":\n"))
-    (insert part1 synonyms-search-text part2)
-    (add-text-properties beg (setq beg  (+ beg (length part1))) '(face synonyms-heading))
-    (add-text-properties beg (setq beg  (+ beg (length synonyms-search-text)))
-                         '(face synonyms-search-text mouse-face synonyms-mouse-face))
-    (add-text-properties beg (+ beg (length part2)) '(face synonyms-heading))
-    (while (> countdown 0)
-      (setq countdown  (1- countdown))
-      (insert (format "\n\%s. " (- entries-count countdown)))
-      (synonyms-format-entry search-text nil morep))))
-
-(defun synonyms-format-finish (search-text morep)
-  "Finish formatting synonyms matching SEARCH-TEXT.
-MORE-P non-nil means additional thesaurus entries can be matched."
-  ;; Put a space after each comma.
-  (goto-char (point-min))
-  (forward-line)                        ; First line might have [^,] in it.
-  (while (search-forward "," nil t) (replace-match ", " nil t))
-  (goto-char (point-min))
-  (let ((case-fold-search       t)
-        (new-search-text        (if morep
-                                    (format "\\(^\\|, \\)\\w*\\(%s\\)\\w*\\($\\|,\\)" search-text)
-                                  (format "\\(^\\|, \\)\\(%s\\)\\($\\|,\\)" search-text)))
-        (no-numbered-headers-p  (not (re-search-forward "^[0-9]+[.]" nil t))))
-    (goto-char (point-min))
-    (forward-line)
-    (while (re-search-forward new-search-text nil t)
-      (add-text-properties (match-beginning 2) (match-end 2) '(face synonyms-search-text))
-      (goto-char (match-end 2)))
-    ;; Do `synonyms-mode' here too, so hyphen will be a word char.
-    ;; IS THERE A WAY TO DO A LET to change the syntax of hyphen, instead of entering mode?
-    (synonyms-mode)
-    (save-excursion
-      (goto-char (point-min))
-      (forward-line)
-      (while (re-search-forward "\\(^\\|, \\)\\(\\(\\w\\|[\\t ]\\)+\\)\\($\\|,\\)" nil t)
-        (add-text-properties (match-beginning 2) (match-end 2) '(mouse-face synonyms-mouse-face))
-        (goto-char (match-end 2)))
-      (fill-region (point-min) (point-max)))
-    (synonyms-add-history-links)))
-
-(defun synonyms-add-history-links ()
-  "Add Back and Forward chronological navigation links"
-  (save-excursion
-    (unless (re-search-backward "Synonyms for") (error "No \"Synonyms for\" text"))
-    (end-of-line)
-    (insert (make-string (- fill-column 16 (point)) ?\ ) "[")
-    (let ((beg      (point))
-          (Back     "Back")
-          (spacer   "]  [")
-          (Forward  "Forward"))
-      (insert Back)
-      (add-text-properties beg (point)
-                           '(face synonyms-link mouse-face synonyms-mouse-face back-link t
-                             help-echo "mouse-2, RET: Go backward in synonyms search history"))
-      (insert spacer Forward)
-      (add-text-properties (+ beg (length Back) (length spacer)) (point)
-                           '(face synonyms-link mouse-face synonyms-mouse-face forward-link t
-                             help-echo "mouse-2, RET: Go forward in synonyms search history"))
-      (insert "]"))))
-
-(defun synonyms-show-synonyms (temp-buf results-buf appendp)
-  "Display search results from buffer TEMP-BUF in buffer RESULTS-BUF.
-If APPEND-P is non-nil and RESULTS-BUF is not empty, then insert a
-separator line between previous search results and the current results."
-  (set-buffer results-buf)
-  (setq buffer-read-only  nil)
-  (unless (= (point-min) (point-max))
-    (if (not appendp)
-        (erase-buffer)
-      (goto-char (point-max))
-      (let ((beg  (point)))
-        (insert "\n" (make-string (1- (window-width)) ?_) "\n\n\n")
-        (add-text-properties beg (point) '(face synonyms-heading)))))
-  (let ((start-result  (point)))
-    (insert-buffer temp-buf)
-    (select-window (display-buffer results-buf))
-    (goto-char start-result)
-    (forward-line 2)                    ; Put cursor on first synonym.
-    (when (looking-at "^[0-9]. ") (goto-char (match-end 0)))
-    (recenter 2)
-    (synonyms-mode)
-    (setq buffer-read-only  t)))
-
-;;;###autoload
-(defun synonyms-history-backward (arg)
-  "Run `synonyms' on a previous argument, moving backward in the history.
-A prefix argument has the same meaning as for command `synonyms'."
-  (interactive "P")
-  (unless (cdr synonyms-history) (error "Cannot move backward in history"))
-  (push (pop synonyms-history) synonyms-history-forward) ; Put current on forward list.
-  (let* ((num-arg  (prefix-numeric-value arg))
-         (morep    (eq synonyms-match-more-flag (atom arg)))
-         (appendp  (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg)))))
-
-    ;; Visit last.  If *Synonyms* has appended search results, go to the previous one, from (point).
-    (if (not (get-buffer "*Synonyms*"))
-        (synonyms-action (car synonyms-history))
-      (let ((divider  (with-current-buffer "*Synonyms*" (re-search-backward "^___" nil t))))
-        (if (not divider)
-            (synonyms-action (car synonyms-history))
-          (set-buffer "*Synonyms*")
-          (goto-char divider)
-          (unless (re-search-backward "^Synonyms for \\([^:]+\\):" nil t)
-            (error "Cannot find previous synonyms page"))
-          (goto-char (match-beginning 1))
-          (recenter 0)
-          (message "%s" (buffer-substring (match-beginning 1) (match-end 1))))))))
-
-;;;###autoload
-(defun synonyms-history-forward (arg)
-  "Run `synonyms' on a previous argument, moving forward in the history.
-A prefix argument has the same meaning as for command `synonyms'."
-  (interactive "P")
-  (unless synonyms-history-forward (error "Cannot move forward in history"))
-  (push (pop synonyms-history-forward) synonyms-history) ; Put current on backward list.
-  (let* ((num-arg  (prefix-numeric-value arg))
-         (morep    (eq synonyms-match-more-flag (atom arg)))
-         (appendp  (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg)))))
-
-    ;; Visit current.  If *Synonyms* has appended search results, go to the next one, from (point).
-    (if (not (get-buffer "*Synonyms*"))
-        (synonyms-action (car synonyms-history))
-      (let ((divider  (with-current-buffer "*Synonyms*" (re-search-forward "^___" nil t))))
-        (if (not divider)
-            (synonyms-action (car synonyms-history))
-          (set-buffer "*Synonyms*")
-          (goto-char divider)
-          (unless (re-search-forward "^Synonyms for \\([^:]+\\):" nil t)
-            (error "Cannot find next synonyms page"))
-          (goto-char (match-beginning 1))
-          (recenter 0)
-          (message "%s" (buffer-substring (match-beginning 1) (match-end 1))))))))
-
-;;;###autoload
-(defalias 'dictionary-definition 'synonyms-definition)
-;;;###autoload
-(defun synonyms-definition (search-text alternate-p)
-  "Look up the definition of a word or phrase using online dictionaries.
-The dictionary used is `synonyms-dictionary-url'.
-With prefix arg, look up the definition in the alternate dictionary,
-`synonyms-dictionary-alternate-url'."
-  (interactive (list (completing-read "Look up definition of word or phrase (regexp): "
-                                      synonyms-obarray nil nil nil 'synonyms-history
-                                      (synonyms-default-regexp))
-                     current-prefix-arg))
-  (synonyms-ensure-synonyms-read-from-cache) ; Fill `synonyms-obarray', for use in completion.
-  (browse-url (concat  (if alternate-p synonyms-dictionary-alternate-url synonyms-dictionary-url)
-                       search-text)))
-
-;;;###autoload
-(defun synonyms-definition-no-read (alternate-p)
-  "Look up the definition of a word or phrase using online dictionaries.
-The dictionary used is `synonyms-dictionary-url'.
-With prefix arg, look up the definition in the alternate dictionary,
-`synonyms-dictionary-alternate-url'."
-  (interactive "P")
-  (synonyms-definition (synonyms-default-regexp) alternate-p))
-
-;;;###autoload
-(defun synonyms-definition-mouse (event alternate-p)
-  "Look up the definition of a word or phrase using online dictionaries.
-The dictionary used is `synonyms-dictionary-url'.
-With prefix arg, look up the definition in the alternate dictionary,
-`synonyms-dictionary-alternate-url'."
-  (interactive "e\nP")
-  (set-buffer (window-buffer (posn-window (event-end event))))
-  (let ((beg     (region-beginning))
-        (end     (region-end))
-        (active  mark-active))
-    (goto-char (posn-point (event-end event)))
-    (cond ((get-text-property (point) 'back-link) (synonyms-history-backward nil))
-          ((get-text-property (point) 'forward-link) (synonyms-history-forward nil))
-          (t (if (and active (> (point) beg) (< (point) end))
-                 (goto-char end)
-               (deactivate-mark))       ; User did not click inside region, so deactivate it.
-             (synonyms-definition (synonyms-default-regexp) alternate-p)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(provide 'synonyms)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; synonyms.el ends here
diff --git a/template.el b/template.el
deleted file mode 100644
index ea36c4b5..00000000
--- a/template.el
+++ /dev/null
@@ -1,2609 +0,0 @@
-;;; template.el --- use templates, decorate comments, auto-update buffers
-
-;; Copyright (C) 1995-2003 Free Software Foundation, Inc.
-;;
-;; Author: Christoph Wedler 
-;; Version: (see `template-version' below)
-;; Keywords: template, comment decoration, auto-updating, data, tools
-;; X-URL: http://emacs-template.sourceforge.net/
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; When you create a new file with Emacs, package Template supplies an initial
-;; buffer content via a template: a file with normal text and expansion
-;; forms. There is a menu to easily create such templates. You can also use new
-;; commands to decorate comments and update the buffer contents.
-
-;; The main difference between Template and other similar packages is that you
-;; can define very flexible templates without having to learn Lisp or changing
-;; your Emacs init file. This package does not help Lisp programmers to define
-;; complex macros.
-
-;; For details, check  or, if you
-;; prefer the manual style, the documentation of the following commands and
-;; variables:
-;;
-;;  * for templates: \\[template-new-file], `template-auto-insert',
-;;    `template-derivation-alist', `template-default-expansion-alist' and
-;;    `template-definition-start',
-;;  * for comment decoration: \\[template-single-comment] and
-;;    \\[template-block-comment], `template-comment-specification-alist'
-;;  * for updating: \\[template-update-buffer], `template-auto-update',
-;;    `template-update-buffer-alist' and `template-header-regexp-alist'.
-
-;; Bug fixes, bug reports, improvements, and suggestions for the newest version
-;; are strongly appreciated.
-
-;;; Installation:
-
-;; This file requires Emacs-20.2, XEmacs-20.2 or higher.
-
-;; Put this file into your load-path and the following into your ~/.emacs:
-;;   (require 'template)
-;;   (template-initialize)
-
-;; You might want to add another item to the "File" menu by (in XEmacs):
-;;   (add-menu-button '("File")
-;;		      ["Insert and Expand Template..."
-;;                     template-expand-template
-;;                     :active (not buffer-read-only)]
-;;		      "Insert File...")
-
-;; To customize, use `M-x customize-group RET template RET' or the customize
-;; entry in menu Options.
-
-;;; Code:
-
-(provide 'template)
-(require 'custom)
-
-;; General Emacs/XEmacs-compatibility compile-time macros
-(eval-when-compile
-  (require 'cl)
-  (defmacro cond-emacs-xemacs (&rest args)
-    (cond-emacs-xemacs-macfn
-     args "`cond-emacs-xemacs' must return exactly one element"))
-  (defun cond-emacs-xemacs-macfn (args &optional msg)
-    (if (atom args) args
-      (and (eq (car args) :@) (null msg) ; (:@ ...spliced...)
-	   (setq args (cdr args)
-		 msg "(:@ ....) must return exactly one element"))
-      (let ((ignore (if (string-match "XEmacs" emacs-version) :EMACS :XEMACS))
-	    (mode :BOTH) code)
-	(while (consp args)
-	  (if (memq (car args) '(:EMACS :XEMACS :BOTH)) (setq mode (pop args)))
-	  (if (atom args)
-	      (or args (error "Used selector %s without elements" mode))
-	    (or (eq ignore mode)
-		(push (cond-emacs-xemacs-macfn (car args)) code))
-	    (pop args)))
-	(cond (msg (if (or args (cdr code)) (error msg) (car code)))
-	      ((or (null args) (eq ignore mode)) (nreverse code))
-	      (t (nconc (nreverse code) args))))))
-  ;; Emacs/XEmacs-compatibility `defun': remove interactive "_" for Emacs, use
-  ;; existing functions when they are `fboundp', provide shortcuts if they are
-  ;; known to be defined in a specific Emacs branch (for short .elc)
-  (defmacro defunx (name arglist &rest definition)
-    (let ((xemacsp (string-match "XEmacs" emacs-version)) reuses first)
-      (while (memq (setq first (car definition))
-		   '(:try :emacs-and-try :xemacs-and-try
-			  :emacs-only :xemacs-only))
-	(if (memq first (if xemacsp
-			    '(:xemacs-and-try :xemacs-only)
-			  '(:emacs-and-try :emacs-only)))
-	    (setq reuses (cadr definition)
-		  definition nil)
-	  (unless (memq first '(:emacs-only :xemacs-only))
-	    (push (cadr definition) reuses)))
-	(setq definition (cddr definition)))
-      (if (and reuses (symbolp reuses))
-	  `(defalias ',name ',reuses)
-	(let* ((docstring (if (stringp (car definition)) (pop definition)))
-	       (spec (and (not xemacsp)
-			  (eq (car-safe (car definition)) 'interactive)
-			  (null (cddar definition))
-			  (cadar definition))))
-	  (if (and (stringp spec)
-		   (not (string-equal spec ""))
-		   (eq (aref spec 0) ?_))
-	      (setq definition
-		    (cons (if (string-equal spec "_")
-			      '(interactive)
-			    `(interactive ,(substring spec 1)))
-			  (cdr definition))))
-	  (if (null reuses)
-	      `(defun ,name ,arglist ,docstring
-		 ,@(cond-emacs-xemacs-macfn definition))
-	    ;; no dynamic docstring in this case
-	    `(eval-and-compile		; no warnings in Emacs
-	       (defalias ',name
-		 (cond ,@(mapcar (lambda (func) `((fboundp ',func) ',func))
-				 (nreverse reuses))
-		       (t ,(if definition
-			       `(lambda ,arglist ,docstring
-				  ,@(cond-emacs-xemacs-macfn definition))
-			     'ignore)))))))))))
-
-(eval-when-compile
-  (require 'cl)
-  (defvar init-file-loaded)		; would be useful in Emacs, too...
-  (defvar file-name-buffer-file-type-alist))
-
-
-
-;;;;##########################################################################
-;;;;  User Options, Variables
-;;;;##########################################################################
-
-
-(defconst template-version "3.1c"
-  "Current version of package template.
-Check  for the newest.")
-
-
-;;;===========================================================================
-;;;  Customization and initialization
-;;;===========================================================================
-
-(defgroup template nil
-  "Use templates, decorate comments, auto-update buffers."
-  :group 'data
-  :link '(emacs-commentary-link "template.el")
-  :link '(url-link "http://emacs-template.sourceforge.net/")
-  :prefix "template-")
-
-(defgroup template-comments nil
-  "Comment decorations in package template."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-updating nil
-  "Updating with package template."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-derivation nil
-  "Deriving templates for new files."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-expansion nil
-  "Expanding the expansion forms in templates."
-  :group 'template
-  :prefix "template-")
-
-(defgroup template-miscellaneous nil
-  "Miscellaneous configurations of package template."
-  :group 'template
-  :prefix "template-")
-
-;; I could imagine that a future version of package custom could make this
-;; `PACKAGE-initialize' stuff easier
-(defcustom template-use-package nil
-  "Pseudo variable.  Used to initialize template in custom buffer.
-Put `(template-initialize)' into your ~/.emacs to initialize package
-template in future sessions.  See variable `template-initialize'."
-  :group 'template
-  :type '(boolean :format "%{%t%}: %[(template-initialize)%], %v\n"
-		  :on "in use" :off "not yet initialized"
-		  :help-echo "Initialize package Template."
-		  :action template-initialize))
-
-(defcustom template-initialize t
-  "Whether/what to initialize with `template-initialize'.
-If t, do full initialization.  Otherwise, the value should be a list
-with elements.  To enable, include
-
- * `auto' to enable `template-auto-update' and `template-auto-insert',
- * `ffap' to make sure that `auto' works with `find-file-at-point',
- * `cc-mode' to enable correct C/C++/Java/Antlr comment filling, i.e.,
-   to add `template-c-init-fill-function' to `c-mode-common-hook',
- * `de-html-helper' to disable `html-helper's template and time-stamps,
- * `keys' to setup the default key bindings,
- * `menus' to setup the menus."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "All" t)
-		 (set :value (auto cc-mode keys menus)
-		      (const :tag "Auto Updating/Inserting" auto)
-		      (const :tag "Correct Auto Inserting with Ffap" ffap)
-		      (const :tag "Correct C Comment Filling" cc-mode)
-		      (const :tag "Deactivate html-helper" de-html-helper)
-		      (const :tag "Setup Key Bindings" keys)
-		      (const :tag "Setup Menus" menus))))
-
-
-;;;===========================================================================
-;;;  Menu
-;;;===========================================================================
-
-(defvar template-comment-menu
-  '("Comment"
-    ["Decorate Comment Line" template-single-comment
-     :active (and (not buffer-read-only)
-		  (memq (template-comment-at-point)
-			'(none delimited single cont)))]
-    ["Decorate Comment Block" template-block-comment
-     :active (and (not buffer-read-only)
-		  (memq (template-comment-at-point)
-			'(single block)))]
-    "---"
-    ["Indent for Comment" indent-for-comment
-     :active (and comment-start (not buffer-read-only))]
-    ["Continue Comment" indent-new-comment-line
-     :active (and  comment-start (not buffer-read-only))]
-    ["Comment Region" comment-region
-     :active (and comment-start (not buffer-read-only) (mark))]
-    ["Comment Region 2" (comment-region 2)
-     :active (and comment-start (not buffer-read-only) (mark))]
-    ["Comment Region 3" (comment-region 3)
-     :active (and comment-start (not buffer-read-only) (mark))]
-    "---"
-    ["Update Buffer" template-update-buffer
-     :active (and template-update-buffer-alist (not buffer-read-only))])
-  "Menu for comment functions.")
-
-(defvar template-creation-menu
-  '("Template Creation"
-    :filter template-menu-filter
-    ["Open Template" template-open-template
-     :active (null (template-buffer-template-p))]
-    "--"
-    ["Define User Input" template-define-prompt t]
-    ["Define Text Register" template-define-register t]
-    ["Define Message" template-define-message t]
-    "---"
-    ["Insert Expansion Form" template-insert-form t])
-  "Menu for template creation.")
-
-
-;;;===========================================================================
-;;;  Commenting
-;;;===========================================================================
-
-(defcustom template-max-column -1
-  "*Width of the separator line, to use with an empty `comment-end'.
-If the value is zero or negative, it is added to `fill-column'.  See
-also `template-max-column-with-end'."
-  :group 'template-comments
-  :type 'integer)
-
-(defcustom template-max-column-with-end 0
-  "*Width of the separator line including a non-empty `comment-end'.
-If the value is zero or negative, it is added to `fill-column'.  See
-also `template-max-column'."
-  :group 'template-comments
-  :type 'integer)
-
-(defcustom template-alt-comment-syntax-alist
-  '((t "/* " " */"))
-  "Alternative comment syntax for languages with \"mixed\" comments.
-Used by function `template-comment-syntax'.  Elements look like
-  (MODES-OR-REGEXP COMMENT-START COMMENT-END)
-
-If the current `major-mode' has a empty `comment-end' and a commenting
-command does not work at `point' with the usual `comment-start', we
-search for the first matching alternative comment syntax in this alist.
-
-Each element must \"pass\" MODES-OR-REGEXP.  If this is a list, it must
-include the current major-mode, if this is a regexp, it must match the
-`buffer-file-name' without version, otherwise it must be non-nil.
-
-Then, COMMENT-START and COMMENT-END is used as the alternative comment
-syntax if `comment-start-skip' matches COMMENT-START."
-  :group 'template-comments
-  :type '(repeat (group (choice (repeat :tag "In major modes" :value nil
-					function)
-				(regexp :tag "Buffer matching" :value "")
-				(sexp :tag "Always" :value t))
-			(string :tag "Alt comment start" :value "/* ")
-			(string :tag "Alt comment end" :value " */"))))
-
-(defcustom template-comment-indent t
-  "Non-nil means, indent single-line/block comments.
-Commands \\[template-single-comment] and \\[template-block-comment]
-indent the comment lines if this value is non-nil and the current major
-mode is not a member of `template-indent-mode-disable-list' or if this
-value is nil and the current major mode is a member of
-`template-indent-mode-enable-list'."
-  :group 'template-comments
-  :type 'boolean)
-
-(defcustom template-indent-mode-disable-list '(sh-mode makefile-mode)
-  "Major modes not having indented single-line/block comments.
-Used if `template-comment-indent' is non-nil.  Major modes in which
-pressing TAB twice is different from pressing TAB once are good
-candidates for this list."
-  :group 'template-comments
-  :type '(repeat (function :tag "Major mode")))
-
-(defcustom template-indent-mode-enable-list nil
-  "Major modes having indented single-line/block comments.
-Used if `template-comment-indent' is nil."
-  :group 'template-comments
-  :type '(repeat (function :tag "Major mode")))
-
-(defcustom template-comment-specification-alist
-  '(("-" "" "" 0)
-    ("-" "" "" 0)
-    ("=" "\n\n" "\n" 1)
-    ("#" "\n\n\f\n" "\n\n" 2))
-  "List of specifications for comment functions.
-Each specification at LEVEL, starting at 1, is a list
-  (SEPARATOR BEFORE-BLOCK AFTER-BLOCK DELETE-LINES)
-
-SEPARATOR is the string which is inserted repeatedly by commands
-\\[template-single-comment] and \\[template-block-comment] up to
-`template-max-column'.
-
-After that, \\[template-block-comment] deletes DELETE-LINES after the
-comment block and inserts string AFTER-BLOCK at the end of the block and
-BEFORE-BLOCK at the front of the block.
-
-The specification LEVEL to use is determined by:
- (1) If the prefix argument is non-nil and its numeric value is > 0,
-     this value is the LEVEL.
- (2) If the prefix argument is nil, and there is an old comment style,
-     use old comment style.
- (3) If `template-comment-specification-special' is a function or the
-     current major mode has a property with this name and its value is a
-     function, this function returns the specification.
- (4) If `comment-end' is empty and `comment-start' is a string of length
-     1: LEVEL is number of repetitions of `comment-start' at the
-     beginning of the line.  Otherwise, if the correctly indented line
-     starts at the beginning of the line, LEVEL=3, else LEVEL=2."
-  :group 'template-comments
-  :type '(repeat (group (string :tag "Separator" :value "-")
-			(string :tag "Before block" :value "")
-			(string :tag "After block" :value "")
-			(integer :tag "Delete lines" :value 0))))
-
-(defcustom template-comment-specification-special nil
-  "Function used for special commenting styles or nil.
-See `template-comment-specification-alist' for details."
-  :group 'template-comments
-  :type '(choice (const nil) function))
-
-
-;;;===========================================================================
-;;;  Auto updating
-;;;===========================================================================
-
-(defcustom template-auto-update 'query
-  "*Whether to update parts of the file when saving the buffer.
-When non-nil and `template-auto-update-disable-regexp' does not match
-the file name, automatically updates parts of the buffer, see
-`template-update-buffer-alist'.  With value t or if the entry in the
-alist has no prompt, do not ask for confirmation.
-
-You should have called `template-initialize' to enable this feature."
-  :group 'template-updating
-  :type '(radio (const :tag "No" nil)
-		(const :tag "Without confirmation" t)
-		(sexp :tag "With confirmation" :format "%t" :value query)))
-
-(defcustom template-auto-update-disable-regexp nil
-  "*Regexp matching files not to automatically update.
-Value nil matches no file.  See `template-auto-update'."
-  :group 'template-updating
-  :type '(choice (const :tag "none" nil) regexp))
-
-(defcustom template-update-buffer-alist
-  '((t "Update header in %s? "
-       (template-update-header t)
-       (file-name-sans-versions (file-name-nondirectory buffer-file-name)))
-    ((html-mode) "Update date inside 
 in %s? "
-     (-2000
-      "\\([0-9]+[ \t]+[A-Za-z][A-Za-z][A-Za-z][ \t]+[0-9]+\\)[ \t\n]*
"
-      1)
-     (format-time-string "%d %b %Y")))
-  "Alist used how to update parts of the buffer.
-Used by function `template-update-buffer'.  Elements look like
-  (MODES-OR-REGEXP PROMPT TEST NEW REPLACEMENT-FUN)
-
-Each element must \"pass\" MODES-OR-REGEXP.  If this is a list, it must
-include the current major-mode, if this is a regexp, it must match the
-`buffer-file-name' without version, otherwise it must be non-nil.
-
-Then, TEST is `eval'd and must return the region = (BEG . END) to be
-replaced or nil if nothing should be updated according to the current
-element.  If TEST is a list and the `car' of TEST is not a function,
-`template-update-buffer-region' is used as the default function, i.e.,
-REPLACEMENT-FUN looks like (LIMIT REGEXP GROUP).  Then, check first/last
-LIMIT characters in buffer and return region according to GROUP's regexp
-group in REGEXP.
-
-Then, NEW is `eval'd.  If it is a string, it is considered as
-replacement for the region, otherwise REPLACE-FUN must be non-nil.
-
-Then, ask user for confirmation with PROMPT where %s is substituted by
-the buffer name if PROMPT is a string and `template-auto-update' is not
-t.
-
-Finally, REPLACEMENT-FUN is called the `eval'd NEW and the beginning and
-the end of the region returned by TEST.  If REPLACEMENT-FUN is nil, just
-replace the region by the `eval'd NEW."
-  :group 'template-updating
-  :type '(repeat (group (choice (repeat :tag "In major modes" :value nil
-					function)
-				(regexp :tag "Buffer matching" :value "")
-				(sexp :tag "Always" :value t))
-			(string :tag "Prompt" :value "Update in %s? ")
-			(choice (list :tag "Default test"
-				      (choice (const :tag "No limit" nil)
-					      (integer :tag "Limit" -1000))
-				      regexp
-				      (integer :tag "Regexp group" :value 0))
-				(sexp :tag "Eval sexp"))
-			(sexp :tag "Eval New string")
-			(option (function :tag "Replacement function")))))
-
-(defcustom template-header-lines 3
-  "*Last line number which is checked by \\[template-update-header]."
-  :group 'template-updating
-  :type 'integer)
-
-(put 'template-header-lines 'template-secure-value #'integerp)
-
-(defcustom template-header-regexp-alist
-  '(("@(#)\\([^ \t\n]+\\)" . 1)
-    ("^%s[ \t]*\\([^ \t\n%s][^ \t\n]*\\)[ \t]+--" . 1))
-  "Alist of regexps matching the file name in the header.
-The `car' of each element is the REGEXP with %s, if present, substituted
-by the comment start.  A second %s, if present, is substitud by a single
-letter non-alpha comment start, or the empty string otherwise.
-
-The `cdr' is the regexp group to be replaced.  Used by
-\\[template-update-header].
-
-The comment start is evaluated from `comment-start', the first character
-in the buffer or \"#\".  It is assumed that a non-alpha single character
-comment start may be repeated.  For example, the substituted regexp in
-`emacs-lisp-mode' is \"\;+\", in `c++-mode' \"//\"."
-  :group 'template-updating
-  :type '(repeat (cons :format "%v"
-		       regexp
-		       (integer :tag "Regexp group" :value 0))))
-
-
-;;;===========================================================================
-;;;  Templates: finding templates
-;;;===========================================================================
-
-(defcustom template-auto-insert 'query
-  "*Whether to automatically use template files for new files.
-Used if the user gave a non-existent file as argument to a command in
-`template-find-file-commands'.  When non-nil and a matching template
-file can be found, use a template like in `template-new-file'.  File
-name refinement is never performed, see `template-derivation-alist'.
-
-With value t, do not ask for confirmation.
-
-You should have called `template-initialize' to enable this feature."
-  :group 'template-derivation
-  :type '(radio (const :tag "No" nil)
-		(const :tag "Without confirmation" t)
-		(sexp :tag "With confirmation" :format "%t" :value query)))
-
-(defcustom template-find-file-commands
-  '(find-file find-file-other-frame find-file-other-screen
-	      find-file-other-window find-file-at-point ffap nil)
-  "*Commands which use templates as last resort, see `template-auto-insert'.
-See also `template-file-select-commands'.
-
-Include nil if you want to use templates for non-existing files as
-command line arguments when starting Emacs."
-  :group 'template-derivation
-  :type '(repeat (function :tag "Command")))
-
-(defcustom template-file-select-commands
-  '(exit-minibuffer minibuffer-complete-and-exit
-		    list-mode-item-mouse-selected
-		    list-mode-item-keyboard-selected)
-  "*Commands which select the file name via minibuffer/completions.
-Checked with commands in `template-find-file-commands'."
-  :group 'template-derivation
-  :type '(repeat (function :tag "Command")))
-
-(defface template-message-face
-  '((((class color) (background light)) (:background "pink"))
-    (t (:bold t)))
-  "Face for temporary message at point.  This only works with XEmacs."
-  :group 'template-miscellaneous)
-
-(defcustom template-extension ".tpl"
-  "*Extension used for template files."
-  :group 'template-derivation
-  :type 'string)
-
-(defcustom template-subdirectories '("./" "Templates/")
-  "*List of subdirectories for template files.
-See `template-derivation-alist' for details."
-  :group 'template-derivation
-  :type '(repeat directory))
-
-(defcustom template-stop-derivation
-  (cond ((fboundp 'file-remote-p) 'file-remote-p)
-	((fboundp 'efs-ftp-path) 'efs-ftp-path)
-	((fboundp 'ange-ftp-ftp-path) 'ange-ftp-ftp-path))
-  "If non-nil, function used to determine whether to stop derivation.
-If non-nil, function is called with argument DIR.  If it returns t,
-`template-derivation' stops to search for more project specific
-templates, i\.e\., just searches in `template-default-directories'."
-  :group 'template-derivation
-  :type '(choice (const :tag "Never" nil)
-		 function))
-
-(defcustom template-default-directories
-  (cons (if (and (not (file-directory-p "~/.templates/"))
-		 (file-directory-p "~/lib/templates"))
-	    (expand-file-name "~/lib/templates/")
-	  (expand-file-name "~/.templates/"))
-	(and (fboundp 'locate-data-directory)
-	     (let ((dir (locate-data-directory "template")))
-	       (and dir (list dir)))))
-  "*List of default directories for template files.
-See `template-derivation-alist' for details."
-  :group 'template-derivation
-  :type '(repeat directory))
-
-(defcustom template-derivation-alist
-  '(;;(("00readme" "" ".txt" "\\`00") . ("00readme" "" ".txt"))
-    ((t "" t))
-    ((t nil null) . (nil nil t 1))
-    (("TEMPLATE" "" t)))
-  "Alist for template file name derivation and file name refinement.
-Template derivation searches for the most specific readable template
-file.  By default, files with the same RAW part as the name of the new
-file are considered to be more specific than files with just the same
-EXT part.  Also files in the same directory are considered to be more
-specific than files in their parent directory or any default template
-directory.  This behavior can be changed by this alist.
-
-Each FORM in this alist has the form (TEMPLATE . REFINEMENT).  If
-TEMPLATE matches, we have found a valid template file and the
-corresponding REFINEMENT is used for the file name refinement.
-
-Before the derivation, the given file name is split into the directory
-part DIR, the file name without directory FILE, and the raw part RAW of
-FILE, the numbering NUM and the extension EXT.  The result is stored in
-`template-file'.
-
-TEMPLATE can have the form (FUNCTION ARG...).  If TEMPLATE matches,
-FUNCTION, called with arguments ARGs, should return the split template
-file name, see `template-split-filename'.
-
-TEMPLATE can also have the form (T-RAW T-NUM T-EXT F-REGEXP) where all
-elements are optional, i.e., have value nil as default.  For TEMPLATE to
-match, all conditions T-RAW, T-NUM and T-EXT must be met and F-REGEXP,
-if non-nil, should match FILE, the non-directory part of the given file
-name.  If a condition is a string, the corresponding part of the
-template file must be equal to it.  If t, the part must be equal to
-RAW/NUM/EXT of the given file name.  If nil, any value will do it.  Any
-other value acts like t when the part of the given file name is
-non-empty, as nil otherwise.
-
-REFINEMENT can have the form (FUNCTION ARG...).  FUNCTION, called with
-the list of the split template filename and ARGs as arguments, should
-set `template-file' if the file name should be refined.
-
-REFINEMENT can also have the form (F-RAW F-NUM F-EXT AUTO-NUM) where all
-elements are optional, i.e., have value nil as default.  If F-RAW, F-NUM
-and F-EXT are non-nil, they change RAW/NUM/EXT of `template-file'.  A
-string will be used as the new part.  If t, the corresponding part of
-the template name will be used.
-
-We will use auto numbering in the following two cases: if NUM is
-non-empty and the file exists already, or if NUM is empty and AUTO-NUM
-is non-nil.  Auto numbering looks at the file names in DIR to generate
-the next unique number which is at least as high as NUM in the first
-case and AUTO-NUM in the second.
-
-Let us use parts of the default value as examples:
-
-Use a template with the same RAW part of the given file name and the
-same EXT part if provided, e.g., for \"exercise2\" use template
-\"exercise.tex.tpl\".  Refine file name to use the extension of the
-template file, also use auto numbering, e.g., if files \"exercise2.tex\"
-and \"exercise3.tex\" exist, refine name to \"exercise4.tex\":
-  ((t nil null) \. (nil nil t 1))
-
-For a file with extension EXT, use TEMPLATE.EXT:
-  ((\"TEMPLATE\" \"\" t))
-
-We could define: If the given file name starts with \"00\", use template
-\"00readme.txt.tpl\".  Refine file name to \"00readme.txt\":
-  ((\"00readme\" \"\" \".txt\" \"\\\\`00\") \. (\"00readme\" \"\" \".txt\"))
-
-Since more than one template file could meet this conditions, the
-template derivation searches for first readable file with extension
-`template-extension' which is found by the following algorithm:
-
-  forall FORMs in `template-derivation-alist' do
-    for directory BASE from DIR
-           while not stopped according to `template-stop-derivation' do
-      forall subdirectories DIRs in `template-subdirectories'
-             relative to BASE do
-        forall TEMPLATEs in DIR do
-          if check_form (FORM, FULL, TEMPLATE) return TEMPLATE
-    forall directories DIRs in `template-default-directories' do
-      forall TEMPLATEs in DIR do
-        if check_form (FORM, FULL, TEMPLATE) return TEMPLATE
-  if not used via `template-auto-insert'
-    forall TEMPLATEs in `template-default-directories'
-           where name_nondir (TEMPLATE) = \"DEFAULT.tpl\" do
-      if readable (TEMPLATE) return TEMPLATE
-    return TEMPLATE in first (`template-default-directories')
-           where name_nondir (TEMPLATE) = \"DEFAULT.tpl\""
-  :group 'template-derivation
-  :type '(repeat (cons :format "%v"
-		       (sexp :tag "Derivation" :value ("TEMPLATE" nil t))
-		       (sexp :tag "Refinement" :value nil))))
-
-
-;;;===========================================================================
-;;;  Templates: expanding templates
-;;;===========================================================================
-
-(defcustom template-confirm-insecure t
-  "*Non-nil means, ask whether to use insecure template expansions.
-Only set this to nil if you ALWAYS check template files before using
-it!"
-  :group 'template-expansion
-  :type 'boolean)
-
-(put 'template-confirm-insecure 'risky-local-variable t)
-
-(defcustom template-message-buffer "*Template Message*"
-  "If non-nil, name of buffer where messages are shown.
-The following messages will be displayed in definition sequence before
-the expansion has taken place:
- - :before messages, see `template-definition-start',
- - user defined prompts if `template-message-prompt-format' is non-nil,
- - user defined registers when there has been a :before message before,
-   see `template-message-register-format'.
-
-The following messages will be displayed in definition sequence after
-the expansion has taken place:
- - :after messages, see `template-definition-start',
- - user defined registers, display them at point if the value of this
-   variable is nil, see `template-message-register-format'."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "None" nil)
-		 (string :tag "Buffer Name")))
-
-(defcustom template-message-prompt-intro
-  "Template expansion will ask for input with the following prompts:"
-  "Default intro message used before listing user defined prompts.
-Used with :before messages, see `template-message-prompt-format'."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "None" nil)
-		 (string :tag "Intro text")))
-
-(defcustom template-message-prompt-format "   %s"
-  "If non-nil, format string for user defined prompts.
-If non-nil and `template-message-buffer' is non-nil, user defined
-prompts will be listed before starting the expansions.  Prompts can be
-defined as specified in the docstring of `template-definition-start'.
-For each PROMPT, this format string will be used with substitution
-PROMPT/%s.
-
-If no :before message has been defined before, use, if non-nil,
-`template-message-prompt-intro' as the first :before message."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "No prompt" nil)
-		 (string :tag "Format string")))
-
-(defcustom template-message-register-intro
-  "Template has defined the following registers:"
-  "Default intro message used before listing user defined prompts.
-Used with :after messages, see `template-message-register-format'."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "None" nil)
-		 (string :tag "Intro text")))
-
-(defcustom template-message-register-format "  %c:\t\"%s\"\t%s"
-  "If non-nil, format string for user defined registers.
-If non-nil, user defined text registers will be listed.  Registers can
-be defined as specified in the docstring of `template-definition-start'.
-For each register CHAR with contents CONTENTS and optional comment
-COMMENT, this format string will be used with substitution CHAR/%c,
-CONTENT/%s and \(COMMENT/%s or \"\"/%s).
-
-The list of register definitions will be displayed:
- - at point if `template-message-buffer' is nil,
- - with :before messages if there has been at least one :before message
-   defined before and if `template-message-buffer' is non-nil,
- - with :after messages if `template-message-buffer' is non-nil.
-   If no :after message has been defined before, use, if non-nil,
-   `template-message-register-intro' as the first :after message."
-  :group 'template-miscellaneous
-  :type '(choice (const :tag "No register content" nil)
-		 (string :tag "Format string")))
-
-(defcustom template-message-timeout 600
-  "*Maximum duration the temporary message will be displayed at point.
-Any user event will also make the temporary message disappear.  The
-temporary message uses face in `template-message-face'."
-  :group 'template-miscellaneous
-  :type 'integer)
-
-(put 'template-message-timeout 'template-secure-value #'integerp)
-
-(defcustom template-date-format "%d %b %Y"
-  "*Date/time format used with the expansion form (>>>DATE<<<).
-See `template-default-expansion-alist' and `format-time-string'.  See
-also `template-time-format'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-date-format 'template-secure-value #'stringp)
-
-(defcustom template-time-format "%T"
-  "*Date/time format used with the expansion form (>>>TIME<<<).
-See `template-default-expansion-alist' and `format-time-string'.  See
-also `template-date-format'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-time-format 'template-secure-value #'stringp)
-
-(defcustom template-string-default "%0.0S"
-  "*Format string used for non-string variable extensions.
-If SYMBOL in (\"KEY\" \. SYMBOL) is not a string, use string with
-substitution SYMBOL/%S.  Default value \"%0.0S\" causes to print
-nothing.  See `template-definition-start'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-string-default 'template-secure-value #'stringp)
-
-(defcustom template-expansion-format "(>>>%s<<<)"
-  "Format string for expansion forms.
-Is a expansion form with substitution KEY/%s.  The value should
-correspond with `template-expansion-regexp'.  Used by
-`template-insert-form'."
-  :group 'template-expansion
-  :type 'string)
-
-(put 'template-expansion-format 'template-secure-value #'stringp)
-
-(defcustom template-expansion-regexp "(>>>\\([-A-Za-z0-9_]+\\)<<<)"
-  "Regexp matching strings which are replaced by their expansions.
-The first regexp group contains the KEY used by the per-template
-expansion, see `template-definition-start' and the global expansions in
-`template-expansion-alist' and `template-default-expansion-alist'.  The
-value should correspond with `template-expansion-alist'.
-
-If there is no defined expansion for the key, ask the user for a
-replacement, see `template-read'.  If the key is matched by
-`template-register-regexp', store buffer position in register, see
-`template-register', .
-
-If you want to use a text literally which is matched by this regexp, use
-the zero expansion form (>>>ZERO_FORM<<<)."
-  :group 'template-expansion
-  :type 'regexp)
-
-(put 'template-expansion-regexp 'template-secure-value #'stringp)
-
-(defcustom template-literal-environment '("LITERAL" . "/LITERAL")
-  "Environment for literal text in template.
-Looks like (OPEN . CLOSE).  Text between expansion forms with keys OPEN
-and CLOSE is not expanded.  If you change OPEN, you should change key
-\"LITERAL\" in `template-default-expansion-alist' accordingly."
-  :group 'template-expansion
-  :type '(cons (string :tag "Open tag") (string :tag "Close tag")))
-
-(defcustom template-register-regexp "\\`[0-9]\\'"
-  "*Regexp matching keys for storing point positions in registers.
-These keys use `template-register' as the default expansion instead of
-`template-read'.  See `template-expansion-regexp'.  If a register is used
-twice, it is marked by a \"*\" in the echo area after the expansion."
-  :group 'template-expansion
-  :type 'regexp)
-
-(put 'template-register-regexp 'template-secure-value #'stringp)
-
-(defcustom template-expansion-alist nil
-  "User defined expansions forms.
-Predefined expansion forms for `template-expansion-regexp'.  Each entry
-has the form (KEY . SEXP).  These expansion forms shadow those in
-`template-default-expansion-alist' and are shadowed by those in the
-per-template definition section.  See `template-definition-start'."
-  :group 'template-expansion
-  :type '(repeat (cons :format "%v"
-		       (string :tag "Key" :value "")
-		       (repeat :tag "Evaluate all" sexp))))
-
-(put 'template-expansion-alist 'risky-local-variable t)
-
-(defvar template-default-expansion-alist
-  '(("POINT" (setq template-point (point-marker))) ; point
-    ("MARK" (setq template-mark (point-marker))) ; mark
-    ("DIR" (insert (car template-file))) ; directory
-    ("FILE" (insert (cadr template-file))) ; file name without directory
-    ("FILE_SANS" (insert (nth 2 template-file)
-			 (nth 3 template-file)))
-    ("FILE_RAW" (insert (nth 2 template-file))) ; raw file name without number
-    ("FILE_NUM" (insert (nth 3 template-file))) ; number
-    ("FILE_UPCASE" (insert (upcase (nth 2 template-file))
-			   (nth 3 template-file)))
-    ("FILE_EXT" (or (string= (nth 4 template-file) "")	; extension
-		    (insert (substring (nth 4 template-file) 1))))
-    ("DATE" (template-insert-time template-date-format))
-    ("TIME" (template-insert-time template-time-format))
-    ("VC_DATE" (set-time-zone-rule "UTC")
-     (template-insert-time "%Y/%m/%d %T" "0000/00/00 00:00:00")
-     ;; using saved `current-time-zone' doesn't work, but nil does
-     (set-time-zone-rule nil))
-    ("YEAR" (template-insert-time "%Y" "0000"))
-    ("ISO_DATE" (template-insert-time "%Y-%m-%d" "0000-00-00"))
-    ("COMMENT" (template-read "Initial comment: ")) ; comment
-    ("AUTHOR" (insert (or user-mail-address	; author
-			  (and (fboundp 'user-mail-address)
-			       (user-mail-address))
-			  (concat (user-login-name) "@" (system-name)))))
-    ("USER_NAME" (insert (or (and (boundp 'user-full-name) ; user name
-				  user-full-name)
-			     (user-full-name))))
-    ("LOGIN_NAME" (insert (user-login-name)))	; login name
-    ("HOST_ADDR" (insert (or (and (boundp 'mail-host-address) ; host address
-				  (stringp mail-host-address)
-				  mail-host-address)
-			     (system-name))))
-    ("LITERAL" (if (search-forward (format template-expansion-format
-					   (cdr template-literal-environment))
-				   nil 'limit)
-		   (delete-region (match-beginning 0) (match-end 0))))
-    ("ZERO_FORM"))			; zero form
-  "Predefined default expansions forms.
-Predefined expansion forms for `template-expansion-regexp'.  Each entry
-has the form (KEY . SEXP).  These expansion forms are shadowed by those
-in `template-expansion-alist' and by those in the per-template
-definition section.  See `template-definition-start'.
-
-The default predefined expansion forms are --default is inserting--:
-  (>>>POINT<<<)       set point
-  (>>>MARK<<<)        set mark, jump to it with \\[exchange-point-and-mark]
-  (>>>DIR<<<)         directory: /home/clstaff/wedler/lib/
-  (>>>FILE<<<)        file w/o directory: text1.txt
-  (>>>FILE_SANS<<<)   file name w/o extension: text1
-  (>>>FILE_RAW<<<)    raw file name: text
-  (>>>FILE_NUM<<<)    number in name: 1
-  (>>>FILE_EXT<<<)    extension: txt
-  (>>>FILE_UPCASE<<<) upcase file name w/o extension: TEXT1
-  (>>>DATE<<<)        date using `template-date-format': 11 Jan 1999
-  (>>>TIME<<<)        time using `template-time-format': 11:58:49
-  (>>>YEAR<<<)        the year: 1999
-  (>>>ISO_DATE<<<)    ISO 8601 date: 1999-01-11
-  (>>>VC_DATE<<<)     UTC date/time for vc: 1999/01/11 10:58:49
-  (>>>COMMENT<<<)     ask user for initial comment
-  (>>>AUTHOR<<<)      author, i.e., `user-mail-address'
-  (>>>USER_NAME<<<)   user name: Christoph Wedler
-  (>>>LOGIN_NAME<<<)  login name: wedler
-  (>>>HOST_ADDR<<<)   Host address: fmi.uni-passau.de
-  (>>>LITERAL<<<)     literal text up to (>>>/LITERAL<<<)
-  (>>>ZERO_FORM<<<)   zero form, i.e., insert nothing.  Useful to insert
-      a text part matched by `template-expansion-regexp' literally.
-
-There are aliases with one-letter keys, see `template-key-alias-alist'.
-
-It is useful to follow the following conventions: upper case keys for
-predefined extensions, lower case and digits for per-template and the
-following default expansions:
-  (>>>0<<<) to (>>>9<<<)  set registers 0 to 9, jump to it with
-      \\[jump-to-register] 0 etc., see `template-register-regexp'
-  (>>>x<<<) where x is any unused letter sequence: ask user.")
-
-(put 'template-default-expansion-alist 'risky-local-variable t)
-
-(defvar template-key-alias-alist
-  '(("P" . "POINT")
-    ("M" . "MARK")
-    ("D" . "DIR")
-    ("F" . "FILE")
-    ("R" . "FILE_RAW")
-    ("N" . "FILE_NUM")
-    ("B" . "FILE_UPCASE")
-    ("E" . "FILE_EXT")
-    ("T" . "DATE")
-    ("V" . "VC_DATE")
-    ("Y" . "YEAR")
-    ("I" . "ISO_DATE")
-    ("C" . "COMMENT")
-    ("A" . "AUTHOR")
-    ("U" . "USER_NAME")
-    ("L" . "LOGIN_NAME")
-    ("H" . "HOST_ADDR")
-    ("Z" . "ZERO_FORM"))
-  "Alist to support the old one-letter predefined expansion forms.
-Used for `template-expansion-alist' and
-`template-default-expansion-alist'.")
-
-(defcustom template-definition-start
-  ">>>TEMPLATE-DEFINITION-SECTION<<<"
-  "Header for the per-template definition section.
-The region following the the first match of this regexp defines the
-per-template definition section.  The region will be deleted before the
-actual expansion, see `template-new-file'.  If you use the \"Local
-Variables:\" section, define it before this region.
-
-The definition section defines expansion forms for strings KEYs matched
-by `template-expansion-regexp' which might shadow those in
-`template-expansion-alist' and `template-default-expansion-alist':
-
-  (\"KEY\"): zero form, same as (>>>ZERO_FORM<<<) in default value of
-`template-default-expansion-alist', useful for inserting text matched by
-`template-expansion-regexp' literally.
-
-  (\"KEY\". CHAR): CHAR is the register where the current buffer
-position is stored, see `template-register-regexp'.
-
-  (\"KEY\" \"PROMPT\" \"PREFIX\" \"SUFFIX\" \"DEFAULT\" AGAIN-P) where
-the last four arguments are optional: ask user with PROMPT for a STRING.
-If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT.
-For AGAIN-P, see `template-read'.  To define, use
-\\[template-define-prompt].
-
-  (\"KEY\" \"PROMPT\" (\"ANSWER\" \. \"TEXT\")...): ask user with PROMPT
-for an input with completion over all ANSWERs and insert corresponding
-TEXT.  Expansion forms in TEXT will be expanded.
-
-  (\"KEY\" \"PROMPT\" (t \. \"TEXT-y\")  (nil \. \"TEXT-n\")): ask user
-with PROMPT a \"y or n\" question with `y-or-n-p' and insert TEXT-y or
-TEXT-n, correspondingly.  Expansion forms in TEXT-X will be expanded.
-The y-case and the n-case are optional and can be exchanged.
-
-  (\"KEY\" \. SYMBOL): insert value of SYMBOL; if value is no string at
-the time of the replacement, use `template-string-default' as format
-string for SYMBOL.
-
-  (\"KEY\" COMMAND \. PREFIX): COMMAND is a symbol or a vector and is
-called with `command-execute' after setting `prefix-arg' to PREFIX, not
-evaluated.  If COMMANDs symbol property `template-secure-command' is
-nil, the form is insecure.  If that symbol property is a function, it is
-called with PREFIX to check whether COMMAND could be called directly
-with PREFIX as remaining arguments.
-
-  (\"KEY\" SEXPR...): evaluate SEXPR during the expansion, see
-`template-expansion-alist' for examples.  This form is insecure.
-
-There are other per-template definitions:
-
-  \"MESSAGE\": additional line displayed at point until first user event
-or after `template-message-timeout' seconds.  The lines are displayed
-with face in `template-message-face'.  With active form selector
-:before, define a message which is displayed in
-`template-message-buffer' before the exansion has started.  With active
-form selector :after, define a message which is displayed in
-`template-message-buffer' after the exansion has taken place.  To
-define interactively, use \\[template-define-message].
-
-  (CHAR \. \"CONTENTS\"): Set register CHAR to have contents CONTENTS.
-CONTENTS can then be inserted into a buffer with \\[insert-register] CHAR.
-
-  (CHAR \"CONTENTS\" COMMENT) where COMMENT is optional: Set register
-CHAR to have contents CONTENTS.  CONTENTS can then be inserted into a
-buffer with \\[insert-register] CHAR.  Also display an additional line
-at point to show the contents with COMMENT.  To define, use
-\\[template-define-register].
-
-The following forms depend on the active form selector which is the last
-of the following expansion forms:
- - :before: \"MESSAGE\" will be displayed before the expansion
- - :after: \"MESSAGE\" will be displayed after the expansion
- - :eval-before: execute COMMAND and SEXPR before expansion
- - :eval-after: execute COMMAND and SEXPR after expansion
- - nil, deprecated: with the first form, the active form selector is
-   :eval-before, with the second, it is :eval-after.
-
-  (VARIABLE . VALUE): set SYMBOL's local value to VALUE, not evaluated.
-This form is only secure if VARIABLE has a symbol property
-`template-secure-value' which returns non-nil when applied to VALUE, not
-evaluated.  This form is useful for variables which determine the
-expansion, like `template-time-format' and `template-date-format'.  For
-local variables in your new file, use the normal way via the \"Local
-Variables:\" section.  The active form selector must not be :eval-before
-or :eval-after.
-
-  COMMAND: COMMAND is a symbol or a vector and is called with
-`command-execute' before the expansion with form selector :eval-before,
-and after the expansion with form selector :eval-after.  If COMMANDs
-symbol property `template-secure-command' is nil, the form is insecure.
-You should use the safe command `normal-mode' in the pre-expansion forms
-if the expansion forms depend on the correct major mode.
-
-  SEXPR: evaluate SEXPR before the expansion with form selector
-:eval-before, and after the expansion with form selector :eval-after.
-This form is insecure.
-
-If any insecure forms have been used, the user of the template will be
-asked whether to use the template, see `template-confirm-insecure'."
-  :group 'template-expansion
-  :type 'string)
-
-
-
-;;;;##########################################################################
-;;;;  Commenting
-;;;;##########################################################################
-
-
-(defunx template-point-at-bol (&optional count)
-  :emacs-only line-beginning-position
-  :xemacs-only point-at-bol)
-
-(defunx template-point-at-eol (&optional count)
-  :emacs-only line-end-position
-  :xemacs-only point-at-eol)
-
-(defunx template-char-or-char-int-p (object)
-  :emacs-only integerp
-  :xemacs-only char-or-char-int-p)
-
-(defunx template-char-or-int-to-char (object)
-  :emacs-only identity
-  "Convert character or integer OBJECT into the equivalent character."
-  (if (characterp object) object (int-to-char object)))
-
-
-;;;===========================================================================
-;;;  Main functions
-;;;===========================================================================
-
-;;;###autoload
-(defun template-single-comment (&optional arg)
-  "Decorate the comment in the current line with dashes and alike.
-The line must be a comment-only line or must contain a comment ending by
-eol.  That is, jump to the end of the current line and insert the dashes
-and the final comment end-string up-to the fill position.  Prefix
-argument ARG and `template-comment-specification' determines the comment
-style to use.  The length of the resulting line is determined by
-`template-max-column' and `template-max-column-with-end'."
-  (interactive "*P")
-  (let* ((orig (point-marker))
-	 (syntax0 (and comment-start comment-start-skip
-		       (condition-case nil
-			   (template-comment-syntax orig 'boc)
-			 (error nil))))
-	 (syntax (cond ((cdr syntax0)
-			(template-comment-syntax orig))
-		       (syntax0
-			(condition-case nil
-			    (template-comment-syntax (point-marker))
-			  (error syntax0)))
-		       (t
-			(back-to-indentation)
-			nil)))
-	 (sep (template-comment-separator-regexp syntax))
-	 (end (template-point-at-eol))
-	 old)
-    (save-excursion
-      (cond ((re-search-forward sep end t)
-	     ;; with sep in current line
-	     (setq old (buffer-substring (match-beginning 1) (match-end 1)))
-	     (delete-region (match-beginning 0) (match-end 0)))
-	    ((cdr syntax)		; with start-end comment
-	     (if (looking-at (concat "[ \t]*\\(.+\\)?"
-				     (regexp-quote (cadr syntax))
-				     "[ \t]*\\(.+\\)?$"))
-		 (if (or (match-beginning 1) (match-beginning 2))
-		     (error "This line contains non-separator chars and %S"
-			    (cadr syntax))
-		   ;; Delete comment-end.  Don't delete its first char if it is
-		   ;; the same as the second of comment-start.
-		   (delete-region (if (and (= (length (car syntax)) 2)
-					   (= (length (cadr syntax)) 2)
-					   (eq (aref (car syntax) 1)
-					       (aref (cadr syntax) 0)))
-				      (1+ (match-beginning 0))
-				    (match-beginning 0))
-				  (match-end 0))))
-	     (goto-char (cddr syntax))
-	     (if (re-search-forward sep end t)
-		 ;; sep in line between comment-start and point-at-eol
-		 (setq old (buffer-substring (match-beginning 1)
-					     (match-end 1)))))))
-    (template-insert-separator
-     (car (template-comment-specification arg old syntax))
-     nil syntax)))
-(put 'template-single-comment 'template-secure-command t)
-
-;;;###autoload
-(defun template-block-comment (&optional arg)
-  "Decorate the current block of comment-only lines with dashes and alike.
-That is, surround the the contiguous comment-only lines around point
-with extra lines containing dashes and alike and to put the correct
-number of newlines around the block.
-
-Barf if the comment syntax at point has a non-empty `comment-end' or if
-point is not in a comment-only line.
-
-A block comment consists of all neighboring lines which start with
-spaces and `comment-start'.  If `comment-start' is a string of length 1,
-the number of repetitions of `comment-start' must be the same or larger
-than in the line where the command is invoked from, too.
-
-Prefix argument ARG and `template-comment-specification' determines the
-comment style to use.  The length of the separator line is determined by
-`template-max-column'.
-
-This command can also be used with point in an empty line after a block
-comment.  A second invocation of this command directly after a
-successful invocation deletes the remaining empty lines from the current
-line on."
-  (interactive "*P")
-  (let* ((orig (point-marker))
-	 (syntax (progn
-		   (end-of-line)
-		   (skip-chars-backward " \t\n\f")
-		   (template-comment-syntax orig))))
-    (when (cdr syntax)
-      (goto-char orig)
-      (error "Command only works with comments terminated by end-of-line"))
-    
-    (if (and (eq last-command 'template-block-comment-success)
-	     (looking-at "[ \t]*$"))
-	(template-insert-newline "" nil (1- (template-point-at-bol)))
-      (let* ((prefix (concat "[ \t]*" (regexp-quote (car syntax))))
-	     (sepline (concat prefix "[ \t]*"
-			      (template-comment-separator-regexp syntax)))
-	     old block-beg block-end def)
-	;; go to the first line with same comment prefix ---------------------
-	(beginning-of-line)
-	(while (and (not (bobp)) (looking-at prefix))
-	  (beginning-of-line 0))
-	(or (looking-at prefix) (beginning-of-line 2))
-	(while (looking-at sepline)
-	  (setq old (buffer-substring (1- (match-end 0)) (match-end 0)))
-	  (kill-line 1))
-	(setq block-beg (point-marker))
-	;; go to the last line with same comment prefix ----------------------
-	(while (looking-at prefix)
-	  (template-indent-according-to-mode)
-	  (beginning-of-line 2))
-	(if (eobp) (newline))
-	(setq block-end (copy-marker (point) t))
-	(while (progn (forward-line -1) (looking-at sepline))
-	  (setq old (buffer-substring (1- (match-end 0)) (match-end 0)))
-	  (kill-line 1))
-	;; insert separator lines --------------------------------------------
-	(goto-char block-beg)
-	(set-marker block-beg nil)
-	(back-to-indentation)
-	(setq def (template-comment-specification arg old syntax))
-	(beginning-of-line)
-	(template-insert-newline (cadr def))
-	(template-insert-separator (car def) (car syntax) syntax)
-	(goto-char block-end)
-	(set-marker block-end nil)
-	(template-insert-separator (car def) (car syntax) syntax)
-	(template-insert-newline (caddr def)
-				 (and (cadddr def)
-				      (save-excursion
-					(forward-line (cadddr def))
-					(point))))
-	(setq this-command 'template-block-comment-success)))
-    (template-indent-according-to-mode)
-    (back-to-indentation)))
-(put 'template-block-comment 'template-secure-command t)
-
-
-;;;===========================================================================
-;;;  Check comment start, return specification
-;;;===========================================================================
-
-(defun template-indent-according-to-mode ()
-  "Indent line according to `template-comment-indent'."
-  (if (if template-comment-indent
-	  (not (memq major-mode template-indent-mode-disable-list))
-	(memq major-mode template-indent-mode-enable-list))
-      (indent-according-to-mode)))
-
-(defun template-default-comment ()
-  "Return default comment according to current position."
-  (if comment-start
-      (substring comment-start 0 (string-match "[ \t]\\'" comment-start))
-    (if (eolp) "#"
-      (let ((default (buffer-substring (point) (1+ (point)))))
-	(if (string-match "[A-Za-z]" default) "#" default)))))
-
-(defun template-comment-at-point ()
-  "Return the comment syntax at the current position.
-Return nil, if no commenting command can be used, i.e., if point is not
-in a comment-only line.  Return `none' if the `major-mode' doesn't
-define a comment syntax.  Return `delimited' if point is between
-`comment-start' and a non-empty `comment-end'.  Return `single' if point
-is in a comment line where the comment syntax has a empty `comment-end',
-return `block' if point is in an empty line after such a comment line."
-  (if (and comment-start comment-start-skip)
-      (save-excursion
-	(let ((orig (point)))
-	  (condition-case nil
-	      (progn
-		(end-of-line)
-		(skip-chars-backward " \t\n\f")
-		(if (cdr (template-comment-syntax orig t)) 'delimited
-		  (if (< (template-point-at-eol) orig) 'block 'single)))
-	    (error
-	     (condition-case nil
-		 (progn
-		   (goto-char orig)
-		   (beginning-of-line)
-		   (when (re-search-forward comment-start-skip
-					    (template-point-at-eol) t)
-		     (goto-char (or (match-end 1) (match-beginning 0)))
-		     (unless (or (cdr (template-comment-syntax orig 'boc))
-				 (< (template-point-at-eol) orig))
-		       'cont)))
-	       (error nil))))))
-    'none))
-
-(defun template-comment-syntax (orig &optional no-indent)
-  "Return the comment syntax at ORIG.  Signal error if not in comment.
-Return (COMMENT-START) if the comment syntax has an empty `comment-end'.
-Return (COMMENT-START COMMENT-END . START-POS) if the comment syntax has
-a non-empty `comment-end' where START-POS is the position of the first
-character inside the comment.  Move point to first character after the
-comment start or the first non-whitespace character on this line.
-
-ORIG should be the same as `point' or in a empty line after `point'.
-
-If optional argument NO-INDENT is nil, indents the current line
-according to `template-comment-indent' and `indent-according-to-mode'.
-If NO-INDENT is `boc', move point to the beginning of the comment.
-
-COMMENT-START is stripped off its final spaces, COMMENT-END off its
-initial spaces."
-  (unless (and comment-start comment-start-skip)
-    (error "No comment syntax has been defined for %s" major-mode))
-  (if (eq no-indent 'boc)
-      (progn
-	(beginning-of-line)
-	(if (re-search-forward comment-start-skip (template-point-at-eol) t)
-	    (goto-char (or (match-end 1) (match-beginning 0)))))
-    (or no-indent (template-indent-according-to-mode))
-    (back-to-indentation))
-  (let* ((string (template-default-comment)))
-    (if (string= comment-end "")
-	(if (looking-at (concat (regexp-quote string)
-				(and (= (length string) 1)
-				     (not (eq no-indent 'boc))
-				     "+")))
-	    (progn
-	      (goto-char (match-end 0))
-	      (list (buffer-substring (match-beginning 0) (point))))
-	  (let ((alist template-alt-comment-syntax-alist)
-		elem c-start c-end)
-	    (while alist
-	      (setq elem (pop alist))
-	      (and (template-match-modes-or-regexp (car elem))
-		   (string-match comment-start-skip (cadr elem))
-		   (setq c-start (cadr elem)
-			 c-end   (caddr elem)
-			 alist   nil)))
-	    (template-comment-syntax-0 orig c-start c-end string)))
-      (template-comment-syntax-0 orig comment-start comment-end))))
-
-(defun template-comment-syntax-0 (orig c-start c-end &optional single)
-  ;; checkdoc-params: (orig c-start c-end single)
-  "Internal function for `template-comment-syntax'."
-  (unless (and (stringp c-start) (stringp c-end) (not (string= c-end "")))
-    (goto-char orig)
-    (error "Line does not start with %S"
-	   (or single (template-default-comment))))
-  (setq c-start (substring c-start 0 (string-match "[ \t]\\'" c-start))
-	c-end   (if (string-match "\\`[ \t]+" c-end)
-		    (substring c-end (match-end 0))
-		  c-end))
-  (cond ((looking-at (regexp-quote c-start))
-	 (goto-char (match-end 0))
-	 (cons c-start (cons c-end (point))))
-	((save-excursion
-	   (when (re-search-backward (concat "^[ \t]*" (regexp-quote c-start))
-				     nil t)
-	     (goto-char (match-end 0))
-	     (let ((match (point)))
-	       (unless (when (search-forward c-end orig t)
-			 (skip-chars-forward " \t")
-			 (< (point) orig))
-		 (cons c-start (cons c-end match)))))))
-	(t
-	 (goto-char orig)
-	 (if single
-	     (error "Not inside a comment (%S or %S-%S) starting in new line"
-		    single c-start c-end)
-	   (error "Not inside a comment (%S-%S) starting in new line"
-		  c-start c-end)))))
-
-
-;;;===========================================================================
-;;;  Comment specification
-;;;===========================================================================
-
-;; A simple `mapconcat' is likely to slow down Emacs' regexp search algorithm
-;; considerably (backtracking => near-infloop).
-(defun template-comment-separator-regexp (syntax)
-  "Return regexp matching separator comment lines.
-The regexp also matches if the lines ends with parts of COMMENT-END in
-argument SYNTAX, see `template-comment-syntax'."
-  (let ((estring (cadr syntax))
-	(alist template-comment-specification-alist)
-	(chars nil)
-	str i c)
-    (while alist
-      (setq str (car (pop alist)))
-      (when str
-	(setq i (length str))
-	(while (>= (decf i) 0)
-	  ;; (pushnew (aref str i) chars), but requires cl at runtime:
-	  (or (memq (setq c (aref str i)) chars) (push c chars)))))
-    (concat "\\("
-	    (mapconcat (lambda (c) (regexp-quote (char-to-string c)))
-		       (or chars "#")
-		       "\\|")
-	    (if estring
-		(concat "\\)+[ \t]*"
-			(mapconcat (lambda (c)
-				     (regexp-quote (char-to-string c)))
-				   estring
-				   "?")
-			"?[ \t]*$")
-	      "\\)+[ \t]*$"))))
-
-(defun template-comment-specification (arg old syntax)
-  "Return the comment specification to use.
-See `template-comment-specification-alist' for details.  ARG is the
-prefix argument, OLD the SEPARATOR of the old comment style and SYNTAX
-is the comment syntax returned by `template-comment-syntax'."
-  (and arg (setq arg (prefix-numeric-value arg)))
-  ;; assumes point-at-indentation
-  (or (and arg (> arg 0)
-	   (if (< (length template-comment-specification-alist) arg)
-	       (car (last template-comment-specification-alist))
-	     (nth (1- arg) template-comment-specification-alist)))
-      (and (null arg) old
-	   (assoc old template-comment-specification-alist))
-      (and (functionp template-comment-specification-special)
-	   (funcall template-comment-specification-special))
-      (and (functionp (get major-mode 'template-comment-specification-special))
-	   (funcall (get major-mode 'template-comment-specification-special)))
-      (and syntax
-	   (template-comment-specification
-	    (if (or (cdr syntax) (> (length comment-start) 1))
-		(save-excursion
-		  (if (cddr syntax) (goto-char (cddr syntax)))
-		  (beginning-of-line)
-		  (if (looking-at "[ \t]") 2 3))
-	      (length (car syntax)))
-	    nil nil))
-      '("-" "" "" 0)))
-
-
-;;;===========================================================================
-;;;  Inserting
-;;;===========================================================================
-
-(defun template-insert-newline (string &optional limit start-limit)
-  "Deletes blank lines around point and insert STRING.
-After optional LIMIT and before optional START-LIMIT, no character will
-be deleted."
-  (let ((start (save-excursion
-		 (skip-chars-backward " \t\n\f" start-limit)
-		 (or (bobp) (forward-line 1))
-		 (point)))
-	(end (save-excursion
-	       (skip-chars-forward " \t\n\f" limit)
-	       (beginning-of-line)
-	       (point))))
-    (if (> end start) (delete-region start end)))
-  (or (bobp) (insert string)))
-
-(defun template-insert-separator (separator &optional cstring syntax)
-  "Insert separator line at point.
-If CSTRING is not nil, insert in special line which starts with CSTRING.
-Insert SEPARATOR repeatedly.  End the line with COMMENT-END as specified
-in `template-comment-syntax'."
-  (when separator
-    (when cstring
-      (open-line 1)
-      (insert cstring)
-      (template-indent-according-to-mode))
-    (end-of-line)
-    (let* ((estring (cadr syntax))
-	   (max-column (if estring
-			   template-max-column-with-end
-			 template-max-column))
-	   (max (- (if (> max-column 0) max-column (+ fill-column max-column))
-		   (length separator)
-		   (length estring))))
-      (while (<= (current-column) max) (insert separator))
-      (if (>= (length separator) (- (current-column) max))
-	  (insert (substring separator 0 (- max (current-column)))))
-      (if estring (insert estring))
-      (if cstring (forward-line 1)))))
-
-
-;;;===========================================================================
-;;;  Adaptations: cc-mode
-;;;===========================================================================
-
-;; There isn't really anything I can do against the filling of "/**" in C, C++
-;; and Antlr mode (it is correct in Java), it should be done in the cc-mode
-;; package.  Similar for filling "*/" with the previous line...
-
-(defun template-c-fill-paragraph (&optional arg)
-  ;; checkdoc-params: (arg)
-  "Like \\[c-fill-paragraph] but handles comment separator lines."
-  (let* ((regexp (concat "\\|[ \t]*\\(/[*/]\\|\\*\\)[ \t]*"
-			 (template-comment-separator-regexp '("/*" "*/"))))
-	 (paragraph-start (concat paragraph-start regexp)) ;#dynamic
-	 (paragraph-separate (concat paragraph-separate regexp)))
-    (c-fill-paragraph arg)))
-
-(defun template-c-init-fill-function ()
-  "Set `fill-paragraph-function' to use `template-c-fill-paragraph'."
-  (when (boundp 'fill-paragraph-function)
-    (make-local-variable 'fill-paragraph-function)
-    (setq fill-paragraph-function 'template-c-fill-paragraph)))
-
-
-
-;;;;##########################################################################
-;;;;  Updating (File Name in Header)
-;;;;##########################################################################
-
-
-;;;===========================================================================
-;;;  General updating
-;;;===========================================================================
-
-(defun template-update-buffer-region (limit regexp group)
-  "Return region = (BEG . END) in buffer to be updated.
-If LIMIT is positive, check first LIMIT characters in buffer, otherwise
-check last -LIMIT characters in buffer for a text to be matched by
-REGEXP.  Return region according to GROUP's regexp group in REGEXP."
-  (let ((case-fold-search nil))
-    (goto-char (if limit
-		   (if (natnump limit) (point-min) (+ (point-max) limit))
-		 (point-min)))
-    (when (re-search-forward regexp
-			     (if (natnump limit)
-				 (+ (point-min) limit)
-			       (point-max))
-			     t)
-      (cons (match-beginning group) (match-end group)))))
-
-(defun template-match-modes-or-regexp (modes-or-regexp)
-  "Return non-nil, if the current buffer passes MODES-OR-REGEXP.
-If MODES-OR-REGEXP is a list, it must include the current `major-mode',
-if it is a regexp, it must match the `buffer-file-name' without version,
-otherwise it must be non-nil."
-  (if (stringp modes-or-regexp)
-      (and buffer-file-name
-	   (string-match modes-or-regexp
-			 (file-name-sans-versions buffer-file-name)))
-    (or (nlistp modes-or-regexp) (memq major-mode modes-or-regexp))))
-
-(defun template-update-buffer (&optional arg)
-  "Update buffer according to `template-update-buffer-alist'.
-Do not do anything if `template-auto-update-disable-regexp' matches the
-file name or if `template-auto-update' is nil.  When optional ARG is
-non-nil, i.e., if called interactively *without* prefix arg, always
-update."
-  (interactive (list (null current-prefix-arg)))
-  (when (or arg
-	    (and template-auto-update buffer-file-name
-		 (null (and template-auto-update-disable-regexp
-			    (string-match template-auto-update-disable-regexp
-					  buffer-file-name)))))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(let ((alist template-update-buffer-alist)
-	      (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt)))
-	      stamp prompt region new)
-	  (while alist
-	    (setq stamp (pop alist))
-	    (condition-case nil
-		(and (template-match-modes-or-regexp (pop stamp))
-		     ;; Run TEST ---------------------------------------------
-		     (setq prompt (pop stamp)
-			   region (pop stamp) ; TEST
-			   region (eval (if (or (atom region)
-						(functionp (car region)))
-					    region
-					  (cons 'template-update-buffer-region
-						region))))
-		     (if (stringp (setq new (eval (pop stamp))))
-			 (null (string= (buffer-substring (car region)
-							  (cdr region))
-					new))
-		       (car stamp))
-		     ;; user confirmation, replacement -----------------------
-		     (or (null prompt)
-			 arg
-			 (eq template-auto-update t)
-			 (y-or-n-p (format prompt (buffer-name))))
-		     (progn
-		       (goto-char (car region))
-		       (if (car stamp)
-			   (funcall (car stamp) new (car region) (cdr region))
-			 (delete-region (car region) (cdr region))
-			 (insert new))))
-	      (error nil))))))))
-
-
-;;;===========================================================================
-;;;  Update header
-;;;===========================================================================
-
-;;;###autoload
-(defun template-update-header (&optional show)
-  "Replace old file name in header with current file name.
-If SHOW is t, just return region of the filename or nil.  Otherwise,
-replace filename if possible and signal an error if SHOW is nil and
-there is no filename in the header.  See `template-header-lines' and
-`template-header-regexp-alist'."
-  (interactive "*P")
-  (if buffer-file-name
-      (save-excursion
-	(goto-char (point-min))
-	(let ((case-fold-search nil)
-	      (comment-regexp (template-default-comment)) ; at `point-min'!
-	      (end (progn (forward-line template-header-lines) (point)))
-	      (alist template-header-regexp-alist)
-	      (disallowed "")
-	      group)
-	  (if (string-match "[A-Za-z]\\|.." comment-regexp)
-	      (setq comment-regexp (regexp-quote comment-regexp)
-		    disallowed "")
-	    (or (eq comment-regexp '(?\]))
-		(setq disallowed comment-regexp))
-	    (setq comment-regexp (concat (regexp-quote comment-regexp) "+")))
-	  (while alist
-	    (goto-char (point-min))
-	    (if (re-search-forward (format (caar alist)
-					   comment-regexp disallowed)
-				   end t)
-		(setq group (cdar alist)
-		      alist nil)
-	      (setq alist (cdr alist))))
-	  (if (and group (match-beginning group))
-	      (if (eq show t)
-		  (cons (match-beginning group) (match-end group))
-		(goto-char (match-beginning group))
-		(delete-region (point) (match-end group))
-		(insert (file-name-sans-versions
-			 (file-name-nondirectory buffer-file-name)))
-		t)
-	    (if show nil (error "No file name in header")))))
-    (if show nil (error "Buffer is not visiting a file"))))
-
-
-
-;;;;##########################################################################
-;;;;  Templates
-;;;;##########################################################################
-
-
-(defvar template-history nil
-  "History, used by `template-read'.")
-
-(defvar template-choice-history nil
-  "History, used by `template-choice'.")
-
-(put 'normal-mode 'template-secure-command t)
-
-(defvar template-all-templates nil
-  "Internal variable.  Template files used for template derivation.")
-(defvar template-file nil
-  "Partitioned name of new file: (DIR FILE RAW NUMBER EXT).
-Internal variable.  DIR is the directory part, FILE the file name
-without directory part.  FILE consists of its extension EXT, RAW and a
-numbering NUMBER just in front of the extension.  It is used by the
-expansions DIR, FILE, FILE_SANS, FILE_EXT and others in
-`template-expansion-alist'.  Also useful for user defined functions in
-`template-derivation-alist' and the per-template definition section.")
-
-(defvar template-modified nil
-  "Internal variable.  Whether user is asked during the expansion process.")
-(defvar template-secure t
-  "Internal variable.  Whether all per-template definitions are secure.")
-(defvar template-point-messages nil
-  "Internal variable.  List of lines for temporary message at point.")
-(defvar template-before-messages nil
-  "Internal variable.  List of lines for temporary message before expansion.")
-(defvar template-after-messages nil
-  "Internal variable.  List of lines for temporary message after expansion.")
-
-(defvar template-point nil
-  "Internal variable.  Position of point.  Set with expansion form P.")
-(defvar template-mark nil
-  "Internal variable.  Position of mark.  Set with expansion form M.")
-
-(defvar template-current nil
-  "Internal variable.  Current key of expansion form.")
-(defvar template-string-alist nil
-  "Internal variable.  Alist of user inputs for `template-read'.")
-(defvar template-register-alist nil
-  "Internal variable.  Alist of used registers.")
-(defvar template-local-alist nil
-  "Internal variable.  Alist of per-template defined expansions.")
-
-(defvar template-ffap-file-finder nil
-  "Value used inside `template-ffap-find-file'.
-If nil, initialize it to the value of `ffap-file-finder', i.e., this
-variable holds the original value of that variable which will be set to
-`template-ffap-find-file' in `template-initialize'.")
-
-
-;;;===========================================================================
-;;;  Functions: `find-file'/`insert-file-contents', hooking into `find-file'
-;;;===========================================================================
-
-(defun template-find-template (filename &optional replace)
-  "Switch to a buffer visiting template file FILENAME.
-If optional REPLACE is non-nil, replace the current buffer contents with
-the contents of file FILENAME.
-
-This function always considers template files as text files."
-  (let ((file-name-buffer-file-type-alist nil))	; Emacs on DOS/NT
-    (if replace
-	(insert-file-contents filename nil nil nil
-			      ;; 5th arg not t with empty accessible part
-			      ;; (XEmacs bug workaround: would infloop)
-			      (> (point-max) (point-min)))
-      (let ((template-auto-insert nil))
-	(switch-to-buffer (find-file-noselect filename))))))
-
-(defun template-not-found-function ()
-  "Use a template when visiting a non-existent file.
-See `template-auto-insert' and `template-find-file-commands'.  Function
-in `find-file-not-found-hooks'."
-  (and template-auto-insert (not buffer-read-only) (bobp) (eobp)
-       (or (memq this-command template-find-file-commands)
-	   (and (memq this-command template-file-select-commands)
-		;; thanks to Dave Love :
-		(memq (car-safe (car command-history))
-		      ;; To always include `find-file-at-point', use ffap
-		      ;; initialization (see `template-ffap-find-file')
-		      template-find-file-commands)))
-       (let ((template (cdr (template-derivation buffer-file-name t t))))
-	 (and template
-	      (file-readable-p template)
-	      (or (eq template-auto-insert t)
-		  (y-or-n-p
-		   (format "Use template %s? "
-			   (cond-emacs-xemacs
-			    (abbreviate-file-name template :XEMACS t)))))
-	      (progn
-		(template-new-file nil template)
-		(setq this-command 'session-disable)
-		t)))))
-
-(defun template-ffap-find-file (filename)
-  "Function to use in `ffap-file-finder'.
-Add an entry to `command-history' if necessary and call function in
-`template-ffap-file-finder' with argument FILENAME."
-  (or (memq (car-safe (car command-history))
-	    '(ffap find-file-at-point))
-      (setq command-history
-	    (cons (list 'find-file-at-point filename) command-history)))
-  (if (eq template-ffap-file-finder 'template-ffap-find-file)
-      (find-file filename)
-    (funcall template-ffap-file-finder filename)))
-
-
-;;;===========================================================================
-;;;  Main function
-;;;===========================================================================
-
-(defun template-expand-template-interactive ()
-  (let* ((use (template-derivation (expand-file-name
-				    (or buffer-file-name "NONE"))
-				   t))
-	 (tpl (read-file-name "Insert and expand template: "
-			      (file-name-directory (cdr use))
-			      (file-name-nondirectory (cdr use))
-			      t
-			      (file-name-nondirectory (cdr use)))))
-    (if (string= tpl "")
-	(error "No template file provided"))
-    (list (expand-file-name tpl (file-name-directory (cdr use))))))
-
-;;;###autoload
-(defun template-expand-template (template)
-  "Expand template file TEMPLATE and insert result in current buffer.
-Using a template for inserting some text consists of:
-  1. Template derivation: suggest a reasonable template file to the user
-     according to `buffer-file-name', see `template-derivation-alist'.
-  2. Template insertion: insert the template file at point into the
-     current buffer.
-  3.. as steps 6.. of `template-new-file'."
-  (interactive (template-expand-template-interactive))
-  (save-restriction
-    (narrow-to-region (point) (point))
-    (template-new-file nil template t)))
-
-(defun template-new-file-interactive ()
-  "Interactive specification for `template-new-file'.
-Return \(FILE TEMPLATE)."
-  (let* ((inp (read-file-name (if current-prefix-arg
-				  "New file (+template, no name change): "
-				"New file (+template): ")
-			      nil ""))
-	 (use (cond ((equal inp "")
-		     (error "Empty/no input"))
-		    ((file-directory-p inp)
-		     (error "%S is a directory" inp))
-		    (t (template-derivation (expand-file-name inp)
-					    current-prefix-arg))))
-	 (tpl (read-file-name (format "File %s uses template: "
-				      (file-name-nondirectory (car use)))
-			      (file-name-directory (cdr use))
-			      (file-name-nondirectory (cdr use))
-			      t
-			      (file-name-nondirectory (cdr use)))))
-    (list (car use)
-	  (if (string= tpl "")
-	      nil
-	    (expand-file-name tpl (file-name-directory (cdr use)))))))
-
-;;;###autoload
-(defun template-new-file (file template &optional with-undo)
-  "Open a new file FILE by using a TEMPLATE.
-Using a template for creating a new file consists of, steps 1 to 3 are
-only executed when called interactively:
-  1. Prompt for the name of the new file.
-  2. Template derivation: suggest a reasonable template file to the user
-     see `template-derivation-alist'.
-  3. File name refinement: e.g., if the given file name is \"exercise\"
-     and there are two files \"exercise1.tex\" and \"exercise2.tex\" in
-     the same directory and if we have a template \"exercise.tex.tpl\",
-     the file name is refined to \"exercise3.tex\".  This is turned off
-     when \\[template-new-file] is called with a prefix argument.
-  4. Template insertion: insert the template file into the empty buffer.
-  5. Read per-template expansion definition section starting at
-     `template-definition-start' and delete it.
-  6. Display :before message in `template-message-buffer'.
-  7. Execute pre-expansion commands defined in the definition section.
-  8. Set local variables defined in the definition section.
-  9. Expansion: expand the expansion forms (text matched by
-     `template-expansion-regexp') They are defined in the definition
-     section, in `template-expansion-alist', or provided by default, see
-     `template-expansion-regexp' and `template-register-regexp'.
- 10. Execute post-expansion commands defined in the definition section.
- 11. Run `normal-mode' and functions in `find-file-hooks'.
- 12. Update header according to `template-update-header' with argument
-    `if-exists'.
- 13. Display :after message in `template-message-buffer'.
- 14. Report: display a temporary message at point defined in the
-     definition section and an automatically generated message in the
-     minibuffer area, see `template-message-timeout'.
-
-If optional WITH-UNDO is non-nil, store corresponding changes in
-`buffer-undo-list'.  If FILE is nil, the buffer for FILE has already
-been created and the accessible part will be replaced by the expanded
-template.  If TEMPLATE is nil (empty input when called interactively),
-do not use a template."
-  (interactive (template-new-file-interactive))
-  ;; check template and file name --------------------------------------------
-  (if template
-      (if (file-readable-p template)
-	  (if (file-directory-p template)
-	      (error "Template %s is a directory" template))
-	(if (null (yes-or-no-p (format "Template %s does not exist.  Create? "
-				       template)))
-	    (error "No template file to use")
-	  (template-make-directory (file-name-directory template))
-	  (template-find-template template)
-	  (error "You should create this template first"))))
-  (if (not file)
-      (switch-to-buffer (current-buffer))
-    (and (or (get-file-buffer file) (file-exists-p file))
-	 (null (yes-or-no-p (format "File %s exists.  Delete contents? " file)))
-	 (error "Cannot use templates for existing files"))
-    (let ((auto-mode-alist nil)
-	  (enable-local-variables nil)
-	  (find-file-not-found-hooks nil)
-	  (enable-local-eval nil))
-      (switch-to-buffer (find-file-noselect file))))
-  (when template
-    (or with-undo (setq buffer-undo-list t))
-    (template-find-template template t)
-    (template-new-file-0 with-undo)))
-
-(defun template-new-file-0 (with-undo)
-  "Perform template replacements in current buffer.
-If WITH-UNDO is non-nil, store corresponding changes in
-`buffer-undo-list'."
-  ;; start replacement -------------------------------------------------------
-  (or with-undo (set-buffer-modified-p nil))
-  (goto-char (point-min))
-  (setq template-secure t
-	template-point nil
-	template-mark nil
-	template-modified nil
-	template-point-messages nil
-	template-before-messages nil
-	template-after-messages nil
-	template-local-alist nil
-	template-register-alist nil
-	template-string-alist nil)
-  (let ((form-selector nil)
-	(pre-command-list nil)
-	(post-command-list nil)
-	(local-variable-list nil)
-	val)
-    ;; read per-template definition section ----------------------------------
-    (goto-char (point-min))
-    (when (re-search-forward
-	   (concat "^[ \t]*" template-definition-start "[ \t]*$") nil t)
-      (condition-case ()
-	  (while t
-	    (setq val (read (current-buffer)))
-	    (cond (;; ("KEY" . xxx): ask user --------------------------------
-		   (and (consp val) (stringp (car val)))
-		   (let* ((def (cdr val)) ; expansion forms
-			  (msg (cond ((null template-message-prompt-format)
-				      nil)
-				     ((stringp def) def)
-				     ((and (consp def) (stringp (car def)))
-				      (car def)))))
-		     (when msg		; list prompts in before-messages
-		       (or template-before-messages
-			   (null template-message-prompt-intro)
-			   (push template-message-prompt-intro
-				 template-before-messages))
-		       (push (format template-message-prompt-format msg)
-			     template-before-messages))
-		     (push (cons (car val) (template-translate-definition def))
-			   template-local-alist)))
-		  ;; :before, :after, :eval-before, :eval-after --------------
-		  ((null val)		; nil is deprecated
-		   (setq form-selector
-			 (cond ((null form-selector) :old-before)
-			       ((eq form-selector :old-before) :old-after)
-			       ((eq form-selector :old-after)
-				(error "More than two (obsolete) nil forms"))
-			       (t
-				(error "Used obsolete nil form with new form selectors")))))
-		  ((memq val '(:before :after :eval-before :eval-after))
-		   (setq form-selector val))
-		  ;; "MESSAGE" -----------------------------------------------
-		  ((stringp val)
-		   (cond ((eq form-selector :before)
-			  (push val template-before-messages))
-			 ((eq form-selector :after)
-			  (push val template-after-messages))
-			 (t
-			  (push val template-point-messages))))
-		  ;; (CHAR . xxx): set register ------------------------------
-		  ((and (consp val) (template-char-or-char-int-p (car val)))
-		   (let ((reg (template-char-or-int-to-char (car val))))
-		     (if (atom (cdr val))
-			 (set-register reg (cdr val))
-		       (set-register reg (cadr val))
-		       (when template-message-register-format
-			 (let ((msg (format template-message-register-format
-					    reg (cadr val)
-					    (or (caddr val) ""))))
-			   (if template-message-buffer
-			       (progn
-				 (if template-before-messages
-				     (push msg template-before-messages))
-				 (or template-after-messages
-				     (null template-message-register-intro)
-				     (push template-message-register-intro
-					   template-after-messages))
-				 (push msg template-after-messages))
-			     (push msg template-point-messages)))))))
-		  ;; set var, execute command and sexpr ----------------------
-		  ((and (memq form-selector '(nil :before :after))
-			(consp val)
-			(symbolp (car val)))
-		   (or (and (functionp (get (car val) 'template-secure-value))
-			    (funcall (get (car val) 'template-secure-value)
-				     (cdr val)))
-		       (setq template-secure nil))
-		   (push val local-variable-list))
-		  ((memq form-selector '(:eval-before :old-before))
-		   (push (template-elisp-in-definition val)
-			 pre-command-list))
-		  ((memq form-selector '(:eval-after :old-after))
-		   (push (template-elisp-in-definition val)
-			 post-command-list))
-		  (t
-		   (error "Illegal form"))))
-	(error nil))
-      (skip-chars-forward " \t\n\f")
-      (or (eobp)
-	  (error "Invalid definition in line %d (pos %d) of the template file"
-		 (count-lines 1 (point)) (point)))
-      (or template-secure
-	  (null (default-value template-confirm-insecure))
-	  (y-or-n-p "Have you checked the template functions? ")
-	  (error "Failed security check"))
-      (delete-region (match-beginning 0) (point-max)))
-    ;; expand ----------------------------------------------------------------
-    (template-display-messages template-before-messages)
-    (eval (cons 'progn (nreverse pre-command-list)))
-    (while local-variable-list
-      (make-local-variable (caar local-variable-list))
-      (set (caar local-variable-list) (cdar local-variable-list))
-      (setq local-variable-list (cdr local-variable-list)))
-    (goto-char (point-min))
-    (while (re-search-forward template-expansion-regexp nil t)
-      (setq template-current (buffer-substring (match-beginning 1)
-					       (match-end 1))
-	    val (assoc template-current template-local-alist))
-      (unless val
-	(if (setq val (assoc template-current template-key-alias-alist))
-	    (setq template-current (cdr val)))
-	(setq val (or (assoc template-current template-expansion-alist)
-		      (assoc template-current
-			     template-default-expansion-alist))))
-      (delete-region (match-beginning 0) (match-end 0))
-      (cond (val
-	     (eval (cons 'progn (cdr val))))
-	    ((string-match template-register-regexp template-current)
-	     (template-register))
-	    (t
-	     (template-read (format "Replacement for `%s': "
-				    template-current)))))
-    (eval (cons 'progn (nreverse post-command-list)))
-    (save-restriction
-      (widen)
-      (normal-mode t)
-      (or with-undo (template-update-header 'if-exists))
-      (run-hooks 'find-file-hooks))
-    ;; message ---------------------------------------------------------------
-    (template-display-messages template-after-messages)
-    (cond ((null template-register-alist)
-	   (message "%s, no buffer location in register"
-		    (if template-mark "Mark set" "No mark")))
-	  (t (message "%s, buffer location in register: %s"
-		      (if template-mark "Mark set" "No mark")
-		      (mapconcat (function
-				  (lambda (x)
-				    (if (cdr x)
-					(concat (char-to-string (car x)) "*")
-				      (char-to-string (car x)))))
-				 (nreverse template-register-alist)
-				 ", "))))
-    (or with-undo (set-buffer-modified-p template-modified))
-    (goto-char (point-min))
-    (when template-point
-      (goto-char template-point)
-      (set-marker template-point nil))
-    (when template-mark
-      (push-mark template-mark)
-      (set-marker template-mark nil)
-      (if (fboundp 'zmacs-activate-region) (zmacs-activate-region)))
-    (when (and template-point-messages
-	       (or (cdr template-point-messages)
-		   (not (string-equal (car template-point-messages) ""))))
-      (let ((beg (point))
-	    end)
-	(if (cdr template-point-messages)
-	    (insert (mapconcat 'identity
-			       (nreverse template-point-messages)
-			       "\n")
-		    "\n")
-	  (insert (car template-point-messages)))
-	(setq end (point))
-	(goto-char beg)
-	(and (fboundp 'make-extent) (fboundp 'set-extent-face)
-	     (set-extent-face (make-extent beg end) 'template-message-face))
-	(recenter)
-	(sit-for template-message-timeout)
-	(delete-region beg end))))
-  (recenter)
-  (unless with-undo
-    (setq buffer-undo-list nil)
-    (set-buffer-modified-p template-modified)))
-
-(defun template-display-messages (messages)
-  (when (and messages template-message-buffer)
-    (setq messages (nreverse messages))
-    (with-output-to-temp-buffer template-message-buffer
-      (while messages
-	(princ (pop messages))
-	(if messages (princ "\n"))))))
-
-
-;;;===========================================================================
-;;;  Determine name of the new file and the template
-;;;===========================================================================
-
-(defun template-derivation (full arg &optional no-default)
-  "Derive template file name and do file name refinement.
-Return (REFINED . TEMPLATE) where REFINED is the refined version of FULL
-and TEMPLATE and template file name, see `template-derivation-alist'.
-FULL is the initial file name given by the user.  File name refinement
-is turned off when ARG is non-nil.  If optional argument NO-DEFAULT is
-non-nil, return nil instead (FULL \. \"~/.templates/DEFAULT.tpl\") if no
-matching entry can be found in `template-derivation-alist'."
-  ;; Get all templates -------------------------------------------------------
-  (setq template-all-templates nil)
-  (let* ((dir (file-name-directory full))
-	 (len (length dir))
-	 (case-fold-search (memq system-type '(vax-vms ms-dos windows-nt))))
-    (while (and dir
-		(not (and template-stop-derivation
-			  (fboundp template-stop-derivation)
-			  (funcall template-stop-derivation dir))))
-      (template-all-templates template-subdirectories dir)
-      (setq dir (file-name-directory (directory-file-name dir)))
-      (or (> len (setq len (length dir)))
-	  (setq dir nil)))
-    (template-all-templates template-default-directories)
-    (setq template-all-templates (nreverse template-all-templates)))
-  ;; Get template file -------------------------------------------------------
-  (if (string= (file-name-nondirectory full) "")
-      (error "You cannot use templates for directories"))
-  (setq template-file (template-split-filename full))
-  (let ((tests template-derivation-alist)
-	test template file)
-    (while tests
-      (setq test (caar tests)
-	    file (cdar tests))
-      (if (setq template
-		(if (functionp (car test))
-		    (apply (car test) (cdr test))
-		  (apply 'template-default-template test)))
-	  (setq tests nil)
-	(setq tests (cdr tests))))
-    (if template
-	(or arg
-	    (if (functionp (car file))
-		(apply (car file) template (cdr file))
-	      (apply 'template-unique-file template file)))
-      (or no-default
-	  (setq template (template-split-filename
-			  "DEFAULT"
-			  (template-default-directory)))))
-    (if template
-	(cons (expand-file-name (cadr template-file) (car template-file))
-	      (expand-file-name (concat (cadr template) template-extension)
-				(car template))))))
-
-(defun template-default-directory ()
-  "Return directory of file \"DEFAULT.tpl\"."
-  (let ((dirs template-default-directories)
-	(name (concat "DEFAULT" template-extension))
-	dir)
-    (while dirs
-      (setq dir (pop dirs))
-      (if (file-readable-p (expand-file-name name dir))
-	  (setq dirs nil)
-	(setq dir nil)))
-    (or dir
-	(car template-default-directories)
-	(expand-file-name "~/.templates/"))))
-
-
-;;;===========================================================================
-;;;  Small functions
-;;;===========================================================================
-
-(defun template-make-directory (dir)
-  "Create DIR if it does not exists yet."
-  (cond ((file-exists-p dir))
-	((yes-or-no-p (format "The directory %s does not exist.  Create? " dir))
-	 (make-directory dir t))
-	(t (error "You should create a directory \"%s\"" dir)))
-  dir)
-
-(defun template-split-filename (file &optional dir)
-  "Split file name into its parts.
-If DIR is nil, FILE is a fully expanded file name, otherwise FILE is a
-file name without its directory part DIR.  See `template-file'."
-  (or dir (setq dir (template-make-directory (file-name-directory file))
-		file (file-name-nondirectory file)))
-  (let* ((ext (string-match "\\.[^.]*\\'" file))
-	 (raw (substring file 0 ext))
-	 (num (string-match "[^0-9][0-9]+\\'" raw)))
-    (if num
-	(list dir file
-	      (substring raw 0 (1+ num))
-	      (substring raw (1+ num))
-	      (if ext (substring file ext) ""))
-      (list dir file raw "" (if ext (substring file ext) "")))))
-
-(defun template-translate-definition (def)
-  "Translate DEF of expansion and set `template-secure' accordingly."
-  (cond ((null def) ; zero form
-	 nil)
-	((template-char-or-char-int-p def)
-	 `((template-register ,def)))
-	((stringp def)
-	 `((template-read ,def nil nil nil t)))
-	((symbolp def)
-	 `((insert (if (stringp ,def) ,def template-string-default))))
-	((and (consp def) (stringp (car def)))
-	 (if (consp (car-safe (cdr def)))
-	     `((template-choice ,(car def) (quote ,(cdr def))))
-	   `((apply (quote template-read) (quote ,def)))))
-	((consp (car-safe def))
-	 (setq template-secure nil)
-	 def)
-	(t
-	 (list (template-elisp-in-definition (car def) (cdr def))))))
-
-(defun template-elisp-in-definition (def &optional prefix)
-  "Return valid elisp definition and set `template-secure' accordingly.
-DEF is the elisp form, PREFIX would be the prefix argument if DEF is a
-command."
-  (cond ((consp def)
-	 (setq template-secure nil)
-	 def)
-	((or (symbolp def) (vectorp def))
-	 (or (and (symbolp def) (get def 'template-secure-command))
-	     (setq template-secure nil))
-	 (if (and (symbolp def)
-		  (functionp (get def 'template-secure-command))
-		  (listp prefix)
-		  (funcall (get def 'template-secure-command) prefix))
-	     `(apply (quote ,def) (quote ,prefix))
-	   `(progn (setq prefix-arg (quote ,prefix))
-		   (command-execute (quote ,def)))))
-	(t
-	 (error "Illegal form"))))
-
-
-;;;===========================================================================
-;;;  Compute template name
-;;;===========================================================================
-
-(defun template-all-templates (dirs &optional base)
-  "Read names of template files in DIRS relatively to BASE.
-Insert the names to internal variable `template-all-templates'."
-  (let ((regexp (concat (regexp-quote template-extension) "\\'"))
-	(endpos (- (length template-extension)))
-	dir templates)
-    (while dirs
-      (setq dir (expand-file-name (car dirs) base)
-	    dirs (cdr dirs))
-      (cond-emacs-xemacs
-       (and (file-accessible-directory-p dir)
-	    (file-readable-p dir)
-	    (setq templates (directory-files dir t regexp :XEMACS nil t))
-	    (while templates
-	      (and :EMACS
-		   (not (file-directory-p (car templates)))
-		   :BOTH
-		   (file-readable-p (car templates))
-		   (push (template-split-filename (substring (car templates)
-							     0
-							     endpos))
-			 template-all-templates))
-	      (setq templates (cdr templates))))))))
-
-(defun template-set-template-part (part file-part)
-  "Set template part according to definition PART and FILE-PART.
-See `template-derivation-alist' for details."
-  (when part
-    (cond ((stringp part) part)
-	  ((eq part t) file-part)
-	  ((null (string= file-part "")) file-part))))
-
-(defun template-default-template (&optional raw num ext regexp)
-  "Return template according to RAW, NUM, EXT and REGEXP.
-See `template-derivation-alist' for details."
-  (if (or (null regexp) (string-match regexp (cadr template-file)))
-      (let ((templates template-all-templates)
-	    (file-rne (cddr template-file))
-	    result template-rne)
-	(setq raw (template-set-template-part raw (car file-rne))
-	      num (template-set-template-part num (cadr file-rne))
-	      ext (template-set-template-part ext (caddr file-rne)))
-	(while templates
-	  (setq template-rne (cddar templates))
-	  (if (and (or (null raw) (string= (car template-rne) raw))
-		   (or (null num) (string= (cadr template-rne) num))
-		   (or (null ext) (string= (caddr template-rne) ext)))
-	      (setq result (car templates)
-		    templates nil)
-	    (setq templates (cdr templates))))
-	result)))
-
-
-;;;===========================================================================
-;;;  File name refinement
-;;;===========================================================================
-
-(defun template-default-file (template &optional raw num ext)
-  "Refine file name according to TEMPLATE, RAW, NUM and EXT.
-The result is in `template-file'.  See `template-derivation-alist'."
-  (let ((template-rne (cddr template))
-	(file-rne (cddr template-file)))
-    (if raw
-	(if (eq raw t) (setq raw (car template-rne)))
-      (setq raw (car file-rne)))
-    (if num
-	(if (eq num t) (setq num (cadr template-rne)))
-      (setq num (cadr file-rne)))
-    (if ext
-	(if (eq ext t) (setq ext (caddr template-rne)))
-      (setq ext (caddr file-rne)))
-    (setcdr template-file (list (concat raw num ext) raw num ext))))
-
-(defunx template-unique-file (template &optional raw num ext auto-num)
-  "Refine file name according to TEMPLATE, RAW, NUM, EXT and AUTO-NUM.
-Use auto numbering if NUM is not \"\" or AUTO-NUM is non-nil.  The
-result is in `template-file'.  See `template-derivation-alist'."
-  (template-default-file template raw num ext)
-  (let* ((dir (car template-file))
-	 (full (expand-file-name (cadr template-file) dir)))
-    (when (if (string= (fourth template-file) "")
-	      auto-num
-	    (setq auto-num
-		  (and (or (get-file-buffer full)
-			   (file-readable-p full))
-		       (string-to-int (fourth template-file)))))
-      (setq auto-num (1- auto-num)
-	    raw (third template-file)
-	    ext (fifth template-file))
-      (let ((list (buffer-list))
-	    file1 dir1)
-	(while list
-	  (and (setq file1 (buffer-file-name (car list)))
-	       (setq dir1 (file-name-directory file1))
-	       (string= dir1 dir)
-	       (setq auto-num
-		     (max (template-filename-number
-			   (cddr (template-split-filename
-				  (file-name-nondirectory file1)
-				  dir1))
-			   raw ext)
-			  auto-num)))
-	  (setq list (cdr list)))
-	(setq list (directory-files dir nil nil t :XEMACS t))
-	(while list
-	  (unless (:EMACS file-directory-p (car list))
-	    (setq auto-num
-		  (max (template-filename-number
-			(cddr (template-split-filename (car list) dir))
-			raw ext)
-		       auto-num)
-		  list (cdr list))))
-	(template-default-file template raw
-			       (int-to-string (1+ auto-num))
-			       ext)))))
-
-(defun template-filename-number (file-rne raw ext)
-  "Return numbering in FILE-RNE if the RAW and EXT parts are equal."
-  (or (and (string= (car file-rne) raw)
-	   (string= (caddr file-rne) ext)
-	   (string-to-int (cadr file-rne)))
-      0))
-
-
-;;;===========================================================================
-;;;  Safe commands for per-template expansions
-;;;===========================================================================
-
-(defun template-insert-time (&optional format default)
-  "Insert time into current buffer using time format FORMAT.
-If FORMAT is not a string, it uses DEFAULT or `current-time-string'."
-  (interactive)
-  (insert (if (and (stringp format) (fboundp 'format-time-string))
-	      (format-time-string format (current-time))
-	    (or default (current-time-string)))))
-(put 'template-insert-time 'template-secure-command
-     (lambda (args)
-       (or (null args) (and (stringp (car args)) (null (cdr args))))))
-
-
-;;;===========================================================================
-;;;  Functions for the predefined expansions
-;;;===========================================================================
-
-(defun template-register (&optional register)
-  "Set current location in register REGISTER.
-That is, \\[jump-to-register] REGISTER jumps to the current position.
-If REGISTER is nil, use register corresponding to the last character in
-`template-current'."
-  (let* ((char (if register
-		   (template-char-or-int-to-char register)
-		 (aref template-current (1- (length template-current)))))
-	 (elem (assoc char template-register-alist)))
-    (point-to-register char)
-    (if elem
-	(setcdr elem t)
-      (push (list char) template-register-alist))))
-
-(defun template-read (prompt &optional prefix suffix default again-p)
-  "Ask user with PROMPT for a STRING to be inserted.
-If STRING is not \"\", insert PREFIX STRING SUFFIX, otherwise DEFAULT.
-If AGAIN-P is nil, do not ask if `template-current' appears another time
-as key in a expansion form.  If AGAIN-P is `expand', the inserted region
-is searched for expansion forms where STRING is marked as a literal
-environment, see `template-literal-environment'."
-  (setq template-modified t)
-  (let ((pos (point))
-	(elem (and (null again-p)
-		   (assoc template-current template-string-alist))))
-    (if elem
-	(setq elem (cdr elem))
-      (setq elem (read-from-minibuffer prompt nil nil nil
-				       'template-history)
-	    elem (cond ((string= elem "") (or default ""))
-		       ((eq again-p 'expand)
-			(concat prefix
-				(format template-expansion-format
-					(car template-literal-environment))
-				elem
-				(format template-expansion-format
-					(cdr template-literal-environment))
-				suffix
-				(format template-expansion-format
-					(car template-literal-environment))
-				(format template-expansion-format
-					(cdr template-literal-environment))))
-		       (t
-			(concat prefix elem suffix))))
-      (or again-p (push (cons template-current elem) template-string-alist)))
-    (insert elem)
-    (if (eq again-p 'expand) (goto-char pos))))
-
-(defun template-choice (prompt table)
-  "Ask user with PROMPT for a choice and insert it.
-Each element in TABLE looks like (ANSWER . TEXT).  Ask for an input with
-completion over all ANSWERs and insert corresponding TEXT if ANSWER is a
-string, otherwise ask a \"y or n\" question and use the result of
-`y-or-n-p' as ANSWER.  Expansion forms in TEXT will be expanded."
-  (setq template-modified t)
-  (let ((pos (point)))
-    (insert (or (cdr (assoc (if (stringp (caar table))
-				(completing-read prompt table nil t nil
-						 'template-choice-history)
-			      (y-or-n-p prompt))
-			    table))
-		"")
-	    (format template-expansion-format
-		    (car template-literal-environment))
-	    (format template-expansion-format
-		    (cdr template-literal-environment)))
-    (goto-char pos)))
-
-
-;;;===========================================================================
-;;;  Menu filter
-;;;===========================================================================
-
-(defun template-menu-filter (menu-items)
-  ;; checkdoc-params: (menu-items)
-  "Menu filter for `template-creation-menu'."
-  (let ((alist (append template-expansion-alist
-		       template-default-expansion-alist))
-	menu used key)
-    (while alist
-      (unless (member (setq key (car (pop alist))) used)
-	(push key used)
-	(push (vector (concat "Insert " key)
-		      (list 'template-insert-form current-prefix-arg key)
-		      t)
-	      menu)))
-    (append menu-items (nreverse menu))))
-
-
-;;;===========================================================================
-;;;  Insert and define forms
-;;;===========================================================================
-
-(defun template-buffer-template-p ()
-  "Return non-nil, if current buffer is likely to be a template file."
-  (and buffer-file-name
-       (string-match (concat (regexp-quote template-extension) "\\'")
-		     (file-name-sans-versions buffer-file-name))))
-
-(defun template-open-template ()
-  "If current buffer is no template file, open a new one."
-  (interactive)
-  (if (template-buffer-template-p)
-      (barf-if-buffer-read-only)
-    (let (name
-	  (dir (and (car template-subdirectories)
-		    (expand-file-name (car template-subdirectories)))))
-      (if (null buffer-file-name)
-	  (setq name (concat "TEMPLATE" template-extension))
-	(setq name (file-name-sans-versions
-		    (file-name-nondirectory buffer-file-name)))
-	(if (string-match ".\\.[^.]*\\'" name)
-	    (setq name (concat "TEMPLATE"
-			       (substring name (1+ (match-beginning 0)))
-			       template-extension))
-	  (setq name (concat name template-extension)
-		;; dot file => template not specific for directory
-		dir (car template-default-directories))))
-      (setq name (read-file-name "Open template file (empty=none): "
-				 dir nil nil name))
-      (or (string= name "")
-	  (template-find-template name)))))
-
-(defun template-insert-form (arg key)
-  "Insert an expansion form according to KEY into template.
-When called interactively, allow completion over all keys in
-`template-expansion-alist' and `template-default-expansion-alist'.
-If prefix ARG is nil, run `template-open-template' first."
-  (interactive
-   (list current-prefix-arg
-	 (completing-read "Insert key (0-9 for register position): "
-			  (append template-expansion-alist
-				  template-default-expansion-alist))))
-  (or arg (template-open-template))
-  (insert (format template-expansion-format key))
-  (if (equal key (car template-literal-environment))
-      (let ((pos (point)))
-	(insert (format template-expansion-format
-			(cdr template-literal-environment)))
-	(goto-char pos))))
-
-(defun template-define-start (arg &rest args)
-  "Insert a definition section and definition into template.
-See `template-definition-start'.  If ARGS is non-nil, pass ARGS to
-`format' for a new definition.  If prefix ARG is nil, run
-`template-open-template' first."
-  (interactive "P")
-  (or arg (template-open-template))
-  (save-excursion
-    (goto-char (point-min))
-    (unless (re-search-forward (concat "^[ \t]*"
-				       template-definition-start
-				       "[ \t]*$") nil t)
-      (goto-char (point-max))
-      (or (bolp) (insert "\n"))
-      (insert template-definition-start))
-    (goto-char (point-max))
-    (or (bolp) (insert "\n"))
-    (if args (insert (apply 'format args) "\n")))
-  (message "Put definition at the end of the template"))
-
-(defun template-define-message (arg message)
-  "Insert a temporary message MESSAGE definition into template.
-For ARG, see `template-define-start'."
-  (interactive "P\nsTemporary message: ")
-  (template-define-start arg "%S" message))
-
-(defun template-define-prompt (arg key prompt &optional prefix suffix default)
-  "Insert a definition for KEY as PROMPT into template.
-For ARG, see `template-define-start'."
-  (interactive "P\nsExpansion key: \nsExpansion prompt: \nsPrefix for non-empty input: \nsSuffix for non-empty input: \nsDefault for empty input: ")
-  (template-define-start arg "(%S %S %S %S %S)"
-			 key prompt prefix suffix default))
-
-(defun template-define-register (arg register)
-  "Insert a setting of REGISTER into template.
-For ARG, see `template-define-start'."
-  (interactive "P\ncDefine register: ")
-  (let* ((old (get-register register))
-	 (contents (read-from-minibuffer "Register contents: "
-				    (and (stringp old)
-					 (not (string-match "\n" old))
-					 old)))
-	 (comment (read-from-minibuffer "Comment (empty=none): ")))
-    (if (string= comment "")
-	(template-define-start arg "(%S %S)" register contents)
-      (template-define-start arg "(%S %S %S)" register contents comment))))
-  
-
-;;;===========================================================================
-;;;  Initialization
-;;;===========================================================================
-
-;; easymenu.el is for top-level menus only...
-(defunx template-add-submenu (menu &optional where)
-  "Add the submenu MENU to the end of a menu in WHERE in the menubar.
-WHERE is a list of menus tried to add MENU to.  If no such menu exist,
-no menu is added.  When using Emacs, always add to the \"Edit\" menu.
-See `easy-menu-define' for the format of MENU."
-  (and menu
-       :EMACS
-       (>= emacs-major-version 21)
-       (boundp 'menu-bar-edit-menu)
-       (let ((keymap (easy-menu-create-menu (car menu) (cdr menu))))
-	 ;; `easy-menu-get-map' doesn't get the right one => use hard-coded
-	 (define-key-after menu-bar-edit-menu (vector (intern (car menu)))
-	   (cons 'menu-item
-		 (cons (car menu)
-		       (if (not (symbolp keymap))
-			   (list keymap)
-			 (cons (symbol-function keymap)
-			       (get keymap 'menu-prop)))))))
-       :XEMACS
-       (featurep 'menubar)
-       (let ((current-menubar default-menubar) path)
-	 (while where
-	   (setq path (list (pop where)))
-	   (if (find-menu-item default-menubar path)
-	       (setq where nil)
-	     (setq path nil)))
-	 (when path (add-submenu path menu)))))
-
-;;;###autoload
-(defunx template-initialize (&rest dummies)
-  ;; checkdoc-params: (dummies)
-  "Initialized package template.  See variable `template-initialize'."
-  (interactive)
-  (setq template-use-package t)
-  (let ((regexp (concat (regexp-quote template-extension) "\\'")))
-    (or (assoc regexp auto-mode-alist)
-	(push (list regexp nil 'template-new-file) auto-mode-alist)))
-  (when (or (eq template-initialize t)
-	    (memq 'cc-mode template-initialize))
-    (add-hook 'c-mode-common-hook 'template-c-init-fill-function)
-    (add-hook 'antlr-mode-hook 'template-c-init-fill-function))
-  (when (or (eq template-initialize t)
-	    (memq 'de-html-helper template-initialize))
-    (setq html-helper-build-new-buffer nil)
-    (setq html-helper-do-write-file-hooks nil))
-  (when (or (eq template-initialize t)
-	    (memq 'keys template-initialize))
-    (condition-case nil			; older Emacses don't understand all
-	(progn
-	  (define-key ctl-x-map "t" 'template-new-file)
-	  (define-key ctl-x-map [(control =)] 'template-single-comment)
-	  (define-key ctl-x-map [(control ?\;)] 'template-block-comment))
-      (error nil)))
-  (when (or (eq template-initialize t)
-	    (memq 'menus template-initialize))
-    (template-add-submenu template-comment-menu :XEMACS '("Edit"))
-    (template-add-submenu template-creation-menu :XEMACS '("Cmds" "Edit"))
-    :EMACS
-    (and (boundp 'menu-bar-files-menu)
-	 (define-key-after menu-bar-files-menu [template-new-file]
-	   '(menu-item "New File Using Template..." template-new-file
-		       :enable (not (window-minibuffer-p
-				     (frame-selected-window
-				      menu-updating-frame)))
-		       :help "Create a new file, using a template")
-	   'dired))
-    :XEMACS
-    (and (featurep 'menubar)
-	 (find-menu-item default-menubar '("File"))
-	 (let ((current-menubar default-menubar))
-	   ;; XEmacs-20.4 `add-submenu' does not have 4th arg IN-MENU
-	   (add-menu-button '("File")
-			    ["New File Using Template..." template-new-file
-			     :active t]
-			    "Insert File..."))))
-    (if (and (boundp 'init-file-loaded) init-file-loaded)
-      ;; doesn't exist in Emacs
-      (template-after-init)
-    (add-hook 'after-init-hook 'template-after-init t)))
-
-(defun template-after-init ()
-  "Late initialization for package template.
-See function and variable `template-initialize'."
-  (when (or (eq template-initialize t)
-	    (memq 'auto template-initialize))
-    (add-hook 'write-file-hooks 'template-update-buffer)
-    (add-hook 'find-file-not-found-hooks 'template-not-found-function t))
-  (when (or (eq template-initialize t)
-	    (memq 'ffap template-initialize))
-    (or template-ffap-file-finder
-	(setq template-ffap-file-finder
-	      (if (boundp 'ffap-file-finder)
-		  ffap-file-finder
-		(or (get 'ffap-file-finder 'saved-value) 'find-file))))
-    (setq ffap-file-finder 'template-ffap-find-file)))
-
-;;; Local IspellPersDict: .ispell_template
-;;; template.el ends here
diff --git a/yaml-mode.el b/yaml-mode.el
deleted file mode 100644
index 66ea331e..00000000
--- a/yaml-mode.el
+++ /dev/null
@@ -1,415 +0,0 @@
-;;; yaml-mode.el --- Major mode for editing YAML files
-
-;; Copyright (C) 2010-2013 Yoshiki Kurihara
-
-;; Author: Yoshiki Kurihara 
-;;         Marshall T. Vandegrift 
-;; Keywords: data yaml
-;; Version: 0.0.9
-
-;; This file is not part of Emacs
-
-;; 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 2, 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This is a major mode for editing files in the YAML data
-;; serialization format.  It was initially developed by Yoshiki
-;; Kurihara and many features were added by Marshall Vandegrift.  As
-;; YAML and Python share the fact that indentation determines
-;; structure, this mode provides indentation and indentation command
-;; behavior very similar to that of python-mode.
-
-;;; Installation:
-
-;; To install, just drop this file into a directory in your
-;; `load-path' and (optionally) byte-compile it.  To automatically
-;; handle files ending in '.yml', add something like:
-;;
-;;    (require 'yaml-mode)
-;;    (add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
-;;
-;; to your .emacs file.
-;;
-;; Unlike python-mode, this mode follows the Emacs convention of not
-;; binding the ENTER key to `newline-and-indent'.  To get this
-;; behavior, add the key definition to `yaml-mode-hook':
-;;
-;;    (add-hook 'yaml-mode-hook
-;;     '(lambda ()
-;;        (define-key yaml-mode-map "\C-m" 'newline-and-indent)))
-
-;;; Known Bugs:
-
-;; YAML is easy to write but complex to parse, and this mode doesn't
-;; even really try.  Indentation and highlighting will break on
-;; abnormally complicated structures.
-
-;;; Code:
-
-
-;; User definable variables
-
-;;;###autoload
-(defgroup yaml nil
-  "Support for the YAML serialization format"
-  :group 'languages
-  :prefix "yaml-")
-
-(defcustom yaml-mode-hook nil
-  "*Hook run by `yaml-mode'."
-  :type 'hook
-  :group 'yaml)
-
-(defcustom yaml-indent-offset 2
-  "*Amount of offset per level of indentation."
-  :type 'integer
-  :group 'yaml)
-
-(defcustom yaml-backspace-function 'backward-delete-char-untabify
-  "*Function called by `yaml-electric-backspace' when deleting backwards.
-It will receive one argument, the numeric prefix value."
-  :type 'function
-  :group 'yaml)
-
-(defcustom yaml-block-literal-search-lines 100
-  "*Maximum number of lines to search for start of block literals."
-  :type 'integer
-  :group 'yaml)
-
-(defcustom yaml-block-literal-electric-alist
-  '((?| . "") (?> . "-"))
-  "*Characters for which to provide electric behavior.
-The association list key should be a key code and the associated value
-should be a string containing additional characters to insert when
-that key is pressed to begin a block literal."
-  :type 'alist
-  :group 'yaml)
-
-(defface yaml-tab-face
-   '((((class color)) (:background "red" :foreground "red" :bold t))
-     (t (:reverse-video t)))
-  "Face to use for highlighting tabs in YAML files."
-  :group 'faces
-  :group 'yaml)
-
-(defcustom yaml-imenu-generic-expression
-  '((nil  "^\\(:?[a-zA-Z_-]+\\):"          1))
-  "The imenu regex to parse an outline of the yaml file."
-  :type 'string
-  :group 'yaml)
-
-
-;; Constants
-
-(defconst yaml-mode-version "0.0.9" "Version of `yaml-mode'.")
-
-(defconst yaml-blank-line-re "^ *$"
-  "Regexp matching a line containing only (valid) whitespace.")
-
-(defconst yaml-comment-re "\\(?:^\\|\\s-+\\)\\(#.*\\)"
-  "Regexp matching a line containing a YAML comment or delimiter.")
-
-(defconst yaml-directive-re "^\\(?:--- \\)? *%\\(\\w+\\)"
-  "Regexp matching a line contatining a YAML directive.")
-
-(defconst yaml-document-delimiter-re "^ *\\(?:---\\|[.][.][.]\\)"
-  "Rexexp matching a YAML document delimiter line.")
-
-(defconst yaml-node-anchor-alias-re "[&*][a-zA-Z0-9_-]+"
-  "Regexp matching a YAML node anchor or alias.")
-
-(defconst yaml-tag-re "!!?[^ \n]+"
-  "Rexexp matching a YAML tag.")
-
-(defconst yaml-bare-scalar-re
-  "\\(?:[^-:,#!\n{\\[ ]\\|[^#!\n{\\[ ]\\S-\\)[^#\n]*?"
-  "Rexexp matching a YAML bare scalar.")
-
-(defconst yaml-hash-key-re
-  (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *"
-          "\\(?:" yaml-tag-re " +\\)?"
-          "\\(" yaml-bare-scalar-re "\\) *:"
-          "\\(?: +\\|$\\)")
-  "Regexp matching a single YAML hash key.")
-
-(defconst yaml-scalar-context-re
-  (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *"
-          "\\(?:" yaml-bare-scalar-re " *: \\)?")
-  "Regexp indicating the begininng of a scalar context.")
-
-(defconst yaml-nested-map-re
-  (concat ".*: *\\(?:&.*\\|{ *\\|" yaml-tag-re " *\\)?$")
-  "Regexp matching a line beginning a YAML nested structure.")
-
-(defconst yaml-block-literal-base-re " *[>|][-+0-9]* *\\(?:\n\\|\\'\\)"
-  "Regexp matching the substring start of a block literal.")
-
-(defconst yaml-block-literal-re
-  (concat yaml-scalar-context-re
-          "\\(?:" yaml-tag-re "\\)?"
-          yaml-block-literal-base-re)
-  "Regexp matching a line beginning a YAML block literal.")
-
-(defconst yaml-nested-sequence-re
-  (concat "^\\(?: *- +\\)+"
-          "\\(?:" yaml-bare-scalar-re " *:\\(?: +.*\\)?\\)?$")
-  "Regexp matching a line containing one or more nested YAML sequences.")
-
-(defconst yaml-constant-scalars-re
-  (concat "\\(?:^\\|\\(?::\\|-\\|,\\|{\\|\\[\\) +\\) *"
-          (regexp-opt
-           '("~" "null" "Null" "NULL"
-             ".nan" ".NaN" ".NAN"
-             ".inf" ".Inf" ".INF"
-             "-.inf" "-.Inf" "-.INF"
-             "y" "Y" "yes" "Yes" "YES" "n" "N" "no" "No" "NO"
-             "true" "True" "TRUE" "false" "False" "FALSE"
-             "on" "On" "ON" "off" "Off" "OFF") t)
-          " *$")
-  "Regexp matching certain scalar constants in scalar context.")
-
-
-;; Mode setup
-
-(defvar yaml-mode-map ()
-  "Keymap used in `yaml-mode' buffers.")
-(if yaml-mode-map
-    nil
-  (setq yaml-mode-map (make-sparse-keymap))
-  (define-key yaml-mode-map "|" 'yaml-electric-bar-and-angle)
-  (define-key yaml-mode-map ">" 'yaml-electric-bar-and-angle)
-  (define-key yaml-mode-map "-" 'yaml-electric-dash-and-dot)
-  (define-key yaml-mode-map "." 'yaml-electric-dash-and-dot)
-  (define-key yaml-mode-map [backspace] 'yaml-electric-backspace)
-  (define-key yaml-mode-map "\C-j" 'newline-and-indent))
-
-(defvar yaml-mode-syntax-table nil
-  "Syntax table in use in `yaml-mode' buffers.")
-(if yaml-mode-syntax-table
-    nil
-  (setq yaml-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\' "\"" yaml-mode-syntax-table)
-  (modify-syntax-entry ?\" "\"" yaml-mode-syntax-table)
-  (modify-syntax-entry ?# "<" yaml-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" yaml-mode-syntax-table)
-  (modify-syntax-entry ?\\ "\\" yaml-mode-syntax-table)
-  (modify-syntax-entry ?- "w" yaml-mode-syntax-table)
-  (modify-syntax-entry ?_ "_" yaml-mode-syntax-table)
-  (modify-syntax-entry ?\( "." yaml-mode-syntax-table)
-  (modify-syntax-entry ?\) "." yaml-mode-syntax-table)
-  (modify-syntax-entry ?\{ "(}" yaml-mode-syntax-table)
-  (modify-syntax-entry ?\} "){" yaml-mode-syntax-table)
-  (modify-syntax-entry ?\[ "(]" yaml-mode-syntax-table)
-  (modify-syntax-entry ?\] ")[" yaml-mode-syntax-table))
-
-;;;###autoload
-(define-derived-mode yaml-mode fundamental-mode "YAML"
-  "Simple mode to edit YAML.
-
-\\{yaml-mode-map}"
-  (set (make-local-variable 'comment-start) "# ")
-  (set (make-local-variable 'comment-start-skip) "#+ *")
-  (set (make-local-variable 'indent-line-function) 'yaml-indent-line)
-  (set (make-local-variable 'indent-tabs-mode) nil)
-  (set (make-local-variable 'font-lock-defaults)
-       '(yaml-font-lock-keywords
-         nil nil nil nil
-         (font-lock-syntactic-keywords . yaml-font-lock-syntactic-keywords))))
-
-
-;; Font-lock support
-
-(defvar yaml-font-lock-keywords
-   (list
-    (cons yaml-comment-re '(1 font-lock-comment-face))
-    (cons yaml-constant-scalars-re '(1 font-lock-constant-face))
-    (cons yaml-tag-re '(0 font-lock-type-face))
-    (cons yaml-node-anchor-alias-re '(0 font-lock-function-name-face t))
-    (cons yaml-hash-key-re '(1 font-lock-variable-name-face t))
-    (cons yaml-document-delimiter-re '(0 font-lock-comment-face))
-    (cons yaml-directive-re '(1 font-lock-builtin-face))
-    '(yaml-font-lock-block-literals 0 font-lock-string-face t)
-    '("^[\t]+" 0 'yaml-tab-face t))
-   "Additional expressions to highlight in YAML mode.")
-
-(defvar yaml-font-lock-syntactic-keywords
-  (list '(yaml-syntactic-block-literals 0 "." t))
-  "Additional syntax features to highlight in YAML mode.")
-
-
-(defun yaml-font-lock-block-literals (bound)
-  "Find lines within block literals.
-Find the next line of the first (if any) block literal after point and
-prior to BOUND.  Returns the beginning and end of the block literal
-line in the match data, as consumed by `font-lock-keywords' matcher
-functions.  The function begins by searching backwards to determine
-whether or not the current line is within a block literal.  This could
-be time-consuming in large buffers, so the number of lines searched is
-artificially limitted to the value of
-`yaml-block-literal-search-lines'."
-  (if (eolp) (goto-char (1+ (point))))
-  (unless (or (eobp) (>= (point) bound))
-    (let ((begin (point))
-          (end (min (1+ (point-at-eol)) bound)))
-      (goto-char (point-at-bol))
-      (while (and (looking-at yaml-blank-line-re) (not (bobp)))
-        (forward-line -1))
-      (let ((nlines yaml-block-literal-search-lines)
-            (min-level (current-indentation)))
-      (forward-line -1)
-      (while (and (/= nlines 0)
-                  (/= min-level 0)
-                  (not (looking-at yaml-block-literal-re))
-                  (not (bobp)))
-        (set 'nlines (1- nlines))
-        (unless (looking-at yaml-blank-line-re)
-          (set 'min-level (min min-level (current-indentation))))
-        (forward-line -1))
-      (cond
-       ((and (< (current-indentation) min-level)
-             (looking-at yaml-block-literal-re))
-          (goto-char end) (set-match-data (list begin end)) t)
-         ((progn
-            (goto-char begin)
-            (re-search-forward (concat yaml-block-literal-re
-                                       " *\\(.*\\)\n")
-                               bound t))
-          (set-match-data (nthcdr 2 (match-data))) t))))))
-
-(defun yaml-syntactic-block-literals (bound)
-  "Find quote characters within block literals.
-Finds the first quote character within a block literal (if any) after
-point and prior to BOUND.  Returns the position of the quote character
-in the match data, as consumed by matcher functions in
-`font-lock-syntactic-keywords'.  This allows the mode to treat ['\"]
-characters in block literals as punctuation syntax instead of string
-syntax, preventing unmatched quotes in block literals from painting
-the entire buffer in `font-lock-string-face'."
-  (let ((found nil))
-    (while (and (not found)
-                (/= (point) bound)
-                (yaml-font-lock-block-literals bound))
-      (let ((begin (match-beginning 0)) (end (match-end 0)))
-        (goto-char begin)
-        (cond
-         ((re-search-forward "['\"]" end t) (setq found t))
-         ((goto-char end)))))
-    found))
-
-
-;; Indentation and electric keys
-
-(defun yaml-compute-indentation ()
-  "Calculate the maximum sensible indentation for the current line."
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at yaml-document-delimiter-re) 0
-      (forward-line -1)
-      (while (and (looking-at yaml-blank-line-re)
-                  (> (point) (point-min)))
-        (forward-line -1))
-      (+ (current-indentation)
-         (if (looking-at yaml-nested-map-re) yaml-indent-offset 0)
-         (if (looking-at yaml-nested-sequence-re) yaml-indent-offset 0)
-         (if (looking-at yaml-block-literal-re) yaml-indent-offset 0)))))
-
-(defun yaml-indent-line ()
-  "Indent the current line.
-The first time this command is used, the line will be indented to the
-maximum sensible indentation.  Each immediately subsequent usage will
-back-dent the line by `yaml-indent-offset' spaces.  On reaching column
-0, it will cycle back to the maximum sensible indentation."
-  (interactive "*")
-  (let ((ci (current-indentation))
-        (cc (current-column))
-        (need (yaml-compute-indentation)))
-    (save-excursion
-      (beginning-of-line)
-      (delete-horizontal-space)
-      (if (and (equal last-command this-command) (/= ci 0))
-          (indent-to (* (/ (- ci 1) yaml-indent-offset) yaml-indent-offset))
-        (indent-to need)))
-      (if (< (current-column) (current-indentation))
-          (forward-to-indentation 0))))
-
-(defun yaml-electric-backspace (arg)
-  "Delete characters or back-dent the current line.
-If invoked following only whitespace on a line, will back-dent to the
-immediately previous multiple of `yaml-indent-offset' spaces."
-  (interactive "*p")
-  (if (or (/= (current-indentation) (current-column)) (bolp))
-      (funcall yaml-backspace-function arg)
-    (let ((ci (current-column)))
-      (beginning-of-line)
-      (delete-horizontal-space)
-      (indent-to (* (/ (- ci (* arg yaml-indent-offset))
-                       yaml-indent-offset)
-                    yaml-indent-offset)))))
-
-(defun yaml-electric-bar-and-angle (arg)
-  "Insert the bound key and possibly begin a block literal.
-Inserts the bound key.  If inserting the bound key causes the current
-line to match the initial line of a block literal, then inserts the
-matching string from `yaml-block-literal-electric-alist', a newline,
-and indents appropriately."
-  (interactive "*P")
-  (self-insert-command (prefix-numeric-value arg))
-  (let ((extra-chars
-         (assoc last-command-event
-                yaml-block-literal-electric-alist)))
-    (cond
-     ((and extra-chars (not arg) (eolp)
-           (save-excursion
-             (beginning-of-line)
-             (looking-at yaml-block-literal-re)))
-      (insert (cdr extra-chars))
-      (newline-and-indent)))))
-
-(defun yaml-electric-dash-and-dot (arg)
-  "Insert the bound key and possibly de-dent line.
-Inserts the bound key.  If inserting the bound key causes the current
-line to match a document delimiter, de-dent the line to the left
-margin."
-  (interactive "*P")
-  (self-insert-command (prefix-numeric-value arg))
-  (save-excursion
-    (beginning-of-line)
-    (if (and (not arg) (looking-at yaml-document-delimiter-re))
-        (delete-horizontal-space))))
-
-
-(defun yaml-set-imenu-generic-expression ()
-  (make-local-variable 'imenu-generic-expression)
-  (make-local-variable 'imenu-create-index-function)
-  (setq imenu-create-index-function 'imenu-default-create-index-function)
-  (setq imenu-generic-expression yaml-imenu-generic-expression))
-
-(add-hook 'yaml-mode-hook 'yaml-set-imenu-generic-expression)
-
-
-(defun yaml-mode-version ()
-  "Diplay version of `yaml-mode'."
-  (interactive)
-  (message "yaml-mode %s" yaml-mode-version)
-  yaml-mode-version)
-
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.ya?ml$" . yaml-mode))
-
-(provide 'yaml-mode)
-
-;;; yaml-mode.el ends here