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