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