code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/easy-mmode.el

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