]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/easy-mmode.el
Add 2010 to copyright years.
[gnu-emacs] / lisp / emacs-lisp / easy-mmode.el
index d3d9e5fdca09c1fd75f7f54fac7fc2d83760c73a..13e08667839e425ad85f0d65e73fb0101aed47e6 100644 (file)
@@ -1,7 +1,7 @@
 ;;; easy-mmode.el --- easy definition for major and minor modes
 
-;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;;   2008, 2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
 ;; Maintainer: Stefan Monnier <monnier@gnu.org>
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) 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
@@ -21,9 +21,7 @@
 ;; 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
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -160,7 +158,7 @@ For example, you could write
       (setq body (cdr body))
       (case keyw
        (:init-value (setq init-value (pop body)))
-       (:lighter (setq lighter (pop body)))
+       (:lighter (setq lighter (purecopy (pop body))))
        (:global (setq globalp (pop body)))
        (:extra-args (setq extra-args (pop body)))
        (:set (setq set (list :set (pop body))))
@@ -236,7 +234,7 @@ With zero or negative ARG turn mode off.
            ,@body
            ;; The on/off hooks are here for backward compatibility only.
            (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
-           (if (called-interactively-p)
+           (if (called-interactively-p 'any)
                (progn
                  ,(if globalp `(customize-mark-as-set ',mode))
                  ;; Avoid overwriting a message shown by the body,
@@ -265,8 +263,7 @@ With zero or negative ARG turn mode off.
 
        (add-minor-mode ',mode ',lighter
                       ,(if keymap keymap-sym
-                         `(if (boundp ',keymap-sym)
-                              (symbol-value ',keymap-sym)))))))
+                         `(if (boundp ',keymap-sym) ,keymap-sym))))))
 \f
 ;;;
 ;;; make global minor mode
@@ -329,9 +326,13 @@ call another major mode in their body."
        (make-variable-buffer-local ',MODE-major-mode)
        ;; The actual global minor-mode
        (define-minor-mode ,global-mode
+        ;; Very short lines to avoid too long lines in the generated
+        ;; doc string.
         ,(format "Toggle %s in every possible buffer.
-With prefix ARG, turn %s on if and only if ARG is positive.
-%s is enabled in all buffers where `%s' would do it.
+With prefix ARG, turn %s on if and only if
+ARG is positive.
+%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)
@@ -390,17 +391,18 @@ See `%s' for more information on %s."
 ;;; 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))))))
+(eval-and-compile
+  (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)))))))
 
 ;;;###autoload
 (defun easy-mmode-define-keymap (bs &optional name m args)
@@ -409,8 +411,17 @@ BS must be a list of (KEY . BINDING) where
 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.
-ARGS is a list of additional keyword arguments."
-  (let (inherit dense)
+ARGS is a list of additional keyword arguments.
+
+Valid keywords and arguments are:
+
+  :name      Name of the keymap; overrides NAME argument.
+  :dense     Non-nil for a dense keymap.
+  :inherit   Parent keymap.
+  :group     Ignored.
+  :suppress  Non-nil to call `suppress-keymap' on keymap,
+             'nodigits to suppress digits as prefix arguments."
+  (let (inherit dense suppress)
     (while args
       (let ((key (pop args))
            (val (pop args)))
@@ -418,11 +429,14 @@ ARGS is a list of additional keyword arguments."
         (:name (setq name val))
         (:dense (setq dense val))
         (:inherit (setq inherit val))
+        (:suppress (setq suppress val))
         (:group)
         (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))))
+    (when suppress
+      (suppress-keymap m (eq suppress 'nodigits)))
     (dolist (b bs)
       (let ((keys (car b))
            (binding (cdr b)))
@@ -442,6 +456,9 @@ ARGS is a list of additional keyword arguments."
 
 ;;;###autoload
 (defmacro easy-mmode-defmap (m bs doc &rest args)
+  "Define a constant M whose value is the result of `easy-mmode-define-keymap'.
+The M, BS, and ARGS arguments are as per that function.  DOC is
+the constant's documentation."
   `(defconst ,m
      (easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
      ,doc))
@@ -520,7 +537,7 @@ BODY is executed after moving to the destination location."
                     (error "No next %s" ,name))
                 (goto-char (match-beginning 0))
                 (when (and (eq (current-buffer) (window-buffer (selected-window)))
-                           (interactive-p))
+                           (called-interactively-p 'interactive))
                   (let ((endpt (or (save-excursion
                                      ,(if endfun `(,endfun)
                                         `(re-search-forward ,re nil t 2)))