diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/battery.el | 279 | ||||
| -rw-r--r-- | lisp/emacs-lisp/easy-mmode.el | 169 | ||||
| -rw-r--r-- | lisp/filecache.el | 666 | ||||
| -rw-r--r-- | lisp/progmodes/meta-mode.el | 1099 |
4 files changed, 2213 insertions, 0 deletions
diff --git a/lisp/battery.el b/lisp/battery.el new file mode 100644 index 00000000000..b04b6af369f --- /dev/null +++ b/lisp/battery.el @@ -0,0 +1,279 @@ +;;; battery.el --- display battery status information. + +;; Copyright (C) 1997 Ralph Schleicher + +;; Author: Ralph Schleicher <rs@purple.UL.BaWue.DE> +;; Keywords: local hardware + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with 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: + +;; There is at present only a function interpreting the new `/proc/apm' +;; file format of Linux version 1.3.58 or newer. That is, what a lucky +;; coincidence, exactly the interface provided by the author's labtop. + +;;; Code: + +(require 'timer) + + +(defvar battery-status-function + (cond ((and (eq system-type 'gnu/linux) + (file-readable-p "/proc/apm")) + 'battery-linux-proc-apm)) + "*Function for getting battery status information. +The function have to return an alist of conversion definitions. +Cons cells are of the form + + (CONVERSION . REPLACEMENT-TEXT) + +CONVERSION is the character code of a \"conversion specification\" +introduced by a `%' character in a control string.") + +(defvar battery-echo-area-format + (cond ((eq battery-status-function 'battery-linux-proc-apm) + "Power %L, battery %B (%p%% load, remaining time %t)")) + "*Control string formatting the string to display in the echo area. +Ordinary characters in the control string are printed as-is, while +conversion specifications introduced by a `%' character in the control +string are substituted as defined by the current value of the variable +`battery-status-function'.") + +(defvar battery-mode-line-string nil + "String to display in the mode line.") + +(defvar battery-mode-line-format + (cond ((eq battery-status-function 'battery-linux-proc-apm) + " [%b%p%%]")) + "*Control string formatting the string to display in the mode line. +Ordinary characters in the control string are printed as-is, while +conversion specifications introduced by a `%' character in the control +string are substituted as defined by the current value of the variable +`battery-status-function'.") + +(defvar battery-update-interval 60 + "*Seconds after which the battery status will be updated.") + +(defvar battery-update-timer nil + "Interval timer object.") + +;;;### autoload +(defun battery () + "Display battery status information in the echo area. +The text beeing displayed in the echo area is controlled by the variables +`battery-echo-area-format' and `battery-status-function'." + (interactive) + (message "%s" (if (and battery-echo-area-format battery-status-function) + (battery-format battery-echo-area-format + (funcall battery-status-function)) + "Battery status not available"))) + +;;;### autoload +(defun display-battery () + "Display battery status information in the mode line. +The text beeing displayed in the mode line is controlled by the variables +`battery-mode-line-format' and `battery-status-function'. +The mode line will be updated automatically every `battery-update-interval' +seconds." + (interactive) + (setq battery-mode-line-string "") + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'battery-mode-line-string global-mode-string) + (setq global-mode-string (append global-mode-string + '(battery-mode-line-string)))) + (and battery-update-timer (cancel-timer battery-update-timer)) + (setq battery-update-timer (run-at-time nil battery-update-interval + 'battery-update-handler)) + (battery-update)) + +(defun battery-update-handler () + (battery-update) + (sit-for 0)) + +(defun battery-update () + "Update battery status information in the mode line." + (setq battery-mode-line-string (if (and battery-mode-line-format + battery-status-function) + (battery-format + battery-mode-line-format + (funcall battery-status-function)) + "")) + (force-mode-line-update)) + + +;;; `/proc/apm' interface for Linux. + +(defconst battery-linux-proc-apm-regexp + (concat "^\\([^ ]+\\)" ; Driver version. + " \\([^ ]+\\)" ; APM BIOS version. + " 0x\\([0-9a-f]+\\)" ; APM BIOS flags. + " 0x\\([0-9a-f]+\\)" ; AC line status. + " 0x\\([0-9a-f]+\\)" ; Battery status. + " 0x\\([0-9a-f]+\\)" ; Battery flags. + " \\([0-9]+\\)%" ; Load percentage. + " \\([0-9]+\\)" ; Remaining time. + " \\(.*\\)" ; Time unit. + "$") + "Regular expression matching contents of `/proc/apm'.") + +(defun battery-linux-proc-apm () + "Get APM status information from Linux kernel. +This function works only with the new `/proc/apm' format introduced +in Linux version 1.3.58. + +The following %-sequences are provided: +%v Linux driver version +%V APM BIOS version +%I APM BIOS status (verbose) +%L AC line status (verbose) +%B Battery status (verbose) +%b Battery status, empty means high, `-' means low, + `!' means critical, and `+' means charging +%p battery load percentage +%s Remaining time in seconds +%m Remaining time in minutes +%h Remaining time in hours +%t Remaining time in the form `h:min'" + (let (driver-version bios-version bios-interface line-status + battery-status battery-status-symbol load-percentage + seconds minutes hours remaining-time buffer tem) + (unwind-protect + (save-excursion + (setq buffer (generate-new-buffer " *battery*")) + (buffer-disable-undo buffer) + (set-buffer buffer) + (battery-insert-file-contents "/proc/apm") + (re-search-forward battery-linux-proc-apm-regexp) + (setq driver-version (match-string 1)) + (setq bios-version (match-string 2)) + (setq tem (battery-hex-to-int-2 (match-string 3))) + (if (not (logand tem 2)) + (setq bios-interface "not supported") + (setq bios-interface "enabled") + (cond ((logand tem 16) (setq bios-interface "disabled")) + ((logand tem 32) (setq bios-interface "disengaged"))) + (setq tem (battery-hex-to-int-2 (match-string 4))) + (cond ((= tem 0) (setq line-status "off-line")) + ((= tem 1) (setq line-status "on-line")) + ((= tem 2) (setq line-status "on backup"))) + (setq tem (battery-hex-to-int-2 (match-string 6))) + (if (= tem 255) + (setq battery-status "N/A") + (setq tem (battery-hex-to-int-2 (match-string 5))) + (cond ((= tem 0) (setq battery-status "high" + battery-status-symbol "")) + ((= tem 1) (setq battery-status "low" + battery-status-symbol "-")) + ((= tem 2) (setq battery-status "critical" + battery-status-symbol "!")) + ((= tem 3) (setq battery-status "charging" + battery-status-symbol "+"))) + (setq load-percentage (match-string 7)) + (setq seconds (string-to-number (match-string 8))) + (and (string-equal (match-string 9) "min") + (setq seconds (* 60 seconds))) + (setq minutes (/ seconds 60) + hours (/ seconds 3600)) + (setq remaining-time + (format "%d:%02d" hours (- minutes (* 60 hours))))))) + (and buffer (kill-buffer buffer))) + (list (cons ?v driver-version) + (cons ?V bios-version) + (cons ?I bios-interface) + (cons ?L line-status) + (cons ?B battery-status) + (cons ?b battery-status-symbol) + (cons ?p load-percentage) + (cons ?s (and seconds (number-to-string seconds))) + (cons ?m (and minutes (number-to-string minutes))) + (cons ?h (and hours (number-to-string hours))) + (cons ?t remaining-time)))) + + +;;; Private functions. + +(defun battery-format (format alist) + "Substitute %-sequences in FORMAT." + (let ((index 0) + (length (length format)) + (result "") + char flag elem) + (while (< index length) + (setq char (aref format index)) + (if (not flag) + (if (char-equal char ?%) + (setq flag t) + (setq result (concat result (char-to-string char)))) + (cond ((char-equal char ?%) + (setq result (concat result "%"))) + ((setq elem (assoc char alist)) + (setq result (concat result (cdr elem))))) + (setq flag nil)) + (setq index (1+ index))) + (or (null flag) + (setq result (concat result "%"))) + result)) + +(defun battery-insert-file-contents (file-name) + "Insert contents of file FILE-NAME after point. +FILE-NAME can be a non-ordinary file, for example, a named pipe. +Return t if file exists." + (let ((load-read-function 'battery-read-function) + (load-path '(".")) + (load-history nil)) + (save-excursion + (load file-name nil t t)))) + +(defun battery-read-function (&optional stream) + "Function for reading expressions from STREAM. +Value is always nil." + (let (char) + (while (not (< (setq char (get-file-char)) 0)) + (insert char)))) + +(defconst battery-hex-map '((?0 . 0) (?1 . 1) (?2 . 2) (?3 . 3) + (?4 . 4) (?5 . 5) (?6 . 6) (?7 . 7) + (?8 . 8) (?9 . 9) (?a . 10) (?b . 11) + (?c . 12) (?d . 13) (?e . 14) (?f . 15))) + +(defun battery-hex-to-int (string) + "Convert a hexadecimal number (a string) into a number." + (save-match-data + (and (string-match "^[ \t]+" string) + (setq string (substring string (match-end 0)))) + (and (string-match "^0[xX]" string) + (setq string (substring string (match-end 0))))) + (battery-hex-to-int-2 string)) + +(defun battery-hex-to-int-2 (string) + (let ((index 0) + (length (length string)) + (value 0) + (elem nil)) + (while (and (< index length) + (setq elem (assoc (downcase (aref string index)) + battery-hex-map))) + (setq value (+ (* 16 value) (cdr elem)) + index (1+ index))) + value)) + + +(provide 'battery) + +;;; battery.el ends here diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el new file mode 100644 index 00000000000..866b32ccc8f --- /dev/null +++ b/lisp/emacs-lisp/easy-mmode.el @@ -0,0 +1,169 @@ +;;; easy-mmode.el --- easy definition of minor modes. + +;; Copyright (C) 1997 Free Software Foundation, Inc. + +;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> + +;; 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 2, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Minor modes are useful and common. This package makes defining a +;; minor mode easy, by focusing on the writing of the minor mode +;; functionalities themselves. Moreover, this package enforces a +;; conventional naming of user interface primitives, making things +;; natural for the minor-mode end-users. + +;; For each mode, easy-mmode defines the following: +;; <mode> : The minor mode predicate. A buffer-local variable. +;; <mode>-map : The keymap possibly associated to <mode>. +;; <mode>-hook,<mode>-on-hook,<mode>-off-hook and <mode>-mode: +;; see `easy-mmode-define-minor-mode' documentation +;; +;; eval +;; (pp (macroexpand '(easy-mmode-define-minor-mode <your-mode> <doc>))) +;; to check the result before using it. + +;; The order in which minor modes are installed is important. Keymap +;; lookup proceeds down minor-mode-map-alist, and the order there +;; tends to be the reverse of the order in which the modes were +;; installed. Perhaps there should be a feature to let you specify +;; orderings. + +;;; Code: + +(defun easy-mmode-define-keymap (keymap-alist &optional menu-name) + "Return a keymap builded from KEYMAP-ALIST. +KEYMAP-ALIST must be a list of (KEYBINDING . BINDING) where +KEYBINDING and BINDINGS are suited as for define-key. +optional MENU-NAME is passed to `make-sparse-keymap'." + (let ((keymap (make-sparse-keymap menu-name))) + (mapcar + (function (lambda (bind) + (define-key keymap + (car bind) (cdr bind)))) + keymap-alist) + keymap)) + +(defmacro easy-mmode-define-toggle (mode &optional doc) + "Define a one arg toggle mode MODE function and associated hooks. +MODE-mode is the so defined function that toggle the mode. +optional DOC is its associated documentation. + +Hooks are checked for run, each time MODE-mode is called. +They run under the followings conditions: +MODE-hook: if the mode is toggled. +MODE-on-hook: if the mode is on. +MODE-off-hook: if the mode is off. + +When the mode is effectively toggled, two hooks may run. +If so MODE-hook is guaranteed to be the first. + +\(defmacro easy-mmode-define-toggle (MODE &optional DOC)" + (let* ((mode-name + (if (string-match "-mode\\'" (symbol-name mode)) + (symbol-name mode) + (concat (symbol-name mode) "-mode"))) + (hook (intern (concat mode-name "-hook"))) + (hook-on (intern (concat mode-name "-on-hook"))) + (hook-off (intern (concat mode-name "-off-hook"))) + (toggle (intern mode-name)) + (mode toggle) + (toggle-doc (or doc + (format "With no argument, toggle %s mode. +With arg turn mode on. +With zero or negative arg turn mode off" + mode-name)))) + `(progn + (defvar ,hook nil + ,(format "Hook called when %s mode is toggled" mode-name)) + + (defvar ,hook-on nil + ,(format "Hook called when %s mode is turned on" mode-name)) + + (defvar ,hook-off nil + ,(format "Hook called when %s mode is turned off" mode-name)) + + (defun ,toggle (&optional arg) + ,toggle-doc + (interactive "P") + (let ((old-mode ,mode)) + (setq ,mode + (if arg + (or (listp arg);; C-u alone + (> (prefix-numeric-value arg) 0)) + (not ,mode))) + (and ,hook + (not (equal old-mode ,mode)) + (run-hooks ',hook)) + (and ,hook-on + ,mode + (run-hooks ',hook-on)) + (and ,hook-off + (not ,mode) + (run-hooks ',hook-off))))))) + +;;;###autoload +(defmacro easy-mmode-define-minor-mode + (mode doc &optional init-value &optional lighter &optional keymap) + "Define a new minor mode MODE. +This function defines the associated control variable, keymap, +toggle command, and hooks (see `easy-mmode-define-toggle'). + +DOC is the documentation for the mode toggle command. +Optional LIGHTER is displayed in the mode-bar when the mode is on. +Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. +If it is a list, it is passed to `easy-mmode-define-keymap' +in order to build a valid keymap. + +\(defmacro easy-mmode-define-minor-mode + (MODE DOC &optional INIT-VALUE &optional LIGHTER &optional KEYMAP)...\)" + (let* ((mode-name (symbol-name mode)) + (mode-doc (format "%s mode control switch." mode-name)) + (keymap-name (concat mode-name "-map")) + (keymap-doc (format "Keymap activated when %s mode is on." mode-name))) + `(progn + ;; define the switch + (defvar ,mode ,init-value ,mode-doc) + (make-variable-buffer-local ',mode) + + ;; define the minor-mode keymap + (defvar ,(intern keymap-name) + (cond ((and ,keymap (keymapp ,keymap)) + ,keymap) + ((listp ,keymap) + (easy-mmode-define-keymap ,keymap)) + (t (error "Invalid keymap %S" ,keymap))) + ,keymap-doc) + + ;; define the toggle and the hooks + ,(macroexpand `(easy-mmode-define-toggle ,mode ,doc)) ; toggle and hooks + + ;; update the mode-bar + (or (assq ',mode minor-mode-alist) + (setq minor-mode-alist + (cons (list ',mode ,lighter) minor-mode-alist))) + + ;; update the minor-mode-map + (or (assq ',mode minor-mode-map-alist) + (setq minor-mode-map-alist + (cons (cons ',mode ,(intern keymap-name)) minor-mode-map-alist)))) )) + +(provide 'easy-mmode) + +;;; easy-mmode.el ends here diff --git a/lisp/filecache.el b/lisp/filecache.el new file mode 100644 index 00000000000..e8a55ac1645 --- /dev/null +++ b/lisp/filecache.el @@ -0,0 +1,666 @@ +;;; filecache.el --- Find files using a pre-loaded cache +;; +;; Author: Peter Breton +;; Created: Sun Nov 10 1996 +;; Version: $Id: filecache.el,v 1.13 1997/02/07 22:27:51 pbreton Exp $ +;; Keywords: +;; Time-stamp: <97/02/07 17:26:54 peter> +;; +;; Copyright (C) Peter Breton Thu Dec 12 1996 +;; +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; filecache.el 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;; LCD Archive Entry: +;; filecache.el|Peter Breton|pbreton@i-kinetics.com| +;; Find files using a pre-loaded cache| +;; Thu Dec 12 1996|1.0|~/misc/filecache.el.gz| +;; +;; Purpose: +;; +;; Find files using a pre-loaded cache +;; +;;; Commentary: +;; +;; The file-cache package is an attempt to make it easy to locate files +;; by name, without having to remember exactly where they are located. +;; This is very handy when working with source trees. You can also add +;; frequently used files to the cache to create a hotlist effect. +;; The cache can be used with any interactive command which takes a +;; filename as an argument. +;; +;; It is worth noting that this package works best when most of the files +;; in the cache have unique names, or (if they have the same name) exist in +;; only a few directories. The worst case is many files all with +;; the same name and in different directories, for example a big source tree +;; with a Makefile in each directory. In such a case, you should probably +;; use an alternate strategy to find the files. +;; +;; ADDING FILES TO THE CACHE: +;; +;; Use the following functions to add items to the file cache: +;; +;; * `file-cache-add-file': Adds a single file to the cache +;; +;; * `file-cache-add-file-list': Adds a list of files to the cache +;; +;; The following functions use the regular expressions in +;; `file-cache-delete-regexps' to eliminate unwanted files: +;; +;; * `file-cache-add-directory': Adds the files in a directory to the +;; cache. You can also specify a regular expression to match the files +;; which should be added. +;; +;; * `file-cache-add-directory-list': Same as above, but acts on a list +;; of directories. You can use `load-path', `exec-path' and the like. +;; +;; * `file-cache-add-directory-using-find': Uses the `find' command to +;; add a directory tree to the cache. +;; +;; * `file-cache-add-directory-using-locate': Uses the `locate' command to +;; add files matching a pattern to the cache. +;; +;; Use the function `file-cache-clear-cache' to remove all items from the +;; cache. There are a number of `file-cache-delete' functions provided +;; as well, but in general it is probably better to not worry too much +;; about extra files in the cache. +;; +;; The most convenient way to initialize the cache is with an +;; `eval-after-load' function, as noted in the INSTALLATION section. +;; +;; FINDING FILES USING THE CACHE: +;; +;; You can use the file-cache with any function that expects a filename as +;; an argument. For example: +;; +;; 1) Invoke a function which expects a filename as an argument: +;; M-x find-file +;; +;; 2) Begin typing a file name. +;; +;; 3) Invoke `file-cache-minibuffer-complete' (bound by default to +;; C-TAB) to complete on the filename using the cache. +;; +;; 4) When you have found a unique completion, the minibuffer contents +;; will change to the full name of that file. +;; +;; If there are a number of directories which contain the completion, +;; invoking `file-cache-minibuffer-complete' repeatedly will cycle through +;; them. +;; +;; 5) You can then edit the minibuffer contents, or press RETURN. +;; +;; It is much easier to simply try it than trying to explain it :) +;; +;;; INSTALLATION +;; +;; Insert the following into your .emacs: +;; +;; (autoload 'file-cache-minibuffer-complete "filecache" nil t) +;; +;; For maximum utility, you should probably define an `eval-after-load' +;; form which loads your favorite files: +;; +;; (eval-after-load +;; "filecache" +;; '(progn +;; (message "Loading file cache...") +;; (file-cache-add-directory-using-find "~/projects") +;; (file-cache-add-directory-list load-path) +;; (file-cache-add-directory "~/") +;; (file-cache-add-file-list (list "~/foo/bar" "~/baz/bar")) +;; )) +;; +;; If you clear and reload the cache frequently, it is probably easiest +;; to put your initializations in a function: +;; +;; (eval-after-load +;; "filecache" +;; '(my-file-cache-initialize)) +;; +;; (defun my-file-cache-initialize () +;; (interactive) +;; (message "Loading file cache...") +;; (file-cache-add-directory-using-find "~/projects") +;; (file-cache-add-directory-list load-path) +;; (file-cache-add-directory "~/") +;; (file-cache-add-file-list (list "~/foo/bar" "~/baz/bar")) +;; )) +;; +;; Of course, you can still add files to the cache afterwards, via +;; Lisp functions. +;; +;; RELATED WORK: +;; +;; This package is a distant relative of Noah Friedman's fff utilities. +;; Our goal is pretty similar, but the implementation strategies are +;; different. +;; +;;; Change log: +;; $Log: filecache.el,v $ +;; Revision 1.13 1997/02/07 22:27:51 pbreton +;; Keybindings use autoload cookies instead of variable +;; +;; Revision 1.12 1997/02/07 22:02:29 pbreton +;; Added small changes suggested by RMS: +;; Revamped the doc strings +;; Added keybindings (using `file-cache-default-minibuffer-key' variable) +;; +;; Revision 1.11 1997/02/01 16:44:47 pbreton +;; Changed `file-cache-directory-name' function. Instead of using a +;; completing-read, it cycles through the directory list. +;; +;; Eliminated bug where file-cache-file-name was called twice per completion. +;; +;; Revision 1.10 1997/01/26 05:44:24 pbreton +;; Added file-cache-delete functions +;; Added file-cache-completions-buffer variable +;; Added file-cache-completions-keymap variable +;; Changed file-cache-completion-setup-function to use +;; file-cache-completions-keymap +;; Added file-cache-choose-completion and file-cache-mouse-choose-completion. +;; These rely on a patch to 'simple.el' +;; Added file-cache-debug-read-from-minibuffer function +;; +;; Revision 1.9 1997/01/17 17:54:24 pbreton +;; File names are no longer case-insensitive; this was tolerable on NT but +;; not on Unix. Instead, file-cache-minibuffer-complete checks to see if the +;; last command was itself, and if the same string is in the minibuffer. If so, +;; this string is used for completion. +;; +;; Added some functions to delete from the file-cache +;; +;; Completing-read of directories requires temporary binding of +;; enable-recursive-minibuffers variable. +;; +;; Revision 1.8 1997/01/17 14:01:08 pbreton +;; Changed file-cache-minibuffer-complete so that it operates in the +;; minibuffer instead of as a recursive minibuffer call. +;; +;; File-cache-alist now expects a filename and a list of directories (there +;; should be at least one). If the list has only one element, that element +;; is used; if it has multiple directories, the user is prompted to choose +;; one. +;; +;; File names in the cache are now canonicalized to lowercase, to resolve a +;; problem which occurs when the cache has files like README and readme. +;; +;; Removed a lot of the extra completion functions which weren't used. +;; +;; Revision 1.7 1996/12/29 15:48:28 pbreton +;; Added functions: +;; `file-cache-minibuffer-complete-using-suffix' +;; `file-cache-minibuffer-complete-with-directory-filter' +;; `file-cache-minibuffer-complete-with-filename-filter' +;; Added documentation for these functions +;; +;; Revision 1.6 1996/12/24 20:27:56 pbreton +;; Added predicate functions to `file-cache-minibuffer-complete' +;; +;; Revision 1.5 1996/12/14 18:05:11 pbreton +;; Fixed uniquify bug by using `member' instead of `memq' +;; Made file-cache-add-* prompts more descriptive +;; More documentation +;; +;; Revision 1.4 1996/12/13 14:42:37 pbreton +;; Removed `file-cache-top-directory' variable +;; Changed file-cache-initialize to file-cache-add-from-file-cache-buffer +;; Regexp to match files in file-cache-buffer is now a variable +;; +;; Revision 1.3 1996/12/12 06:01:27 peter +;; Added `file-cache-add-file' and `file-cache-add-file-list' functions +;; +;; Revision 1.2 1996/12/12 05:47:49 peter +;; Fixed uniquifying bug +;; Added directory functions +;; `file-cache-find-file' now uses file-cache-file-name +;; `file-cache-minibuffer-complete' handles string completion correctly. +;; It also prepends `file-cache-minibuffer-prompt' to the normal prompt +;; +;; Revision 1.1 1996/11/26 12:12:43 peter +;; Initial revision +;; +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Variables +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; User-modifiable variables +(defvar file-cache-filter-regexps + (list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$" + "\\.$" "#$") + "*List of regular expressions used as filters by the file cache. +File names which match these expressions will not be added to the cache. +Note that the functions `file-cache-add-file' and `file-cache-add-file-list' +do not use this variable.") + +(defvar file-cache-find-command "find" + "*External program used by `file-cache-add-directory-using-find'.") + +(defvar file-cache-locate-command "locate" + "*External program used by `file-cache-add-directory-using-locate'.") + +;; Minibuffer messages +(defvar file-cache-no-match-message " [File Cache: No match]" + "Message to display when there is no completion.") + +(defvar file-cache-sole-match-message " [File Cache: sole completion]" + "Message to display when there is only one completion.") + +(defvar file-cache-non-unique-message " [File Cache: complete but not unique]" + "Message to display when there is a non-unique completion.") + +(defvar file-cache-multiple-directory-message nil) + +;; Internal variables +;; This should be named *Completions* because that's what the function +;; switch-to-completions in simple.el expects +(defvar file-cache-completions-buffer "*Completions*" + "Buffer to display completions when using the file cache.") + +(defvar file-cache-buffer "*File Cache*" + "Buffer to hold the cache of file names.") + +(defvar file-cache-buffer-default-regexp "^.+$" + "Regexp to match files in `file-cache-buffer'.") + +(defvar file-cache-last-completion nil) + +(defvar file-cache-alist nil + "Internal data structure to hold cache of file names.") + +(defvar file-cache-completions-keymap nil + "Keymap for file cache completions buffer.") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions to add files to the cache +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun file-cache-add-directory (directory &optional regexp) + "Add DIRECTORY to the file cache. +If the optional REGEXP argument is non-nil, only files which match it will +be added to the cache." + (interactive "DAdd files from directory: ") + (let* ((dir (expand-file-name directory)) + (dir-files (directory-files dir t regexp)) + ) + ;; Filter out files we don't want to see + (mapcar + '(lambda (file) + (mapcar + '(lambda (regexp) + (if (string-match regexp file) + (setq dir-files (delq file dir-files)))) + file-cache-filter-regexps)) + dir-files) + (file-cache-add-file-list dir-files))) + +(defun file-cache-add-directory-list (directory-list &optional regexp) + "Add DIRECTORY-LIST (a list of directory names) to the file cache. +If the optional REGEXP argument is non-nil, only files which match it +will be added to the cache. Note that the REGEXP is applied to the files +in each directory, not to the directory list itself." + (interactive "XAdd files from directory list: ") + (mapcar + '(lambda (dir) (file-cache-add-directory dir regexp)) + directory-list)) + +(defun file-cache-add-file-list (file-list) + "Add FILE-LIST (a list of files names) to the file cache." + (interactive "XFile List: ") + (mapcar 'file-cache-add-file file-list)) + +;; Workhorse function +(defun file-cache-add-file (file) + "Add FILE to the file cache." + (interactive "fAdd File: ") + (let* ((file-name (file-name-nondirectory file)) + (dir-name (file-name-directory file)) + (the-entry (assoc file-name file-cache-alist)) + ) + ;; Does the entry exist already? + (if the-entry + (if (or (and (stringp (cdr the-entry)) + (string= dir-name (cdr the-entry))) + (and (listp (cdr the-entry)) + (member dir-name (cdr the-entry)))) + nil + (setcdr the-entry (append (list dir-name) (cdr the-entry))) + ) + ;; If not, add it to the cache + (setq file-cache-alist + (cons (cons file-name (list dir-name)) + file-cache-alist))) + )) + +(defun file-cache-add-directory-using-find (directory) + "Use the `find' command to add files to the file cache. +Find is run in DIRECTORY." + (interactive "DAdd files under directory: ") + (let ((dir (expand-file-name directory))) + (set-buffer (get-buffer-create file-cache-buffer)) + (erase-buffer) + (call-process file-cache-find-command nil + (get-buffer file-cache-buffer) nil + dir "-name" + (if (memq system-type + (list 'windows-nt 'ms-dos)) "'*'" "*") + "-print") + (file-cache-add-from-file-cache-buffer))) + +(defun file-cache-add-directory-using-locate (string) + "Use the `locate' command to add files to the file cache. +STRING is passed as an argument to the locate command." + (interactive "sAdd files using locate string: ") + (set-buffer (get-buffer-create file-cache-buffer)) + (erase-buffer) + (call-process file-cache-locate-command nil + (get-buffer file-cache-buffer) nil + string) + (file-cache-add-from-file-cache-buffer)) + +(defun file-cache-add-from-file-cache-buffer (&optional regexp) + "Add any entries found in the file cache buffer. +Each entry matches the regular expression `file-cache-buffer-default-regexp' +or the optional REGEXP argument." + (set-buffer file-cache-buffer) + (mapcar + (function (lambda (elt) + (goto-char (point-min)) + (delete-matching-lines elt))) + file-cache-filter-regexps) + (goto-char (point-min)) + (let ((full-filename)) + (while (re-search-forward + (or regexp file-cache-buffer-default-regexp) + (point-max) t) + (setq full-filename (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (file-cache-add-file full-filename)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions to delete from the cache +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun file-cache-clear-cache () + "Clear the file cache." + (interactive) + (setq file-cache-alist nil)) + +;; This clears *all* files with the given name +(defun file-cache-delete-file (file) + "Delete FILE from the file cache." + (interactive + (list (completing-read "Delete file from cache: " file-cache-alist))) + (setq file-cache-alist + (delq (assoc file file-cache-alist) file-cache-alist))) + +(defun file-cache-delete-file-list (file-list) + "Delete FILE-LIST (a list of files) from the file cache." + (interactive "XFile List: ") + (mapcar 'file-cache-delete-file file-list)) + +(defun file-cache-delete-file-regexp (regexp) + "Delete files matching REGEXP from the file cache." + (interactive "sRegexp: ") + (let ((delete-list)) + (mapcar '(lambda (elt) + (and (string-match regexp (car elt)) + (setq delete-list (cons (car elt) delete-list)))) + file-cache-alist) + (file-cache-delete-file-list delete-list) + (message "Deleted %d files from file cache" (length delete-list)))) + +(defun file-cache-delete-directory (directory) + "Delete DIRECTORY from the file cache." + (interactive "DDelete directory from file cache: ") + (let ((dir (expand-file-name directory)) + (result 0)) + (mapcar + '(lambda (entry) + (if (file-cache-do-delete-directory dir entry) + (setq result (1+ result)))) + file-cache-alist) + (if (zerop result) + (error "No entries containing %s found in cache" directory) + (message "Deleted %d entries" result)))) + +(defun file-cache-do-delete-directory (dir entry) + (let ((directory-list (cdr entry)) + (directory (file-cache-canonical-directory dir)) + ) + (and (member directory directory-list) + (if (equal 1 (length directory-list)) + (setq file-cache-alist + (delq entry file-cache-alist)) + (setcdr entry (delete directory directory-list))) + ) + )) + +(defun file-cache-delete-directory-list (directory-list) + "Delete DIRECTORY-LIST (a list of directories) from the file cache." + (interactive "XDirectory List: ") + (mapcar 'file-cache-delete-directory directory-list)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Utility functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Returns the name of a directory for a file in the cache +(defun file-cache-directory-name (file) + (let* ((directory-list (cdr (assoc file file-cache-alist))) + (len (length directory-list)) + (directory) + (num) + ) + (if (not (listp directory-list)) + (error "Unknown type in file-cache-alist for key %s" file)) + (cond + ;; Single element + ((eq 1 len) + (setq directory (elt directory-list 0))) + ;; No elements + ((eq 0 len) + (error "No directory found for key %s" file)) + ;; Multiple elements + (t + (let* ((minibuffer-dir (file-name-directory (buffer-string))) + (dir-list (member minibuffer-dir directory-list)) + ) + (setq directory + ;; If the directory is in the list, return the next element + ;; Otherwise, return the first element + (if dir-list + (or (elt directory-list + (setq num (1+ (- len (length dir-list))))) + (elt directory-list (setq num 0))) + (elt directory-list (setq num 0)))) + ) + ) + ) + ;; If there were multiple directories, set up a minibuffer message + (setq file-cache-multiple-directory-message + (and num (format " [%d of %d]" (1+ num) len))) + directory)) + +;; Returns the name of a file in the cache +(defun file-cache-file-name (file) + (let ((directory (file-cache-directory-name file))) + (concat directory file))) + +;; Return a canonical directory for comparison purposes. +;; Such a directory ends with a forward slash. +(defun file-cache-canonical-directory (dir) + (let ((directory dir)) + (if (not (char-equal ?/ (string-to-char (substring directory -1)))) + (concat directory "/") + directory))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Minibuffer functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun file-cache-minibuffer-complete () + "Complete a filename in the minibuffer using a preloaded cache." + (interactive) + (let* + ( + (completion-ignore-case nil) + (case-fold-search nil) + (string (file-name-nondirectory (buffer-string))) + (completion-string (try-completion string file-cache-alist)) + (completion-list) + (len) + (file-cache-string) + ) + (cond + ;; If it's the longest match, insert it + ((stringp completion-string) + ;; If we've already inserted a unique string, see if the user + ;; wants to use that one + (if (and (string= string completion-string) + (assoc string file-cache-alist)) + (if (and (eq last-command this-command) + (string= file-cache-last-completion completion-string)) + (progn + (erase-buffer) + (insert-string (file-cache-file-name completion-string)) + (setq file-cache-last-completion nil) + ) + (file-cache-temp-minibuffer-message file-cache-non-unique-message) + (setq file-cache-last-completion string) + ) + (setq file-cache-last-completion string) + (setq completion-list (all-completions string file-cache-alist) + len (length completion-list)) + (if (> len 1) + (progn + (goto-char (point-max)) + (insert-string + (substring completion-string (length string))) + ;; Add our own setup function to the Completions Buffer + (let ((completion-setup-hook + (reverse + (append (list 'file-cache-completion-setup-function) + completion-setup-hook))) + ) + (with-output-to-temp-buffer file-cache-completions-buffer + (display-completion-list completion-list)) + ) + ) + (setq file-cache-string (file-cache-file-name completion-string)) + (if (string= file-cache-string (buffer-string)) + (file-cache-temp-minibuffer-message file-cache-sole-match-message) + (erase-buffer) + (insert-string file-cache-string) + (if file-cache-multiple-directory-message + (file-cache-temp-minibuffer-message + file-cache-multiple-directory-message))) + ))) + + ;; If it's the only match, replace the original contents + ((eq completion-string t) + (setq file-cache-string (file-cache-file-name string)) + (if (string= file-cache-string (buffer-string)) + (file-cache-temp-minibuffer-message file-cache-sole-match-message) + (erase-buffer) + (insert-string file-cache-string) + (if file-cache-multiple-directory-message + (file-cache-temp-minibuffer-message + file-cache-multiple-directory-message)) + )) + + ;; No match + ((eq completion-string nil) + (file-cache-temp-minibuffer-message file-cache-no-match-message)) + ) +)) + +;; Lifted from "complete.el" +(defun file-cache-temp-minibuffer-message (msg) + "A Lisp version of `temp_minibuffer_message' from minibuf.c." + (let ((savemax (point-max))) + (save-excursion + (goto-char (point-max)) + (insert msg)) + (let ((inhibit-quit t)) + (sit-for 2) + (delete-region savemax (point-max)) + (if quit-flag + (setq quit-flag nil + unread-command-events (list 7)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Completion functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun file-cache-completion-setup-function () + (set-buffer file-cache-completions-buffer) + + (if file-cache-completions-keymap + nil + (setq file-cache-completions-keymap + (copy-keymap completion-list-mode-map)) + (define-key file-cache-completions-keymap [mouse-2] + 'file-cache-mouse-choose-completion) + (define-key file-cache-completions-keymap "\C-m" + 'file-cache-choose-completion)) + + (use-local-map file-cache-completions-keymap) + ) + +(defun file-cache-choose-completion () + "Choose a completion in the `*Completions*' buffer." + (interactive) + (let ((completion-no-auto-exit t)) + (choose-completion) + (select-window (active-minibuffer-window)) + (file-cache-minibuffer-complete) + ) + ) + +(defun file-cache-mouse-choose-completion (event) + "Choose a completion with the mouse." + (interactive "e") + (let ((completion-no-auto-exit t)) + (mouse-choose-completion event) + (select-window (active-minibuffer-window)) + (file-cache-minibuffer-complete) + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Debugging functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun file-cache-debug-read-from-minibuffer (file) + "Debugging function." + (interactive + (list (completing-read "File Cache: " file-cache-alist))) + (message "%s" (assoc file file-cache-alist)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Keybindings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload (define-key minibuffer-local-completion-map [C-tab] 'file-cache-minibuffer-complete) +;;;###autoload (define-key minibuffer-local-map [C-tab] 'file-cache-minibuffer-complete) +;;;###autoload (define-key minibuffer-local-must-match-map [C-tab] 'file-cache-minibuffer-complete) + +(provide 'filecache) + +;;; filecache.el ends here diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el new file mode 100644 index 00000000000..b615862cc52 --- /dev/null +++ b/lisp/progmodes/meta-mode.el @@ -0,0 +1,1099 @@ +;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources. + +;; Copyright (C) 1997 by Ulrik Vieth. + +;; Author: Ulrik Vieth <vieth@thphy.uni-duesseldorf.de> +;; Version: 1.0 +;; Keywords: Metafont, MetaPost, tex, languages + +;;; This file is *not* part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Description: +;; +;; This Emacs Lisp package provides a major mode for editing Metafont +;; or MetaPost sources. It includes all the necessary code to set up +;; a major mode including an approriate syntax table, keymap, and a +;; mode-specific pull-down menu. It also provides a sophisticated set +;; of font-lock patterns, a fancy indentation function adapted from +;; AUC-TeX's latex.el, and some basic mode-specific editing functions +;; such as functions to move to the beginning or end of the enclosing +;; environment, or to mark, re-indent, or comment-out environments. +;; On the other hand, it doesn't yet provide any functionality for +;; running Metafont or MetaPost in a shell buffer form within Emacs, +;; but such functionality might be added later, either as part of this +;; package or as a separate Emacs Lisp package. + +;; Installation: +;; +;; Install this file (meta-mode.el) in your personal or system-wide +;; Emacs Lisp directory and add these lines to your startup files: +;; +;; (autoload 'metafont-mode "meta-mode" "Metafont editing mode." t) +;; (autoload 'metapost-mode "meta-mode" "MetaPost editing mode." t) +;; +;; (setq auto-mode-alist +;; (append '(("\\.mf\\'" . metafont-mode) +;; ("\\.mp\\'" . metapost-mode)) auto-mode-alist)) +;; +;; An interface to running Metafont or MetaPost as a shell process +;; from within Emacs is currently under development as a separate +;; Emacs Lisp package (meta-buf.el). In order to have that package +;; loaded automatically when first entering Metafont or MetaPost mode, +;; you might use the load-hook provided in this package by adding +;; these lines to your startup file: +;; +;; (add-hook 'meta-mode-load-hook +;; '(lambda () (require 'meta-buf))) +;; +;; The add-on package loaded this way may in turn make use of the +;; mode-hooks provided in this package to activate additional features +;; when entering Metafont or MetaPost mode. + +;; Font Lock Support: +;; +;; If you are using global-font-lock-mode (introduced in Emacs 19.31), +;; fontification in Metafont and/or MetaPost mode will be activated +;; automatically. To speed up fontification for the rather complex +;; patterns used in these modes, it may be a good idea to activate +;; lazy-lock as a font-lock-support-mode (introduced in Emacs 19.32) +;; by adding these lines to your startup file: +;; +;; (global-font-lock-mode t) +;; (setq font-lock-support-mode 'lazy-lock-mode) +;; +;; If you are using an older version of Emacs, which doesn't provide +;; global-font-lock-mode or font-lock-support-mode, you can also +;; activate fontification in Metafont and/or MetaPost mode by adding +;; the following lines to your startup file: +;; +;; (add-hook 'meta-common-mode-hook 'turn-on-font-lock) +;; (add-hook 'meta-common-mode-hook 'turn-on-lazy-lock) + +;; Customization: +;; +;; Following the usual Emacs Lisp coding conventions, the major modes +;; defined in this package provide several hook variables to allow for +;; local customization when entering the modes. In particular, there +;; is a `meta-common-mode-hook' which applies to both modes as well as +;; `metafont-mode-hook' and `metapost-mode-hook' which apply to the +;; individual modes. In addition, there are several variables and +;; regexps controlling e.g. the behavior of the indentation function, +;; which may be customized via `edit-options'. Please refer to the +;; docstrings in the code below for details. + +;; Availability: +;; +;; This package is currently available via my "TeX Software" WWW page: +;; +;; http://www.thphy.uni-duesseldorf.de/~vieth/subjects/tex/software.html +;; +;; As of this version 1.0, this package will be uploaded to CTAN +;; archives, where it shall find a permanent home, presumably in +;; tex-archive/support/emacs-modes. It will also be submitted for +;; integration into the GNU Emacs distribution at that time. +;; +;; History: +;; +;; v 0.0 -- 1997/02/01 UV Started writing meta-mode.el. +;; v 0.1 -- 1997/02/02 UV Added preliminary set of font-lock patterns. +;; v 0.2 -- 1997/02/03 UV Improved and debugged font-lock patterns. +;; Added indent-line-function for TAB. +;; v 0.3 -- 1997/02/17 UV Improved font-lock patterns and syntax table. +;; Improved and debbuged indentation function. +;; v 0.4 -- 1997/02/18 UV Added functions to indent regions for M-C-q, +;; also added a preliminary mode-specific menu. +;; v 0.5 -- 1997/02/19 UV Added functions to skip to next or previous +;; defun and to re-indent or comment-out defuns. +;; v 0.6 -- 1997/02/20 UV More debugging, testing and clean-up. +;; v 0.7 -- 1997/02/22 UV Use easymenu to define mode-specific menu. +;; v 0.8 -- 1997/02/24 UV Added completion function for M-TAB. +;; v 0.9 -- 1997/03/08 UV Added fill-paragraph function for comments. +;; Also fixed a few remaining font-lock problems. +;; Added meta-mode-load-hook to load meta-buf.el. +;; v 1.0 -- 1997/04/07 UV Cleanup for official public release. +;; +;; Historical Footnote: +;; +;; This package was begun on February 1, 1997, exactly 20 years after +;; the genesis of TeX took place according to Don Knuth's own account +;; (cf. ``The Errors of TeX'', reprinted in ``Literate Programming'', +;; Chapter 10, p. 249). What better date could there be to choose? +;; + + +;;; Code: + +(require 'easymenu) + +;;; Fontification. + +(defvar meta-font-lock-keywords + (let ((input-keywords + "\\(input\\|generate\\)") + (begin-keywords + (concat "\\(begin\\(char\\|fig\\|graph\\|logochar\\)\\|" + "\\cmchar\\|dcchar\\|ecchar\\)")) + (end-keywords + "\\(end\\(char\\|fig\\|graph\\)\\)") + (macro-keywords-1 + "\\(def\\|let\\|mode_def\\|vardef\\)") + (macro-keywords-2 + "\\(primarydef\\|secondarydef\\|tertiarydef\\)") +;(make-regexp +; '("expr" "suffix" "text" "primary" "secondary" "tertiary") t) + (args-keywords + (concat "\\(expr\\|primary\\|s\\(econdary\\|uffix\\)\\|" + "te\\(rtiary\\|xt\\)\\)")) +;(make-regexp +; '("boolean" "color" "numeric" "pair" "path" "pen" "picture" +; "string" "transform" "newinternal") t) + (type-keywords + (concat "\\(boolean\\|color\\|n\\(ewinternal\\|umeric\\)\\|" + "p\\(a\\(ir\\|th\\)\\|en\\|icture\\)\\|string\\|" + "transform\\)")) +;(make-regexp +; '("for" "forever" "forsuffixes" "endfor" +; "step" "until" "upto" "downto" "thru" "within" +; "iff" "if" "elseif" "else" "fi" "exitif" "exitunless" +; "let" "def" "vardef" "enddef" "mode_def" +; "true" "false" "known" "unknown" "and" "or" "not" +; "save" "interim" "inner" "outer" "relax" +; "begingroup" "endgroup" "expandafter" "scantokens" +; "generate" "input" "endinput" "end" "bye" +; "message" "errmessage" "errhelp" "special" "numspecial" +; "readstring" "readfrom" "write") t) + (syntactic-keywords + (concat "\\(and\\|b\\(egingroup\\|ye\\)\\|" + "d\\(ef\\|ownto\\)\\|e\\(lse\\(\\|if\\)" + "\\|nd\\(\\|def\\|for\\|group\\|input\\)" + "\\|rr\\(help\\|message\\)" + "\\|x\\(it\\(if\\|unless\\)\\|pandafter\\)\\)\\|" + "f\\(alse\\|i\\|or\\(\\|ever\\|suffixes\\)\\)\\|" + "generate\\|i\\(ff?\\|n\\(ner\\|put\\|terim\\)\\)\\|" + "known\\|let\\|m\\(essage\\|ode_def\\)\\|" + "n\\(ot\\|umspecial\\)\\|o\\(r\\|uter\\)\\|" + "re\\(ad\\(from\\|string\\)\\|lax\\)\\|" + "s\\(ave\\|cantokens\\|pecial\\|tep\\)\\|" + "t\\(hru\\|rue\\)\\|" + "u\\(n\\(known\\|til\\)\\|pto\\)\\|" + "vardef\\|w\\(ithin\\|rite\\)\\)")) + ) + (list + ;; embedded TeX code in btex ... etex + (cons (concat "\\(btex\\|verbatimtex\\)" + "[ \t]+\\(.*\\)[ \t]+" + "\\(etex\\)") + '((1 font-lock-keyword-face) + (2 font-lock-string-face) + (3 font-lock-keyword-face))) + ;; unary macro definitions: def, vardef, let + (cons (concat "\\<" macro-keywords-1 "\\>" + "[ \t]+\\(\\sw+\\|\\s_+\\|\\s.+\\)") + '((1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + ;; binary macro defintions: <leveldef> x operator y + (cons (concat "\\<" macro-keywords-2 "\\>" + "[ \t]+\\(\\sw+\\)" + "[ \t]*\\(\\sw+\\|\\s.+\\)" + "[ \t]*\\(\\sw+\\)") + '((1 font-lock-keyword-face) + (2 font-lock-variable-name-face nil t) + (3 font-lock-function-name-face nil t) + (4 font-lock-variable-name-face nil t))) + ;; variable declarations: numeric, pair, color, ... + (cons (concat "\\<" type-keywords "\\>" + "\\([ \t]+\\(\\sw+\\)\\)*") + '((1 font-lock-type-face) + (font-lock-match-meta-declaration-item-and-skip-to-next + (goto-char (match-end 1)) nil + (1 font-lock-variable-name-face nil t)))) + ;; argument declarations: expr, suffix, text, ... + (cons (concat "\\<" args-keywords "\\>" + "\\([ \t]+\\(\\sw+\\|\\s_+\\)\\)*") + '((1 font-lock-type-face) + (font-lock-match-meta-declaration-item-and-skip-to-next + (goto-char (match-end 1)) nil + (1 font-lock-variable-name-face nil t)))) + ;; special case of arguments: expr x of y + (cons (concat "\\(expr\\)[ \t]+\\(\\sw+\\)" + "[ \t]+\\(of\\)[ \t]+\\(\\sw+\\)") + '((1 font-lock-type-face) + (2 font-lock-variable-name-face) + (3 font-lock-keyword-face nil t) + (4 font-lock-variable-name-face nil t))) + ;; syntactic keywords + (cons (concat "\\<" syntactic-keywords "\\>") + 'font-lock-keyword-face) + ;; beginchar, beginfig + (cons (concat "\\<" begin-keywords "\\>") + 'font-lock-keyword-face) + ;; endchar, endfig + (cons (concat "\\<" end-keywords "\\>") + 'font-lock-keyword-face) + ;; input, generate + (cons (concat "\\<" input-keywords "\\>" + "[ \t]+\\(\\sw+\\)") + '((1 font-lock-keyword-face) + (2 font-lock-reference-face))) + ;; embedded Metafont/MetaPost code in comments + (cons "|\\([^|]+\\)|" + '(1 font-lock-reference-face t)) + )) + "Default expressions to highlight in Metafont or MetaPost mode.") + + +(defun font-lock-match-meta-declaration-item-and-skip-to-next (limit) + ;; Match and move over Metafont/MetaPost declaration item after point. + ;; + ;; The expected syntax of an item is either "word" or "symbol", + ;; possibly ending with optional whitespace. Everything following + ;; the item (but belonging to it) is expected to by skipable by + ;; `forward-sexp'. The list of items is expected to be separated + ;; by commas and terminated by semicolons or equals signs. + ;; + (if (looking-at "[ \t]*\\(\\sw+\\|\\s_+\\)") + (save-match-data + (condition-case nil + (save-restriction + ;; Restrict to end of line, currently guaranteed to be LIMIT. + (narrow-to-region (point-min) limit) + (goto-char (match-end 1)) + ;; Move over any item value, etc., to the next item. + (while (not (looking-at "[ \t]*\\(\\(,\\)\\|;\\|=\\|$\\)")) + (goto-char (or (scan-sexps (point) 1) (point-max)))) + (goto-char (match-end 2))) + (error t))))) + + + +;;; Completion. + +;; The data used to prepare the following lists of primitives and +;; standard macros available in Metafont or MetaPost was extracted +;; from the original sources like this: +;; +;; grep '^primitive' texk-7.0/web2c/{mf,mp}.web |\ +;; sed 's/primitive(\("[a-zA-Z]*"\).*/\1/' > {mf,mp}_prim.list +;; +;; grep '\(let\|def\|vardef\|primarydef\|secondarydef\|tertiarydef\)' +;; texmf/meta{font,post}/plain.{mf,mp} > {mf,mp}_plain.list + +(defconst meta-common-primitives-list + '("ASCII" "addto" "also" "and" "angle" "atleast" "batchmode" + "begingroup" "boolean" "boundarychar" "char" "charcode" "chardp" + "charexists" "charext" "charht" "charic" "charlist" "charwd" + "contour" "controls" "cosd" "curl" "cycle" "day" "decimal" "def" + "delimiters" "designsize" "directiontime" "doublepath" "dump" "else" + "elseif" "end" "enddef" "endfor" "endgroup" "endinput" "errhelp" + "errmessage" "errorstopmode" "everyjob" "exitif" "expandafter" + "expr" "extensible" "false" "fi" "floor" "fontdimen" "fontmaking" + "for" "forever" "forsuffixes" "headerbyte" "hex" "if" "inner" + "input" "interim" "intersectiontimes" "jobname" "kern" "known" + "length" "let" "ligtable" "makepath" "makepen" "message" "mexp" + "mlog" "month" "newinternal" "nonstopmode" "normaldeviate" "not" + "nullpen" "nullpicture" "numeric" "oct" "odd" "of" "or" "outer" + "pair" "path" "pausing" "pen" "pencircle" "penoffset" "picture" + "point" "postcontrol" "precontrol" "primary" "primarydef" "quote" + "randomseed" "readstring" "reverse" "rotated" "save" "scaled" + "scantokens" "scrollmode" "secondary" "secondarydef" "shifted" + "shipout" "show" "showdependencies" "showstats" "showstopping" + "showtoken" "showvariable" "sind" "skipto" "slanted" "special" + "sqrt" "step" "str" "string" "subpath" "substring" "suffix" + "tension" "tertiary" "tertiarydef" "text" "time" "to" + "tracingcapsules" "tracingchoices" "tracingcommands" + "tracingequations" "tracingmacros" "tracingonline" "tracingoutput" + "tracingrestores" "tracingspecs" "tracingstats" "tracingtitles" + "transform" "transformed" "true" "turningnumber" "uniformdeviate" + "unknown" "until" "vardef" "warningcheck" "withpen" "xpart" + "xscaled" "xxpart" "xypart" "year" "ypart" "yscaled" "yxpart" + "yypart" "zscaled") + "List of primitives common to Metafont and MetaPost.") + +(defconst metafont-primitives-list + '("at" "autorounding" "chardx" "chardy" "cull" "display" + "dropping" "fillin" "from" "granularity" "hppp" "inwindow" + "keeping" "numspecial" "openwindow" "proofing" "smoothing" + "totalweight" "tracingedges" "tracingpens" "turningcheck" "vppp" + "withweight" "xoffset" "yoffset") + "List of primitives only defined in Metafont.") + +(defconst metapost-primitives-list + '("arclength" "arctime" "bluepart" "bounded" "btex" "clip" + "clipped" "color" "dashed" "dashpart" "etex" "filled" "fontpart" + "fontsize" "greenpart" "infont" "linecap" "linejoin" "llcorner" + "lrcorner" "miterlimit" "mpxbreak" "pathpart" "penpart" + "prologues" "readfrom" "redpart" "setbounds" "stroked" "textpart" + "textual" "tracinglostchars" "truecorners" "ulcorner" "urcorner" + "verbatimtex" "withcolor" "within" "write") + "List of primitives only defined in MetaPost.") + +(defconst meta-common-plain-macros-list + '( "abs" "bot" "bye" "byte" "ceiling" "clear_pen_memory" + "clearit" "clearpen" "clearxy" "counterclockwise" "cutdraw" "decr" + "dir" "direction" "directionpoint" "div" "dotprod" "downto" "draw" + "drawdot" "erase" "exitunless" "fill" "filldraw" "flex" "gobble" + "hide" "incr" "interact" "interpath" "intersectionpoint" "inverse" + "label" "labels" "lft" "loggingall" "magstep" "makelabel" "max" + "min" "mod" "numtok" "penlabels" "penpos" "penstroke" "pickup" + "range" "reflectedabout" "relax" "rotatedabout" "rotatedaround" + "round" "rt" "savepen" "shipit" "softjoin" "solve" "stop" + "superellipse" "takepower" "tensepath" "thru" "top" "tracingall" + "tracingnone" "undraw" "undrawdot" "unfill" "unfilldraw" + "unitvector" "upto" "whatever") + "List of macros common to plain Metafont and MetaPost.") + +(defconst metafont-plain-macros-list + '("beginchar" "change_width" "culldraw" "cullit" "cutoff" + "define_blacker_pixels" "define_corrected_pixels" + "define_good_x_pixels" "define_good_y_pixels" + "define_horizontal_corrected_pixels" "define_pixels" + "define_whole_blacker_pixels" "define_whole_pixels" + "define_whole_vertical_blacker_pixels" + "define_whole_vertical_pixels" "endchar" "fix_units" + "font_coding_scheme" "font_extra_space" "font_identifier" + "font_normal_shrink" "font_normal_space" "font_normal_stretch" + "font_quad" "font_size" "font_slant" "font_x_height" "gfcorners" + "good.bot" "good.lft" "good.rt" "good.top" "good.x" "good.y" + "grayfont" "hround" "imagerules" "italcorr" "labelfont" + "lowres_fix" "makebox" "makegrid" "maketicks" "mode_lowres" + "mode_proof" "mode_setup" "mode_smoke" "nodisplays" "notransforms" + "openit" "penrazor" "pensquare" "proofoffset" "proofrule" + "proofrulethickness" "screenchars" "screenrule" "screenstrokes" + "showit" "slantfont" "smode" "titlefont" "vround") + "List of macros only defined in plain Metafont.") + +(defconst metapost-plain-macros-list + '("arrowhead" "bbox" "beginfig" "buildcycle" "center" "cutafter" + "cutbefore" "dashpattern" "dotlabel" "dotlabels" "drawarrow" + "drawdblarrow" "drawoptions" "endfig" "image" "label" "off" "on" + "thelabel") + "List of macros only defined in plain MetaPost.") + +(defconst metapost-graph-macros-list + '("augment" "auto.x" "auto.y" "autogrid" "begingraph" "endgraph" + "format" "frame" "gdata" "gdotlabel" "gdraw" "gdrawarrow" + "gdrawdblarrow" "gfill" "glabel" "grid" "itick" "otick" "plot" + "setcoords" "setrange") + "List of macros only defined in MetaPost \"graph\" package.") + +(defconst metapost-boxes-macros-list + '("boxit" "boxjoin" "bpath" "circleit" "drawboxed" "drawboxes" + "drawunboxed" "fixpos" "fixsize" "pic" "rboxit") + "List of macros only defined in MetaPost \"boxes\" package.") + + +(defvar metafont-symbol-list + (append meta-common-primitives-list + metafont-primitives-list + meta-common-plain-macros-list + metafont-plain-macros-list) + "List of known symbols to complete in Metafont mode.") + +(defvar metapost-symbol-list + (append meta-common-primitives-list + metapost-primitives-list + meta-common-plain-macros-list + metapost-plain-macros-list + metapost-graph-macros-list + metapost-boxes-macros-list) + "List of known symbols to complete in MetaPost mode.") + + +(defvar meta-symbol-list nil + "List of known symbols to complete in Metafont or MetaPost mode.") + +(defvar meta-symbol-changed nil + "Flag indicating whether `meta-symbol-list' has been initialized.") + +(defvar meta-complete-list nil +; (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list) +; (list "" 'ispell-complete-word)) + "List of ways to perform completion in Metafont or MetaPost mode. + +Each entry is a list with the following elements: +1. Regexp matching the preceding text. +2. A number indicating the subgroup in the regexp containing the text. +3. A function returning an alist of possible completions. +4. Text to append after a succesful completion (if any). + +Or alternatively: +1. Regexp matching the preceding text. +2. Function to do the actual completion.") + + +(defun meta-add-symbols (&rest entries) + "Add entries to list of known symbols in Metafont or MetaPost mode." + (if meta-symbol-changed + (setq meta-symbol-list (cons entries meta-symbol-list)) + (setq meta-symbol-changed t) + (setq meta-symbol-list (cons entries meta-symbol-list)))) + +(defun meta-symbol-list () + "Return value of list of known symbols in Metafont or MetaPost mode. +If the list was changed, sort the list and remove duplicates first." + (if (not meta-symbol-changed) + () + (setq meta-symbol-changed nil) + (message "Preparing completion list...") + ;; sort list of symbols + (setq meta-symbol-list + (sort (mapcar 'meta-listify (apply 'append meta-symbol-list)) + 'meta-car-string-lessp)) + ;; remove duplicates + (let ((entry meta-symbol-list)) + (while (and entry (cdr entry)) + (let ((this (car entry)) + (next (car (cdr entry)))) + (if (not (string-equal (car this) (car next))) + (setq entry (cdr entry)) + (if (> (length next) (length this)) + (setcdr this (cdr next))) + (setcdr entry (cdr (cdr entry))))))) + (message "Preparing completion list... done")) + meta-symbol-list) + +(defun meta-listify (a) + ;; utility function used in `meta-add-symbols' + (if (listp a) a (list a))) + +(defun meta-car-string-lessp (a b) + ;; utility function used in `meta-add-symbols' + (string-lessp (car a) (car b))) + + +(defun meta-complete-symbol () + "Perform completion on Metafont or MetaPost symbol preceding point." + (interactive "*") + (let ((list meta-complete-list) + entry) + (while list + (setq entry (car list) + list (cdr list)) + (if (meta-looking-at-backward (car entry) 200) + (setq list nil))) + (if (numberp (nth 1 entry)) + (let* ((sub (nth 1 entry)) + (close (nth 3 entry)) + (begin (match-beginning sub)) + (end (match-end sub)) + (pattern (meta-match-buffer 0)) + (symbol (buffer-substring begin end)) + (list (funcall (nth 2 entry))) + (completion (try-completion symbol list))) + (cond ((eq completion t) + (and close + (not (looking-at (regexp-quote close))) + (insert close))) + ((null completion) + (error "Can't find completion for \"%s\"" pattern)) + ((not (string-equal symbol completion)) + (delete-region begin end) + (insert completion) + (and close + (eq (try-completion completion list) t) + (not (looking-at (regexp-quote close))) + (insert close))) + (t + (message "Making completion list...") + (let ((list (all-completions symbol list nil))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list list))) + (message "Making completion list... done")))) + (funcall (nth 1 entry))))) + + +(defun meta-looking-at-backward (regexp &optional limit) + ;; utility function used in `meta-complete-symbol' + (let ((pos (point))) + (save-excursion + (and (re-search-backward + regexp (if limit (max (point-min) (- (point) limit))) t) + (eq (match-end 0) pos))))) + +(defun meta-match-buffer (n) + ;; utility function used in `meta-complete-symbol' + (if (match-beginning n) + (let ((str (buffer-substring (match-beginning n) (match-end n)))) + (set-text-properties 0 (length str) nil str) + (copy-sequence str)) + "")) + + + +;;; Indentation. + +(defvar meta-indent-level 2 + "*Indentation of begin-end blocks in Metafont or MetaPost mode.") + + +(defvar meta-left-comment-regexp "%%+" + "*Regexp matching comments that should be placed on the left margin.") + +(defvar meta-right-comment-regexp nil + "*Regexp matching comments that should be placed to the right margin.") + +(defvar meta-ignore-comment-regexp "%[^%]" + "*Regexp matching comments that whose indentation should not be touched.") + + +(defvar meta-begin-environment-regexp + (concat "\\(begin\\(char\\|fig\\|gr\\(aph\\|oup\\)\\|logochar\\)\\|" + "def\\|for\\(\\|ever\\|suffixes\\)\\|if\\|mode_def\\|" + "primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)") + "*Regexp matching the beginning of environments to be indented.") + +(defvar meta-end-environment-regexp + (concat "\\(end\\(char\\|def\\|f\\(ig\\|or\\)\\|gr\\(aph\\|oup\\)\\)" + "\\|fi\\)") + "*Regexp matching the end of environments to be indented.") + +(defvar meta-within-environment-regexp +; (concat "\\(e\\(lse\\(\\|if\\)\\|xit\\(if\\|unless\\)\\)\\)") + (concat "\\(else\\(\\|if\\)\\)") + "*Regexp matching keywords within environments not to be indented.") + + +(defun meta-comment-indent () + "Return the indentation for a comment in Metafont or MetaPost mode." + (if (and meta-left-comment-regexp + (looking-at meta-left-comment-regexp)) + (current-column) + (skip-chars-backward "\t ") + (max (if (bolp) 0 (1+ (current-column))) + comment-column))) + +(defun meta-indent-line () + "Indent the line containing point as Metafont or MetaPost source." + (interactive) + (let ((indent (meta-indent-calculate))) + (save-excursion + (if (/= (current-indentation) indent) + (let ((beg (progn (beginning-of-line) (point))) + (end (progn (back-to-indentation) (point)))) + (delete-region beg end) + (indent-to indent)))) + (if (< (current-column) indent) + (back-to-indentation)))) + +(defun meta-indent-calculate () + "Return the indentation of current line of Metafont or MetaPost source." + (save-excursion + (back-to-indentation) + (cond + ;; Comments to the left margin. + ((and meta-left-comment-regexp + (looking-at meta-left-comment-regexp)) + 0) + ;; Comments to the right margin. + ((and meta-right-comment-regexp + (looking-at meta-right-comment-regexp)) + comment-column) + ;; Comments best left alone. + ((and meta-ignore-comment-regexp + (looking-at meta-ignore-comment-regexp)) + (current-indentation)) + ;; Backindent at end of environments. + ((looking-at + (concat "\\<" meta-end-environment-regexp "\\>")) + (- (meta-indent-calculate-last) meta-indent-level)) + ;; Backindent at keywords within environments. + ((looking-at + (concat "\\<" meta-within-environment-regexp "\\>")) + (- (meta-indent-calculate-last) meta-indent-level)) + (t (meta-indent-calculate-last))))) + +(defun meta-indent-calculate-last () + "Return the indentation of previous line of Metafont or MetaPost source." + (save-restriction + (widen) + (skip-chars-backward "\n\t ") + (move-to-column (current-indentation)) + ;; Ignore comments. + (while (and (looking-at comment-start) (not (bobp))) + (skip-chars-backward "\n\t ") + (if (not (bobp)) + (move-to-column (current-indentation)))) + (cond + ((bobp) 0) + (t (+ (current-indentation) + (meta-indent-level-count) + (cond + ;; Compensate for backindent at end of environments. + ((looking-at + (concat "\\<"meta-end-environment-regexp "\\>")) + meta-indent-level) + ;; Compensate for backindent within environments. + ((looking-at + (concat "\\<" meta-within-environment-regexp "\\>")) + meta-indent-level) + (t 0))))) + )) + +(defun meta-indent-level-count () + "Count indentation change for begin-end commands in the current line." + (save-excursion + (save-restriction + (let ((count 0)) + (narrow-to-region + (point) (save-excursion + (re-search-forward "[^\\\\\"]%\\|\n\\|\\'" nil t) + (backward-char) (point))) + (while (re-search-forward "\\<\\sw+\\>\\|(\\|)" nil t) + (save-excursion + (goto-char (match-beginning 0)) + (cond + ;; Count number of begin-end keywords within line. + ((looking-at + (concat "\\<" meta-begin-environment-regexp "\\>")) + (setq count (+ count meta-indent-level))) + ((looking-at + (concat "\\<" meta-end-environment-regexp "\\>")) + (setq count (- count meta-indent-level))) + ;; Count number of open-close parentheses within line. + ((looking-at "(") + (setq count (+ count meta-indent-level))) + ((looking-at ")") + (setq count (- count meta-indent-level))) + ))) + count)))) + + + +;;; Filling paragraphs. + +(defun meta-fill-paragraph (&optional justify) + "Like \\[fill-paragraph], but handle Metafont or MetaPost comments. +If any part of the current line is a comment, fill the comment or the +paragraph of it that point is in, preserving the comment's indentation +and initial semicolons." + (interactive "P") + (let (has-comment ; Non-nil if line contains a comment. + has-code-and-comment ; Non-nil if line contains code and a comment. + comment-fill-prefix ; If has-comment, fill-prefix for the comment. + ) + ;; Figure out what kind of comment we are looking at. + (save-excursion + (beginning-of-line) + (cond + ;; A line with nothing but a comment on it? + ((looking-at (concat "[ \t]*" comment-start-skip)) + (setq has-comment t) + (setq comment-fill-prefix + (buffer-substring (match-beginning 0) (match-end 0)))) + ;; A line with some code, followed by a comment? + ((condition-case nil + (save-restriction + (narrow-to-region (point-min) + (save-excursion (end-of-line) (point))) + (while (not (looking-at (concat comment-start "\\|$"))) + (skip-chars-forward (concat "^" comment-start "\n\"\\\\")) + (cond + ((eq (char-after (point)) ?\\) (forward-char 2)) + ((eq (char-after (point)) ?\") (forward-sexp 1)))) + (looking-at comment-start-skip)) + (error nil)) + (setq has-comment t + has-code-and-comment t) + (setq comment-fill-prefix + (concat (make-string (/ (current-column) 8) ?\t) + (make-string (% (current-column) 8) ?\ ) + (buffer-substring (match-beginning 0) (match-end 0))))) + )) + (if (not has-comment) + (fill-paragraph justify) + ;; Narrow to include only the comment, and then fill the region. + (save-excursion + (save-restriction + (beginning-of-line) + (narrow-to-region + ;; Find the first line we should include in the region to fill. + (save-excursion + (while (and (zerop (forward-line -1)) + (looking-at (concat "^[ \t]*" comment-start)))) + (or (looking-at (concat ".*" comment-start)) + (forward-line 1)) + (point)) + ;; Find the beginning of the first line past the region to fill. + (save-excursion + (while (progn (forward-line 1) + (looking-at (concat "^[ \t]*" comment-start)))) + (point))) + (let* ((paragraph-start + (concat paragraph-start "\\|[ \t%]*$")) + (paragraph-separate + (concat paragraph-start "\\|[ \t%]*$")) + (paragraph-ignore-fill-prefix nil) + (fill-prefix comment-fill-prefix) + (after-line (if has-code-and-comment + (save-excursion (forward-line 1) (point)))) + (end (progn (forward-paragraph) + (or (bolp) (newline 1)) + (point))) + (beg (progn (backward-paragraph) + (if (eq (point) after-line) (forward-line -1)) + (point))) + (after-pos (save-excursion + (goto-char beg) + (if (not (looking-at fill-prefix)) + (progn + (re-search-forward comment-start-skip) + (point))))) + ) + (fill-region-as-paragraph beg end justify nil after-pos)) + ))) + t)) + + + +;;; Editing commands. + +(defvar meta-begin-defun-regexp + (concat "\\(begin\\(char\\|fig\\|logochar\\)\\|def\\|mode_def\\|" + "primarydef\\|secondarydef\\|tertiarydef\\|vardef\\)") + "*Regexp matching beginning of defuns in Metafont or MetaPost mode.") + +(defvar meta-end-defun-regexp + (concat "\\(end\\(char\\|def\\|fig\\)\\)") + "*Regexp matching the end of defuns in Metafont or MetaPost mode.") + + +(defun meta-beginning-of-defun (&optional arg) + "Move backward to beginnning of a defun in Metafont or MetaPost code. +With numeric argument, do it that many times. +Negative arg -N means move forward to Nth following beginning of defun. +Returns t unless search stops due to beginning or end of buffer." + (interactive "p") + (if (or (null arg) (= 0 arg)) (setq arg 1)) + (and arg (< arg 0) (not (eobp)) (forward-char 1)) + (and (re-search-backward + (concat "\\<" meta-begin-defun-regexp "\\>") nil t arg) + (progn (goto-char (match-beginning 0)) + (skip-chars-backward "%") + (skip-chars-backward " \t") t))) + +(defun meta-end-of-defun (&optional arg) + "Move forward to end of a defun in Metafont or MetaPost code. +With numeric argument, do it that many times. +Negative argument -N means move back to Nth preceding end of defun. +Returns t unless search stops due to beginning or end of buffer." + (interactive "p") + (if (or (null arg) (= 0 arg)) (setq arg 1)) + (and (< arg 0) (not (bobp)) (forward-line -1)) + (and (re-search-forward + (concat "\\<" meta-end-defun-regexp "\\>") nil t arg) + (progn (goto-char (match-end 0)) + (skip-chars-forward ";") + (skip-chars-forward " \t") + (if (looking-at "\n") (forward-line 1)) t))) + + +(defun meta-comment-region (beg end &optional arg) + "Comment out active region as Metafont or MetaPost source." + (interactive "r") + (comment-region beg end arg)) + +(defun meta-uncomment-region (beg end) + "Uncomment active region as Metafont or MetaPost source." + (interactive "r") + (comment-region beg end -1)) + +(defun meta-comment-defun (&optional arg) + "Comment out current environment as Metafont or MetaPost source. +With prefix argument, uncomment the environment. +The environment used is the one that contains point or follows point." + (interactive "P") + (save-excursion + (let* ((end (if (meta-end-of-defun) (point) (point-max))) + (beg (if (meta-beginning-of-defun) (point) (point-min)))) + (comment-region beg end arg)))) + +(defun meta-uncomment-defun () + "Uncomment current environment as Metafont or MetaPost source." + (interactive) + (meta-comment-defun -1)) + + +(defun meta-indent-region (beg end) + "Indent the active region as Metafont or MetaPost source." + (interactive "r") + (indent-region beg end nil)) + +(defun meta-indent-buffer () + "Indent the whole buffer contents as Metafont or MetaPost source." + (interactive) + (save-excursion + (indent-region (point-min) (point-max) nil))) + +(defun meta-indent-defun () + "Indent the current environment as Metafont or MetaPost source. +The environment indented is the one that contains point or follows point." + (interactive) + (save-excursion + (let* ((end (if (meta-end-of-defun) (point) (point-max))) + (beg (if (meta-beginning-of-defun) (point) (point-min)))) + (indent-region beg end nil)))) + + +(defun meta-mark-defun () + "Put mark at end of the environment, point at the beginning. +The environment marked is the one that contains point or follows point." + (interactive) + (push-mark (point)) + (meta-end-of-defun) + (push-mark (point) nil t) + (meta-beginning-of-defun)) + + + +;;; Syntax table, keymap and menu. + +(defvar meta-mode-abbrev-table nil + "Abbrev table used in Metafont or MetaPost mode.") +(define-abbrev-table 'meta-mode-abbrev-table ()) + +(defvar meta-mode-syntax-table nil + "Syntax table used in Metafont or MetaPost mode.") +(if meta-mode-syntax-table + () + (setq meta-mode-syntax-table (make-syntax-table)) + ;; underscores are word constituents + (modify-syntax-entry ?_ "w" meta-mode-syntax-table) + ;; miscellaneous non-word symbols + (modify-syntax-entry ?# "_" meta-mode-syntax-table) + (modify-syntax-entry ?@ "_" meta-mode-syntax-table) + (modify-syntax-entry ?$ "_" meta-mode-syntax-table) + (modify-syntax-entry ?? "_" meta-mode-syntax-table) + (modify-syntax-entry ?! "_" meta-mode-syntax-table) + ;; binary operators + (modify-syntax-entry ?& "." meta-mode-syntax-table) + (modify-syntax-entry ?+ "." meta-mode-syntax-table) + (modify-syntax-entry ?- "." meta-mode-syntax-table) + (modify-syntax-entry ?/ "." meta-mode-syntax-table) + (modify-syntax-entry ?* "." meta-mode-syntax-table) + (modify-syntax-entry ?. "." meta-mode-syntax-table) + (modify-syntax-entry ?: "." meta-mode-syntax-table) + (modify-syntax-entry ?= "." meta-mode-syntax-table) + (modify-syntax-entry ?< "." meta-mode-syntax-table) + (modify-syntax-entry ?> "." meta-mode-syntax-table) + (modify-syntax-entry ?| "." meta-mode-syntax-table) + ;; opening and closing delimiters + (modify-syntax-entry ?\( "()" meta-mode-syntax-table) + (modify-syntax-entry ?\) ")(" meta-mode-syntax-table) + (modify-syntax-entry ?\[ "(]" meta-mode-syntax-table) + (modify-syntax-entry ?\] ")[" meta-mode-syntax-table) + (modify-syntax-entry ?\{ "(}" meta-mode-syntax-table) + (modify-syntax-entry ?\} "){" meta-mode-syntax-table) + ;; comment character + (modify-syntax-entry ?% "<" meta-mode-syntax-table) + (modify-syntax-entry ?\n ">" meta-mode-syntax-table) + ;; escape character, needed for embedded TeX code + (modify-syntax-entry ?\\ "\\" meta-mode-syntax-table) + ) + +(defvar meta-mode-map nil + "Keymap used in Metafont or MetaPost mode.") +(if meta-mode-map + () + (setq meta-mode-map (make-sparse-keymap)) + (define-key meta-mode-map "\t" 'meta-indent-line) + (define-key meta-mode-map "\C-m" 'reindent-then-newline-and-indent) + ;; Comment Paragraphs: +; (define-key meta-mode-map "\M-a" 'backward-sentence) +; (define-key meta-mode-map "\M-e" 'forward-sentence) +; (define-key meta-mode-map "\M-h" 'mark-paragraph) +; (define-key meta-mode-map "\M-q" 'fill-paragraph) + ;; Navigation: + (define-key meta-mode-map "\M-\C-a" 'meta-beginning-of-defun) + (define-key meta-mode-map "\M-\C-e" 'meta-end-of-defun) + (define-key meta-mode-map "\M-\C-h" 'meta-mark-defun) + ;; Indentation: + (define-key meta-mode-map "\M-\C-q" 'meta-indent-defun) + (define-key meta-mode-map "\C-c\C-qe" 'meta-indent-defun) + (define-key meta-mode-map "\C-c\C-qr" 'meta-indent-region) + (define-key meta-mode-map "\C-c\C-qb" 'meta-indent-buffer) + ;; Commenting Out: + (define-key meta-mode-map "\C-c%" 'meta-comment-defun) +; (define-key meta-mode-map "\C-uC-c%" 'meta-uncomment-defun) + (define-key meta-mode-map "\C-c;" 'meta-comment-region) + (define-key meta-mode-map "\C-c:" 'meta-uncomment-region) + ;; Symbol Completion: + (define-key meta-mode-map "\M-\t" 'meta-complete-symbol) + ;; Shell Commands: +; (define-key meta-mode-map "\C-c\C-c" 'meta-command-file) +; (define-key meta-mode-map "\C-c\C-k" 'meta-kill-job) +; (define-key meta-mode-map "\C-c\C-l" 'meta-recenter-output) + ) + +(easy-menu-define + meta-mode-menu meta-mode-map + "Menu used in Metafont or MetaPost mode." + (list "Meta" + ["Forward Environment" meta-beginning-of-defun t] + ["Backward Environment" meta-end-of-defun t] + "--" + ["Indent Line" meta-indent-line t] + ["Indent Environment" meta-indent-defun t] + ["Indent Region" meta-indent-region + :active (meta-mark-active)] + ["Indent Buffer" meta-indent-buffer t] + "--" + ["Comment Out Environment" meta-comment-defun t] + ["Uncomment Environment" meta-uncomment-defun t] + ["Comment Out Region" meta-comment-region + :active (meta-mark-active)] + ["Uncomment Region" meta-uncomment-region + :active (meta-mark-active)] + "--" + ["Complete Symbol" meta-complete-symbol t] +; "--" +; ["Command on Buffer" meta-command-file t] +; ["Kill Job" meta-kill-job t] +; ["Recenter Output Buffer" meta-recenter-output-buffer t] + )) + +;; Compatibility: XEmacs doesn't have the `mark-active' variable. +(defun meta-mark-active () + "Return whether the mark and region are currently active in this buffer." + (or (and (boundp 'mark-active) mark-active) (mark))) + + + +;;; Hook variables. + +(defvar meta-mode-load-hook nil + "*Hook evaluated when first loading Metafont or MetaPost mode.") + +(defvar meta-common-mode-hook nil + "*Hook evaluated by both `metafont-mode' and `metapost-mode'.") + +(defvar metafont-mode-hook nil + "*Hook evaluated by `metafont-mode' after `meta-common-mode-hook'.") +(defvar metapost-mode-hook nil + "*Hook evaluated by `metapost-mode' after `meta-common-mode-hook'.") + + + +;;; Initialization. + +(defun meta-common-initialization () + "Common initialization for Metafont or MetaPost mode." + (kill-all-local-variables) + + (make-local-variable 'paragraph-start) + (make-local-variable 'paragraph-separate) + (setq paragraph-start + (concat page-delimiter "\\|$")) + (setq paragraph-separate + (concat page-delimiter "\\|$")) + + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-start) + (make-local-variable 'comment-end) + (make-local-variable 'comment-multi-line) + (setq comment-start-skip "%+[ \t]*") + (setq comment-start "%") + (setq comment-end "") + (setq comment-multi-line nil) + + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments t) + + (make-local-variable 'comment-indent-function) + (setq comment-indent-function 'meta-comment-indent) + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'meta-fill-paragraph) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'meta-indent-line) + ;; No need to define a mode-specific 'indent-region-function. + ;; Simply use the generic 'indent-region and 'comment-region. + + ;; Set defaults for font-lock mode. + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(meta-font-lock-keywords + nil nil ((?_ . "w")) nil + (font-lock-comment-start-regexp . "%"))) + + ;; Activate syntax table, keymap and menu. + (setq local-abbrev-table meta-mode-abbrev-table) + (set-syntax-table meta-mode-syntax-table) + (use-local-map meta-mode-map) + (easy-menu-add meta-mode-menu) + ) + + +(defun metafont-mode () + "Major mode for editing Metafont sources. +Special commands: +\\{meta-mode-map} + +Turning on Metafont mode calls the value of the variables +`meta-common-mode-hook' and `metafont-mode-hook'." + (interactive) + (meta-common-initialization) + (setq mode-name "Metafont") + (setq major-mode 'metafont-mode) + + ;; Set defaults for completion function. + (make-local-variable 'meta-symbol-list) + (make-local-variable 'meta-symbol-changed) + (make-local-variable 'meta-complete-list) + (setq meta-symbol-list nil) + (setq meta-symbol-changed nil) + (apply 'meta-add-symbols metafont-symbol-list) + (setq meta-complete-list + (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list) + (list "" 'ispell-complete-word))) + (run-hooks 'meta-common-mode-hook 'metafont-mode-hook)) + +(defun metapost-mode () + "Major mode for editing MetaPost sources. +Special commands: +\\{meta-mode-map} + +Turning on MetaPost mode calls the value of the variable +`meta-common-mode-hook' and `metafont-mode-hook'." + (interactive) + (meta-common-initialization) + (setq mode-name "MetaPost") + (setq major-mode 'metapost-mode) + + ;; Set defaults for completion function. + (make-local-variable 'meta-symbol-list) + (make-local-variable 'meta-symbol-changed) + (make-local-variable 'meta-complete-list) + (setq meta-symbol-list nil) + (setq meta-symbol-changed nil) + (apply 'meta-add-symbols metapost-symbol-list) + (setq meta-complete-list + (list (list "\\<\\(\\sw+\\)" 1 'meta-symbol-list) + (list "" 'ispell-complete-word))) + (run-hooks 'meta-common-mode-hook 'metapost-mode-hook)) + + +;;; Just in case ... + +(provide 'meta-mode) +(run-hooks 'meta-mode-load-hook) + +;;; meta-mode.el ends here |