lisp/emacs-lisp/easy-mmode.el

   1 ;;; easy-mmode.el --- easy definition of minor modes.
   2
   3 ;; Copyright (C) 1997  Free Software Foundation, Inc.
   4
   5 ;; Author:  Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
   6 ;; Maintainer:  Stefan Monnier <monnier@gnu.org>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Minor modes are useful and common.  This package makes defining a
  28 ;; minor mode easy, by focusing on the writing of the minor mode
  29 ;; functionalities themselves.  Moreover, this package enforces a
  30 ;; conventional naming of user interface primitives, making things
  31 ;; natural for the minor-mode end-users.
  32
  33 ;; For each mode, easy-mmode defines the following:
  34 ;; <mode>      : The minor mode predicate. A buffer-local variable.
  35 ;; <mode>-map  : The keymap possibly associated to <mode>.
  36 ;; <mode>-hook,<mode>-on-hook,<mode>-off-hook and <mode>-mode:
  37 ;;       see `easy-mmode-define-minor-mode' documentation
  38 ;;
  39 ;; eval
  40 ;;  (pp (macroexpand '(easy-mmode-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 ;;; Code:
  50
  51 (defun easy-mmode-define-keymap (keymap-alist &optional menu-name)
  52   "Return a keymap built from KEYMAP-ALIST.
  53 KEYMAP-ALIST must be a list of (KEYBINDING . BINDING) where
  54 KEYBINDING and BINDINGS are suited as for define-key.
  55 optional MENU-NAME is passed to `make-sparse-keymap'."
  56   (let ((keymap (make-sparse-keymap menu-name)))
  57     (mapcar
  58      (function (lambda (bind)
  59                  (define-key keymap
  60                    (car bind) (cdr bind))))
  61      keymap-alist)
  62     keymap))
  63
  64 (defmacro easy-mmode-define-toggle (mode &optional doc &rest body)
  65   "Define a one arg toggle mode MODE function and associated hooks.
  66 MODE is the so defined function that toggles the mode.
  67 optional DOC is its associated documentation.
  68 BODY is executed after the toggling and before running the hooks.
  69
  70 Hooks are checked for run, each time MODE-mode is called.
  71 They run under the followings conditions:
  72 MODE-hook: if the mode is toggled.
  73 MODE-on-hook: if the mode is on.
  74 MODE-off-hook: if the mode is off.
  75
  76 When the mode is effectively toggled, two hooks may run.
  77 If so MODE-hook is guaranteed to be the first."
  78   (let* ((mode-name (symbol-name mode))
  79          (hook (intern (concat mode-name "-hook")))
  80          (hook-on (intern (concat mode-name "-on-hook")))
  81          (hook-off (intern (concat mode-name "-off-hook")))
  82          (toggle-doc (or doc
  83                          (format "With no argument, toggle %s.
  84 With universal prefix ARG turn mode on.
  85 With zero or negative ARG turn mode off.
  86 \\{%s}" mode-name (concat mode-name "-map")))))
  87     `(progn
  88        (defcustom ,hook  nil
  89          ,(format "Hook called when `%s' is toggled" mode-name)
  90          :type 'hook)
  91
  92        (defcustom ,hook-on  nil
  93          ,(format "Hook called when `%s' is turned on" mode-name)
  94          :type 'hook)
  95
  96        (defcustom ,hook-off nil
  97          ,(format "Hook called when `%s' is turned off" mode-name)
  98          :type 'hook)
  99
 100        (defun ,mode (&optional arg)
 101          ,toggle-doc
 102          (interactive "P")
 103          (let ((old-mode ,mode))
 104            (setq ,mode
 105                  (if arg
 106                      (> (prefix-numeric-value arg) 0)
 107                    (not ,mode)))
 108            ,@body
 109            (unless (equal old-mode ,mode) (run-hooks ',hook))
 110            (run-hooks (if ,mode ',hook-on ',hook-off)))))))
 111
 112 ;;;###autoload
 113 (defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
 114 ;;;###autoload
 115 (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
 116   "Define a new minor mode MODE.
 117 This function defines the associated control variable, keymap,
 118 toggle command, and hooks (see `easy-mmode-define-toggle').
 119
 120 DOC is the documentation for the mode toggle command.
 121 Optional INIT-VALUE is the initial value of the mode's variable.
 122 Optional LIGHTER is displayed in the mode-bar when the mode is on.
 123 Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
 124 If it is a list, it is passed to `easy-mmode-define-keymap'
 125 in order to build a valid keymap.
 126 BODY contains code that will be executed each time the mode is (dis)activated.
 127 It will be executed after any toggling but before running the hooks."
 128   (let* ((mode-name (symbol-name mode))
 129          (mode-doc (format "Non-nil if mode is enabled.
 130 Use the function `%s' to change this variable." mode-name))
 131          (keymap-sym (intern (concat mode-name "-map")))
 132          (keymap-doc (format "Keymap for `%s'." mode-name)))
 133     `(progn
 134        ;; Define the variable to enable or disable the mode.
 135        (defvar ,mode ,init-value ,mode-doc)
 136        (make-variable-buffer-local ',mode)
 137
 138        ;; Define the minor-mode keymap.
 139        ,(when keymap
 140           `(defvar ,keymap-sym
 141              (cond ((and ,keymap (keymapp ,keymap))
 142                     ,keymap)
 143                    ((listp ,keymap)
 144                     (easy-mmode-define-keymap ,keymap))
 145                    (t (error "Invalid keymap %S" ,keymap)))
 146              ,keymap-doc))
 147
 148        ;; Define the toggle and the hooks.
 149        (easy-mmode-define-toggle ,mode ,doc ,@body)
 150
 151        ;; Update the mode line.
 152        (or (assq ',mode minor-mode-alist)
 153            (setq minor-mode-alist
 154                  (cons (list ',mode nil) minor-mode-alist)))
 155        (setcar (cdr (assq ',mode minor-mode-alist)) ,lighter)
 156
 157        ;; Update the minor mode map.
 158        (or (assq ',mode minor-mode-map-alist)
 159            (setq minor-mode-map-alist
 160                  (cons (cons ',mode nil) minor-mode-map-alist)))
 161        (setcdr (assq ',mode minor-mode-map-alist)
 162                ,keymap-sym)) ))
 163
 164 (provide 'easy-mmode)
 165
 166 ;;; easy-mmode.el ends here