Commit | Line | Data |
---|---|---|
5a7a545c | 1 | ;;; easy-mmode.el --- easy definition for major and minor modes. |
6b279740 | 2 | |
c8c21615 | 3 | ;; Copyright (C) 1997,2000 Free Software Foundation, Inc. |
6b279740 RS |
4 | |
5 | ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> | |
29cc3b84 | 6 | ;; Maintainer: Stefan Monnier <monnier@gnu.org> |
6b279740 RS |
7 | |
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; Minor modes are useful and common. This package makes defining a | |
28 | ;; minor mode easy, by focusing on the writing of the minor mode | |
29 | ;; functionalities themselves. Moreover, this package enforces a | |
30 | ;; conventional naming of user interface primitives, making things | |
31 | ;; natural for the minor-mode end-users. | |
32 | ||
33 | ;; For each mode, easy-mmode defines the following: | |
34 | ;; <mode> : The minor mode predicate. A buffer-local variable. | |
35 | ;; <mode>-map : The keymap possibly associated to <mode>. | |
c8c21615 SM |
36 | ;; <mode>-hook : The hook run at the end of the toggle function. |
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 | |
be22f4cc SM |
54 | (eval-when-compile (require 'cl)) |
55 | ||
b5bbbb76 SM |
56 | (defun easy-mmode-pretty-mode-name (mode &optional lighter) |
57 | "Turn the symbol MODE into a string intended for the user. | |
58 | If provided LIGHTER will be used to help choose capitalization." | |
59 | (let* ((case-fold-search t) | |
60 | (name (concat (capitalize (replace-regexp-in-string | |
61 | "-mode\\'" "" (symbol-name mode))) | |
62 | " mode"))) | |
63 | (if (not (stringp lighter)) name | |
64 | (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\-s+\\'" "" lighter)) | |
65 | (replace-regexp-in-string lighter lighter name t t)))) | |
3837de12 | 66 | |
6b279740 | 67 | ;;;###autoload |
29cc3b84 SM |
68 | (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) |
69 | ;;;###autoload | |
70 | (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body) | |
6b279740 | 71 | "Define a new minor mode MODE. |
b5bbbb76 SM |
72 | This function defines the associated control variable MODE, keymap MODE-map, |
73 | toggle command MODE, and hook MODE-hook. | |
6b279740 RS |
74 | |
75 | DOC is the documentation for the mode toggle command. | |
29cc3b84 | 76 | Optional INIT-VALUE is the initial value of the mode's variable. |
c8c21615 | 77 | Optional LIGHTER is displayed in the modeline when the mode is on. |
6b279740 | 78 | Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. |
b5bbbb76 SM |
79 | If it is a list, it is passed to `easy-mmode-define-keymap' |
80 | in order to build a valid keymap. | |
29cc3b84 | 81 | BODY contains code that will be executed each time the mode is (dis)activated. |
b5bbbb76 SM |
82 | It will be executed after any toggling but before running the hooks. |
83 | BODY can start with a list of CL-style keys specifying additional arguments. | |
84 | Currently two such keyword arguments are supported: | |
85 | :group followed by the group name to use for any generated `defcustom'. | |
86 | :global if non-nil specifies that the minor mode is not meant to be | |
87 | buffer-local. By default, the variable is made buffer-local." | |
6b279740 | 88 | (let* ((mode-name (symbol-name mode)) |
b5bbbb76 | 89 | (pretty-name (easy-mmode-pretty-mode-name mode lighter)) |
c8c21615 | 90 | (globalp nil) |
b5bbbb76 | 91 | ;; We might as well provide a best-guess default group. |
be22f4cc SM |
92 | (group |
93 | (list 'quote | |
94 | (intern (replace-regexp-in-string "-mode\\'" "" mode-name)))) | |
1328a6df SM |
95 | (keymap-sym (if (and keymap (symbolp keymap)) keymap |
96 | (intern (concat mode-name "-map")))) | |
b5bbbb76 SM |
97 | (hook (intern (concat mode-name "-hook"))) |
98 | (hook-on (intern (concat mode-name "-on-hook"))) | |
99 | (hook-off (intern (concat mode-name "-off-hook")))) | |
100 | ||
101 | ;; FIXME: compatibility that should be removed. | |
c8c21615 SM |
102 | (when (and (consp init-value) (eq (car init-value) 'global)) |
103 | (setq init-value (cdr init-value) globalp t)) | |
104 | ||
b5bbbb76 | 105 | ;; Check keys. |
be22f4cc SM |
106 | (while (keywordp (car body)) |
107 | (case (pop body) | |
108 | (:global (setq globalp (pop body))) | |
109 | (:group (setq group (pop body))) | |
110 | (t (setq body (cdr body))))) | |
b5bbbb76 SM |
111 | |
112 | ;; Add default properties to LIGHTER. | |
113 | (unless (or (not (stringp lighter)) (get-text-property 0 'local-map lighter) | |
114 | (get-text-property 0 'keymap lighter)) | |
115 | (setq lighter | |
116 | (apply 'propertize lighter | |
117 | 'local-map (make-mode-line-mouse2-map mode) | |
118 | (unless (get-text-property 0 'help-echo lighter) | |
119 | (list 'help-echo | |
120 | (format "mouse-2: turn off %s" pretty-name)))))) | |
121 | ||
6b279740 | 122 | `(progn |
5e21ef7a | 123 | ;; Define the variable to enable or disable the mode. |
d5b037c5 SM |
124 | ,(if (not globalp) |
125 | `(progn | |
126 | (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled. | |
b5bbbb76 | 127 | Use the function `%s' to change this variable." pretty-name mode)) |
d5b037c5 | 128 | (make-variable-buffer-local ',mode)) |
6b279740 | 129 | |
1328a6df SM |
130 | (let ((curfile (or (and (boundp 'byte-compile-current-file) |
131 | byte-compile-current-file) | |
132 | load-file-name))) | |
133 | `(defcustom ,mode ,init-value | |
134 | ,(format "Toggle %s. | |
d5b037c5 SM |
135 | Setting this variable directly does not take effect; |
136 | use either \\[customize] or the function `%s'." | |
1328a6df SM |
137 | pretty-name mode) |
138 | :set (lambda (symbol value) (funcall symbol (or value 0))) | |
139 | :initialize 'custom-initialize-default | |
140 | :group ,group | |
141 | :type 'boolean | |
142 | ,@(when curfile | |
143 | (list | |
144 | :require | |
145 | (list 'quote | |
146 | (intern (file-name-nondirectory | |
147 | (file-name-sans-extension curfile))))))))) | |
148 | ||
149 | ;; The toggle's hook. Wrapped in `progn' to prevent autoloading. | |
150 | (progn | |
151 | (defcustom ,hook nil | |
152 | ,(format "Hook run at the end of function `%s'." mode-name) | |
153 | :group ,group | |
154 | :type 'hook)) | |
b5bbbb76 SM |
155 | |
156 | ;; The actual function. | |
157 | (defun ,mode (&optional arg) | |
158 | ,(or doc | |
159 | (format "With no argument, toggle %s. | |
160 | With universal prefix ARG turn mode on. | |
161 | With zero or negative ARG turn mode off. | |
162 | \\{%s}" pretty-name keymap-sym)) | |
163 | (interactive "P") | |
164 | (setq ,mode | |
165 | (if arg | |
166 | (> (prefix-numeric-value arg) 0) | |
167 | (not ,mode))) | |
168 | ,@body | |
169 | ;; The on/off hooks are here for backward compatibility only. | |
170 | (run-hooks ',hook (if ,mode ',hook-on ',hook-off)) | |
171 | ;; Return the new setting. | |
172 | (if (interactive-p) | |
173 | (message ,(format "%s %%sabled" pretty-name) | |
174 | (if ,mode "en" "dis"))) | |
175 | ,mode) | |
6b279740 | 176 | |
1328a6df SM |
177 | ;; Autoloading an easy-mmode-define-minor-mode autoloads |
178 | ;; everything up-to-here. | |
179 | :autoload-end | |
180 | ||
d5b037c5 | 181 | ;; Define the minor-mode keymap. |
1328a6df | 182 | ,(unless (symbolp keymap) ;nil is also a symbol. |
d5b037c5 | 183 | `(defvar ,keymap-sym |
1328a6df SM |
184 | (let ((m ,keymap)) |
185 | (cond ((keymapp m) m) | |
186 | ((listp m) (easy-mmode-define-keymap m)) | |
187 | (t (error "Invalid keymap %S" ,keymap)))) | |
d5b037c5 SM |
188 | ,(format "Keymap for `%s'." mode-name))) |
189 | ||
b5bbbb76 | 190 | (add-minor-mode ',mode ',lighter |
1328a6df | 191 | ,(if keymap keymap-sym |
cb5da1a3 SM |
192 | `(if (boundp ',keymap-sym) |
193 | (symbol-value ',keymap-sym)))) | |
c8c21615 SM |
194 | |
195 | ;; If the mode is global, call the function according to the default. | |
196 | ,(if globalp `(if ,mode (,mode 1)))))) | |
5a7a545c | 197 | \f |
be22f4cc SM |
198 | ;;; |
199 | ;;; make global minor mode | |
200 | ;;; | |
201 | ||
d5b037c5 | 202 | ;;;###autoload |
be22f4cc SM |
203 | (defmacro easy-mmode-define-global-mode (global-mode mode turn-on |
204 | &rest keys) | |
205 | "Make GLOBAL-MODE out of the MODE buffer-local minor mode. | |
206 | TURN-ON is a function that will be called with no args in every buffer | |
207 | and that should try to turn MODE on if applicable for that buffer. | |
208 | KEYS is a list of CL-style keyword arguments: | |
209 | :group to specify the custom group." | |
210 | (let* ((mode-name (symbol-name mode)) | |
211 | (global-mode-name (symbol-name global-mode)) | |
212 | (pretty-name (easy-mmode-pretty-mode-name mode)) | |
213 | (pretty-global-name (easy-mmode-pretty-mode-name global-mode)) | |
214 | ;; We might as well provide a best-guess default group. | |
215 | (group | |
216 | (list 'quote | |
217 | (intern (replace-regexp-in-string "-mode\\'" "" mode-name)))) | |
218 | (buffers (intern (concat global-mode-name "-buffers"))) | |
219 | (cmmh (intern (concat global-mode-name "-cmmh")))) | |
220 | ||
221 | ;; Check keys. | |
222 | (while (keywordp (car keys)) | |
223 | (case (pop keys) | |
224 | (:group (setq group (pop keys))) | |
225 | (t (setq keys (cdr keys))))) | |
226 | ||
227 | `(progn | |
be22f4cc SM |
228 | ;; The actual global minor-mode |
229 | (define-minor-mode ,global-mode | |
230 | ,(format "Toggle %s in every buffer. | |
231 | With prefix ARG, turn %s on if and only if ARG is positive. | |
232 | %s is actually not turned on in every buffer but only in those | |
233 | in which `%s' turns it on." | |
234 | pretty-name pretty-global-name pretty-name turn-on) | |
235 | nil nil nil :global t :group ,group | |
236 | ||
237 | ;; Setup hook to handle future mode changes and new buffers. | |
238 | (if ,global-mode | |
d5b037c5 SM |
239 | (progn |
240 | (add-hook 'find-file-hooks ',buffers) | |
241 | (add-hook 'change-major-mode-hook ',cmmh)) | |
242 | (remove-hook 'find-file-hooks ',buffers) | |
be22f4cc SM |
243 | (remove-hook 'change-major-mode-hook ',cmmh)) |
244 | ||
245 | ;; Go through existing buffers. | |
246 | (dolist (buf (buffer-list)) | |
247 | (with-current-buffer buf | |
248 | (if ,global-mode (,turn-on) (,mode -1))))) | |
249 | ||
1328a6df SM |
250 | ;; Autoloading easy-mmode-define-global-mode |
251 | ;; autoloads everything up-to-here. | |
252 | :autoload-end | |
253 | ||
be22f4cc SM |
254 | ;; List of buffers left to process. |
255 | (defvar ,buffers nil) | |
256 | ||
257 | ;; The function that calls TURN-ON in each buffer. | |
258 | (defun ,buffers () | |
be22f4cc | 259 | (remove-hook 'post-command-hook ',buffers) |
d5b037c5 SM |
260 | (while ,buffers |
261 | (let ((buf (pop ,buffers))) | |
262 | (when (buffer-live-p buf) | |
263 | (with-current-buffer buf (,turn-on)))))) | |
be22f4cc SM |
264 | |
265 | ;; The function that catches kill-all-local-variables. | |
266 | (defun ,cmmh () | |
267 | (add-to-list ',buffers (current-buffer)) | |
d5b037c5 | 268 | (add-hook 'post-command-hook ',buffers))))) |
be22f4cc | 269 | |
5a7a545c SM |
270 | ;;; |
271 | ;;; easy-mmode-defmap | |
272 | ;;; | |
273 | ||
274 | (if (fboundp 'set-keymap-parents) | |
275 | (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents) | |
276 | (defun easy-mmode-set-keymap-parents (m parents) | |
277 | (set-keymap-parent | |
278 | m | |
279 | (cond | |
280 | ((not (consp parents)) parents) | |
281 | ((not (cdr parents)) (car parents)) | |
282 | (t (let ((m (copy-keymap (pop parents)))) | |
283 | (easy-mmode-set-keymap-parents m parents) | |
284 | m)))))) | |
285 | ||
286 | (defun easy-mmode-define-keymap (bs &optional name m args) | |
287 | "Return a keymap built from bindings BS. | |
288 | BS must be a list of (KEY . BINDING) where | |
3837de12 SM |
289 | KEY and BINDINGS are suitable for `define-key'. |
290 | Optional NAME is passed to `make-sparse-keymap'. | |
291 | Optional map M can be used to modify an existing map. | |
5a7a545c SM |
292 | ARGS is a list of additional arguments." |
293 | (let (inherit dense suppress) | |
294 | (while args | |
295 | (let ((key (pop args)) | |
296 | (val (pop args))) | |
be22f4cc SM |
297 | (case key |
298 | (:dense (setq dense val)) | |
299 | (:inherit (setq inherit val)) | |
300 | (:group) | |
5a7a545c SM |
301 | ;;((eq key :suppress) (setq suppress val)) |
302 | (t (message "Unknown argument %s in defmap" key))))) | |
303 | (unless (keymapp m) | |
304 | (setq bs (append m bs)) | |
305 | (setq m (if dense (make-keymap name) (make-sparse-keymap name)))) | |
306 | (dolist (b bs) | |
307 | (let ((keys (car b)) | |
308 | (binding (cdr b))) | |
309 | (dolist (key (if (consp keys) keys (list keys))) | |
310 | (cond | |
311 | ((symbolp key) | |
312 | (substitute-key-definition key binding m global-map)) | |
313 | ((null binding) | |
314 | (unless (keymapp (lookup-key m key)) (define-key m key binding))) | |
315 | ((let ((o (lookup-key m key))) | |
316 | (or (null o) (numberp o) (eq o 'undefined))) | |
317 | (define-key m key binding)))))) | |
318 | (cond | |
319 | ((keymapp inherit) (set-keymap-parent m inherit)) | |
320 | ((consp inherit) (easy-mmode-set-keymap-parents m inherit))) | |
321 | m)) | |
322 | ||
323 | ;;;###autoload | |
324 | (defmacro easy-mmode-defmap (m bs doc &rest args) | |
e4ad5f9e SM |
325 | `(progn |
326 | (autoload 'easy-mmode-define-keymap "easy-mmode") | |
327 | (defconst ,m | |
328 | (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args)) | |
329 | ,doc))) | |
5a7a545c SM |
330 | |
331 | \f | |
332 | ;;; | |
333 | ;;; easy-mmode-defsyntax | |
334 | ;;; | |
335 | ||
336 | (defun easy-mmode-define-syntax (css args) | |
337 | (let ((st (make-syntax-table (cadr (memq :copy args))))) | |
338 | (dolist (cs css) | |
339 | (let ((char (car cs)) | |
340 | (syntax (cdr cs))) | |
341 | (if (sequencep char) | |
e4ad5f9e | 342 | (mapcar (lambda (c) (modify-syntax-entry c syntax st)) char) |
5a7a545c SM |
343 | (modify-syntax-entry char syntax st)))) |
344 | st)) | |
345 | ||
346 | ;;;###autoload | |
347 | (defmacro easy-mmode-defsyntax (st css doc &rest args) | |
e4ad5f9e SM |
348 | `(progn |
349 | (autoload 'easy-mmode-define-syntax "easy-mmode") | |
350 | (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) doc))) | |
5a7a545c SM |
351 | |
352 | ||
353 | \f | |
c7ea3acc | 354 | ;;; |
5a7a545c | 355 | ;;; A "macro-only" reimplementation of define-derived-mode. |
c7ea3acc | 356 | ;;; |
5a7a545c | 357 | |
c7ea3acc SM |
358 | ;;;###autoload |
359 | (defmacro define-derived-mode (child parent name &optional docstring &rest body) | |
5a7a545c SM |
360 | "Create a new mode as a variant of an existing mode. |
361 | ||
362 | The arguments to this command are as follow: | |
363 | ||
364 | CHILD: the name of the command for the derived mode. | |
365 | PARENT: the name of the command for the parent mode (e.g. `text-mode'). | |
366 | NAME: a string which will appear in the status line (e.g. \"Hypertext\") | |
367 | DOCSTRING: an optional documentation string--if you do not supply one, | |
368 | the function will attempt to invent something useful. | |
369 | BODY: forms to execute just before running the | |
370 | hooks for the new mode. | |
371 | ||
372 | Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: | |
373 | ||
374 | (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\") | |
375 | ||
376 | You could then make new key bindings for `LaTeX-thesis-mode-map' | |
377 | without changing regular LaTeX mode. In this example, BODY is empty, | |
378 | and DOCSTRING is generated by default. | |
379 | ||
380 | On a more complicated level, the following command uses `sgml-mode' as | |
381 | the parent, and then sets the variable `case-fold-search' to nil: | |
382 | ||
383 | (define-derived-mode article-mode sgml-mode \"Article\" | |
384 | \"Major mode for editing technical articles.\" | |
385 | (setq case-fold-search nil)) | |
386 | ||
387 | Note that if the documentation string had been left out, it would have | |
388 | been generated automatically, with a reference to the keymap." | |
389 | ||
5a7a545c SM |
390 | (let* ((child-name (symbol-name child)) |
391 | (map (intern (concat child-name "-map"))) | |
392 | (syntax (intern (concat child-name "-syntax-table"))) | |
393 | (abbrev (intern (concat child-name "-abbrev-table"))) | |
394 | (hook (intern (concat child-name "-hook")))) | |
395 | ||
3837de12 SM |
396 | (unless parent (setq parent 'fundamental-mode)) |
397 | ||
e4ad5f9e SM |
398 | (when (and docstring (not (stringp docstring))) |
399 | ;; DOCSTRING is really the first command and there's no docstring | |
400 | (push docstring body) | |
401 | (setq docstring nil)) | |
402 | ||
403 | (unless (stringp docstring) | |
404 | ;; Use a default docstring. | |
405 | (setq docstring | |
5a7a545c SM |
406 | (format "Major mode derived from `%s' by `define-derived-mode'. |
407 | Inherits all of the parent's attributes, but has its own keymap, | |
408 | abbrev table and syntax table: | |
409 | ||
410 | `%s', `%s' and `%s' | |
411 | ||
e4ad5f9e SM |
412 | which more-or-less shadow %s's corresponding tables." |
413 | parent map syntax abbrev parent))) | |
414 | ||
415 | (unless (string-match (regexp-quote (symbol-name hook)) docstring) | |
416 | ;; Make sure the docstring mentions the mode's hook | |
c8c21615 SM |
417 | (setq docstring |
418 | (concat docstring | |
419 | (unless (eq parent 'fundamental-mode) | |
420 | (concat | |
421 | "\nAdditionally to any hooks its parent mode " | |
422 | (if (string-match (regexp-quote (format "`%s'" parent)) | |
423 | docstring) nil | |
424 | (format "`%s' " parent)) | |
425 | "might have run),")) | |
426 | (format "\nThis mode runs `%s' just before exiting." hook)))) | |
5a7a545c | 427 | |
e4ad5f9e SM |
428 | (unless (string-match "\\\\[{[]" docstring) |
429 | ;; And don't forget to put the mode's keymap | |
430 | (setq docstring (concat docstring "\n\\{" (symbol-name map) "}"))) | |
431 | ||
432 | `(progn | |
433 | (defvar ,map (make-sparse-keymap)) | |
434 | (defvar ,syntax (make-char-table 'syntax-table nil)) | |
1328a6df SM |
435 | (defvar ,abbrev) |
436 | (define-abbrev-table ',abbrev nil) | |
3837de12 | 437 | (put ',child 'derived-mode-parent ',parent) |
e4ad5f9e SM |
438 | |
439 | (defun ,child () | |
440 | ,docstring | |
441 | (interactive) | |
5a7a545c | 442 | ; Run the parent. |
c7ea3acc SM |
443 | (combine-run-hooks |
444 | ||
445 | (,parent) | |
5a7a545c | 446 | ; Identify special modes. |
c7ea3acc | 447 | (put ',child 'special (get ',parent 'special)) |
5a7a545c | 448 | ; Identify the child mode. |
c7ea3acc SM |
449 | (setq major-mode ',child) |
450 | (setq mode-name ,name) | |
5a7a545c | 451 | ; Set up maps and tables. |
c7ea3acc SM |
452 | (unless (keymap-parent ,map) |
453 | (set-keymap-parent ,map (current-local-map))) | |
454 | (let ((parent (char-table-parent ,syntax))) | |
455 | (unless (and parent (not (eq parent (standard-syntax-table)))) | |
456 | (set-char-table-parent ,syntax (syntax-table)))) | |
457 | (when local-abbrev-table | |
458 | (mapatoms | |
459 | (lambda (symbol) | |
460 | (or (intern-soft (symbol-name symbol) ,abbrev) | |
461 | (define-abbrev ,abbrev (symbol-name symbol) | |
462 | (symbol-value symbol) (symbol-function symbol)))) | |
463 | local-abbrev-table)) | |
5a7a545c | 464 | |
c7ea3acc SM |
465 | (use-local-map ,map) |
466 | (set-syntax-table ,syntax) | |
467 | (setq local-abbrev-table ,abbrev) | |
5a7a545c | 468 | ; Splice in the body (if any). |
c7ea3acc | 469 | ,@body) |
5a7a545c | 470 | ; Run the hooks, if any. |
e4ad5f9e SM |
471 | (run-hooks ',hook))))) |
472 | ||
3837de12 SM |
473 | ;; Inspired from derived-mode-class in derived.el |
474 | (defun easy-mmode-derived-mode-p (mode) | |
475 | "Non-nil if the current major mode is derived from MODE. | |
476 | Uses the `derived-mode-parent' property of the symbol to trace backwards." | |
477 | (let ((parent major-mode)) | |
478 | (while (and (not (eq parent mode)) | |
479 | (setq parent (get parent 'derived-mode-parent)))) | |
480 | parent)) | |
481 | ||
c7ea3acc SM |
482 | \f |
483 | ;;; | |
484 | ;;; easy-mmode-define-navigation | |
485 | ;;; | |
486 | ||
487 | (defmacro easy-mmode-define-navigation (base re &optional name endfun) | |
488 | "Define BASE-next and BASE-prev to navigate in the buffer. | |
489 | RE determines the places the commands should move point to. | |
490 | NAME should describe the entities matched by RE and is used to build | |
491 | the docstrings of the two functions. | |
492 | BASE-next also tries to make sure that the whole entry is visible by | |
493 | searching for its end (by calling ENDFUN if provided or by looking for | |
494 | the next entry) and recentering if necessary. | |
495 | ENDFUN should return the end position (with or without moving point)." | |
496 | (let* ((base-name (symbol-name base)) | |
497 | (prev-sym (intern (concat base-name "-prev"))) | |
498 | (next-sym (intern (concat base-name "-next")))) | |
36a5b60e | 499 | (unless name (setq name (symbol-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) |
c7ea3acc SM |
505 | (interactive) |
506 | (unless count (setq count 1)) | |
507 | (if (< count 0) (,prev-sym (- count)) | |
508 | (if (looking-at ,re) (incf count)) | |
36a5b60e | 509 | (unless (re-search-forward ,re nil t count) |
c8c21615 | 510 | (error ,(format "No next %s" name))) |
c7ea3acc SM |
511 | (goto-char (match-beginning 0)) |
512 | (when (eq (current-buffer) (window-buffer (selected-window))) | |
513 | (let ((endpt (or (save-excursion | |
514 | ,(if endfun `(,endfun) | |
515 | `(re-search-forward ,re nil t 2))) | |
516 | (point-max)))) | |
517 | (unless (<= endpt (window-end)) (recenter)))))) | |
518 | (defun ,prev-sym (&optional count) | |
519 | ,(format "Go to the previous COUNT'th %s" (or name base-name)) | |
520 | (interactive) | |
521 | (unless count (setq count 1)) | |
522 | (if (< count 0) (,next-sym (- count)) | |
36a5b60e | 523 | (unless (re-search-backward ,re nil t count) |
c8c21615 | 524 | (error ,(format "No previous %s" name)))))))) |
5a7a545c | 525 | |
6b279740 RS |
526 | (provide 'easy-mmode) |
527 | ||
528 | ;;; easy-mmode.el ends here |