Mercurial > emacs
comparison lisp/emacs-lisp/easy-mmode.el @ 28081:6360842e5962
(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.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Fri, 10 Mar 2000 01:16:34 +0000 |
parents | 271f77895660 |
children | 9ff6e6a6c6b5 |
comparison
equal
deleted
inserted
replaced
28080:1806455a01be | 28081:6360842e5962 |
---|---|
1 ;;; easy-mmode.el --- easy definition of minor modes. | 1 ;;; easy-mmode.el --- easy definition for major and minor modes. |
2 | 2 |
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> | 5 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> |
6 ;; Maintainer: Stefan Monnier <monnier@gnu.org> | 6 ;; Maintainer: Stefan Monnier <monnier@gnu.org> |
44 ;; lookup proceeds down minor-mode-map-alist, and the order there | 44 ;; lookup proceeds down minor-mode-map-alist, and the order there |
45 ;; tends to be the reverse of the order in which the modes were | 45 ;; tends to be the reverse of the order in which the modes were |
46 ;; installed. Perhaps there should be a feature to let you specify | 46 ;; installed. Perhaps there should be a feature to let you specify |
47 ;; orderings. | 47 ;; orderings. |
48 | 48 |
49 ;; Additionally to `define-minor-mode', the package provides convenient | |
50 ;; ways to define keymaps, and other helper functions for major and minor modes. | |
51 | |
49 ;;; Code: | 52 ;;; Code: |
50 | |
51 (defun easy-mmode-define-keymap (keymap-alist &optional menu-name) | |
52 "Return a keymap built from KEYMAP-ALIST. | |
53 KEYMAP-ALIST must be a list of (KEYBINDING . BINDING) where | |
54 KEYBINDING and BINDINGS are suited as for define-key. | |
55 optional MENU-NAME is passed to `make-sparse-keymap'." | |
56 (let ((keymap (make-sparse-keymap menu-name))) | |
57 (mapcar | |
58 (function (lambda (bind) | |
59 (define-key keymap | |
60 (car bind) (cdr bind)))) | |
61 keymap-alist) | |
62 keymap)) | |
63 | 53 |
64 (defmacro easy-mmode-define-toggle (mode &optional doc &rest body) | 54 (defmacro easy-mmode-define-toggle (mode &optional doc &rest body) |
65 "Define a one arg toggle mode MODE function and associated hooks. | 55 "Define a one arg toggle mode MODE function and associated hooks. |
66 MODE is the so defined function that toggles the mode. | 56 MODE is the so defined function that toggles the mode. |
67 optional DOC is its associated documentation. | 57 optional DOC is its associated documentation. |
159 (setq minor-mode-map-alist | 149 (setq minor-mode-map-alist |
160 (cons (cons ',mode nil) minor-mode-map-alist))) | 150 (cons (cons ',mode nil) minor-mode-map-alist))) |
161 (setcdr (assq ',mode minor-mode-map-alist) | 151 (setcdr (assq ',mode minor-mode-map-alist) |
162 ,keymap-sym)) )) | 152 ,keymap-sym)) )) |
163 | 153 |
154 | |
155 ;;; | |
156 ;;; easy-mmode-defmap | |
157 ;;; | |
158 | |
159 (if (fboundp 'set-keymap-parents) | |
160 (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents) | |
161 (defun easy-mmode-set-keymap-parents (m parents) | |
162 (set-keymap-parent | |
163 m | |
164 (cond | |
165 ((not (consp parents)) parents) | |
166 ((not (cdr parents)) (car parents)) | |
167 (t (let ((m (copy-keymap (pop parents)))) | |
168 (easy-mmode-set-keymap-parents m parents) | |
169 m)))))) | |
170 | |
171 (defun easy-mmode-define-keymap (bs &optional name m args) | |
172 "Return a keymap built from bindings BS. | |
173 BS must be a list of (KEY . BINDING) where | |
174 KEY and BINDINGS are suited as for define-key. | |
175 optional NAME is passed to `make-sparse-keymap'. | |
176 optional map M can be used to modify an existing map. | |
177 ARGS is a list of additional arguments." | |
178 (let (inherit dense suppress) | |
179 (while args | |
180 (let ((key (pop args)) | |
181 (val (pop args))) | |
182 (cond | |
183 ((eq key :dense) (setq dense val)) | |
184 ((eq key :inherit) (setq inherit val)) | |
185 ((eq key :group) ) | |
186 ;;((eq key :suppress) (setq suppress val)) | |
187 (t (message "Unknown argument %s in defmap" key))))) | |
188 (unless (keymapp m) | |
189 (setq bs (append m bs)) | |
190 (setq m (if dense (make-keymap name) (make-sparse-keymap name)))) | |
191 (dolist (b bs) | |
192 (let ((keys (car b)) | |
193 (binding (cdr b))) | |
194 (dolist (key (if (consp keys) keys (list keys))) | |
195 (cond | |
196 ((symbolp key) | |
197 (substitute-key-definition key binding m global-map)) | |
198 ((null binding) | |
199 (unless (keymapp (lookup-key m key)) (define-key m key binding))) | |
200 ((let ((o (lookup-key m key))) | |
201 (or (null o) (numberp o) (eq o 'undefined))) | |
202 (define-key m key binding)))))) | |
203 (cond | |
204 ((keymapp inherit) (set-keymap-parent m inherit)) | |
205 ((consp inherit) (easy-mmode-set-keymap-parents m inherit))) | |
206 m)) | |
207 | |
208 ;;;###autoload | |
209 (defmacro easy-mmode-defmap (m bs doc &rest args) | |
210 `(defconst ,m | |
211 (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) | |
212 ,doc)) | |
213 | |
214 | |
215 ;;; | |
216 ;;; easy-mmode-defsyntax | |
217 ;;; | |
218 | |
219 (defun easy-mmode-define-syntax (css args) | |
220 (let ((st (make-syntax-table (cadr (memq :copy args))))) | |
221 (dolist (cs css) | |
222 (let ((char (car cs)) | |
223 (syntax (cdr cs))) | |
224 (if (sequencep char) | |
225 (mapcar* (lambda (c) (modify-syntax-entry c syntax st)) char) | |
226 (modify-syntax-entry char syntax st)))) | |
227 st)) | |
228 | |
229 ;;;###autoload | |
230 (defmacro easy-mmode-defsyntax (st css doc &rest args) | |
231 `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc)) | |
232 | |
233 | |
234 | |
235 ;;; A "macro-only" reimplementation of define-derived-mode. | |
236 | |
237 (defmacro easy-mmode-define-derived-mode (child parent name &optional docstring &rest body) | |
238 "Create a new mode as a variant of an existing mode. | |
239 | |
240 The arguments to this command are as follow: | |
241 | |
242 CHILD: the name of the command for the derived mode. | |
243 PARENT: the name of the command for the parent mode (e.g. `text-mode'). | |
244 NAME: a string which will appear in the status line (e.g. \"Hypertext\") | |
245 DOCSTRING: an optional documentation string--if you do not supply one, | |
246 the function will attempt to invent something useful. | |
247 BODY: forms to execute just before running the | |
248 hooks for the new mode. | |
249 | |
250 Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: | |
251 | |
252 (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\") | |
253 | |
254 You could then make new key bindings for `LaTeX-thesis-mode-map' | |
255 without changing regular LaTeX mode. In this example, BODY is empty, | |
256 and DOCSTRING is generated by default. | |
257 | |
258 On a more complicated level, the following command uses `sgml-mode' as | |
259 the parent, and then sets the variable `case-fold-search' to nil: | |
260 | |
261 (define-derived-mode article-mode sgml-mode \"Article\" | |
262 \"Major mode for editing technical articles.\" | |
263 (setq case-fold-search nil)) | |
264 | |
265 Note that if the documentation string had been left out, it would have | |
266 been generated automatically, with a reference to the keymap." | |
267 | |
268 ; Some trickiness, since what | |
269 ; appears to be the docstring | |
270 ; may really be the first | |
271 ; element of the body. | |
272 (if (and docstring (not (stringp docstring))) | |
273 (progn (setq body (cons docstring body)) | |
274 (setq docstring nil))) | |
275 (let* ((child-name (symbol-name child)) | |
276 (map (intern (concat child-name "-map"))) | |
277 (syntax (intern (concat child-name "-syntax-table"))) | |
278 (abbrev (intern (concat child-name "-abbrev-table"))) | |
279 (hook (intern (concat child-name "-hook")))) | |
280 | |
281 `(progn | |
282 (defvar ,map (make-sparse-keymap)) | |
283 (defvar ,syntax (make-char-table 'syntax-table nil)) | |
284 (defvar ,abbrev (progn (define-abbrev-table ',abbrev nil) ,abbrev)) | |
285 | |
286 (defun ,child () | |
287 ,(or docstring | |
288 (format "Major mode derived from `%s' by `define-derived-mode'. | |
289 Inherits all of the parent's attributes, but has its own keymap, | |
290 abbrev table and syntax table: | |
291 | |
292 `%s', `%s' and `%s' | |
293 | |
294 which more-or-less shadow %s's corresponding tables. | |
295 It also runs its own `%s' after its parent's. | |
296 | |
297 \\{%s}" parent map syntax abbrev parent hook map)) | |
298 (interactive) | |
299 ; Run the parent. | |
300 (,parent) | |
301 ; Identify special modes. | |
302 (put ',child 'special (get ',parent 'special)) | |
303 ; Identify the child mode. | |
304 (setq major-mode ',child) | |
305 (setq mode-name ,name) | |
306 ; Set up maps and tables. | |
307 (unless (keymap-parent ,map) | |
308 (set-keymap-parent ,map (current-local-map))) | |
309 (let ((parent (char-table-parent ,syntax))) | |
310 (unless (and parent (not (eq parent (standard-syntax-table)))) | |
311 (set-char-table-parent ,syntax (syntax-table)))) | |
312 (when local-abbrev-table | |
313 (mapatoms | |
314 (lambda (symbol) | |
315 (or (intern-soft (symbol-name symbol) ,abbrev) | |
316 (define-abbrev ,abbrev (symbol-name symbol) | |
317 (symbol-value symbol) (symbol-function symbol)))) | |
318 local-abbrev-table)) | |
319 | |
320 (use-local-map ,map) | |
321 (set-syntax-table ,syntax) | |
322 (setq local-abbrev-table ,abbrev) | |
323 ; Splice in the body (if any). | |
324 ,@body | |
325 ; Run the hooks, if any. | |
326 (run-hooks ',hook))))) | |
327 | |
328 | |
164 (provide 'easy-mmode) | 329 (provide 'easy-mmode) |
165 | 330 |
166 ;;; easy-mmode.el ends here | 331 ;;; easy-mmode.el ends here |