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