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