* etc/NEWS: Doc fix.
[bpt/emacs.git] / lisp / emacs-lisp / easy-mmode.el
CommitLineData
e8af40ee 1;;; easy-mmode.el --- easy definition for major and minor modes
6b279740 2
acaf905b 3;; Copyright (C) 1997, 2000-2012 Free Software Foundation, Inc.
6b279740 4
9781053a
PJ
5;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
6;; Maintainer: Stefan Monnier <monnier@gnu.org>
bd78fa1d 7;; Package: emacs
9781053a
PJ
8
9;; Keywords: extensions lisp
6b279740
RS
10
11;; This file is part of GNU Emacs.
12
d6cba7ae 13;; GNU Emacs is free software: you can redistribute it and/or modify
6b279740 14;; it under the terms of the GNU General Public License as published by
d6cba7ae
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
6b279740
RS
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
d6cba7ae 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
6b279740
RS
25
26;;; Commentary:
27
28;; Minor modes are useful and common. This package makes defining a
29;; minor mode easy, by focusing on the writing of the minor mode
30;; functionalities themselves. Moreover, this package enforces a
31;; conventional naming of user interface primitives, making things
32;; natural for the minor-mode end-users.
33
34;; For each mode, easy-mmode defines the following:
35;; <mode> : The minor mode predicate. A buffer-local variable.
36;; <mode>-map : The keymap possibly associated to <mode>.
c8c21615 37;; see `define-minor-mode' documentation
6b279740
RS
38;;
39;; eval
c8c21615 40;; (pp (macroexpand '(define-minor-mode <your-mode> <doc>)))
6b279740
RS
41;; to check the result before using it.
42
43;; The order in which minor modes are installed is important. Keymap
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
46;; installed. Perhaps there should be a feature to let you specify
47;; orderings.
48
5a7a545c
SM
49;; Additionally to `define-minor-mode', the package provides convenient
50;; ways to define keymaps, and other helper functions for major and minor modes.
6b279740 51
5a7a545c 52;;; Code:
6b279740 53
be22f4cc
SM
54(eval-when-compile (require 'cl))
55
b5bbbb76
SM
56(defun easy-mmode-pretty-mode-name (mode &optional lighter)
57 "Turn the symbol MODE into a string intended for the user.
e6469973
EZ
58If provided, LIGHTER will be used to help choose capitalization by,
59replacing its case-insensitive matches with the literal string in LIGHTER."
b5bbbb76 60 (let* ((case-fold-search t)
906aee93 61 ;; Produce "Foo-Bar minor mode" from foo-bar-minor-mode.
b643ec53 62 (name (concat (replace-regexp-in-string
906aee93
EZ
63 ;; If the original mode name included "-minor" (some
64 ;; of them don't, e.g. auto-revert-mode), then
65 ;; replace it with " minor".
b643ec53 66 "-Minor" " minor"
e6469973 67 ;; "foo-bar-minor" -> "Foo-Bar-Minor"
b643ec53 68 (capitalize (replace-regexp-in-string
e6469973 69 ;; "foo-bar-minor-mode" -> "foo-bar-minor"
b643ec53 70 "-mode\\'" "" (symbol-name mode))))
b5bbbb76
SM
71 " mode")))
72 (if (not (stringp lighter)) name
e6469973
EZ
73 ;; Strip leading and trailing whitespace from LIGHTER.
74 (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\s-+\\'" ""
75 lighter))
76 ;; Replace any (case-insensitive) matches for LIGHTER in NAME
77 ;; with a literal LIGHTER. E.g., if NAME is "Iimage mode" and
78 ;; LIGHTER is " iImag", then this will produce "iImage mode".
79 ;; (LIGHTER normally comes from the mode-line string passed to
80 ;; define-minor-mode, and normally includes at least one leading
81 ;; space.)
82 (replace-regexp-in-string (regexp-quote lighter) lighter name t t))))
3837de12 83
6b279740 84;;;###autoload
29cc3b84
SM
85(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
86;;;###autoload
87(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
6b279740 88 "Define a new minor mode MODE.
60dc2671
GM
89This defines the toggle command MODE and (by default) a control variable
90MODE (you can override this with the :variable keyword, see below).
6b279740 91DOC is the documentation for the mode toggle command.
bc7d7ea6 92
60d47423
GM
93The defined mode command takes one optional (prefix) argument.
94Interactively with no prefix argument it toggles the mode.
95With a prefix argument, it enables the mode if the argument is
96positive and otherwise disables it. When called from Lisp, it
97enables the mode if the argument is omitted or nil, and toggles
98the mode if the argument is `toggle'. If DOC is nil this
99function adds a basic doc-string stating these facts.
100
29cc3b84 101Optional INIT-VALUE is the initial value of the mode's variable.
c8c21615 102Optional LIGHTER is displayed in the modeline when the mode is on.
bc7d7ea6
CY
103Optional KEYMAP is the default keymap bound to the mode keymap.
104 If non-nil, it should be a variable name (whose value is a keymap),
1a1fcbe1 105 or an expression that returns either a keymap or a list of
c1ebb47e
GM
106 arguments for `easy-mmode-define-keymap'. If you supply a KEYMAP
107 argument that is not a symbol, this macro defines the variable
108 MODE-map and gives it the value that KEYMAP specifies.
bc7d7ea6
CY
109
110BODY contains code to execute each time the mode is enabled or disabled.
111 It is executed after toggling the mode, and before running MODE-hook.
112 Before the actual body code, you can write keyword arguments, i.e.
113 alternating keywords and values. These following special keywords
114 are supported (other keywords are passed to `defcustom' if the minor
115 mode is global):
116
a6ce6869 117:group GROUP Custom group name to use in all generated `defcustom' forms.
ab7bc290 118 Defaults to MODE without the possible trailing \"-mode\".
c25eec81
LK
119 Don't use this default group name unless you have written a
120 `defgroup' to define that group properly.
c8fb3bf9 121:global GLOBAL If non-nil specifies that the minor mode is not meant to be
ab7bc290 122 buffer-local, so don't make the variable MODE buffer-local.
a6ce6869 123 By default, the mode is buffer-local.
c8fb3bf9 124:init-value VAL Same as the INIT-VALUE argument.
60dc2671 125 Not used if you also specify :variable.
c8fb3bf9 126:lighter SPEC Same as the LIGHTER argument.
2e2a0075 127:keymap MAP Same as the KEYMAP argument.
a6ce6869 128:require SYM Same as in `defcustom'.
60dc2671
GM
129:variable PLACE The location to use instead of the variable MODE to store
130 the state of the mode. This can be simply a different
131 named variable, or more generally anything that can be used
132 with the CL macro `setf'. PLACE can also be of the form
133 \(GET . SET), where GET is an expression that returns the
134 current state, and SET is a function that takes one argument,
135 the new state, and sets it. If you specify a :variable,
136 this function does not define a MODE variable (nor any of
137 the terms used in :variable).
2cb228f7
AM
138:after-hook A single lisp form which is evaluated after the mode hooks
139 have been run. It should not be quoted.
a6ce6869
RS
140
141For example, you could write
142 (define-minor-mode foo-mode \"If enabled, foo on you!\"
73ceba9f 143 :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
a6ce6869 144 ...BODY CODE...)"
b581bb5c
SM
145 (declare (doc-string 2)
146 (debug (&define name stringp
2e2a0075
SM
147 [&optional [&not keywordp] sexp
148 &optional [&not keywordp] sexp
149 &optional [&not keywordp] sexp]
150 [&rest [keywordp sexp]]
151 def-body)))
a6ce6869 152
bff53411
SM
153 ;; Allow skipping the first three args.
154 (cond
155 ((keywordp init-value)
156 (setq body (list* init-value lighter keymap body)
157 init-value nil lighter nil keymap nil))
158 ((keywordp lighter)
159 (setq body (list* lighter keymap body) lighter nil keymap nil))
160 ((keywordp keymap) (push keymap body) (setq keymap nil)))
161
dae157b7
SM
162 (let* ((last-message (make-symbol "last-message"))
163 (mode-name (symbol-name mode))
b5bbbb76 164 (pretty-name (easy-mmode-pretty-mode-name mode lighter))
c8c21615 165 (globalp nil)
fceb44d2 166 (set nil)
c736d6cf 167 (initialize nil)
0a74e3bf 168 (group nil)
fceb44d2 169 (type nil)
0a74e3bf 170 (extra-args nil)
73ceba9f 171 (extra-keywords nil)
0c495c21
SM
172 (variable nil) ;The PLACE where the state is stored.
173 (setter nil) ;The function (if any) to set the mode var.
174 (modefun mode) ;The minor mode function name we're defining.
c8fb3bf9 175 (require t)
2cb228f7 176 (after-hook nil)
b5bbbb76
SM
177 (hook (intern (concat mode-name "-hook")))
178 (hook-on (intern (concat mode-name "-on-hook")))
73ceba9f 179 (hook-off (intern (concat mode-name "-off-hook")))
6c9b47ae 180 keyw keymap-sym tmp)
b5bbbb76 181
b5bbbb76 182 ;; Check keys.
73ceba9f
SM
183 (while (keywordp (setq keyw (car body)))
184 (setq body (cdr body))
185 (case keyw
bff53411 186 (:init-value (setq init-value (pop body)))
8b908da6 187 (:lighter (setq lighter (purecopy (pop body))))
be22f4cc 188 (:global (setq globalp (pop body)))
0a74e3bf 189 (:extra-args (setq extra-args (pop body)))
fceb44d2 190 (:set (setq set (list :set (pop body))))
c736d6cf 191 (:initialize (setq initialize (list :initialize (pop body))))
0a74e3bf 192 (:group (setq group (nconc group (list :group (pop body)))))
fceb44d2 193 (:type (setq type (list :type (pop body))))
c8fb3bf9 194 (:require (setq require (pop body)))
2e2a0075 195 (:keymap (setq keymap (pop body)))
0c495c21 196 (:variable (setq variable (pop body))
781acb9f
GM
197 (if (not (and (setq tmp (cdr-safe variable))
198 (or (symbolp tmp)
199 (functionp tmp))))
0c495c21
SM
200 ;; PLACE is not of the form (GET . SET).
201 (setq mode variable)
202 (setq mode (car variable))
203 (setq setter (cdr variable))))
2cb228f7 204 (:after-hook (setq after-hook (pop body)))
73ceba9f 205 (t (push keyw extra-keywords) (push (pop body) extra-keywords))))
eab6e8b9 206
2e2a0075
SM
207 (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
208 (intern (concat mode-name "-map"))))
209
fceb44d2
LT
210 (unless set (setq set '(:set 'custom-set-minor-mode)))
211
c736d6cf 212 (unless initialize
fceb44d2 213 (setq initialize '(:initialize 'custom-initialize-default)))
c736d6cf 214
0a74e3bf
SM
215 (unless group
216 ;; We might as well provide a best-guess default group.
217 (setq group
ab7bc290
LK
218 `(:group ',(intern (replace-regexp-in-string
219 "-mode\\'" "" mode-name)))))
7fb80935 220
9d794026 221 ;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
fceb44d2
LT
222 (unless type (setq type '(:type 'boolean)))
223
6b279740 224 `(progn
5e21ef7a 225 ;; Define the variable to enable or disable the mode.
f44379e7
SM
226 ,(cond
227 ;; If :variable is specified, then the var will be
228 ;; declared elsewhere.
229 (variable nil)
230 ((not globalp)
231 `(progn
232 (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
a2ed9670 233Use the command `%s' to change this variable." pretty-name mode))
f44379e7
SM
234 (make-variable-buffer-local ',mode)))
235 (t
94dfee0b
SM
236 (let ((base-doc-string
237 (concat "Non-nil if %s is enabled.
7d5e5e70 238See the command `%s' for a description of this minor mode."
94dfee0b 239 (if body "
d5b037c5 240Setting this variable directly does not take effect;
da506c0e
RS
241either customize it (see the info node `Easy Customization')
242or call the function `%s'."))))
a566ce8e
RS
243 `(defcustom ,mode ,init-value
244 ,(format base-doc-string pretty-name mode mode)
fceb44d2 245 ,@set
c736d6cf 246 ,@initialize
0a74e3bf 247 ,@group
fceb44d2 248 ,@type
94dfee0b 249 ,@(unless (eq require t) `(:require ,require))
f44379e7 250 ,@(nreverse extra-keywords)))))
1328a6df 251
b5bbbb76 252 ;; The actual function.
f44379e7 253 (defun ,modefun (&optional arg ,@extra-args)
b5bbbb76 254 ,(or doc
bff53411 255 (format (concat "Toggle %s on or off.
e95def75
CY
256With a prefix argument ARG, enable %s if ARG is
257positive, and disable it otherwise. If called from Lisp, enable
60d47423 258the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
e95def75 259\\{%s}") pretty-name pretty-name keymap-sym))
5ddfa187
SM
260 ;; Use `toggle' rather than (if ,mode 0 1) so that using
261 ;; repeat-command still does the toggling correctly.
262 (interactive (list (or current-prefix-arg 'toggle)))
dae157b7 263 (let ((,last-message (current-message)))
9c2d6a4a 264 (,@(if setter `(funcall #',setter)
0c495c21 265 (list (if (symbolp mode) 'setq 'setf) mode))
f44379e7
SM
266 (if (eq arg 'toggle)
267 (not ,mode)
268 ;; A nil argument also means ON now.
269 (> (prefix-numeric-value arg) 0)))
dae157b7
SM
270 ,@body
271 ;; The on/off hooks are here for backward compatibility only.
272 (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
12a3c28c 273 (if (called-interactively-p 'any)
dae157b7 274 (progn
0c495c21
SM
275 ,(if (and globalp (symbolp mode))
276 `(customize-mark-as-set ',mode))
dae157b7
SM
277 ;; Avoid overwriting a message shown by the body,
278 ;; but do overwrite previous messages.
279 (unless (and (current-message)
280 (not (equal ,last-message
281 (current-message))))
282 (message ,(format "%s %%sabled" pretty-name)
2cb228f7
AM
283 (if ,mode "en" "dis")))))
284 ,@(when after-hook `(,after-hook)))
bff53411 285 (force-mode-line-update)
d99d3266 286 ;; Return the new setting.
b5bbbb76 287 ,mode)
2e2a0075 288
ab7bc290
LK
289 ;; Autoloading a define-minor-mode autoloads everything
290 ;; up-to-here.
1328a6df
SM
291 :autoload-end
292
d5b037c5 293 ;; Define the minor-mode keymap.
1328a6df 294 ,(unless (symbolp keymap) ;nil is also a symbol.
d5b037c5 295 `(defvar ,keymap-sym
1328a6df
SM
296 (let ((m ,keymap))
297 (cond ((keymapp m) m)
298 ((listp m) (easy-mmode-define-keymap m))
1a1fcbe1 299 (t (error "Invalid keymap %S" m))))
d5b037c5
SM
300 ,(format "Keymap for `%s'." mode-name)))
301
0c495c21
SM
302 ,(if (not (symbolp mode))
303 (if (or lighter keymap)
304 (error ":lighter and :keymap unsupported with mode expression %s" mode))
305 `(with-no-warnings
306 (add-minor-mode ',mode ',lighter
f44379e7 307 ,(if keymap keymap-sym
0c495c21
SM
308 `(if (boundp ',keymap-sym) ,keymap-sym))
309 nil
e58e988a 310 ,(unless (eq mode modefun) `',modefun)))))))
5a7a545c 311\f
be22f4cc
SM
312;;;
313;;; make global minor mode
314;;;
315
d5b037c5 316;;;###autoload
275e4f4c 317(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
39a27f95 318;;;###autoload
275e4f4c
CY
319(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
320;;;###autoload
321(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys)
9f729dab 322 "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
be22f4cc
SM
323TURN-ON is a function that will be called with no args in every buffer
324 and that should try to turn MODE on if applicable for that buffer.
0ceed14b
LT
325KEYS is a list of CL-style keyword arguments. As the minor mode
326 defined by this function is always global, any :global keyword is
327 ignored. Other keywords have the same meaning as in `define-minor-mode',
328 which see. In particular, :group specifies the custom group.
329 The most useful keywords are those that are passed on to the
330 `defcustom'. It normally makes no sense to pass the :lighter
275e4f4c 331 or :keymap keywords to `define-globalized-minor-mode', since these
0ceed14b 332 are usually passed to the buffer-local version of the minor mode.
876daebc
LT
333
334If MODE's set-up depends on the major mode in effect when it was
335enabled, then disabling and reenabling MODE should make MODE work
336correctly with the current major mode. This is important to
337prevent problems with derived modes, that is, major modes that
338call another major mode in their body."
b581bb5c 339 (declare (doc-string 2))
0a74e3bf 340 (let* ((global-mode-name (symbol-name global-mode))
be22f4cc
SM
341 (pretty-name (easy-mmode-pretty-mode-name mode))
342 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
0a74e3bf 343 (group nil)
0ceed14b 344 (extra-keywords nil)
876daebc
LT
345 (MODE-buffers (intern (concat global-mode-name "-buffers")))
346 (MODE-enable-in-buffers
347 (intern (concat global-mode-name "-enable-in-buffers")))
348 (MODE-check-buffers
349 (intern (concat global-mode-name "-check-buffers")))
350 (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
0ceed14b
LT
351 (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
352 keyw)
be22f4cc
SM
353
354 ;; Check keys.
0ceed14b
LT
355 (while (keywordp (setq keyw (car keys)))
356 (setq keys (cdr keys))
357 (case keyw
0a74e3bf 358 (:group (setq group (nconc group (list :group (pop keys)))))
0ceed14b
LT
359 (:global (setq keys (cdr keys)))
360 (t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
be22f4cc 361
0a74e3bf
SM
362 (unless group
363 ;; We might as well provide a best-guess default group.
364 (setq group
ab7bc290
LK
365 `(:group ',(intern (replace-regexp-in-string
366 "-mode\\'" "" (symbol-name mode))))))
dce88ea6 367
be22f4cc 368 `(progn
876daebc
LT
369 (defvar ,MODE-major-mode nil)
370 (make-variable-buffer-local ',MODE-major-mode)
be22f4cc
SM
371 ;; The actual global minor-mode
372 (define-minor-mode ,global-mode
af414f10
EZ
373 ;; Very short lines to avoid too long lines in the generated
374 ;; doc string.
06e21633
CY
375 ,(format "Toggle %s in all buffers.
376With prefix ARG, enable %s if ARG is positive;
377otherwise, disable it. If called from Lisp, enable the mode if
378ARG is omitted or nil.
379
af414f10
EZ
380%s is enabled in all buffers where
381\`%s' would do it.
44395dee 382See `%s' for more information on %s."
06e21633
CY
383 pretty-name pretty-global-name
384 pretty-name turn-on mode pretty-name)
0ceed14b 385 :global t ,@group ,@(nreverse extra-keywords)
be22f4cc
SM
386
387 ;; Setup hook to handle future mode changes and new buffers.
388 (if ,global-mode
d5b037c5 389 (progn
876daebc
LT
390 (add-hook 'after-change-major-mode-hook
391 ',MODE-enable-in-buffers)
15de15c6
CY
392 (add-hook 'change-major-mode-after-body-hook
393 ',MODE-enable-in-buffers)
876daebc
LT
394 (add-hook 'find-file-hook ',MODE-check-buffers)
395 (add-hook 'change-major-mode-hook ',MODE-cmhh))
396 (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
15de15c6
CY
397 (remove-hook 'change-major-mode-after-body-hook
398 ',MODE-enable-in-buffers)
876daebc
LT
399 (remove-hook 'find-file-hook ',MODE-check-buffers)
400 (remove-hook 'change-major-mode-hook ',MODE-cmhh))
be22f4cc
SM
401
402 ;; Go through existing buffers.
403 (dolist (buf (buffer-list))
404 (with-current-buffer buf
34befa9a 405 (if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
be22f4cc 406
275e4f4c 407 ;; Autoloading define-globalized-minor-mode autoloads everything
f5678943 408 ;; up-to-here.
1328a6df
SM
409 :autoload-end
410
be22f4cc 411 ;; List of buffers left to process.
876daebc 412 (defvar ,MODE-buffers nil)
be22f4cc
SM
413
414 ;; The function that calls TURN-ON in each buffer.
876daebc
LT
415 (defun ,MODE-enable-in-buffers ()
416 (dolist (buf ,MODE-buffers)
417 (when (buffer-live-p buf)
418 (with-current-buffer buf
17818d71
SM
419 (unless (eq ,MODE-major-mode major-mode)
420 (if ,mode
421 (progn
422 (,mode -1)
423 (,turn-on)
424 (setq ,MODE-major-mode major-mode))
425 (,turn-on)
426 (setq ,MODE-major-mode major-mode)))))))
876daebc
LT
427 (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
428
429 (defun ,MODE-check-buffers ()
430 (,MODE-enable-in-buffers)
431 (setq ,MODE-buffers nil)
432 (remove-hook 'post-command-hook ',MODE-check-buffers))
433 (put ',MODE-check-buffers 'definition-name ',global-mode)
be22f4cc
SM
434
435 ;; The function that catches kill-all-local-variables.
876daebc
LT
436 (defun ,MODE-cmhh ()
437 (add-to-list ',MODE-buffers (current-buffer))
438 (add-hook 'post-command-hook ',MODE-check-buffers))
439 (put ',MODE-cmhh 'definition-name ',global-mode))))
be22f4cc 440
5a7a545c
SM
441;;;
442;;; easy-mmode-defmap
443;;;
444
210c6549
GM
445(eval-and-compile
446 (if (fboundp 'set-keymap-parents)
447 (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
448 (defun easy-mmode-set-keymap-parents (m parents)
449 (set-keymap-parent
450 m
451 (cond
452 ((not (consp parents)) parents)
453 ((not (cdr parents)) (car parents))
454 (t (let ((m (copy-keymap (pop parents))))
455 (easy-mmode-set-keymap-parents m parents)
456 m)))))))
5a7a545c 457
5d78d57d 458;;;###autoload
5a7a545c
SM
459(defun easy-mmode-define-keymap (bs &optional name m args)
460 "Return a keymap built from bindings BS.
461BS must be a list of (KEY . BINDING) where
3837de12
SM
462KEY and BINDINGS are suitable for `define-key'.
463Optional NAME is passed to `make-sparse-keymap'.
464Optional map M can be used to modify an existing map.
38a48ab7
GM
465ARGS is a list of additional keyword arguments.
466
467Valid keywords and arguments are:
468
469 :name Name of the keymap; overrides NAME argument.
470 :dense Non-nil for a dense keymap.
471 :inherit Parent keymap.
472 :group Ignored.
473 :suppress Non-nil to call `suppress-keymap' on keymap,
474 'nodigits to suppress digits as prefix arguments."
475 (let (inherit dense suppress)
5a7a545c
SM
476 (while args
477 (let ((key (pop args))
478 (val (pop args)))
be22f4cc 479 (case key
165958d2 480 (:name (setq name val))
be22f4cc
SM
481 (:dense (setq dense val))
482 (:inherit (setq inherit val))
38a48ab7 483 (:suppress (setq suppress val))
be22f4cc 484 (:group)
5a7a545c
SM
485 (t (message "Unknown argument %s in defmap" key)))))
486 (unless (keymapp m)
487 (setq bs (append m bs))
488 (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
38a48ab7
GM
489 (when suppress
490 (suppress-keymap m (eq suppress 'nodigits)))
5a7a545c
SM
491 (dolist (b bs)
492 (let ((keys (car b))
493 (binding (cdr b)))
494 (dolist (key (if (consp keys) keys (list keys)))
495 (cond
496 ((symbolp key)
497 (substitute-key-definition key binding m global-map))
498 ((null binding)
499 (unless (keymapp (lookup-key m key)) (define-key m key binding)))
500 ((let ((o (lookup-key m key)))
501 (or (null o) (numberp o) (eq o 'undefined)))
502 (define-key m key binding))))))
503 (cond
504 ((keymapp inherit) (set-keymap-parent m inherit))
505 ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
506 m))
507
508;;;###autoload
509(defmacro easy-mmode-defmap (m bs doc &rest args)
117fdd32
GM
510 "Define a constant M whose value is the result of `easy-mmode-define-keymap'.
511The M, BS, and ARGS arguments are as per that function. DOC is
512the constant's documentation."
5d78d57d
SM
513 `(defconst ,m
514 (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
515 ,doc))
5a7a545c
SM
516
517\f
518;;;
519;;; easy-mmode-defsyntax
520;;;
521
522(defun easy-mmode-define-syntax (css args)
e4fe3460
SM
523 (let ((st (make-syntax-table (plist-get args :copy)))
524 (parent (plist-get args :inherit)))
5a7a545c
SM
525 (dolist (cs css)
526 (let ((char (car cs))
527 (syntax (cdr cs)))
528 (if (sequencep char)
9b97ee2e 529 (mapc (lambda (c) (modify-syntax-entry c syntax st)) char)
5a7a545c 530 (modify-syntax-entry char syntax st))))
e4fe3460
SM
531 (if parent (set-char-table-parent
532 st (if (symbolp parent) (symbol-value parent) parent)))
5a7a545c
SM
533 st))
534
535;;;###autoload
536(defmacro easy-mmode-defsyntax (st css doc &rest args)
e4fe3460 537 "Define variable ST as a syntax-table.
2a83a11d 538CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
e4ad5f9e
SM
539 `(progn
540 (autoload 'easy-mmode-define-syntax "easy-mmode")
2a83a11d 541 (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
5a7a545c
SM
542
543
544\f
c7ea3acc
SM
545;;;
546;;; easy-mmode-define-navigation
547;;;
548
cc349341
SM
549(defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun
550 &rest body)
c7ea3acc
SM
551 "Define BASE-next and BASE-prev to navigate in the buffer.
552RE determines the places the commands should move point to.
eed083e6 553NAME should describe the entities matched by RE. It is used to build
c7ea3acc
SM
554 the docstrings of the two functions.
555BASE-next also tries to make sure that the whole entry is visible by
556 searching for its end (by calling ENDFUN if provided or by looking for
557 the next entry) and recentering if necessary.
877f9b05
TTN
558ENDFUN should return the end position (with or without moving point).
559NARROWFUN non-nil means to check for narrowing before moving, and if
cc349341
SM
560found, do `widen' first and then call NARROWFUN with no args after moving.
561BODY is executed after moving to the destination location."
562 (declare (indent 5) (debug (exp exp exp def-form def-form &rest def-body)))
c7ea3acc
SM
563 (let* ((base-name (symbol-name base))
564 (prev-sym (intern (concat base-name "-prev")))
877f9b05 565 (next-sym (intern (concat base-name "-next")))
cc349341
SM
566 (when-narrowed
567 (lambda (body)
568 (if (null narrowfun) body
569 `(let ((was-narrowed
570 (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
571 (widen))))
572 ,body
573 (when was-narrowed (,narrowfun)))))))
8fd9bef2 574 (unless name (setq name base-name))
c7ea3acc
SM
575 `(progn
576 (defun ,next-sym (&optional count)
36a5b60e 577 ,(format "Go to the next COUNT'th %s." name)
9e288f75 578 (interactive "p")
c7ea3acc
SM
579 (unless count (setq count 1))
580 (if (< count 0) (,prev-sym (- count))
6c119ac0 581 (if (looking-at ,re) (setq count (1+ count)))
cc349341
SM
582 ,(funcall when-narrowed
583 `(if (not (re-search-forward ,re nil t count))
584 (if (looking-at ,re)
585 (goto-char (or ,(if endfun `(,endfun)) (point-max)))
71873e2b 586 (user-error "No next %s" ,name))
cc349341
SM
587 (goto-char (match-beginning 0))
588 (when (and (eq (current-buffer) (window-buffer (selected-window)))
32226619 589 (called-interactively-p 'interactive))
cc349341
SM
590 (let ((endpt (or (save-excursion
591 ,(if endfun `(,endfun)
592 `(re-search-forward ,re nil t 2)))
593 (point-max))))
594 (unless (pos-visible-in-window-p endpt nil t)
595 (recenter '(0)))))))
596 ,@body))
d5ba8197 597 (put ',next-sym 'definition-name ',base)
c7ea3acc
SM
598 (defun ,prev-sym (&optional count)
599 ,(format "Go to the previous COUNT'th %s" (or name base-name))
9e288f75 600 (interactive "p")
c7ea3acc
SM
601 (unless count (setq count 1))
602 (if (< count 0) (,next-sym (- count))
cc349341
SM
603 ,(funcall when-narrowed
604 `(unless (re-search-backward ,re nil t count)
71873e2b 605 (user-error "No previous %s" ,name)))
cc349341 606 ,@body))
d5ba8197 607 (put ',prev-sym 'definition-name ',base))))
877f9b05 608
5a7a545c 609
6b279740
RS
610(provide 'easy-mmode)
611
612;;; easy-mmode.el ends here