Commit 5a7a545c authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(easy-mmode-define-keymap): Extend to allow more flexibility.

(easy-mmode-set-keymap-parents, easy-mmode-define-syntax): New functions.
(easy-mmode-defmap, easy-mmode-defsyntax, easy-mmode-define-derived-mode):
New macros.
parent 445b0666
2000-03-09 Stefan Monnier <>
* emacs-lisp/easy-mmode.el (easy-mmode-define-keymap): Extend to allow
more flexibility.
(easy-mmode-set-keymap-parents, easy-mmode-define-syntax): New functions.
(easy-mmode-defmap, easy-mmode-defsyntax, easy-mmode-define-derived-mode):
New macros.
2000-09-01 Didier Verna <>
* rect.el (replace-rectangle): New function.
;;; 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.
......@@ -46,20 +46,10 @@
;; 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)))
(function (lambda (bind)
(define-key keymap
(car bind) (cdr bind))))
;;; Code:
(defmacro easy-mmode-define-toggle (mode &optional doc &rest body)
"Define a one arg toggle mode MODE function and associated hooks.
......@@ -161,6 +151,181 @@ Use the function `%s' to change this variable." mode-name))
(setcdr (assq ',mode minor-mode-map-alist)
,keymap-sym)) ))
;;; 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)
((not (consp parents)) parents)
((not (cdr parents)) (car parents))
(t (let ((m (copy-keymap (pop parents))))
(easy-mmode-set-keymap-parents m parents)
(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)))
((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)))
((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))))))
((keymapp inherit) (set-keymap-parent m inherit))
((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
(defmacro easy-mmode-defmap (m bs doc &rest args)
`(defconst ,m
(easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
;;; 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))))
(defmacro easy-mmode-defsyntax (st css doc &rest args)
`(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc))
;;; 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"))))
(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))
; Run the 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
(lambda (symbol)
(or (intern-soft (symbol-name symbol) ,abbrev)
(define-abbrev ,abbrev (symbol-name symbol)
(symbol-value symbol) (symbol-function symbol))))
(use-local-map ,map)
(set-syntax-table ,syntax)
(setq local-abbrev-table ,abbrev)
; Splice in the body (if any).
; Run the hooks, if any.
(run-hooks ',hook)))))
(provide 'easy-mmode)
;;; easy-mmode.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment