LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - easy-mmode.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 169 259 65.3 %
Date: 2017-08-27 09:44:50 Functions: 3 11 27.3 %

          Line data    Source code
       1             : ;;; easy-mmode.el --- easy definition for major and minor modes
       2             : 
       3             : ;; Copyright (C) 1997, 2000-2017 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          58 :   (let* ((case-fold-search t)
      59             :          ;; Produce "Foo-Bar minor mode" from foo-bar-minor-mode.
      60          58 :          (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          58 :                         (capitalize (replace-regexp-in-string
      67             :                                      ;; "foo-bar-minor-mode" -> "foo-bar-minor"
      68             :                                      "toggle-\\|-mode\\'" ""
      69          58 :                                      (symbol-name mode))))
      70          58 :                        " mode")))
      71          58 :     (setq name (replace-regexp-in-string "\\`Global-" "Global " name))
      72          58 :     (if (not (stringp lighter)) name
      73             :       ;; Strip leading and trailing whitespace from LIGHTER.
      74           0 :       (setq lighter (replace-regexp-in-string "\\`\\s-+\\|\\s-+\\'" ""
      75           0 :                                               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          58 :       (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          50 :   (cond
     165          50 :    ((keywordp init-value)
     166          48 :     (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
     167          48 :                  `(,init-value ,lighter))
     168          48 :           init-value nil lighter nil keymap nil))
     169           2 :    ((keywordp lighter)
     170           0 :     (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
     171          50 :    ((keywordp keymap) (push keymap body) (setq keymap nil)))
     172             : 
     173          50 :   (let* ((last-message (make-symbol "last-message"))
     174          50 :          (mode-name (symbol-name mode))
     175          50 :          (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          50 :          (setter `(setq ,mode))  ;The beginning of the exp to set the mode var.
     185          50 :          (getter mode)           ;The exp to get the mode value.
     186          50 :          (modefun mode)          ;The minor mode function name we're defining.
     187             :          (require t)
     188             :          (after-hook nil)
     189          50 :          (hook (intern (concat mode-name "-hook")))
     190          50 :          (hook-on (intern (concat mode-name "-on-hook")))
     191          50 :          (hook-off (intern (concat mode-name "-off-hook")))
     192             :          keyw keymap-sym tmp)
     193             : 
     194             :     ;; Check keys.
     195         162 :     (while (keywordp (setq keyw (car body)))
     196         112 :       (setq body (cdr body))
     197         112 :       (pcase keyw
     198          32 :         (`:init-value (setq init-value (pop body)))
     199           8 :         (`:lighter (setq lighter (purecopy (pop body))))
     200          56 :         (`:global (setq globalp (pop body))
     201          28 :          (when (and globalp (symbolp mode))
     202          28 :            (setq setter `(setq-default ,mode))
     203          28 :            (setq getter `(default-value ',mode))))
     204           2 :         (`:extra-args (setq extra-args (pop body)))
     205           0 :         (`:set (setq set (list :set (pop body))))
     206          18 :         (`:initialize (setq initialize (list :initialize (pop body))))
     207          58 :         (`:group (setq group (nconc group (list :group (pop body)))))
     208           0 :         (`:type (setq type (list :type (pop body))))
     209           0 :         (`:require (setq require (pop body)))
     210           2 :         (`:keymap (setq keymap (pop body)))
     211          36 :         (`:variable (setq variable (pop body))
     212          18 :          (if (not (and (setq tmp (cdr-safe variable))
     213          12 :                        (or (symbolp tmp)
     214          18 :                            (functionp tmp))))
     215             :              ;; PLACE is not of the form (GET . SET).
     216          12 :              (progn
     217          12 :                (setq setter `(setf ,variable))
     218          12 :                (setq getter variable))
     219           6 :            (setq getter (car variable))
     220          18 :            (setq setter `(funcall #',(cdr variable)))))
     221           2 :         (`:after-hook (setq after-hook (pop body)))
     222         112 :         (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
     223             : 
     224          50 :     (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
     225          50 :                        (intern (concat mode-name "-map"))))
     226             : 
     227          50 :     (unless set (setq set '(:set #'custom-set-minor-mode)))
     228             : 
     229          50 :     (unless initialize
     230          50 :       (setq initialize '(:initialize 'custom-initialize-default)))
     231             : 
     232          50 :     (unless group
     233             :       ;; We might as well provide a best-guess default group.
     234          21 :       (setq group
     235          21 :             `(:group ',(intern (replace-regexp-in-string
     236          50 :                                 "-mode\\'" "" mode-name)))))
     237             : 
     238             :     ;; TODO? Mark booleans as safe if booleanp?  Eg abbrev-mode.
     239          50 :     (unless type (setq type '(:type 'boolean)))
     240             : 
     241          50 :     `(progn
     242             :        ;; Define the variable to enable or disable the mode.
     243          50 :        ,(cond
     244             :          ;; If :variable is specified, then the var will be
     245             :          ;; declared elsewhere.
     246          50 :          (variable nil)
     247          32 :          ((not globalp)
     248           9 :           `(progn
     249             :              :autoload-end
     250           9 :              (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
     251           9 : Use the command `%s' to change this variable." pretty-name mode))
     252           9 :              (make-variable-buffer-local ',mode)))
     253             :          (t
     254          23 :           (let ((base-doc-string
     255          23 :                  (concat "Non-nil if %s is enabled.
     256             : See the `%s' command
     257             : for a description of this minor mode."
     258          23 :                          (if body "
     259             : Setting this variable directly does not take effect;
     260             : either customize it (see the info node `Easy Customization')
     261          23 : or call the function `%s'."))))
     262          23 :             `(defcustom ,mode ,init-value
     263          23 :                ,(format base-doc-string pretty-name mode mode)
     264          23 :                ,@set
     265          23 :                ,@initialize
     266          23 :                ,@group
     267          23 :                ,@type
     268          23 :                ,@(unless (eq require t) `(:require ,require))
     269          50 :                ,@(nreverse extra-keywords)))))
     270             : 
     271             :        ;; The actual function.
     272          50 :        (defun ,modefun (&optional arg ,@extra-args)
     273          50 :          ,(or doc
     274           0 :               (format (concat "Toggle %s on or off.
     275             : With a prefix argument ARG, enable %s if ARG is
     276             : positive, and disable it otherwise.  If called from Lisp, enable
     277             : the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
     278          50 : \\{%s}") pretty-name pretty-name keymap-sym))
     279             :          ;; Use `toggle' rather than (if ,mode 0 1) so that using
     280             :          ;; repeat-command still does the toggling correctly.
     281             :          (interactive (list (or current-prefix-arg 'toggle)))
     282          50 :          (let ((,last-message (current-message)))
     283          50 :            (,@setter
     284             :             (if (eq arg 'toggle)
     285          50 :                 (not ,getter)
     286             :               ;; A nil argument also means ON now.
     287             :               (> (prefix-numeric-value arg) 0)))
     288          50 :            ,@body
     289             :            ;; The on/off hooks are here for backward compatibility only.
     290          50 :            (run-hooks ',hook (if ,getter ',hook-on ',hook-off))
     291             :            (if (called-interactively-p 'any)
     292             :                (progn
     293          50 :                  ,(if (and globalp (not variable))
     294          50 :                       `(customize-mark-as-set ',mode))
     295             :                  ;; Avoid overwriting a message shown by the body,
     296             :                  ;; but do overwrite previous messages.
     297             :                  (unless (and (current-message)
     298          50 :                               (not (equal ,last-message
     299             :                                           (current-message))))
     300          50 :                    (let ((local ,(if globalp "" " in current buffer")))
     301          50 :                      (message ,(format "%s %%sabled%%s" pretty-name)
     302          50 :                               (if ,getter "en" "dis") local)))))
     303          50 :            ,@(when after-hook `(,after-hook)))
     304             :          (force-mode-line-update)
     305             :          ;; Return the new setting.
     306          50 :          ,getter)
     307             : 
     308             :        ;; Autoloading a define-minor-mode autoloads everything
     309             :        ;; up-to-here.
     310             :        :autoload-end
     311             : 
     312          50 :        (defvar ,hook nil
     313          50 :          ,(format "Hook run after entering or leaving `%s'.
     314             : No problems result if this variable is not bound.
     315             : `add-hook' automatically binds it.  (This is true for all hook variables.)"
     316          50 :                   modefun))
     317             : 
     318             :        ;; Define the minor-mode keymap.
     319          50 :        ,(unless (symbolp keymap)        ;nil is also a symbol.
     320           0 :           `(defvar ,keymap-sym
     321           0 :              (let ((m ,keymap))
     322             :                (cond ((keymapp m) m)
     323             :                      ((listp m) (easy-mmode-define-keymap m))
     324             :                      (t (error "Invalid keymap %S" m))))
     325          50 :              ,(format "Keymap for `%s'." mode-name)))
     326             : 
     327          50 :        ,(let ((modevar (pcase getter (`(default-value ',v) v) (_ getter))))
     328          50 :           (if (not (symbolp modevar))
     329           7 :               (if (or lighter keymap)
     330           7 :                   (error ":lighter and :keymap unsupported with mode expression %S" getter))
     331          43 :             `(with-no-warnings
     332          43 :                (add-minor-mode ',modevar ',lighter
     333          43 :                                ,(if keymap keymap-sym
     334          43 :                                   `(if (boundp ',keymap-sym) ,keymap-sym))
     335             :                                nil
     336          50 :                                ,(unless (eq mode modefun) `',modefun))))))))
     337             : 
     338             : ;;;
     339             : ;;; make global minor mode
     340             : ;;;
     341             : 
     342             : ;;;###autoload
     343             : (defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
     344             : ;;;###autoload
     345             : (defalias 'define-global-minor-mode 'define-globalized-minor-mode)
     346             : ;;;###autoload
     347             : (defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys)
     348             :   "Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
     349             : TURN-ON is a function that will be called with no args in every buffer
     350             :   and that should try to turn MODE on if applicable for that buffer.
     351             : KEYS is a list of CL-style keyword arguments.  As the minor mode
     352             :   defined by this function is always global, any :global keyword is
     353             :   ignored.  Other keywords have the same meaning as in `define-minor-mode',
     354             :   which see.  In particular, :group specifies the custom group.
     355             :   The most useful keywords are those that are passed on to the
     356             :   `defcustom'.  It normally makes no sense to pass the :lighter
     357             :   or :keymap keywords to `define-globalized-minor-mode', since these
     358             :   are usually passed to the buffer-local version of the minor mode.
     359             : 
     360             : If MODE's set-up depends on the major mode in effect when it was
     361             : enabled, then disabling and reenabling MODE should make MODE work
     362             : correctly with the current major mode.  This is important to
     363             : prevent problems with derived modes, that is, major modes that
     364             : call another major mode in their body.
     365             : 
     366             : When a major mode is initialized, MODE is actually turned on just
     367             : after running the major mode's hook.  However, MODE is not turned
     368             : on if the hook has explicitly disabled it."
     369             :   (declare (doc-string 2))
     370           4 :   (let* ((global-mode-name (symbol-name global-mode))
     371           4 :          (mode-name (symbol-name mode))
     372           4 :          (pretty-name (easy-mmode-pretty-mode-name mode))
     373           4 :          (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
     374             :          (group nil)
     375             :          (extra-keywords nil)
     376           4 :          (MODE-buffers (intern (concat global-mode-name "-buffers")))
     377             :          (MODE-enable-in-buffers
     378           4 :           (intern (concat global-mode-name "-enable-in-buffers")))
     379             :          (MODE-check-buffers
     380           4 :           (intern (concat global-mode-name "-check-buffers")))
     381           4 :          (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
     382           4 :          (minor-MODE-hook (intern (concat mode-name "-hook")))
     383           4 :          (MODE-set-explicitly (intern (concat mode-name "-set-explicitly")))
     384           4 :          (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
     385             :          keyw)
     386             : 
     387             :     ;; Check keys.
     388          11 :     (while (keywordp (setq keyw (car keys)))
     389           7 :       (setq keys (cdr keys))
     390           7 :       (pcase keyw
     391           4 :         (`:group (setq group (nconc group (list :group (pop keys)))))
     392           0 :         (`:global (setq keys (cdr keys)))
     393          10 :         (_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
     394             : 
     395           4 :     (unless group
     396             :       ;; We might as well provide a best-guess default group.
     397           2 :       (setq group
     398           2 :             `(:group ',(intern (replace-regexp-in-string
     399           4 :                                 "-mode\\'" "" (symbol-name mode))))))
     400             : 
     401           4 :     `(progn
     402             :        (progn
     403             :          :autoload-end
     404           4 :          (defvar ,MODE-major-mode nil)
     405           4 :          (make-variable-buffer-local ',MODE-major-mode))
     406             :        ;; The actual global minor-mode
     407           4 :        (define-minor-mode ,global-mode
     408             :          ;; Very short lines to avoid too long lines in the generated
     409             :          ;; doc string.
     410           4 :          ,(format "Toggle %s in all buffers.
     411             : With prefix ARG, enable %s if ARG is positive;
     412             : otherwise, disable it.  If called from Lisp, enable the mode if
     413             : ARG is omitted or nil.
     414             : 
     415             : %s is enabled in all buffers where
     416             : `%s' would do it.
     417             : See `%s' for more information on %s."
     418           4 :                   pretty-name pretty-global-name
     419           4 :                   pretty-name turn-on mode pretty-name)
     420           4 :          :global t ,@group ,@(nreverse extra-keywords)
     421             : 
     422             :          ;; Setup hook to handle future mode changes and new buffers.
     423           4 :          (if ,global-mode
     424             :              (progn
     425             :                (add-hook 'after-change-major-mode-hook
     426           4 :                          ',MODE-enable-in-buffers)
     427           4 :                (add-hook 'find-file-hook ',MODE-check-buffers)
     428           4 :                (add-hook 'change-major-mode-hook ',MODE-cmhh))
     429           4 :            (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
     430           4 :            (remove-hook 'find-file-hook ',MODE-check-buffers)
     431           4 :            (remove-hook 'change-major-mode-hook ',MODE-cmhh))
     432             : 
     433             :          ;; Go through existing buffers.
     434             :          (dolist (buf (buffer-list))
     435             :            (with-current-buffer buf
     436           4 :              (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1))))))
     437             : 
     438             :        ;; Autoloading define-globalized-minor-mode autoloads everything
     439             :        ;; up-to-here.
     440             :        :autoload-end
     441             : 
     442             :        ;; MODE-set-explicitly is set in MODE-set-explicitly and cleared by
     443             :        ;; kill-all-local-variables.
     444           4 :        (defvar-local ,MODE-set-explicitly nil)
     445           4 :        (defun ,MODE-set-explicitly ()
     446           4 :          (setq ,MODE-set-explicitly t))
     447           4 :        (put ',MODE-set-explicitly 'definition-name ',global-mode)
     448             : 
     449             :        ;; A function which checks whether MODE has been disabled in the major
     450             :        ;; mode hook which has just been run.
     451           4 :        (add-hook ',minor-MODE-hook ',MODE-set-explicitly)
     452             : 
     453             :        ;; List of buffers left to process.
     454           4 :        (defvar ,MODE-buffers nil)
     455             : 
     456             :        ;; The function that calls TURN-ON in each buffer.
     457           4 :        (defun ,MODE-enable-in-buffers ()
     458           4 :          (dolist (buf ,MODE-buffers)
     459             :            (when (buffer-live-p buf)
     460             :              (with-current-buffer buf
     461           4 :                (unless ,MODE-set-explicitly
     462           4 :                  (unless (eq ,MODE-major-mode major-mode)
     463           4 :                    (if ,mode
     464             :                        (progn
     465           4 :                          (,mode -1)
     466           4 :                          (funcall #',turn-on))
     467           4 :                      (funcall #',turn-on))))
     468           4 :                (setq ,MODE-major-mode major-mode)))))
     469           4 :        (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
     470             : 
     471           4 :        (defun ,MODE-check-buffers ()
     472           4 :          (,MODE-enable-in-buffers)
     473           4 :          (setq ,MODE-buffers nil)
     474           4 :          (remove-hook 'post-command-hook ',MODE-check-buffers))
     475           4 :        (put ',MODE-check-buffers 'definition-name ',global-mode)
     476             : 
     477             :        ;; The function that catches kill-all-local-variables.
     478           4 :        (defun ,MODE-cmhh ()
     479           4 :          (add-to-list ',MODE-buffers (current-buffer))
     480           4 :          (add-hook 'post-command-hook ',MODE-check-buffers))
     481           4 :        (put ',MODE-cmhh 'definition-name ',global-mode))))
     482             : 
     483             : ;;;
     484             : ;;; easy-mmode-defmap
     485             : ;;;
     486             : 
     487             : (defun easy-mmode-set-keymap-parents (m parents)
     488           0 :   (set-keymap-parent
     489           0 :    m (if (cdr parents) (make-composed-keymap parents) (car parents))))
     490             : 
     491             : ;;;###autoload
     492             : (defun easy-mmode-define-keymap (bs &optional name m args)
     493             :   "Return a keymap built from bindings BS.
     494             : BS must be a list of (KEY . BINDING) where
     495             : KEY and BINDINGS are suitable for `define-key'.
     496             : Optional NAME is passed to `make-sparse-keymap'.
     497             : Optional map M can be used to modify an existing map.
     498             : ARGS is a list of additional keyword arguments.
     499             : 
     500             : Valid keywords and arguments are:
     501             : 
     502             :   :name      Name of the keymap; overrides NAME argument.
     503             :   :dense     Non-nil for a dense keymap.
     504             :   :inherit   Parent keymap.
     505             :   :group     Ignored.
     506             :   :suppress  Non-nil to call `suppress-keymap' on keymap,
     507             :              `nodigits' to suppress digits as prefix arguments."
     508           0 :   (let (inherit dense suppress)
     509           0 :     (while args
     510           0 :       (let ((key (pop args))
     511           0 :             (val (pop args)))
     512           0 :         (pcase key
     513           0 :          (`:name (setq name val))
     514           0 :          (`:dense (setq dense val))
     515           0 :          (`:inherit (setq inherit val))
     516           0 :          (`:suppress (setq suppress val))
     517             :          (`:group)
     518           0 :          (_ (message "Unknown argument %s in defmap" key)))))
     519           0 :     (unless (keymapp m)
     520           0 :       (setq bs (append m bs))
     521           0 :       (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
     522           0 :     (when suppress
     523           0 :       (suppress-keymap m (eq suppress 'nodigits)))
     524           0 :     (dolist (b bs)
     525           0 :       (let ((keys (car b))
     526           0 :             (binding (cdr b)))
     527           0 :         (dolist (key (if (consp keys) keys (list keys)))
     528           0 :           (cond
     529           0 :            ((symbolp key)
     530           0 :             (substitute-key-definition key binding m global-map))
     531           0 :            ((null binding)
     532           0 :             (unless (keymapp (lookup-key m key)) (define-key m key binding)))
     533           0 :            ((let ((o (lookup-key m key)))
     534           0 :               (or (null o) (numberp o) (eq o 'undefined)))
     535           0 :             (define-key m key binding))))))
     536           0 :     (cond
     537           0 :      ((keymapp inherit) (set-keymap-parent m inherit))
     538           0 :      ((consp inherit) (easy-mmode-set-keymap-parents m inherit)))
     539           0 :     m))
     540             : 
     541             : ;;;###autoload
     542             : (defmacro easy-mmode-defmap (m bs doc &rest args)
     543             :   "Define a constant M whose value is the result of `easy-mmode-define-keymap'.
     544             : The M, BS, and ARGS arguments are as per that function.  DOC is
     545             : the constant's documentation."
     546           0 :   `(defconst ,m
     547           0 :      (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
     548           0 :      ,doc))
     549             : 
     550             : 
     551             : ;;;
     552             : ;;; easy-mmode-defsyntax
     553             : ;;;
     554             : 
     555             : (defun easy-mmode-define-syntax (css args)
     556           0 :   (let ((st (make-syntax-table (plist-get args :copy)))
     557           0 :         (parent (plist-get args :inherit)))
     558           0 :     (dolist (cs css)
     559           0 :       (let ((char (car cs))
     560           0 :             (syntax (cdr cs)))
     561           0 :         (if (sequencep char)
     562           0 :             (mapc (lambda (c) (modify-syntax-entry c syntax st)) char)
     563           0 :           (modify-syntax-entry char syntax st))))
     564           0 :     (if parent (set-char-table-parent
     565           0 :                 st (if (symbolp parent) (symbol-value parent) parent)))
     566           0 :     st))
     567             : 
     568             : ;;;###autoload
     569             : (defmacro easy-mmode-defsyntax (st css doc &rest args)
     570             :   "Define variable ST as a syntax-table.
     571             : CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
     572           0 :   `(progn
     573             :      (autoload 'easy-mmode-define-syntax "easy-mmode")
     574           0 :      (defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
     575             : 
     576             : 
     577             : 
     578             : ;;;
     579             : ;;; easy-mmode-define-navigation
     580             : ;;;
     581             : 
     582             : (defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun
     583             :                                              &rest body)
     584             :   "Define BASE-next and BASE-prev to navigate in the buffer.
     585             : RE determines the places the commands should move point to.
     586             : NAME should describe the entities matched by RE.  It is used to build
     587             :   the docstrings of the two functions.
     588             : BASE-next also tries to make sure that the whole entry is visible by
     589             :   searching for its end (by calling ENDFUN if provided or by looking for
     590             :   the next entry) and recentering if necessary.
     591             : ENDFUN should return the end position (with or without moving point).
     592             : NARROWFUN non-nil means to check for narrowing before moving, and if
     593             : found, do `widen' first and then call NARROWFUN with no args after moving.
     594             : BODY is executed after moving to the destination location."
     595             :   (declare (indent 5) (debug (exp exp exp def-form def-form &rest def-body)))
     596           0 :   (let* ((base-name (symbol-name base))
     597           0 :          (prev-sym (intern (concat base-name "-prev")))
     598           0 :          (next-sym (intern (concat base-name "-next")))
     599             :          (when-narrowed
     600             :           (lambda (body)
     601           0 :             (if (null narrowfun) body
     602           0 :               `(let ((was-narrowed
     603             :                       (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
     604             :                         (widen))))
     605           0 :                  ,body
     606           0 :                  (when was-narrowed (funcall #',narrowfun)))))))
     607           0 :     (unless name (setq name base-name))
     608           0 :     `(progn
     609           0 :        (defun ,next-sym (&optional count)
     610           0 :          ,(format "Go to the next COUNT'th %s." name)
     611             :          (interactive "p")
     612             :          (unless count (setq count 1))
     613           0 :          (if (< count 0) (,prev-sym (- count))
     614           0 :            (if (looking-at ,re) (setq count (1+ count)))
     615           0 :            ,(funcall when-narrowed
     616           0 :              `(if (not (re-search-forward ,re nil t count))
     617           0 :                   (if (looking-at ,re)
     618           0 :                       (goto-char (or ,(if endfun `(funcall #',endfun)) (point-max)))
     619           0 :                     (user-error "No next %s" ,name))
     620             :                 (goto-char (match-beginning 0))
     621             :                 (when (and (eq (current-buffer) (window-buffer))
     622             :                            (called-interactively-p 'interactive))
     623             :                   (let ((endpt (or (save-excursion
     624           0 :                                      ,(if endfun `(funcall #',endfun)
     625           0 :                                         `(re-search-forward ,re nil t 2)))
     626             :                                    (point-max))))
     627             :                     (unless (pos-visible-in-window-p endpt nil t)
     628           0 :                       (recenter '(0)))))))
     629           0 :            ,@body))
     630           0 :        (put ',next-sym 'definition-name ',base)
     631           0 :        (defun ,prev-sym (&optional count)
     632           0 :          ,(format "Go to the previous COUNT'th %s" (or name base-name))
     633             :          (interactive "p")
     634             :          (unless count (setq count 1))
     635           0 :          (if (< count 0) (,next-sym (- count))
     636           0 :            ,(funcall when-narrowed
     637           0 :              `(unless (re-search-backward ,re nil t count)
     638           0 :                 (user-error "No previous %s" ,name)))
     639           0 :            ,@body))
     640           0 :        (put ',prev-sym 'definition-name ',base))))
     641             : 
     642             : 
     643             : (provide 'easy-mmode)
     644             : 
     645             : ;;; easy-mmode.el ends here

Generated by: LCOV version 1.12