easy-mmode.el 20.3 KB
Newer Older
1
;;; easy-mmode.el --- easy definition for major and minor modes
Richard M. Stallman's avatar
Richard M. Stallman committed
2

3
;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2006, 2007 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

Pavel Janík's avatar
Pavel Janík committed
6 7 8 9
;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
;; Maintainer: Stefan Monnier <monnier@gnu.org>

;; Keywords: extensions lisp
Richard M. Stallman's avatar
Richard M. Stallman committed
10 11 12 13 14

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
15
;; the Free Software Foundation; either version 3, or (at your option)
Richard M. Stallman's avatar
Richard M. Stallman committed
16 17 18 19 20 21 22 23 24
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
25 26
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29 30 31 32 33 34 35 36 37 38

;;; Commentary:

;; Minor modes are useful and common.  This package makes defining a
;; minor mode easy, by focusing on the writing of the minor mode
;; functionalities themselves.  Moreover, this package enforces a
;; conventional naming of user interface primitives, making things
;; natural for the minor-mode end-users.

;; For each mode, easy-mmode defines the following:
;; <mode>      : The minor mode predicate. A buffer-local variable.
;; <mode>-map  : The keymap possibly associated to <mode>.
39
;;       see `define-minor-mode' documentation
Richard M. Stallman's avatar
Richard M. Stallman committed
40 41
;;
;; eval
42
;;  (pp (macroexpand '(define-minor-mode <your-mode> <doc>)))
Richard M. Stallman's avatar
Richard M. Stallman committed
43 44 45 46 47 48 49 50
;; to check the result before using it.

;; The order in which minor modes are installed is important.  Keymap
;; lookup proceeds down minor-mode-map-alist, and the order there
;; tends to be the reverse of the order in which the modes were
;; installed.  Perhaps there should be a feature to let you specify
;; orderings.

51 52
;; Additionally to `define-minor-mode', the package provides convenient
;; ways to define keymaps, and other helper functions for major and minor modes.
Richard M. Stallman's avatar
Richard M. Stallman committed
53

54
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
55

56 57
(eval-when-compile (require 'cl))

58 59
(defun easy-mmode-pretty-mode-name (mode &optional lighter)
  "Turn the symbol MODE into a string intended for the user.
60 61
If provided, LIGHTER will be used to help choose capitalization by,
replacing its case-insensitive matches with the literal string in LIGHTER."
62
  (let* ((case-fold-search t)
63
	 ;; Produce "Foo-Bar minor mode" from foo-bar-minor-mode.
64
	 (name (concat (replace-regexp-in-string
65 66 67
			;; If the original mode name included "-minor" (some
			;; of them don't, e.g. auto-revert-mode), then
			;; replace it with " minor".
68
			"-Minor" " minor"
69
			;; "foo-bar-minor" -> "Foo-Bar-Minor"
70
			(capitalize (replace-regexp-in-string
71
				     ;; "foo-bar-minor-mode" -> "foo-bar-minor"
72
				     "-mode\\'" "" (symbol-name mode))))
73 74
		       " mode")))
    (if (not (stringp lighter)) name
75 76 77 78 79 80 81 82 83 84
      ;; Strip leading and trailing whitespace from LIGHTER.
      (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\s-+\\'" ""
					      lighter))
      ;; Replace any (case-insensitive) matches for LIGHTER in NAME
      ;; with a literal LIGHTER.  E.g., if NAME is "Iimage mode" and
      ;; LIGHTER is " iImag", then this will produce "iImage mode".
      ;; (LIGHTER normally comes from the mode-line string passed to
      ;; define-minor-mode, and normally includes at least one leading
      ;; space.)
      (replace-regexp-in-string (regexp-quote lighter) lighter name t t))))
85

Richard M. Stallman's avatar
Richard M. Stallman committed
86
;;;###autoload
Stefan Monnier's avatar
Stefan Monnier committed
87 88 89
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
;;;###autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
Richard M. Stallman's avatar
Richard M. Stallman committed
90
  "Define a new minor mode MODE.
91
This function defines the associated control variable MODE, keymap MODE-map,
92
and toggle command MODE.
Richard M. Stallman's avatar
Richard M. Stallman committed
93 94

DOC is the documentation for the mode toggle command.
Stefan Monnier's avatar
Stefan Monnier committed
95
Optional INIT-VALUE is the initial value of the mode's variable.
96
Optional LIGHTER is displayed in the modeline when the mode is on.
Richard M. Stallman's avatar
Richard M. Stallman committed
97
Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
98
  If it is a list, it is passed to `easy-mmode-define-keymap'
Stefan Monnier's avatar
Stefan Monnier committed
99 100 101 102 103
  in order to build a valid keymap.  It's generally better to use
  a separate MODE-map variable than to use this argument.
The above three arguments can be skipped if keyword arguments are
used (see below).

Eli Zaretskii's avatar
Eli Zaretskii committed
104
BODY contains code to execute each time the mode is activated or deactivated.
105
  It is executed after toggling the mode,
106
  and before running the hook variable `MODE-hook'.
107 108 109
  Before the actual body code, you can write keyword arguments (alternating
  keywords and values).  These following keyword arguments are supported (other
  keywords will be passed to `defcustom' if the minor mode is global):
110
:group GROUP	Custom group name to use in all generated `defcustom' forms.
111
		Defaults to MODE without the possible trailing \"-mode\".
112 113
		Don't use this default group name unless you have written a
		`defgroup' to define that group properly.
114
:global GLOBAL	If non-nil specifies that the minor mode is not meant to be
115
		buffer-local, so don't make the variable MODE buffer-local.
116
		By default, the mode is buffer-local.
117 118
:init-value VAL	Same as the INIT-VALUE argument.
:lighter SPEC	Same as the LIGHTER argument.
119
:keymap MAP	Same as the KEYMAP argument.
120 121 122 123
:require SYM	Same as in `defcustom'.

For example, you could write
  (define-minor-mode foo-mode \"If enabled, foo on you!\"
124
    :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
125
    ...BODY CODE...)"
126 127 128 129 130 131
  (declare (debug (&define name stringp
			   [&optional [&not keywordp] sexp
			    &optional [&not keywordp] sexp
			    &optional [&not keywordp] sexp]
			   [&rest [keywordp sexp]]
			   def-body)))
132

Stefan Monnier's avatar
Stefan Monnier committed
133 134 135 136 137 138 139 140 141
  ;; Allow skipping the first three args.
  (cond
   ((keywordp init-value)
    (setq body (list* init-value lighter keymap body)
	  init-value nil lighter nil keymap nil))
   ((keywordp lighter)
    (setq body (list* lighter keymap body) lighter nil keymap nil))
   ((keywordp keymap) (push keymap body) (setq keymap nil)))

142 143
  (let* ((last-message (current-message))
	 (mode-name (symbol-name mode))
144
	 (pretty-name (easy-mmode-pretty-mode-name mode lighter))
145
	 (globalp nil)
146
	 (set nil)
147
	 (initialize nil)
148
	 (group nil)
149
	 (type nil)
150
	 (extra-args nil)
151
	 (extra-keywords nil)
152
	 (require t)
153 154
	 (hook (intern (concat mode-name "-hook")))
	 (hook-on (intern (concat mode-name "-on-hook")))
155
	 (hook-off (intern (concat mode-name "-off-hook")))
156
	 keyw keymap-sym)
157 158

    ;; Check keys.
159 160 161
    (while (keywordp (setq keyw (car body)))
      (setq body (cdr body))
      (case keyw
Stefan Monnier's avatar
Stefan Monnier committed
162 163
	(:init-value (setq init-value (pop body)))
	(:lighter (setq lighter (pop body)))
164
	(:global (setq globalp (pop body)))
165
	(:extra-args (setq extra-args (pop body)))
166
	(:set (setq set (list :set (pop body))))
167
	(:initialize (setq initialize (list :initialize (pop body))))
168
	(:group (setq group (nconc group (list :group (pop body)))))
169
	(:type (setq type (list :type (pop body))))
170
	(:require (setq require (pop body)))
171
	(:keymap (setq keymap (pop body)))
172
	(t (push keyw extra-keywords) (push (pop body) extra-keywords))))
173

174 175 176
    (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
		       (intern (concat mode-name "-map"))))

177 178
    (unless set (setq set '(:set 'custom-set-minor-mode)))

179
    (unless initialize
180
      (setq initialize '(:initialize 'custom-initialize-default)))
181

182 183 184
    (unless group
      ;; We might as well provide a best-guess default group.
      (setq group
185 186
	    `(:group ',(intern (replace-regexp-in-string
				"-mode\\'" "" mode-name)))))
187

188 189
    (unless type (setq type '(:type 'boolean)))

Richard M. Stallman's avatar
Richard M. Stallman committed
190
    `(progn
Karl Heuer's avatar
Karl Heuer committed
191
       ;; Define the variable to enable or disable the mode.
192 193 194
       ,(if (not globalp)
	    `(progn
	       (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
195
Use the command `%s' to change this variable." pretty-name mode))
196
	       (make-variable-buffer-local ',mode))
Richard M. Stallman's avatar
Richard M. Stallman committed
197

198 199
	  (let ((base-doc-string
                 (concat "Non-nil if %s is enabled.
200
See the command `%s' for a description of this minor mode."
201
                         (if body "
202
Setting this variable directly does not take effect;
203 204
either customize it (see the info node `Easy Customization')
or call the function `%s'."))))
205 206
	    `(defcustom ,mode ,init-value
	       ,(format base-doc-string pretty-name mode mode)
207
	       ,@set
208
	       ,@initialize
209
	       ,@group
210
	       ,@type
211 212
	       ,@(unless (eq require t) `(:require ,require))
               ,@(nreverse extra-keywords))))
213

214
       ;; The actual function.
215
       (defun ,mode (&optional arg ,@extra-args)
216
	 ,(or doc
Stefan Monnier's avatar
Stefan Monnier committed
217 218
	      (format (concat "Toggle %s on or off.
Interactively, with no prefix argument, toggle the mode.
219
With universal prefix ARG turn mode on.
220
With zero or negative ARG turn mode off.
Stefan Monnier's avatar
Stefan Monnier committed
221
\\{%s}") pretty-name keymap-sym))
222 223 224
	 ;; Use `toggle' rather than (if ,mode 0 1) so that using
	 ;; repeat-command still does the toggling correctly.
	 (interactive (list (or current-prefix-arg 'toggle)))
225
	 (setq ,mode
226 227 228 229 230 231 232 233 234
	       (cond
		((eq arg 'toggle) (not ,mode))
		(arg (> (prefix-numeric-value arg) 0))
		(t
		 (if (null ,mode) t
		   (message
		    "Toggling %s off; better pass an explicit argument."
		    ',mode)
		   nil))))
235 236 237
	 ,@body
	 ;; The on/off hooks are here for backward compatibility only.
	 (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
238
	 (if (called-interactively-p)
239 240
	     (progn
	       ,(if globalp `(customize-mark-as-set ',mode))
241 242 243 244
	       ;; Avoid overwriting a message shown by the body,
               ;; but do overwrite previous messages.
	       (unless  ,(and (current-message)
                              (not (equal last-message (current-message))))
245
		 (message ,(format "%s %%sabled" pretty-name)
246
			  (if ,mode "en" "dis")))))
Stefan Monnier's avatar
Stefan Monnier committed
247
	 (force-mode-line-update)
248
	 ;; Return the new setting.
249
	 ,mode)
250

251 252
       ;; Autoloading a define-minor-mode autoloads everything
       ;; up-to-here.
253 254
       :autoload-end

255
       ;; Define the minor-mode keymap.
256
       ,(unless (symbolp keymap)	;nil is also a symbol.
257
	  `(defvar ,keymap-sym
258 259 260 261
	     (let ((m ,keymap))
	       (cond ((keymapp m) m)
		     ((listp m) (easy-mmode-define-keymap m))
		     (t (error "Invalid keymap %S" ,keymap))))
262 263
	     ,(format "Keymap for `%s'." mode-name)))

264
       (add-minor-mode ',mode ',lighter
265
		       ,(if keymap keymap-sym
266
			  `(if (boundp ',keymap-sym)
267
			       (symbol-value ',keymap-sym)))))))
268

269 270 271 272
;;;
;;; make global minor mode
;;;

273
;;;###autoload
274
(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
275
;;;###autoload
276 277 278
(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
;;;###autoload
(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys)
279
  "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
280 281
TURN-ON is a function that will be called with no args in every buffer
  and that should try to turn MODE on if applicable for that buffer.
282 283 284 285 286 287
KEYS is a list of CL-style keyword arguments.  As the minor mode
  defined by this function is always global, any :global keyword is
  ignored.  Other keywords have the same meaning as in `define-minor-mode',
  which see.  In particular, :group specifies the custom group.
  The most useful keywords are those that are passed on to the
  `defcustom'.  It normally makes no sense to pass the :lighter
288
  or :keymap keywords to `define-globalized-minor-mode', since these
289
  are usually passed to the buffer-local version of the minor mode.
290 291 292 293 294 295 296

If MODE's set-up depends on the major mode in effect when it was
enabled, then disabling and reenabling MODE should make MODE work
correctly with the current major mode.  This is important to
prevent problems with derived modes, that is, major modes that
call another major mode in their body."

297
  (let* ((global-mode-name (symbol-name global-mode))
298 299
	 (pretty-name (easy-mmode-pretty-mode-name mode))
	 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
300
	 (group nil)
301
	 (extra-keywords nil)
302 303 304 305 306 307
	 (MODE-buffers (intern (concat global-mode-name "-buffers")))
	 (MODE-enable-in-buffers
	  (intern (concat global-mode-name "-enable-in-buffers")))
	 (MODE-check-buffers
	  (intern (concat global-mode-name "-check-buffers")))
	 (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
308 309
	 (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
	 keyw)
310 311

    ;; Check keys.
312 313 314
    (while (keywordp (setq keyw (car keys)))
      (setq keys (cdr keys))
      (case keyw
315
	(:group (setq group (nconc group (list :group (pop keys)))))
316 317
	(:global (setq keys (cdr keys)))
	(t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
318

319 320 321
    (unless group
      ;; We might as well provide a best-guess default group.
      (setq group
322 323
	    `(:group ',(intern (replace-regexp-in-string
				"-mode\\'" "" (symbol-name mode))))))
324

325
    `(progn
326 327
       (defvar ,MODE-major-mode nil)
       (make-variable-buffer-local ',MODE-major-mode)
328 329
       ;; The actual global minor-mode
       (define-minor-mode ,global-mode
330
	 ,(format "Toggle %s in every possible buffer.
331
With prefix ARG, turn %s on if and only if ARG is positive.
332 333 334 335
%s is enabled in all buffers where `%s' would do it.
See `%s' for more information on %s."
		  pretty-name pretty-global-name pretty-name turn-on
		  mode pretty-name)
336
	 :global t ,@group ,@(nreverse extra-keywords)
337 338 339

	 ;; Setup hook to handle future mode changes and new buffers.
	 (if ,global-mode
340
	     (progn
341 342 343 344 345 346 347
	       (add-hook 'after-change-major-mode-hook
			 ',MODE-enable-in-buffers)
	       (add-hook 'find-file-hook ',MODE-check-buffers)
	       (add-hook 'change-major-mode-hook ',MODE-cmhh))
	   (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
	   (remove-hook 'find-file-hook ',MODE-check-buffers)
	   (remove-hook 'change-major-mode-hook ',MODE-cmhh))
348 349 350 351

	 ;; Go through existing buffers.
	 (dolist (buf (buffer-list))
	   (with-current-buffer buf
352
	     (if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
353

354
       ;; Autoloading define-globalized-minor-mode autoloads everything
355
       ;; up-to-here.
356 357
       :autoload-end

358
       ;; List of buffers left to process.
359
       (defvar ,MODE-buffers nil)
360 361

       ;; The function that calls TURN-ON in each buffer.
362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379
       (defun ,MODE-enable-in-buffers ()
	 (dolist (buf ,MODE-buffers)
	   (when (buffer-live-p buf)
	     (with-current-buffer buf
	       (if ,mode
		   (unless (eq ,MODE-major-mode major-mode)
		     (,mode -1)
		     (,turn-on)
		     (setq ,MODE-major-mode major-mode))
		 (,turn-on)
		 (setq ,MODE-major-mode major-mode))))))
       (put ',MODE-enable-in-buffers 'definition-name ',global-mode)

       (defun ,MODE-check-buffers ()
	 (,MODE-enable-in-buffers)
	 (setq ,MODE-buffers nil)
	 (remove-hook 'post-command-hook ',MODE-check-buffers))
       (put ',MODE-check-buffers 'definition-name ',global-mode)
380 381

       ;; The function that catches kill-all-local-variables.
382 383 384 385
       (defun ,MODE-cmhh ()
	 (add-to-list ',MODE-buffers (current-buffer))
	 (add-hook 'post-command-hook ',MODE-check-buffers))
       (put ',MODE-cmhh 'definition-name ',global-mode))))
386

387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402
;;;
;;; easy-mmode-defmap
;;;

(if (fboundp 'set-keymap-parents)
    (defalias 'easy-mmode-set-keymap-parents 'set-keymap-parents)
  (defun easy-mmode-set-keymap-parents (m parents)
    (set-keymap-parent
     m
     (cond
      ((not (consp parents)) parents)
      ((not (cdr parents)) (car parents))
      (t (let ((m (copy-keymap (pop parents))))
	   (easy-mmode-set-keymap-parents m parents)
	   m))))))

403
;;;###autoload
404 405 406
(defun easy-mmode-define-keymap (bs &optional name m args)
  "Return a keymap built from bindings BS.
BS must be a list of (KEY . BINDING) where
407 408 409
KEY and BINDINGS are suitable for `define-key'.
Optional NAME is passed to `make-sparse-keymap'.
Optional map M can be used to modify an existing map.
Stefan Monnier's avatar
Stefan Monnier committed
410
ARGS is a list of additional keyword arguments."
411
  (let (inherit dense)
412 413 414
    (while args
      (let ((key (pop args))
	    (val (pop args)))
415
	(case key
Stefan Monnier's avatar
Stefan Monnier committed
416
	 (:name (setq name val))
417 418 419
	 (:dense (setq dense val))
	 (:inherit (setq inherit val))
	 (:group)
420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442
	 (t (message "Unknown argument %s in defmap" key)))))
    (unless (keymapp m)
      (setq bs (append m bs))
      (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
    (dolist (b bs)
      (let ((keys (car b))
	    (binding (cdr b)))
	(dolist (key (if (consp keys) keys (list keys)))
	  (cond
	   ((symbolp key)
	    (substitute-key-definition key binding m global-map))
	   ((null binding)
	    (unless (keymapp (lookup-key m key)) (define-key m key binding)))
	   ((let ((o (lookup-key m key)))
	      (or (null o) (numberp o) (eq o 'undefined)))
	    (define-key m key binding))))))
    (cond
     ((keymapp inherit) (set-keymap-parent m inherit))
     ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
    m))

;;;###autoload
(defmacro easy-mmode-defmap (m bs doc &rest args)
443 444 445
  `(defconst ,m
     (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
     ,doc))
446 447 448 449 450 451 452


;;;
;;; easy-mmode-defsyntax
;;;

(defun easy-mmode-define-syntax (css args)
453 454
  (let ((st (make-syntax-table (plist-get args :copy)))
	(parent (plist-get args :inherit)))
455 456 457 458
    (dolist (cs css)
      (let ((char (car cs))
	    (syntax (cdr cs)))
	(if (sequencep char)
459
	    (mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
460
	  (modify-syntax-entry char syntax st))))
461 462
    (if parent (set-char-table-parent
		st (if (symbolp parent) (symbol-value parent) parent)))
463 464 465 466
    st))

;;;###autoload
(defmacro easy-mmode-defsyntax (st css doc &rest args)
467
  "Define variable ST as a syntax-table.
468
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
469 470
  `(progn
     (autoload 'easy-mmode-define-syntax "easy-mmode")
471
     (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
472 473


474 475 476 477 478

;;;
;;; easy-mmode-define-navigation
;;;

479
(defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun)
480 481
  "Define BASE-next and BASE-prev to navigate in the buffer.
RE determines the places the commands should move point to.
482
NAME should describe the entities matched by RE.  It is used to build
483 484 485 486
  the docstrings of the two functions.
BASE-next also tries to make sure that the whole entry is visible by
  searching for its end (by calling ENDFUN if provided or by looking for
  the next entry) and recentering if necessary.
487 488
ENDFUN should return the end position (with or without moving point).
NARROWFUN non-nil means to check for narrowing before moving, and if
489
found, do `widen' first and then call NARROWFUN with no args after moving."
490 491
  (let* ((base-name (symbol-name base))
	 (prev-sym (intern (concat base-name "-prev")))
492
	 (next-sym (intern (concat base-name "-next")))
493 494 495 496 497
         (check-narrow-maybe
	  (when narrowfun
	    '(setq was-narrowed
		   (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
		     (widen)))))
498
         (re-narrow-maybe (when narrowfun
499
                            `(when was-narrowed (,narrowfun)))))
500
    (unless name (setq name base-name))
501
    `(progn
502 503
       (add-to-list 'debug-ignored-errors
		    ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
504
       (defun ,next-sym (&optional count)
505
	 ,(format "Go to the next COUNT'th %s." name)
506
	 (interactive "p")
507 508
	 (unless count (setq count 1))
	 (if (< count 0) (,prev-sym (- count))
509
	   (if (looking-at ,re) (setq count (1+ count)))
510
           (let (was-narrowed)
511 512 513 514 515 516 517 518 519 520 521 522 523 524 525
             ,check-narrow-maybe
             (if (not (re-search-forward ,re nil t count))
                 (if (looking-at ,re)
                     (goto-char (or ,(if endfun `(,endfun)) (point-max)))
                   (error "No next %s" ,name))
               (goto-char (match-beginning 0))
               (when (and (eq (current-buffer) (window-buffer (selected-window)))
                          (interactive-p))
                 (let ((endpt (or (save-excursion
                                    ,(if endfun `(,endfun)
                                       `(re-search-forward ,re nil t 2)))
                                  (point-max))))
                   (unless (pos-visible-in-window-p endpt nil t)
                     (recenter '(0))))))
             ,re-narrow-maybe)))
526
       (put ',next-sym 'definition-name ',base)
527 528
       (defun ,prev-sym (&optional count)
	 ,(format "Go to the previous COUNT'th %s" (or name base-name))
529
	 (interactive "p")
530 531
	 (unless count (setq count 1))
	 (if (< count 0) (,next-sym (- count))
532
           (let (was-narrowed)
533 534 535
             ,check-narrow-maybe
             (unless (re-search-backward ,re nil t count)
               (error "No previous %s" ,name))
536 537
             ,re-narrow-maybe)))
       (put ',prev-sym 'definition-name ',base))))
538

539

Richard M. Stallman's avatar
Richard M. Stallman committed
540 541
(provide 'easy-mmode)

Miles Bader's avatar
Miles Bader committed
542
;;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a
Richard M. Stallman's avatar
Richard M. Stallman committed
543
;;; easy-mmode.el ends here