Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; easy-mmode.el --- easy definition for major and minor modes |
6b279740 | 2 | |
ceb4c4d3 | 3 | ;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, |
f0fa15c5 | 4 | ;; 2006, 2007 Free Software Foundation, Inc. |
6b279740 | 5 | |
9781053a PJ |
6 | ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> |
7 | ;; Maintainer: Stefan Monnier <monnier@gnu.org> | |
8 | ||
9 | ;; Keywords: extensions lisp | |
6b279740 RS |
10 | |
11 | ;; This file is part of GNU Emacs. | |
12 | ||
13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 | ;; it under the terms of the GNU General Public License as published by | |
15 | ;; the Free Software Foundation; either version 2, or (at your option) | |
16 | ;; any later version. | |
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 | |
24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
3a35cf56 LK |
25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 | ;; Boston, MA 02110-1301, USA. | |
6b279740 RS |
27 | |
28 | ;;; Commentary: | |
29 | ||
30 | ;; Minor modes are useful and common. This package makes defining a | |
31 | ;; minor mode easy, by focusing on the writing of the minor mode | |
32 | ;; functionalities themselves. Moreover, this package enforces a | |
33 | ;; conventional naming of user interface primitives, making things | |
34 | ;; natural for the minor-mode end-users. | |
35 | ||
36 | ;; For each mode, easy-mmode defines the following: | |
37 | ;; <mode> : The minor mode predicate. A buffer-local variable. | |
38 | ;; <mode>-map : The keymap possibly associated to <mode>. | |
c8c21615 | 39 | ;; see `define-minor-mode' documentation |
6b279740 RS |
40 | ;; |
41 | ;; eval | |
c8c21615 | 42 | ;; (pp (macroexpand '(define-minor-mode <your-mode> <doc>))) |
6b279740 RS |
43 | ;; to check the result before using it. |
44 | ||
45 | ;; The order in which minor modes are installed is important. Keymap | |
46 | ;; lookup proceeds down minor-mode-map-alist, and the order there | |
47 | ;; tends to be the reverse of the order in which the modes were | |
48 | ;; installed. Perhaps there should be a feature to let you specify | |
49 | ;; orderings. | |
50 | ||
5a7a545c SM |
51 | ;; Additionally to `define-minor-mode', the package provides convenient |
52 | ;; ways to define keymaps, and other helper functions for major and minor modes. | |
6b279740 | 53 | |
5a7a545c | 54 | ;;; Code: |
6b279740 | 55 | |
be22f4cc SM |
56 | (eval-when-compile (require 'cl)) |
57 | ||
b5bbbb76 SM |
58 | (defun easy-mmode-pretty-mode-name (mode &optional lighter) |
59 | "Turn the symbol MODE into a string intended for the user. | |
e6469973 EZ |
60 | If provided, LIGHTER will be used to help choose capitalization by, |
61 | replacing its case-insensitive matches with the literal string in LIGHTER." | |
b5bbbb76 | 62 | (let* ((case-fold-search t) |
906aee93 | 63 | ;; Produce "Foo-Bar minor mode" from foo-bar-minor-mode. |
b643ec53 | 64 | (name (concat (replace-regexp-in-string |
906aee93 EZ |
65 | ;; If the original mode name included "-minor" (some |
66 | ;; of them don't, e.g. auto-revert-mode), then | |
67 | ;; replace it with " minor". | |
b643ec53 | 68 | "-Minor" " minor" |
e6469973 | 69 | ;; "foo-bar-minor" -> "Foo-Bar-Minor" |
b643ec53 | 70 | (capitalize (replace-regexp-in-string |
e6469973 | 71 | ;; "foo-bar-minor-mode" -> "foo-bar-minor" |
b643ec53 | 72 | "-mode\\'" "" (symbol-name mode)))) |
b5bbbb76 SM |
73 | " mode"))) |
74 | (if (not (stringp lighter)) name | |
e6469973 EZ |
75 | ;; Strip leading and trailing whitespace from LIGHTER. |
76 | (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\s-+\\'" "" | |
77 | lighter)) | |
78 | ;; Replace any (case-insensitive) matches for LIGHTER in NAME | |
79 | ;; with a literal LIGHTER. E.g., if NAME is "Iimage mode" and | |
80 | ;; LIGHTER is " iImag", then this will produce "iImage mode". | |
81 | ;; (LIGHTER normally comes from the mode-line string passed to | |
82 | ;; define-minor-mode, and normally includes at least one leading | |
83 | ;; space.) | |
84 | (replace-regexp-in-string (regexp-quote lighter) lighter name t t)))) | |
3837de12 | 85 | |
6b279740 | 86 | ;;;###autoload |
29cc3b84 SM |
87 | (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) |
88 | ;;;###autoload | |
89 | (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body) | |
6b279740 | 90 | "Define a new minor mode MODE. |
b5bbbb76 | 91 | This function defines the associated control variable MODE, keymap MODE-map, |
f5678943 | 92 | and toggle command MODE. |
6b279740 RS |
93 | |
94 | DOC is the documentation for the mode toggle command. | |
29cc3b84 | 95 | Optional INIT-VALUE is the initial value of the mode's variable. |
c8c21615 | 96 | Optional LIGHTER is displayed in the modeline when the mode is on. |
6b279740 | 97 | Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. |
b5bbbb76 | 98 | If it is a list, it is passed to `easy-mmode-define-keymap' |
bff53411 SM |
99 | in order to build a valid keymap. It's generally better to use |
100 | a separate MODE-map variable than to use this argument. | |
101 | The above three arguments can be skipped if keyword arguments are | |
102 | used (see below). | |
103 | ||
10944042 | 104 | BODY contains code to execute each time the mode is activated or deactivated. |
b50b95ce RS |
105 | It is executed after toggling the mode, |
106 | and before running the hook variable `mode-HOOK'. | |
f5678943 LK |
107 | Before the actual body code, you can write keyword arguments (alternating |
108 | keywords and values). These following keyword arguments are supported (other | |
109 | keywords will be passed to `defcustom' if the minor mode is global): | |
a6ce6869 | 110 | :group GROUP Custom group name to use in all generated `defcustom' forms. |
ab7bc290 | 111 | Defaults to MODE without the possible trailing \"-mode\". |
c25eec81 LK |
112 | Don't use this default group name unless you have written a |
113 | `defgroup' to define that group properly. | |
c8fb3bf9 | 114 | :global GLOBAL If non-nil specifies that the minor mode is not meant to be |
ab7bc290 | 115 | buffer-local, so don't make the variable MODE buffer-local. |
a6ce6869 | 116 | By default, the mode is buffer-local. |
c8fb3bf9 SM |
117 | :init-value VAL Same as the INIT-VALUE argument. |
118 | :lighter SPEC Same as the LIGHTER argument. | |
2e2a0075 | 119 | :keymap MAP Same as the KEYMAP argument. |
a6ce6869 RS |
120 | :require SYM Same as in `defcustom'. |
121 | ||
122 | For example, you could write | |
123 | (define-minor-mode foo-mode \"If enabled, foo on you!\" | |
73ceba9f | 124 | :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\" |
a6ce6869 | 125 | ...BODY CODE...)" |
2e2a0075 SM |
126 | (declare (debug (&define name stringp |
127 | [&optional [¬ keywordp] sexp | |
128 | &optional [¬ keywordp] sexp | |
129 | &optional [¬ keywordp] sexp] | |
130 | [&rest [keywordp sexp]] | |
131 | def-body))) | |
a6ce6869 | 132 | |
bff53411 SM |
133 | ;; Allow skipping the first three args. |
134 | (cond | |
135 | ((keywordp init-value) | |
136 | (setq body (list* init-value lighter keymap body) | |
137 | init-value nil lighter nil keymap nil)) | |
138 | ((keywordp lighter) | |
139 | (setq body (list* lighter keymap body) lighter nil keymap nil)) | |
140 | ((keywordp keymap) (push keymap body) (setq keymap nil))) | |
141 | ||
8c87a72c SM |
142 | (let* ((last-message (current-message)) |
143 | (mode-name (symbol-name mode)) | |
b5bbbb76 | 144 | (pretty-name (easy-mmode-pretty-mode-name mode lighter)) |
c8c21615 | 145 | (globalp nil) |
fceb44d2 | 146 | (set nil) |
c736d6cf | 147 | (initialize nil) |
0a74e3bf | 148 | (group nil) |
fceb44d2 | 149 | (type nil) |
0a74e3bf | 150 | (extra-args nil) |
73ceba9f | 151 | (extra-keywords nil) |
c8fb3bf9 | 152 | (require t) |
b5bbbb76 SM |
153 | (hook (intern (concat mode-name "-hook"))) |
154 | (hook-on (intern (concat mode-name "-on-hook"))) | |
73ceba9f | 155 | (hook-off (intern (concat mode-name "-off-hook"))) |
2e2a0075 | 156 | keyw keymap-sym) |
b5bbbb76 | 157 | |
b5bbbb76 | 158 | ;; Check keys. |
73ceba9f SM |
159 | (while (keywordp (setq keyw (car body))) |
160 | (setq body (cdr body)) | |
161 | (case keyw | |
bff53411 SM |
162 | (:init-value (setq init-value (pop body))) |
163 | (:lighter (setq lighter (pop body))) | |
be22f4cc | 164 | (:global (setq globalp (pop body))) |
0a74e3bf | 165 | (:extra-args (setq extra-args (pop body))) |
fceb44d2 | 166 | (:set (setq set (list :set (pop body)))) |
c736d6cf | 167 | (:initialize (setq initialize (list :initialize (pop body)))) |
0a74e3bf | 168 | (:group (setq group (nconc group (list :group (pop body))))) |
fceb44d2 | 169 | (:type (setq type (list :type (pop body)))) |
c8fb3bf9 | 170 | (:require (setq require (pop body))) |
2e2a0075 | 171 | (:keymap (setq keymap (pop body))) |
73ceba9f | 172 | (t (push keyw extra-keywords) (push (pop body) extra-keywords)))) |
eab6e8b9 | 173 | |
2e2a0075 SM |
174 | (setq keymap-sym (if (and keymap (symbolp keymap)) keymap |
175 | (intern (concat mode-name "-map")))) | |
176 | ||
fceb44d2 LT |
177 | (unless set (setq set '(:set 'custom-set-minor-mode))) |
178 | ||
c736d6cf | 179 | (unless initialize |
fceb44d2 | 180 | (setq initialize '(:initialize 'custom-initialize-default))) |
c736d6cf | 181 | |
0a74e3bf SM |
182 | (unless group |
183 | ;; We might as well provide a best-guess default group. | |
184 | (setq group | |
ab7bc290 LK |
185 | `(:group ',(intern (replace-regexp-in-string |
186 | "-mode\\'" "" mode-name))))) | |
7fb80935 | 187 | |
fceb44d2 LT |
188 | (unless type (setq type '(:type 'boolean))) |
189 | ||
6b279740 | 190 | `(progn |
5e21ef7a | 191 | ;; Define the variable to enable or disable the mode. |
d5b037c5 SM |
192 | ,(if (not globalp) |
193 | `(progn | |
194 | (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled. | |
a2ed9670 | 195 | Use the command `%s' to change this variable." pretty-name mode)) |
d5b037c5 | 196 | (make-variable-buffer-local ',mode)) |
6b279740 | 197 | |
94dfee0b SM |
198 | (let ((base-doc-string |
199 | (concat "Non-nil if %s is enabled. | |
200 | See the command `%s' for a description of this minor-mode." | |
201 | (if body " | |
d5b037c5 | 202 | Setting this variable directly does not take effect; |
da506c0e RS |
203 | either customize it (see the info node `Easy Customization') |
204 | or call the function `%s'.")))) | |
a566ce8e RS |
205 | `(defcustom ,mode ,init-value |
206 | ,(format base-doc-string pretty-name mode mode) | |
fceb44d2 | 207 | ,@set |
c736d6cf | 208 | ,@initialize |
0a74e3bf | 209 | ,@group |
fceb44d2 | 210 | ,@type |
94dfee0b SM |
211 | ,@(unless (eq require t) `(:require ,require)) |
212 | ,@(nreverse extra-keywords)))) | |
1328a6df | 213 | |
b5bbbb76 | 214 | ;; The actual function. |
0a74e3bf | 215 | (defun ,mode (&optional arg ,@extra-args) |
b5bbbb76 | 216 | ,(or doc |
bff53411 SM |
217 | (format (concat "Toggle %s on or off. |
218 | Interactively, with no prefix argument, toggle the mode. | |
5ddfa187 | 219 | With universal prefix ARG turn mode on. |
b5bbbb76 | 220 | With zero or negative ARG turn mode off. |
bff53411 | 221 | \\{%s}") pretty-name keymap-sym)) |
5ddfa187 SM |
222 | ;; Use `toggle' rather than (if ,mode 0 1) so that using |
223 | ;; repeat-command still does the toggling correctly. | |
224 | (interactive (list (or current-prefix-arg 'toggle))) | |
b5bbbb76 | 225 | (setq ,mode |
5ddfa187 SM |
226 | (cond |
227 | ((eq arg 'toggle) (not ,mode)) | |
228 | (arg (> (prefix-numeric-value arg) 0)) | |
229 | (t | |
230 | (if (null ,mode) t | |
231 | (message | |
232 | "Toggling %s off; better pass an explicit argument." | |
233 | ',mode) | |
234 | nil)))) | |
b5bbbb76 SM |
235 | ,@body |
236 | ;; The on/off hooks are here for backward compatibility only. | |
237 | (run-hooks ',hook (if ,mode ',hook-on ',hook-off)) | |
a27235b3 | 238 | (if (called-interactively-p) |
d99d3266 SM |
239 | (progn |
240 | ,(if globalp `(customize-mark-as-set ',mode)) | |
8c87a72c SM |
241 | ;; Avoid overwriting a message shown by the body, |
242 | ;; but do overwrite previous messages. | |
243 | (unless ,(and (current-message) | |
244 | (not (equal last-message (current-message)))) | |
2e2a0075 | 245 | (message ,(format "%s %%sabled" pretty-name) |
eb81f275 | 246 | (if ,mode "en" "dis"))))) |
bff53411 | 247 | (force-mode-line-update) |
d99d3266 | 248 | ;; Return the new setting. |
b5bbbb76 | 249 | ,mode) |
2e2a0075 | 250 | |
ab7bc290 LK |
251 | ;; Autoloading a define-minor-mode autoloads everything |
252 | ;; up-to-here. | |
1328a6df SM |
253 | :autoload-end |
254 | ||
d5b037c5 | 255 | ;; Define the minor-mode keymap. |
1328a6df | 256 | ,(unless (symbolp keymap) ;nil is also a symbol. |
d5b037c5 | 257 | `(defvar ,keymap-sym |
1328a6df SM |
258 | (let ((m ,keymap)) |
259 | (cond ((keymapp m) m) | |
260 | ((listp m) (easy-mmode-define-keymap m)) | |
261 | (t (error "Invalid keymap %S" ,keymap)))) | |
d5b037c5 SM |
262 | ,(format "Keymap for `%s'." mode-name))) |
263 | ||
b5bbbb76 | 264 | (add-minor-mode ',mode ',lighter |
1328a6df | 265 | ,(if keymap keymap-sym |
cb5da1a3 | 266 | `(if (boundp ',keymap-sym) |
f4cb1d8c | 267 | (symbol-value ',keymap-sym))))))) |
5a7a545c | 268 | \f |
be22f4cc SM |
269 | ;;; |
270 | ;;; make global minor mode | |
271 | ;;; | |
272 | ||
d5b037c5 | 273 | ;;;###autoload |
275e4f4c | 274 | (defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode) |
39a27f95 | 275 | ;;;###autoload |
275e4f4c CY |
276 | (defalias 'define-global-minor-mode 'define-globalized-minor-mode) |
277 | ;;;###autoload | |
278 | (defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys) | |
9f729dab | 279 | "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE. |
be22f4cc SM |
280 | TURN-ON is a function that will be called with no args in every buffer |
281 | and that should try to turn MODE on if applicable for that buffer. | |
0ceed14b LT |
282 | KEYS is a list of CL-style keyword arguments. As the minor mode |
283 | defined by this function is always global, any :global keyword is | |
284 | ignored. Other keywords have the same meaning as in `define-minor-mode', | |
285 | which see. In particular, :group specifies the custom group. | |
286 | The most useful keywords are those that are passed on to the | |
287 | `defcustom'. It normally makes no sense to pass the :lighter | |
275e4f4c | 288 | or :keymap keywords to `define-globalized-minor-mode', since these |
0ceed14b | 289 | are usually passed to the buffer-local version of the minor mode. |
876daebc LT |
290 | |
291 | If MODE's set-up depends on the major mode in effect when it was | |
292 | enabled, then disabling and reenabling MODE should make MODE work | |
293 | correctly with the current major mode. This is important to | |
294 | prevent problems with derived modes, that is, major modes that | |
295 | call another major mode in their body." | |
296 | ||
0a74e3bf | 297 | (let* ((global-mode-name (symbol-name global-mode)) |
be22f4cc SM |
298 | (pretty-name (easy-mmode-pretty-mode-name mode)) |
299 | (pretty-global-name (easy-mmode-pretty-mode-name global-mode)) | |
0a74e3bf | 300 | (group nil) |
0ceed14b | 301 | (extra-keywords nil) |
876daebc LT |
302 | (MODE-buffers (intern (concat global-mode-name "-buffers"))) |
303 | (MODE-enable-in-buffers | |
304 | (intern (concat global-mode-name "-enable-in-buffers"))) | |
305 | (MODE-check-buffers | |
306 | (intern (concat global-mode-name "-check-buffers"))) | |
307 | (MODE-cmhh (intern (concat global-mode-name "-cmhh"))) | |
0ceed14b LT |
308 | (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode"))) |
309 | keyw) | |
be22f4cc SM |
310 | |
311 | ;; Check keys. | |
0ceed14b LT |
312 | (while (keywordp (setq keyw (car keys))) |
313 | (setq keys (cdr keys)) | |
314 | (case keyw | |
0a74e3bf | 315 | (:group (setq group (nconc group (list :group (pop keys))))) |
0ceed14b LT |
316 | (:global (setq keys (cdr keys))) |
317 | (t (push keyw extra-keywords) (push (pop keys) extra-keywords)))) | |
be22f4cc | 318 | |
0a74e3bf SM |
319 | (unless group |
320 | ;; We might as well provide a best-guess default group. | |
321 | (setq group | |
ab7bc290 LK |
322 | `(:group ',(intern (replace-regexp-in-string |
323 | "-mode\\'" "" (symbol-name mode)))))) | |
dce88ea6 | 324 | |
be22f4cc | 325 | `(progn |
876daebc LT |
326 | (defvar ,MODE-major-mode nil) |
327 | (make-variable-buffer-local ',MODE-major-mode) | |
be22f4cc SM |
328 | ;; The actual global minor-mode |
329 | (define-minor-mode ,global-mode | |
330 | ,(format "Toggle %s in every buffer. | |
331 | With prefix ARG, turn %s on if and only if ARG is positive. | |
332 | %s is actually not turned on in every buffer but only in those | |
333 | in which `%s' turns it on." | |
334 | pretty-name pretty-global-name pretty-name turn-on) | |
0ceed14b | 335 | :global t ,@group ,@(nreverse extra-keywords) |
be22f4cc SM |
336 | |
337 | ;; Setup hook to handle future mode changes and new buffers. | |
338 | (if ,global-mode | |
d5b037c5 | 339 | (progn |
876daebc LT |
340 | (add-hook 'after-change-major-mode-hook |
341 | ',MODE-enable-in-buffers) | |
342 | (add-hook 'find-file-hook ',MODE-check-buffers) | |
343 | (add-hook 'change-major-mode-hook ',MODE-cmhh)) | |
344 | (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers) | |
345 | (remove-hook 'find-file-hook ',MODE-check-buffers) | |
346 | (remove-hook 'change-major-mode-hook ',MODE-cmhh)) | |
be22f4cc SM |
347 | |
348 | ;; Go through existing buffers. | |
349 | (dolist (buf (buffer-list)) | |
350 | (with-current-buffer buf | |
34befa9a | 351 | (if ,global-mode (,turn-on) (when ,mode (,mode -1)))))) |
be22f4cc | 352 | |
275e4f4c | 353 | ;; Autoloading define-globalized-minor-mode autoloads everything |
f5678943 | 354 | ;; up-to-here. |
1328a6df SM |
355 | :autoload-end |
356 | ||
be22f4cc | 357 | ;; List of buffers left to process. |
876daebc | 358 | (defvar ,MODE-buffers nil) |
be22f4cc SM |
359 | |
360 | ;; The function that calls TURN-ON in each buffer. | |
876daebc LT |
361 | (defun ,MODE-enable-in-buffers () |
362 | (dolist (buf ,MODE-buffers) | |
363 | (when (buffer-live-p buf) | |
364 | (with-current-buffer buf | |
365 | (if ,mode | |
366 | (unless (eq ,MODE-major-mode major-mode) | |
367 | (,mode -1) | |
368 | (,turn-on) | |
369 | (setq ,MODE-major-mode major-mode)) | |
370 | (,turn-on) | |
371 | (setq ,MODE-major-mode major-mode)))))) | |
372 | (put ',MODE-enable-in-buffers 'definition-name ',global-mode) | |
373 | ||
374 | (defun ,MODE-check-buffers () | |
375 | (,MODE-enable-in-buffers) | |
376 | (setq ,MODE-buffers nil) | |
377 | (remove-hook 'post-command-hook ',MODE-check-buffers)) | |
378 | (put ',MODE-check-buffers 'definition-name ',global-mode) | |
be22f4cc SM |
379 | |
380 | ;; The function that catches kill-all-local-variables. | |
876daebc LT |
381 | (defun ,MODE-cmhh () |
382 | (add-to-list ',MODE-buffers (current-buffer)) | |
383 | (add-hook 'post-command-hook ',MODE-check-buffers)) | |
384 | (put ',MODE-cmhh 'definition-name ',global-mode)))) | |
be22f4cc | 385 | |
5a7a545c SM |
386 | ;;; |
387 | ;;; easy-mmode-defmap | |
388 | ;;; | |
389 | ||
390 | (if (fboundp 'set-keymap-parents) | |
391 | (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents) | |
392 | (defun easy-mmode-set-keymap-parents (m parents) | |
393 | (set-keymap-parent | |
394 | m | |
395 | (cond | |
396 | ((not (consp parents)) parents) | |
397 | ((not (cdr parents)) (car parents)) | |
398 | (t (let ((m (copy-keymap (pop parents)))) | |
399 | (easy-mmode-set-keymap-parents m parents) | |
400 | m)))))) | |
401 | ||
5d78d57d | 402 | ;;;###autoload |
5a7a545c SM |
403 | (defun easy-mmode-define-keymap (bs &optional name m args) |
404 | "Return a keymap built from bindings BS. | |
405 | BS must be a list of (KEY . BINDING) where | |
3837de12 SM |
406 | KEY and BINDINGS are suitable for `define-key'. |
407 | Optional NAME is passed to `make-sparse-keymap'. | |
408 | Optional map M can be used to modify an existing map. | |
165958d2 | 409 | ARGS is a list of additional keyword arguments." |
eb81f275 | 410 | (let (inherit dense) |
5a7a545c SM |
411 | (while args |
412 | (let ((key (pop args)) | |
413 | (val (pop args))) | |
be22f4cc | 414 | (case key |
165958d2 | 415 | (:name (setq name val)) |
be22f4cc SM |
416 | (:dense (setq dense val)) |
417 | (:inherit (setq inherit val)) | |
418 | (:group) | |
5a7a545c SM |
419 | (t (message "Unknown argument %s in defmap" key))))) |
420 | (unless (keymapp m) | |
421 | (setq bs (append m bs)) | |
422 | (setq m (if dense (make-keymap name) (make-sparse-keymap name)))) | |
423 | (dolist (b bs) | |
424 | (let ((keys (car b)) | |
425 | (binding (cdr b))) | |
426 | (dolist (key (if (consp keys) keys (list keys))) | |
427 | (cond | |
428 | ((symbolp key) | |
429 | (substitute-key-definition key binding m global-map)) | |
430 | ((null binding) | |
431 | (unless (keymapp (lookup-key m key)) (define-key m key binding))) | |
432 | ((let ((o (lookup-key m key))) | |
433 | (or (null o) (numberp o) (eq o 'undefined))) | |
434 | (define-key m key binding)))))) | |
435 | (cond | |
436 | ((keymapp inherit) (set-keymap-parent m inherit)) | |
437 | ((consp inherit) (easy-mmode-set-keymap-parents m inherit))) | |
438 | m)) | |
439 | ||
440 | ;;;###autoload | |
441 | (defmacro easy-mmode-defmap (m bs doc &rest args) | |
5d78d57d SM |
442 | `(defconst ,m |
443 | (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) | |
444 | ,doc)) | |
5a7a545c SM |
445 | |
446 | \f | |
447 | ;;; | |
448 | ;;; easy-mmode-defsyntax | |
449 | ;;; | |
450 | ||
451 | (defun easy-mmode-define-syntax (css args) | |
e4fe3460 SM |
452 | (let ((st (make-syntax-table (plist-get args :copy))) |
453 | (parent (plist-get args :inherit))) | |
5a7a545c SM |
454 | (dolist (cs css) |
455 | (let ((char (car cs)) | |
456 | (syntax (cdr cs))) | |
457 | (if (sequencep char) | |
e4ad5f9e | 458 | (mapcar (lambda (c) (modify-syntax-entry c syntax st)) char) |
5a7a545c | 459 | (modify-syntax-entry char syntax st)))) |
e4fe3460 SM |
460 | (if parent (set-char-table-parent |
461 | st (if (symbolp parent) (symbol-value parent) parent))) | |
5a7a545c SM |
462 | st)) |
463 | ||
464 | ;;;###autoload | |
465 | (defmacro easy-mmode-defsyntax (st css doc &rest args) | |
e4fe3460 | 466 | "Define variable ST as a syntax-table. |
2a83a11d | 467 | CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)." |
e4ad5f9e SM |
468 | `(progn |
469 | (autoload 'easy-mmode-define-syntax "easy-mmode") | |
2a83a11d | 470 | (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc))) |
5a7a545c SM |
471 | |
472 | ||
473 | \f | |
c7ea3acc SM |
474 | ;;; |
475 | ;;; easy-mmode-define-navigation | |
476 | ;;; | |
477 | ||
877f9b05 | 478 | (defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun) |
c7ea3acc SM |
479 | "Define BASE-next and BASE-prev to navigate in the buffer. |
480 | RE determines the places the commands should move point to. | |
eed083e6 | 481 | NAME should describe the entities matched by RE. It is used to build |
c7ea3acc SM |
482 | the docstrings of the two functions. |
483 | BASE-next also tries to make sure that the whole entry is visible by | |
484 | searching for its end (by calling ENDFUN if provided or by looking for | |
485 | the next entry) and recentering if necessary. | |
877f9b05 TTN |
486 | ENDFUN should return the end position (with or without moving point). |
487 | NARROWFUN non-nil means to check for narrowing before moving, and if | |
488 | found, do widen first and then call NARROWFUN with no args after moving." | |
c7ea3acc SM |
489 | (let* ((base-name (symbol-name base)) |
490 | (prev-sym (intern (concat base-name "-prev"))) | |
877f9b05 | 491 | (next-sym (intern (concat base-name "-next"))) |
e8a12926 SM |
492 | (check-narrow-maybe |
493 | (when narrowfun | |
494 | '(setq was-narrowed | |
495 | (prog1 (or (< (- (point-max) (point-min)) (buffer-size))) | |
496 | (widen))))) | |
877f9b05 | 497 | (re-narrow-maybe (when narrowfun |
e8a12926 | 498 | `(when was-narrowed (,narrowfun))))) |
8fd9bef2 | 499 | (unless name (setq name base-name)) |
c7ea3acc | 500 | `(progn |
b5bbbb76 SM |
501 | (add-to-list 'debug-ignored-errors |
502 | ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) | |
c7ea3acc | 503 | (defun ,next-sym (&optional count) |
36a5b60e | 504 | ,(format "Go to the next COUNT'th %s." name) |
9e288f75 | 505 | (interactive "p") |
c7ea3acc SM |
506 | (unless count (setq count 1)) |
507 | (if (< count 0) (,prev-sym (- count)) | |
6c119ac0 | 508 | (if (looking-at ,re) (setq count (1+ count))) |
e8a12926 | 509 | (let (was-narrowed) |
877f9b05 TTN |
510 | ,check-narrow-maybe |
511 | (if (not (re-search-forward ,re nil t count)) | |
512 | (if (looking-at ,re) | |
513 | (goto-char (or ,(if endfun `(,endfun)) (point-max))) | |
514 | (error "No next %s" ,name)) | |
515 | (goto-char (match-beginning 0)) | |
516 | (when (and (eq (current-buffer) (window-buffer (selected-window))) | |
517 | (interactive-p)) | |
518 | (let ((endpt (or (save-excursion | |
519 | ,(if endfun `(,endfun) | |
520 | `(re-search-forward ,re nil t 2))) | |
521 | (point-max)))) | |
522 | (unless (pos-visible-in-window-p endpt nil t) | |
523 | (recenter '(0)))))) | |
524 | ,re-narrow-maybe))) | |
d5ba8197 | 525 | (put ',next-sym 'definition-name ',base) |
c7ea3acc SM |
526 | (defun ,prev-sym (&optional count) |
527 | ,(format "Go to the previous COUNT'th %s" (or name base-name)) | |
9e288f75 | 528 | (interactive "p") |
c7ea3acc SM |
529 | (unless count (setq count 1)) |
530 | (if (< count 0) (,next-sym (- count)) | |
e8a12926 | 531 | (let (was-narrowed) |
877f9b05 TTN |
532 | ,check-narrow-maybe |
533 | (unless (re-search-backward ,re nil t count) | |
534 | (error "No previous %s" ,name)) | |
d5ba8197 JL |
535 | ,re-narrow-maybe))) |
536 | (put ',prev-sym 'definition-name ',base)))) | |
877f9b05 | 537 | |
5a7a545c | 538 | |
6b279740 RS |
539 | (provide 'easy-mmode) |
540 | ||
ab5796a9 | 541 | ;;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a |
6b279740 | 542 | ;;; easy-mmode.el ends here |