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