-;;; easy-mmode.el --- easy definition of minor modes.
+;;; easy-mmode.el --- easy definition for major and minor modes.
;; Copyright (C) 1997 Free Software Foundation, Inc.
;; installed. Perhaps there should be a feature to let you specify
;; orderings.
-;;; Code:
+;; Additionally to `define-minor-mode', the package provides convenient
+;; ways to define keymaps, and other helper functions for major and minor modes.
-(defun easy-mmode-define-keymap (keymap-alist &optional menu-name)
- "Return a keymap built 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))
+;;; Code:
(defmacro easy-mmode-define-toggle (mode &optional doc &rest body)
"Define a one arg toggle mode MODE function and associated hooks.
(setcdr (assq ',mode minor-mode-map-alist)
,keymap-sym)) ))
+\f
+;;;
+;;; easy-mmode-defmap
+;;;
+
+(if (fboundp 'set-keymap-parents)
+ (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
+ (defun easy-mmode-set-keymap-parents (m parents)
+ (set-keymap-parent
+ m
+ (cond
+ ((not (consp parents)) parents)
+ ((not (cdr parents)) (car parents))
+ (t (let ((m (copy-keymap (pop parents))))
+ (easy-mmode-set-keymap-parents m parents)
+ m))))))
+
+(defun easy-mmode-define-keymap (bs &optional name m args)
+ "Return a keymap built from bindings BS.
+BS must be a list of (KEY . BINDING) where
+KEY and BINDINGS are suited as for define-key.
+optional NAME is passed to `make-sparse-keymap'.
+optional map M can be used to modify an existing map.
+ARGS is a list of additional arguments."
+ (let (inherit dense suppress)
+ (while args
+ (let ((key (pop args))
+ (val (pop args)))
+ (cond
+ ((eq key :dense) (setq dense val))
+ ((eq key :inherit) (setq inherit val))
+ ((eq key :group) )
+ ;;((eq key :suppress) (setq suppress val))
+ (t (message "Unknown argument %s in defmap" key)))))
+ (unless (keymapp m)
+ (setq bs (append m bs))
+ (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
+ (dolist (b bs)
+ (let ((keys (car b))
+ (binding (cdr b)))
+ (dolist (key (if (consp keys) keys (list keys)))
+ (cond
+ ((symbolp key)
+ (substitute-key-definition key binding m global-map))
+ ((null binding)
+ (unless (keymapp (lookup-key m key)) (define-key m key binding)))
+ ((let ((o (lookup-key m key)))
+ (or (null o) (numberp o) (eq o 'undefined)))
+ (define-key m key binding))))))
+ (cond
+ ((keymapp inherit) (set-keymap-parent m inherit))
+ ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
+ m))
+
+;;;###autoload
+(defmacro easy-mmode-defmap (m bs doc &rest args)
+ `(defconst ,m
+ (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
+ ,doc))
+
+\f
+;;;
+;;; easy-mmode-defsyntax
+;;;
+
+(defun easy-mmode-define-syntax (css args)
+ (let ((st (make-syntax-table (cadr (memq :copy args)))))
+ (dolist (cs css)
+ (let ((char (car cs))
+ (syntax (cdr cs)))
+ (if (sequencep char)
+ (mapcar* (lambda (c) (modify-syntax-entry c syntax st)) char)
+ (modify-syntax-entry char syntax st))))
+ st))
+
+;;;###autoload
+(defmacro easy-mmode-defsyntax (st css doc &rest args)
+ `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc))
+
+
+\f
+;;; A "macro-only" reimplementation of define-derived-mode.
+
+(defmacro easy-mmode-define-derived-mode (child parent name &optional docstring &rest body)
+ "Create a new mode as a variant of an existing mode.
+
+The arguments to this command are as follow:
+
+CHILD: the name of the command for the derived mode.
+PARENT: the name of the command for the parent mode (e.g. `text-mode').
+NAME: a string which will appear in the status line (e.g. \"Hypertext\")
+DOCSTRING: an optional documentation string--if you do not supply one,
+ the function will attempt to invent something useful.
+BODY: forms to execute just before running the
+ hooks for the new mode.
+
+Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode:
+
+ (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\")
+
+You could then make new key bindings for `LaTeX-thesis-mode-map'
+without changing regular LaTeX mode. In this example, BODY is empty,
+and DOCSTRING is generated by default.
+
+On a more complicated level, the following command uses `sgml-mode' as
+the parent, and then sets the variable `case-fold-search' to nil:
+
+ (define-derived-mode article-mode sgml-mode \"Article\"
+ \"Major mode for editing technical articles.\"
+ (setq case-fold-search nil))
+
+Note that if the documentation string had been left out, it would have
+been generated automatically, with a reference to the keymap."
+
+ ; Some trickiness, since what
+ ; appears to be the docstring
+ ; may really be the first
+ ; element of the body.
+ (if (and docstring (not (stringp docstring)))
+ (progn (setq body (cons docstring body))
+ (setq docstring nil)))
+ (let* ((child-name (symbol-name child))
+ (map (intern (concat child-name "-map")))
+ (syntax (intern (concat child-name "-syntax-table")))
+ (abbrev (intern (concat child-name "-abbrev-table")))
+ (hook (intern (concat child-name "-hook"))))
+
+ `(progn
+ (defvar ,map (make-sparse-keymap))
+ (defvar ,syntax (make-char-table 'syntax-table nil))
+ (defvar ,abbrev (progn (define-abbrev-table ',abbrev nil) ,abbrev))
+
+ (defun ,child ()
+ ,(or docstring
+ (format "Major mode derived from `%s' by `define-derived-mode'.
+Inherits all of the parent's attributes, but has its own keymap,
+abbrev table and syntax table:
+
+ `%s', `%s' and `%s'
+
+which more-or-less shadow %s's corresponding tables.
+It also runs its own `%s' after its parent's.
+
+\\{%s}" parent map syntax abbrev parent hook map))
+ (interactive)
+ ; Run the parent.
+ (,parent)
+ ; Identify special modes.
+ (put ',child 'special (get ',parent 'special))
+ ; Identify the child mode.
+ (setq major-mode ',child)
+ (setq mode-name ,name)
+ ; Set up maps and tables.
+ (unless (keymap-parent ,map)
+ (set-keymap-parent ,map (current-local-map)))
+ (let ((parent (char-table-parent ,syntax)))
+ (unless (and parent (not (eq parent (standard-syntax-table))))
+ (set-char-table-parent ,syntax (syntax-table))))
+ (when local-abbrev-table
+ (mapatoms
+ (lambda (symbol)
+ (or (intern-soft (symbol-name symbol) ,abbrev)
+ (define-abbrev ,abbrev (symbol-name symbol)
+ (symbol-value symbol) (symbol-function symbol))))
+ local-abbrev-table))
+
+ (use-local-map ,map)
+ (set-syntax-table ,syntax)
+ (setq local-abbrev-table ,abbrev)
+ ; Splice in the body (if any).
+ ,@body
+ ; Run the hooks, if any.
+ (run-hooks ',hook)))))
+
+\f
(provide 'easy-mmode)
;;; easy-mmode.el ends here
projects / emacs.git / commitdiff