* doc/emacs/glossary.texi (Glossary): Standardize on "text terminal" terminology.
[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...)"
2e2a0075
SM
145 (declare (debug (&define name stringp
146 [&optional [&not keywordp] sexp
147 &optional [&not keywordp] sexp
148 &optional [&not keywordp] sexp]
149 [&rest [keywordp sexp]]
150 def-body)))
a6ce6869 151
bff53411
SM
152 ;; Allow skipping the first three args.
153 (cond
154 ((keywordp init-value)
155 (setq body (list* init-value lighter keymap body)
156 init-value nil lighter nil keymap nil))
157 ((keywordp lighter)
158 (setq body (list* lighter keymap body) lighter nil keymap nil))
159 ((keywordp keymap) (push keymap body) (setq keymap nil)))
160
dae157b7
SM
161 (let* ((last-message (make-symbol "last-message"))
162 (mode-name (symbol-name mode))
b5bbbb76 163 (pretty-name (easy-mmode-pretty-mode-name mode lighter))
c8c21615 164 (globalp nil)
fceb44d2 165 (set nil)
c736d6cf 166 (initialize nil)
0a74e3bf 167 (group nil)
fceb44d2 168 (type nil)
0a74e3bf 169 (extra-args nil)
73ceba9f 170 (extra-keywords nil)
0c495c21
SM
171 (variable nil) ;The PLACE where the state is stored.
172 (setter nil) ;The function (if any) to set the mode var.
173 (modefun mode) ;The minor mode function name we're defining.
c8fb3bf9 174 (require t)
2cb228f7 175 (after-hook nil)
b5bbbb76
SM
176 (hook (intern (concat mode-name "-hook")))
177 (hook-on (intern (concat mode-name "-on-hook")))
73ceba9f 178 (hook-off (intern (concat mode-name "-off-hook")))
6c9b47ae 179 keyw keymap-sym tmp)
b5bbbb76 180
b5bbbb76 181 ;; Check keys.
73ceba9f
SM
182 (while (keywordp (setq keyw (car body)))
183 (setq body (cdr body))
184 (case keyw
bff53411 185 (:init-value (setq init-value (pop body)))
8b908da6 186 (:lighter (setq lighter (purecopy (pop body))))
be22f4cc 187 (:global (setq globalp (pop body)))
0a74e3bf 188 (:extra-args (setq extra-args (pop body)))
fceb44d2 189 (:set (setq set (list :set (pop body))))
c736d6cf 190 (:initialize (setq initialize (list :initialize (pop body))))
0a74e3bf 191 (:group (setq group (nconc group (list :group (pop body)))))
fceb44d2 192 (:type (setq type (list :type (pop body))))
c8fb3bf9 193 (:require (setq require (pop body)))
2e2a0075 194 (:keymap (setq keymap (pop body)))
0c495c21 195 (:variable (setq variable (pop body))
781acb9f
GM
196 (if (not (and (setq tmp (cdr-safe variable))
197 (or (symbolp tmp)
198 (functionp tmp))))
0c495c21
SM
199 ;; PLACE is not of the form (GET . SET).
200 (setq mode variable)
201 (setq mode (car variable))
202 (setq setter (cdr variable))))
2cb228f7 203 (:after-hook (setq after-hook (pop body)))
73ceba9f 204 (t (push keyw extra-keywords) (push (pop body) extra-keywords))))
eab6e8b9 205
2e2a0075
SM
206 (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
207 (intern (concat mode-name "-map"))))
208
fceb44d2
LT
209 (unless set (setq set '(:set 'custom-set-minor-mode)))
210
c736d6cf 211 (unless initialize
fceb44d2 212 (setq initialize '(:initialize 'custom-initialize-default)))
c736d6cf 213
0a74e3bf
SM
214 (unless group
215 ;; We might as well provide a best-guess default group.
216 (setq group
ab7bc290
LK
217 `(:group ',(intern (replace-regexp-in-string
218 "-mode\\'" "" mode-name)))))
7fb80935 219
9d794026 220 ;; TODO? Mark booleans as safe if booleanp? Eg abbrev-mode.
fceb44d2
LT
221 (unless type (setq type '(:type 'boolean)))
222
6b279740 223 `(progn
5e21ef7a 224 ;; Define the variable to enable or disable the mode.
f44379e7
SM
225 ,(cond
226 ;; If :variable is specified, then the var will be
227 ;; declared elsewhere.
228 (variable nil)
229 ((not globalp)
230 `(progn
231 (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
a2ed9670 232Use the command `%s' to change this variable." pretty-name mode))
f44379e7
SM
233 (make-variable-buffer-local ',mode)))
234 (t
94dfee0b
SM
235 (let ((base-doc-string
236 (concat "Non-nil if %s is enabled.
7d5e5e70 237See the command `%s' for a description of this minor mode."
94dfee0b 238 (if body "
d5b037c5 239Setting this variable directly does not take effect;
da506c0e
RS
240either customize it (see the info node `Easy Customization')
241or call the function `%s'."))))
a566ce8e
RS
242 `(defcustom ,mode ,init-value
243 ,(format base-doc-string pretty-name mode mode)
fceb44d2 244 ,@set
c736d6cf 245 ,@initialize
0a74e3bf 246 ,@group
fceb44d2 247 ,@type
94dfee0b 248 ,@(unless (eq require t) `(:require ,require))
f44379e7 249 ,@(nreverse extra-keywords)))))
1328a6df 250
b5bbbb76 251 ;; The actual function.
f44379e7 252 (defun ,modefun (&optional arg ,@extra-args)
b5bbbb76 253 ,(or doc
bff53411 254 (format (concat "Toggle %s on or off.
e95def75
CY
255With a prefix argument ARG, enable %s if ARG is
256positive, and disable it otherwise. If called from Lisp, enable
60d47423 257the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
e95def75 258\\{%s}") pretty-name pretty-name keymap-sym))
5ddfa187
SM
259 ;; Use `toggle' rather than (if ,mode 0 1) so that using
260 ;; repeat-command still does the toggling correctly.
261 (interactive (list (or current-prefix-arg 'toggle)))
dae157b7 262 (let ((,last-message (current-message)))
0c495c21
SM
263 (,@(if setter (list setter)
264 (list (if (symbolp mode) 'setq 'setf) mode))
f44379e7
SM
265 (if (eq arg 'toggle)
266 (not ,mode)
267 ;; A nil argument also means ON now.
268 (> (prefix-numeric-value arg) 0)))
dae157b7
SM
269 ,@body
270 ;; The on/off hooks are here for backward compatibility only.
271 (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
12a3c28c 272 (if (called-interactively-p 'any)
dae157b7 273 (progn
0c495c21
SM
274 ,(if (and globalp (symbolp mode))
275 `(customize-mark-as-set ',mode))
dae157b7
SM
276 ;; Avoid overwriting a message shown by the body,
277 ;; but do overwrite previous messages.
278 (unless (and (current-message)
279 (not (equal ,last-message
280 (current-message))))
281 (message ,(format "%s %%sabled" pretty-name)
2cb228f7
AM
282 (if ,mode "en" "dis")))))
283 ,@(when after-hook `(,after-hook)))
bff53411 284 (force-mode-line-update)
d99d3266 285 ;; Return the new setting.
b5bbbb76 286 ,mode)
2e2a0075 287
ab7bc290
LK
288 ;; Autoloading a define-minor-mode autoloads everything
289 ;; up-to-here.
1328a6df
SM
290 :autoload-end
291
d5b037c5 292 ;; Define the minor-mode keymap.
1328a6df 293 ,(unless (symbolp keymap) ;nil is also a symbol.
d5b037c5 294 `(defvar ,keymap-sym
1328a6df
SM
295 (let ((m ,keymap))
296 (cond ((keymapp m) m)
297 ((listp m) (easy-mmode-define-keymap m))
1a1fcbe1 298 (t (error "Invalid keymap %S" m))))
d5b037c5
SM
299 ,(format "Keymap for `%s'." mode-name)))
300
0c495c21
SM
301 ,(if (not (symbolp mode))
302 (if (or lighter keymap)
303 (error ":lighter and :keymap unsupported with mode expression %s" mode))
304 `(with-no-warnings
305 (add-minor-mode ',mode ',lighter
f44379e7 306 ,(if keymap keymap-sym
0c495c21
SM
307 `(if (boundp ',keymap-sym) ,keymap-sym))
308 nil
e58e988a 309 ,(unless (eq mode modefun) `',modefun)))))))
5a7a545c 310\f
be22f4cc
SM
311;;;
312;;; make global minor mode
313;;;
314
d5b037c5 315;;;###autoload
275e4f4c 316(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
39a27f95 317;;;###autoload
275e4f4c
CY
318(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
319;;;###autoload
320(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys)
9f729dab 321 "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
be22f4cc
SM
322TURN-ON is a function that will be called with no args in every buffer
323 and that should try to turn MODE on if applicable for that buffer.
0ceed14b
LT
324KEYS is a list of CL-style keyword arguments. As the minor mode
325 defined by this function is always global, any :global keyword is
326 ignored. Other keywords have the same meaning as in `define-minor-mode',
327 which see. In particular, :group specifies the custom group.
328 The most useful keywords are those that are passed on to the
329 `defcustom'. It normally makes no sense to pass the :lighter
275e4f4c 330 or :keymap keywords to `define-globalized-minor-mode', since these
0ceed14b 331 are usually passed to the buffer-local version of the minor mode.
876daebc
LT
332
333If MODE's set-up depends on the major mode in effect when it was
334enabled, then disabling and reenabling MODE should make MODE work
335correctly with the current major mode. This is important to
336prevent problems with derived modes, that is, major modes that
337call another major mode in their body."
338
0a74e3bf 339 (let* ((global-mode-name (symbol-name global-mode))
be22f4cc
SM
340 (pretty-name (easy-mmode-pretty-mode-name mode))
341 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
0a74e3bf 342 (group nil)
0ceed14b 343 (extra-keywords nil)
876daebc
LT
344 (MODE-buffers (intern (concat global-mode-name "-buffers")))
345 (MODE-enable-in-buffers
346 (intern (concat global-mode-name "-enable-in-buffers")))
347 (MODE-check-buffers
348 (intern (concat global-mode-name "-check-buffers")))
349 (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
0ceed14b
LT
350 (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
351 keyw)
be22f4cc
SM
352
353 ;; Check keys.
0ceed14b
LT
354 (while (keywordp (setq keyw (car keys)))
355 (setq keys (cdr keys))
356 (case keyw
0a74e3bf 357 (:group (setq group (nconc group (list :group (pop keys)))))
0ceed14b
LT
358 (:global (setq keys (cdr keys)))
359 (t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
be22f4cc 360
0a74e3bf
SM
361 (unless group
362 ;; We might as well provide a best-guess default group.
363 (setq group
ab7bc290
LK
364 `(:group ',(intern (replace-regexp-in-string
365 "-mode\\'" "" (symbol-name mode))))))
dce88ea6 366
be22f4cc 367 `(progn
876daebc
LT
368 (defvar ,MODE-major-mode nil)
369 (make-variable-buffer-local ',MODE-major-mode)
be22f4cc
SM
370 ;; The actual global minor-mode
371 (define-minor-mode ,global-mode
af414f10
EZ
372 ;; Very short lines to avoid too long lines in the generated
373 ;; doc string.
06e21633
CY
374 ,(format "Toggle %s in all buffers.
375With prefix ARG, enable %s if ARG is positive;
376otherwise, disable it. If called from Lisp, enable the mode if
377ARG is omitted or nil.
378
af414f10
EZ
379%s is enabled in all buffers where
380\`%s' would do it.
44395dee 381See `%s' for more information on %s."
06e21633
CY
382 pretty-name pretty-global-name
383 pretty-name turn-on mode pretty-name)
0ceed14b 384 :global t ,@group ,@(nreverse extra-keywords)
be22f4cc
SM
385
386 ;; Setup hook to handle future mode changes and new buffers.
387 (if ,global-mode
d5b037c5 388 (progn
876daebc
LT
389 (add-hook 'after-change-major-mode-hook
390 ',MODE-enable-in-buffers)
15de15c6
CY
391 (add-hook 'change-major-mode-after-body-hook
392 ',MODE-enable-in-buffers)
876daebc
LT
393 (add-hook 'find-file-hook ',MODE-check-buffers)
394 (add-hook 'change-major-mode-hook ',MODE-cmhh))
395 (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
15de15c6
CY
396 (remove-hook 'change-major-mode-after-body-hook
397 ',MODE-enable-in-buffers)
876daebc
LT
398 (remove-hook 'find-file-hook ',MODE-check-buffers)
399 (remove-hook 'change-major-mode-hook ',MODE-cmhh))
be22f4cc
SM
400
401 ;; Go through existing buffers.
402 (dolist (buf (buffer-list))
403 (with-current-buffer buf
34befa9a 404 (if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
be22f4cc 405
275e4f4c 406 ;; Autoloading define-globalized-minor-mode autoloads everything
f5678943 407 ;; up-to-here.
1328a6df
SM
408 :autoload-end
409
be22f4cc 410 ;; List of buffers left to process.
876daebc 411 (defvar ,MODE-buffers nil)
be22f4cc
SM
412
413 ;; The function that calls TURN-ON in each buffer.
876daebc
LT
414 (defun ,MODE-enable-in-buffers ()
415 (dolist (buf ,MODE-buffers)
416 (when (buffer-live-p buf)
417 (with-current-buffer buf
17818d71
SM
418 (unless (eq ,MODE-major-mode major-mode)
419 (if ,mode
420 (progn
421 (,mode -1)
422 (,turn-on)
423 (setq ,MODE-major-mode major-mode))
424 (,turn-on)
425 (setq ,MODE-major-mode major-mode)))))))
876daebc
LT
426 (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
427
428 (defun ,MODE-check-buffers ()
429 (,MODE-enable-in-buffers)
430 (setq ,MODE-buffers nil)
431 (remove-hook 'post-command-hook ',MODE-check-buffers))
432 (put ',MODE-check-buffers 'definition-name ',global-mode)
be22f4cc
SM
433
434 ;; The function that catches kill-all-local-variables.
876daebc
LT
435 (defun ,MODE-cmhh ()
436 (add-to-list ',MODE-buffers (current-buffer))
437 (add-hook 'post-command-hook ',MODE-check-buffers))
438 (put ',MODE-cmhh 'definition-name ',global-mode))))
be22f4cc 439
5a7a545c
SM
440;;;
441;;; easy-mmode-defmap
442;;;
443
210c6549
GM
444(eval-and-compile
445 (if (fboundp 'set-keymap-parents)
446 (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
447 (defun easy-mmode-set-keymap-parents (m parents)
448 (set-keymap-parent
449 m
450 (cond
451 ((not (consp parents)) parents)
452 ((not (cdr parents)) (car parents))
453 (t (let ((m (copy-keymap (pop parents))))
454 (easy-mmode-set-keymap-parents m parents)
455 m)))))))
5a7a545c 456
5d78d57d 457;;;###autoload
5a7a545c
SM
458(defun easy-mmode-define-keymap (bs &optional name m args)
459 "Return a keymap built from bindings BS.
460BS must be a list of (KEY . BINDING) where
3837de12
SM
461KEY and BINDINGS are suitable for `define-key'.
462Optional NAME is passed to `make-sparse-keymap'.
463Optional map M can be used to modify an existing map.
38a48ab7
GM
464ARGS is a list of additional keyword arguments.
465
466Valid keywords and arguments are:
467
468 :name Name of the keymap; overrides NAME argument.
469 :dense Non-nil for a dense keymap.
470 :inherit Parent keymap.
471 :group Ignored.
472 :suppress Non-nil to call `suppress-keymap' on keymap,
473 'nodigits to suppress digits as prefix arguments."
474 (let (inherit dense suppress)
5a7a545c
SM
475 (while args
476 (let ((key (pop args))
477 (val (pop args)))
be22f4cc 478 (case key
165958d2 479 (:name (setq name val))
be22f4cc
SM
480 (:dense (setq dense val))
481 (:inherit (setq inherit val))
38a48ab7 482 (:suppress (setq suppress val))
be22f4cc 483 (:group)
5a7a545c
SM
484 (t (message "Unknown argument %s in defmap" key)))))
485 (unless (keymapp m)
486 (setq bs (append m bs))
487 (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
38a48ab7
GM
488 (when suppress
489 (suppress-keymap m (eq suppress 'nodigits)))
5a7a545c
SM
490 (dolist (b bs)
491 (let ((keys (car b))
492 (binding (cdr b)))
493 (dolist (key (if (consp keys) keys (list keys)))
494 (cond
495 ((symbolp key)
496 (substitute-key-definition key binding m global-map))
497 ((null binding)
498 (unless (keymapp (lookup-key m key)) (define-key m key binding)))
499 ((let ((o (lookup-key m key)))
500 (or (null o) (numberp o) (eq o 'undefined)))
501 (define-key m key binding))))))
502 (cond
503 ((keymapp inherit) (set-keymap-parent m inherit))
504 ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
505 m))
506
507;;;###autoload
508(defmacro easy-mmode-defmap (m bs doc &rest args)
117fdd32
GM
509 "Define a constant M whose value is the result of `easy-mmode-define-keymap'.
510The M, BS, and ARGS arguments are as per that function. DOC is
511the constant's documentation."
5d78d57d
SM
512 `(defconst ,m
513 (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
514 ,doc))
5a7a545c
SM
515
516\f
517;;;
518;;; easy-mmode-defsyntax
519;;;
520
521(defun easy-mmode-define-syntax (css args)
e4fe3460
SM
522 (let ((st (make-syntax-table (plist-get args :copy)))
523 (parent (plist-get args :inherit)))
5a7a545c
SM
524 (dolist (cs css)
525 (let ((char (car cs))
526 (syntax (cdr cs)))
527 (if (sequencep char)
9b97ee2e 528 (mapc (lambda (c) (modify-syntax-entry c syntax st)) char)
5a7a545c 529 (modify-syntax-entry char syntax st))))
e4fe3460
SM
530 (if parent (set-char-table-parent
531 st (if (symbolp parent) (symbol-value parent) parent)))
5a7a545c
SM
532 st))
533
534;;;###autoload
535(defmacro easy-mmode-defsyntax (st css doc &rest args)
e4fe3460 536 "Define variable ST as a syntax-table.
2a83a11d 537CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
e4ad5f9e
SM
538 `(progn
539 (autoload 'easy-mmode-define-syntax "easy-mmode")
2a83a11d 540 (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
5a7a545c
SM
541
542
543\f
c7ea3acc
SM
544;;;
545;;; easy-mmode-define-navigation
546;;;
547
cc349341
SM
548(defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun
549 &rest body)
c7ea3acc
SM
550 "Define BASE-next and BASE-prev to navigate in the buffer.
551RE determines the places the commands should move point to.
eed083e6 552NAME should describe the entities matched by RE. It is used to build
c7ea3acc
SM
553 the docstrings of the two functions.
554BASE-next also tries to make sure that the whole entry is visible by
555 searching for its end (by calling ENDFUN if provided or by looking for
556 the next entry) and recentering if necessary.
877f9b05
TTN
557ENDFUN should return the end position (with or without moving point).
558NARROWFUN non-nil means to check for narrowing before moving, and if
cc349341
SM
559found, do `widen' first and then call NARROWFUN with no args after moving.
560BODY is executed after moving to the destination location."
561 (declare (indent 5) (debug (exp exp exp def-form def-form &rest def-body)))
c7ea3acc
SM
562 (let* ((base-name (symbol-name base))
563 (prev-sym (intern (concat base-name "-prev")))
877f9b05 564 (next-sym (intern (concat base-name "-next")))
cc349341
SM
565 (when-narrowed
566 (lambda (body)
567 (if (null narrowfun) body
568 `(let ((was-narrowed
569 (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
570 (widen))))
571 ,body
572 (when was-narrowed (,narrowfun)))))))
8fd9bef2 573 (unless name (setq name base-name))
c7ea3acc 574 `(progn
b5bbbb76
SM
575 (add-to-list 'debug-ignored-errors
576 ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
c7ea3acc 577 (defun ,next-sym (&optional count)
36a5b60e 578 ,(format "Go to the next COUNT'th %s." name)
9e288f75 579 (interactive "p")
c7ea3acc
SM
580 (unless count (setq count 1))
581 (if (< count 0) (,prev-sym (- count))
6c119ac0 582 (if (looking-at ,re) (setq count (1+ count)))
cc349341
SM
583 ,(funcall when-narrowed
584 `(if (not (re-search-forward ,re nil t count))
585 (if (looking-at ,re)
586 (goto-char (or ,(if endfun `(,endfun)) (point-max)))
587 (error "No next %s" ,name))
588 (goto-char (match-beginning 0))
589 (when (and (eq (current-buffer) (window-buffer (selected-window)))
32226619 590 (called-interactively-p 'interactive))
cc349341
SM
591 (let ((endpt (or (save-excursion
592 ,(if endfun `(,endfun)
593 `(re-search-forward ,re nil t 2)))
594 (point-max))))
595 (unless (pos-visible-in-window-p endpt nil t)
596 (recenter '(0)))))))
597 ,@body))
d5ba8197 598 (put ',next-sym 'definition-name ',base)
c7ea3acc
SM
599 (defun ,prev-sym (&optional count)
600 ,(format "Go to the previous COUNT'th %s" (or name base-name))
9e288f75 601 (interactive "p")
c7ea3acc
SM
602 (unless count (setq count 1))
603 (if (< count 0) (,next-sym (- count))
cc349341
SM
604 ,(funcall when-narrowed
605 `(unless (re-search-backward ,re nil t count)
606 (error "No previous %s" ,name)))
607 ,@body))
d5ba8197 608 (put ',prev-sym 'definition-name ',base))))
877f9b05 609
5a7a545c 610
6b279740
RS
611(provide 'easy-mmode)
612
613;;; easy-mmode.el ends here