--- /dev/null
+;;; 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)
+
+\f
+(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))
+
+\f
+;;; `/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))))
+
+\f
+;;; 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))
+
+\f
+(provide 'battery)
+
+;;; battery.el ends here
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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?
+;;
+
+\f
+;;; 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)))))
+
+
+\f
+;;; 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))
+ ""))
+
+
+\f
+;;; 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))))
+
+
+\f
+;;; 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))
+
+
+\f
+;;; 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))
+
+
+\f
+;;; 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)))
+
+
+\f
+;;; 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'.")
+
+
+\f
+;;; 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
--- /dev/null
+/* news-risc6.h is for the "RISC News", OS version 6. */
+/* This is in the public domain. */
+
+/* Define NO_ARG_ARRAY if you cannot take the address of the first of a
+ * group of arguments and treat it as an array of the arguments. */
+
+#define NO_ARG_ARRAY
+
+/* Use type int rather than a union, to represent Lisp_Object */
+/* This is desirable for most machines. */
+
+#define NO_UNION_TYPE
+
+/* Data type of load average, as read out of kmem. */
+
+#define LOAD_AVE_TYPE long
+
+/* Convert that into an integer that is 100 for a load average of 1.0 */
+
+#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / 256.0)
+
+/* Define C_ALLOCA if this machine does not support a true alloca
+ and the one written in C should be used instead.
+ Define HAVE_ALLOCA to say that the system provides a properly
+ working alloca function and it should be used.
+ Define neither one if an assembler-language alloca
+ in the file alloca.s should be used. */
+
+#define HAVE_ALLOCA
+
+/* Define NO_REMAP if memory segmentation makes it not work well
+ to change the boundary between the text section and data section
+ when Emacs is dumped. If you define this, the preloaded Lisp
+ code will not be sharable; but that's better than failing completely. */
+
+#define NO_REMAP
+
+/* Alter some of the options used when linking. */
+
+/*#define C_DEBUG_SWITCH -g*/
+#define C_DEBUG_SWITCH -O -Olimit 2000
+#ifdef __GNUC__
+#define C_OPTIMIZE_SWITCH -O
+#define LD_SWITCH_MACHINE -g -Xlinker -D -Xlinker 800000
+#else /* !__GNUC__ */
+/*#define LD_SWITCH_MACHINE -D 800000 -g*/
+#define LD_SWITCH_MACHINE -D 800000
+#endif /* !__GNUC__ */
+#define LIBS_MACHINE -lmld
+#define LIBS_TERMCAP -lcurses
+
+/* The standard definitions of these macros would work ok,
+ but these are faster because the constants are short. */
+
+#define XUINT(a) (((unsigned)(a) << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS))
+
+#define XSET(var, type, ptr) \
+ ((var) = \
+ ((int)(type) << VALBITS) \
+ + (((unsigned) (ptr) << (BITS_PER_INT-VALBITS)) >> (BITS_PER_INT-VALBITS)))
+
+#define XUNMARK(a) \
+ ((a) = \
+ (((unsigned)(a) << (BITS_PER_INT-GCTYPEBITS-VALBITS)) \
+ >> (BITS_PER_INT-GCTYPEBITS-VALBITS)))
--- /dev/null
+/* Definitions file for GNU Emacs running on Sony's NEWS-OS 6.x */
+
+#include "usg5-4-2.h"
+
+#define NEWSOS6
+#define HAVE_TEXT_START
projects / emacs.git / commitdiff