Fix event race
[bpt/emacs.git] / lisp / emacs-lisp / easy-mmode.el
CommitLineData
e8af40ee 1;;; easy-mmode.el --- easy definition for major and minor modes
6b279740 2
ba318903 3;; Copyright (C) 1997, 2000-2014 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 150 (declare (doc-string 2)
8ee4c296 151 (debug (&define name string-or-null-p
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
7f17cc40
SM
299 (defvar ,hook nil
300 ,(format "Hook run after entering or leaving `%s'.
301No problems result if this variable is not bound.
302`add-hook' automatically binds it. (This is true for all hook variables.)"
303 mode))
304
d5b037c5 305 ;; Define the minor-mode keymap.
1328a6df 306 ,(unless (symbolp keymap) ;nil is also a symbol.
d5b037c5 307 `(defvar ,keymap-sym
1328a6df
SM
308 (let ((m ,keymap))
309 (cond ((keymapp m) m)
310 ((listp m) (easy-mmode-define-keymap m))
1a1fcbe1 311 (t (error "Invalid keymap %S" m))))
d5b037c5
SM
312 ,(format "Keymap for `%s'." mode-name)))
313
0c495c21
SM
314 ,(if (not (symbolp mode))
315 (if (or lighter keymap)
316 (error ":lighter and :keymap unsupported with mode expression %s" mode))
317 `(with-no-warnings
318 (add-minor-mode ',mode ',lighter
f44379e7 319 ,(if keymap keymap-sym
0c495c21
SM
320 `(if (boundp ',keymap-sym) ,keymap-sym))
321 nil
e58e988a 322 ,(unless (eq mode modefun) `',modefun)))))))
5a7a545c 323\f
be22f4cc
SM
324;;;
325;;; make global minor mode
326;;;
327
d5b037c5 328;;;###autoload
275e4f4c 329(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
39a27f95 330;;;###autoload
275e4f4c
CY
331(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
332;;;###autoload
333(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys)
9f729dab 334 "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
be22f4cc
SM
335TURN-ON is a function that will be called with no args in every buffer
336 and that should try to turn MODE on if applicable for that buffer.
0ceed14b
LT
337KEYS is a list of CL-style keyword arguments. As the minor mode
338 defined by this function is always global, any :global keyword is
339 ignored. Other keywords have the same meaning as in `define-minor-mode',
340 which see. In particular, :group specifies the custom group.
341 The most useful keywords are those that are passed on to the
342 `defcustom'. It normally makes no sense to pass the :lighter
275e4f4c 343 or :keymap keywords to `define-globalized-minor-mode', since these
0ceed14b 344 are usually passed to the buffer-local version of the minor mode.
876daebc
LT
345
346If MODE's set-up depends on the major mode in effect when it was
347enabled, then disabling and reenabling MODE should make MODE work
348correctly with the current major mode. This is important to
349prevent problems with derived modes, that is, major modes that
f852f6d8
AM
350call another major mode in their body.
351
352When a major mode is initialized, MODE is actually turned on just
353after running the major mode's hook. However, MODE is not turned
354on if the hook has explicitly disabled it."
b581bb5c 355 (declare (doc-string 2))
0a74e3bf 356 (let* ((global-mode-name (symbol-name global-mode))
f852f6d8 357 (mode-name (symbol-name mode))
be22f4cc
SM
358 (pretty-name (easy-mmode-pretty-mode-name mode))
359 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
0a74e3bf 360 (group nil)
0ceed14b 361 (extra-keywords nil)
876daebc
LT
362 (MODE-buffers (intern (concat global-mode-name "-buffers")))
363 (MODE-enable-in-buffers
364 (intern (concat global-mode-name "-enable-in-buffers")))
365 (MODE-check-buffers
366 (intern (concat global-mode-name "-check-buffers")))
367 (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
f852f6d8 368 (minor-MODE-hook (intern (concat mode-name "-hook")))
9f70f91e 369 (MODE-set-explicitly (intern (concat mode-name "-set-explicitly")))
0ceed14b
LT
370 (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
371 keyw)
be22f4cc
SM
372
373 ;; Check keys.
0ceed14b
LT
374 (while (keywordp (setq keyw (car keys)))
375 (setq keys (cdr keys))
f80efb86
SM
376 (pcase keyw
377 (`:group (setq group (nconc group (list :group (pop keys)))))
378 (`:global (setq keys (cdr keys)))
379 (_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
be22f4cc 380
0a74e3bf
SM
381 (unless group
382 ;; We might as well provide a best-guess default group.
383 (setq group
ab7bc290
LK
384 `(:group ',(intern (replace-regexp-in-string
385 "-mode\\'" "" (symbol-name mode))))))
dce88ea6 386
be22f4cc 387 `(progn
500fcedc
SM
388 (progn
389 :autoload-end
390 (defvar ,MODE-major-mode nil)
391 (make-variable-buffer-local ',MODE-major-mode))
be22f4cc
SM
392 ;; The actual global minor-mode
393 (define-minor-mode ,global-mode
af414f10
EZ
394 ;; Very short lines to avoid too long lines in the generated
395 ;; doc string.
06e21633
CY
396 ,(format "Toggle %s in all buffers.
397With prefix ARG, enable %s if ARG is positive;
398otherwise, disable it. If called from Lisp, enable the mode if
399ARG is omitted or nil.
400
af414f10
EZ
401%s is enabled in all buffers where
402\`%s' would do it.
44395dee 403See `%s' for more information on %s."
06e21633
CY
404 pretty-name pretty-global-name
405 pretty-name turn-on mode pretty-name)
0ceed14b 406 :global t ,@group ,@(nreverse extra-keywords)
be22f4cc
SM
407
408 ;; Setup hook to handle future mode changes and new buffers.
409 (if ,global-mode
d5b037c5 410 (progn
876daebc
LT
411 (add-hook 'after-change-major-mode-hook
412 ',MODE-enable-in-buffers)
413 (add-hook 'find-file-hook ',MODE-check-buffers)
414 (add-hook 'change-major-mode-hook ',MODE-cmhh))
415 (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
416 (remove-hook 'find-file-hook ',MODE-check-buffers)
417 (remove-hook 'change-major-mode-hook ',MODE-cmhh))
be22f4cc
SM
418
419 ;; Go through existing buffers.
420 (dolist (buf (buffer-list))
421 (with-current-buffer buf
70122acf 422 (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1))))))
be22f4cc 423
275e4f4c 424 ;; Autoloading define-globalized-minor-mode autoloads everything
f5678943 425 ;; up-to-here.
1328a6df
SM
426 :autoload-end
427
f440830d
GM
428 ;; MODE-set-explicitly is set in MODE-set-explicitly and cleared by
429 ;; kill-all-local-variables.
430 (defvar-local ,MODE-set-explicitly nil)
431 (defun ,MODE-set-explicitly ()
432 (setq ,MODE-set-explicitly t))
433 (put ',MODE-set-explicitly 'definition-name ',global-mode)
434
f852f6d8
AM
435 ;; A function which checks whether MODE has been disabled in the major
436 ;; mode hook which has just been run.
9f70f91e 437 (add-hook ',minor-MODE-hook ',MODE-set-explicitly)
f852f6d8 438
be22f4cc 439 ;; List of buffers left to process.
876daebc 440 (defvar ,MODE-buffers nil)
be22f4cc
SM
441
442 ;; The function that calls TURN-ON in each buffer.
876daebc
LT
443 (defun ,MODE-enable-in-buffers ()
444 (dolist (buf ,MODE-buffers)
445 (when (buffer-live-p buf)
446 (with-current-buffer buf
9f70f91e 447 (unless ,MODE-set-explicitly
f852f6d8
AM
448 (unless (eq ,MODE-major-mode major-mode)
449 (if ,mode
450 (progn
451 (,mode -1)
70122acf
SM
452 (funcall #',turn-on))
453 (funcall #',turn-on))))
f852f6d8 454 (setq ,MODE-major-mode major-mode)))))
876daebc
LT
455 (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
456
457 (defun ,MODE-check-buffers ()
458 (,MODE-enable-in-buffers)
459 (setq ,MODE-buffers nil)
460 (remove-hook 'post-command-hook ',MODE-check-buffers))
461 (put ',MODE-check-buffers 'definition-name ',global-mode)
be22f4cc
SM
462
463 ;; The function that catches kill-all-local-variables.
876daebc
LT
464 (defun ,MODE-cmhh ()
465 (add-to-list ',MODE-buffers (current-buffer))
466 (add-hook 'post-command-hook ',MODE-check-buffers))
f440830d 467 (put ',MODE-cmhh 'definition-name ',global-mode))))
be22f4cc 468
5a7a545c
SM
469;;;
470;;; easy-mmode-defmap
471;;;
472
9f70f91e
SM
473(defun easy-mmode-set-keymap-parents (m parents)
474 (set-keymap-parent
475 m (if (cdr parents) (make-composed-keymap parents) (car parents))))
5a7a545c 476
5d78d57d 477;;;###autoload
5a7a545c
SM
478(defun easy-mmode-define-keymap (bs &optional name m args)
479 "Return a keymap built from bindings BS.
480BS must be a list of (KEY . BINDING) where
3837de12
SM
481KEY and BINDINGS are suitable for `define-key'.
482Optional NAME is passed to `make-sparse-keymap'.
483Optional map M can be used to modify an existing map.
38a48ab7
GM
484ARGS is a list of additional keyword arguments.
485
486Valid keywords and arguments are:
487
488 :name Name of the keymap; overrides NAME argument.
489 :dense Non-nil for a dense keymap.
490 :inherit Parent keymap.
491 :group Ignored.
492 :suppress Non-nil to call `suppress-keymap' on keymap,
493 'nodigits to suppress digits as prefix arguments."
494 (let (inherit dense suppress)
5a7a545c
SM
495 (while args
496 (let ((key (pop args))
497 (val (pop args)))
f80efb86
SM
498 (pcase key
499 (`:name (setq name val))
500 (`:dense (setq dense val))
501 (`:inherit (setq inherit val))
502 (`:suppress (setq suppress val))
503 (`:group)
504 (_ (message "Unknown argument %s in defmap" key)))))
5a7a545c
SM
505 (unless (keymapp m)
506 (setq bs (append m bs))
507 (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
38a48ab7
GM
508 (when suppress
509 (suppress-keymap m (eq suppress 'nodigits)))
5a7a545c
SM
510 (dolist (b bs)
511 (let ((keys (car b))
512 (binding (cdr b)))
513 (dolist (key (if (consp keys) keys (list keys)))
514 (cond
515 ((symbolp key)
516 (substitute-key-definition key binding m global-map))
517 ((null binding)
518 (unless (keymapp (lookup-key m key)) (define-key m key binding)))
519 ((let ((o (lookup-key m key)))
520 (or (null o) (numberp o) (eq o 'undefined)))
521 (define-key m key binding))))))
522 (cond
523 ((keymapp inherit) (set-keymap-parent m inherit))
524 ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
525 m))
526
527;;;###autoload
528(defmacro easy-mmode-defmap (m bs doc &rest args)
117fdd32
GM
529 "Define a constant M whose value is the result of `easy-mmode-define-keymap'.
530The M, BS, and ARGS arguments are as per that function. DOC is
531the constant's documentation."
5d78d57d
SM
532 `(defconst ,m
533 (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
534 ,doc))
5a7a545c
SM
535
536\f
537;;;
538;;; easy-mmode-defsyntax
539;;;
540
541(defun easy-mmode-define-syntax (css args)
e4fe3460
SM
542 (let ((st (make-syntax-table (plist-get args :copy)))
543 (parent (plist-get args :inherit)))
5a7a545c
SM
544 (dolist (cs css)
545 (let ((char (car cs))
546 (syntax (cdr cs)))
547 (if (sequencep char)
9b97ee2e 548 (mapc (lambda (c) (modify-syntax-entry c syntax st)) char)
5a7a545c 549 (modify-syntax-entry char syntax st))))
e4fe3460
SM
550 (if parent (set-char-table-parent
551 st (if (symbolp parent) (symbol-value parent) parent)))
5a7a545c
SM
552 st))
553
554;;;###autoload
555(defmacro easy-mmode-defsyntax (st css doc &rest args)
e4fe3460 556 "Define variable ST as a syntax-table.
2a83a11d 557CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
e4ad5f9e
SM
558 `(progn
559 (autoload 'easy-mmode-define-syntax "easy-mmode")
2a83a11d 560 (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
5a7a545c
SM
561
562
563\f
c7ea3acc
SM
564;;;
565;;; easy-mmode-define-navigation
566;;;
567
cc349341
SM
568(defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun
569 &rest body)
c7ea3acc
SM
570 "Define BASE-next and BASE-prev to navigate in the buffer.
571RE determines the places the commands should move point to.
eed083e6 572NAME should describe the entities matched by RE. It is used to build
c7ea3acc
SM
573 the docstrings of the two functions.
574BASE-next also tries to make sure that the whole entry is visible by
575 searching for its end (by calling ENDFUN if provided or by looking for
576 the next entry) and recentering if necessary.
877f9b05
TTN
577ENDFUN should return the end position (with or without moving point).
578NARROWFUN non-nil means to check for narrowing before moving, and if
cc349341
SM
579found, do `widen' first and then call NARROWFUN with no args after moving.
580BODY is executed after moving to the destination location."
581 (declare (indent 5) (debug (exp exp exp def-form def-form &rest def-body)))
c7ea3acc
SM
582 (let* ((base-name (symbol-name base))
583 (prev-sym (intern (concat base-name "-prev")))
877f9b05 584 (next-sym (intern (concat base-name "-next")))
cc349341
SM
585 (when-narrowed
586 (lambda (body)
587 (if (null narrowfun) body
588 `(let ((was-narrowed
589 (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
590 (widen))))
591 ,body
70122acf 592 (when was-narrowed (funcall #',narrowfun)))))))
8fd9bef2 593 (unless name (setq name base-name))
c7ea3acc
SM
594 `(progn
595 (defun ,next-sym (&optional count)
36a5b60e 596 ,(format "Go to the next COUNT'th %s." name)
9e288f75 597 (interactive "p")
c7ea3acc
SM
598 (unless count (setq count 1))
599 (if (< count 0) (,prev-sym (- count))
6c119ac0 600 (if (looking-at ,re) (setq count (1+ count)))
cc349341
SM
601 ,(funcall when-narrowed
602 `(if (not (re-search-forward ,re nil t count))
603 (if (looking-at ,re)
70122acf 604 (goto-char (or ,(if endfun `(funcall #',endfun)) (point-max)))
71873e2b 605 (user-error "No next %s" ,name))
cc349341 606 (goto-char (match-beginning 0))
290d5b58 607 (when (and (eq (current-buffer) (window-buffer))
32226619 608 (called-interactively-p 'interactive))
cc349341 609 (let ((endpt (or (save-excursion
70122acf 610 ,(if endfun `(funcall #',endfun)
cc349341
SM
611 `(re-search-forward ,re nil t 2)))
612 (point-max))))
613 (unless (pos-visible-in-window-p endpt nil t)
614 (recenter '(0)))))))
615 ,@body))
d5ba8197 616 (put ',next-sym 'definition-name ',base)
c7ea3acc
SM
617 (defun ,prev-sym (&optional count)
618 ,(format "Go to the previous COUNT'th %s" (or name base-name))
9e288f75 619 (interactive "p")
c7ea3acc
SM
620 (unless count (setq count 1))
621 (if (< count 0) (,next-sym (- count))
cc349341
SM
622 ,(funcall when-narrowed
623 `(unless (re-search-backward ,re nil t count)
71873e2b 624 (user-error "No previous %s" ,name)))
cc349341 625 ,@body))
d5ba8197 626 (put ',prev-sym 'definition-name ',base))))
877f9b05 627
5a7a545c 628
6b279740
RS
629(provide 'easy-mmode)
630
631;;; easy-mmode.el ends here