Commit | Line | Data |
---|---|---|
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 |
56 | If provided, LIGHTER will be used to help choose capitalization by, |
57 | replacing 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 |
88 | This defines the toggle command MODE and (by default) a control variable |
89 | MODE (you can override this with the :variable keyword, see below). | |
6b279740 | 90 | DOC is the documentation for the mode toggle command. |
bc7d7ea6 | 91 | |
60d47423 | 92 | The defined mode command takes one optional (prefix) argument. |
c88b867f CY |
93 | Interactively with no prefix argument, it toggles the mode. |
94 | A prefix argument enables the mode if the argument is positive, | |
95 | and disables it otherwise. | |
96 | ||
97 | When called from Lisp, the mode command toggles the mode if the | |
98 | argument is `toggle', disables the mode if the argument is a | |
99 | non-positive integer, and enables the mode otherwise (including | |
100 | if the argument is omitted or nil or a positive integer). | |
101 | ||
102 | If DOC is nil, give the mode command a basic doc-string | |
103 | documenting what its argument does. | |
60d47423 | 104 | |
29cc3b84 | 105 | Optional INIT-VALUE is the initial value of the mode's variable. |
37269466 | 106 | Optional LIGHTER is displayed in the mode line when the mode is on. |
bc7d7ea6 CY |
107 | Optional 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 | |
114 | BODY 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 | |
146 | For 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 [¬ keywordp] sexp |
153 | &optional [¬ keywordp] sexp | |
154 | &optional [¬ 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 | 239 | Use 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 | 244 | See the command `%s' for a description of this minor mode." |
94dfee0b | 245 | (if body " |
d5b037c5 | 246 | Setting this variable directly does not take effect; |
da506c0e RS |
247 | either customize it (see the info node `Easy Customization') |
248 | or 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 |
262 | With a prefix argument ARG, enable %s if ARG is |
263 | positive, and disable it otherwise. If called from Lisp, enable | |
60d47423 | 264 | the 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'. | |
301 | No 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 |
335 | TURN-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 |
337 | KEYS 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 | |
346 | If MODE's set-up depends on the major mode in effect when it was | |
347 | enabled, then disabling and reenabling MODE should make MODE work | |
348 | correctly with the current major mode. This is important to | |
349 | prevent problems with derived modes, that is, major modes that | |
f852f6d8 AM |
350 | call another major mode in their body. |
351 | ||
352 | When a major mode is initialized, MODE is actually turned on just | |
353 | after running the major mode's hook. However, MODE is not turned | |
354 | on 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. |
397 | With prefix ARG, enable %s if ARG is positive; | |
398 | otherwise, disable it. If called from Lisp, enable the mode if | |
399 | ARG is omitted or nil. | |
400 | ||
af414f10 EZ |
401 | %s is enabled in all buffers where |
402 | \`%s' would do it. | |
44395dee | 403 | See `%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. | |
480 | BS must be a list of (KEY . BINDING) where | |
3837de12 SM |
481 | KEY and BINDINGS are suitable for `define-key'. |
482 | Optional NAME is passed to `make-sparse-keymap'. | |
483 | Optional map M can be used to modify an existing map. | |
38a48ab7 GM |
484 | ARGS is a list of additional keyword arguments. |
485 | ||
486 | Valid 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'. |
530 | The M, BS, and ARGS arguments are as per that function. DOC is | |
531 | the 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 | 557 | CSS 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. |
571 | RE determines the places the commands should move point to. | |
eed083e6 | 572 | NAME should describe the entities matched by RE. It is used to build |
c7ea3acc SM |
573 | the docstrings of the two functions. |
574 | BASE-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 |
577 | ENDFUN should return the end position (with or without moving point). |
578 | NARROWFUN non-nil means to check for narrowing before moving, and if | |
cc349341 SM |
579 | found, do `widen' first and then call NARROWFUN with no args after moving. |
580 | BODY 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 |