]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/easy-mmode.el
Moved from lisp/.
[gnu-emacs] / lisp / emacs-lisp / easy-mmode.el
index abd045a65322001a43bdd7edd1539b09db2ac419..6b9c593915ff82b373493e0980a1fa1ddca1a650 100644 (file)
@@ -1,6 +1,6 @@
 ;;; easy-mmode.el --- easy definition for major and minor modes
 
-;; Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000, 2001, 2003 Free Software Foundation, Inc.
 
 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
 ;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -88,14 +88,30 @@ used (see below).
 
 BODY contains code that will be executed each time the mode is (dis)activated.
   It will be executed after any toggling but before running the hooks.
-  BODY can start with a list of CL-style keys specifying additional arguments.
-  The following keyword arguments are supported:
-:group GROUP   Group name to use for any generated `defcustom'.
+  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):
+:group GROUP   Custom group name to use in all generated `defcustom' forms.
 :global GLOBAL If non-nil specifies that the minor mode is not meant to be
-               buffer-local.  By default, the variable is made buffer-local.
+               buffer-local, so don't make the variable MODE buffer-local.
+               By default, the mode is buffer-local.
 :init-value VAL        Same as the INIT-VALUE argument.
 :lighter SPEC  Same as the LIGHTER argument.
-:require SYM   Same as defcustom's :require argument."
+:keymap MAP    Same as the KEYMAP argument.
+:require SYM   Same as in `defcustom'.
+
+For example, you could write
+  (define-minor-mode foo-mode \"If enabled, foo on you!\"
+    :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
+    ...BODY CODE...)"
+  (declare (debug (&define name stringp
+                          [&optional [&not keywordp] sexp
+                           &optional [&not keywordp] sexp
+                           &optional [&not keywordp] sexp]
+                          [&rest [keywordp sexp]]
+                          def-body)))
+
   ;; Allow skipping the first three args.
   (cond
    ((keywordp init-value)
@@ -110,36 +126,35 @@ BODY contains code that will be executed each time the mode is (dis)activated.
         (globalp nil)
         (group nil)
         (extra-args nil)
+        (extra-keywords nil)
         (require t)
-        (keymap-sym (if (and keymap (symbolp keymap)) keymap
-                      (intern (concat mode-name "-map"))))
         (hook (intern (concat mode-name "-hook")))
         (hook-on (intern (concat mode-name "-on-hook")))
-        (hook-off (intern (concat mode-name "-off-hook"))))
+        (hook-off (intern (concat mode-name "-off-hook")))
+        keyw keymap-sym)
 
     ;; Check keys.
-    (while (keywordp (car body))
-      (case (pop body)
+    (while (keywordp (setq keyw (car body)))
+      (setq body (cdr body))
+      (case keyw
        (:init-value (setq init-value (pop body)))
        (:lighter (setq lighter (pop body)))
        (:global (setq globalp (pop body)))
        (:extra-args (setq extra-args (pop body)))
        (:group (setq group (nconc group (list :group (pop body)))))
        (:require (setq require (pop body)))
-       (t (pop body))))
+       (:keymap (setq keymap (pop body)))
+       (t (push keyw extra-keywords) (push (pop body) extra-keywords))))
+
+    (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
+                      (intern (concat mode-name "-map"))))
 
     (unless group
       ;; We might as well provide a best-guess default group.
       (setq group
-           `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""
-                                                        mode-name)))))
-    ;; Add default properties to LIGHTER.
-    (unless (or (not (stringp lighter)) (get-text-property 0 'local-map lighter)
-               (get-text-property 0 'keymap lighter))
-      (setq lighter
-           (propertize lighter
-                       'local-map mode-line-minor-mode-keymap
-                       'help-echo "mouse-3: minor mode menu")))
+           `(:group ',(or (custom-current-group)
+                          (intern (replace-regexp-in-string
+                                   "-mode\\'" "" mode-name))))))
 
     `(progn
        ;; Define the variable to enable or disable the mode.
@@ -158,7 +173,7 @@ See the command `%s' for a description of this minor-mode.
 Setting this variable directly does not take effect;
 use either \\[customize] or the function `%s'."
                        pretty-name mode mode)
-              :set (lambda (symbol value) (funcall symbol (or value 0)))
+              :set 'custom-set-minor-mode
               :initialize 'custom-initialize-default
               ,@group
               :type 'boolean
@@ -167,7 +182,8 @@ use either \\[customize] or the function `%s'."
                  ((not (eq require t)) `(:require ,require))
                  (t `(:require
                       ',(intern (file-name-nondirectory
-                                 (file-name-sans-extension curfile)))))))))
+                                 (file-name-sans-extension curfile))))))
+              ,@(nreverse extra-keywords))))
 
        ;; The actual function.
        (defun ,mode (&optional arg ,@extra-args)
@@ -196,8 +212,9 @@ With zero or negative ARG turn mode off.
         (if (interactive-p)
             (progn
               ,(if globalp `(customize-mark-as-set ',mode))
-              (message ,(format "%s %%sabled" pretty-name)
-                       (if ,mode "en" "dis"))))
+              (unless (current-message)
+                (message ,(format "%s %%sabled" pretty-name)
+                         (if ,mode "en" "dis")))))
         (force-mode-line-update)
         ;; Return the new setting.
         ,mode)
@@ -209,7 +226,7 @@ With zero or negative ARG turn mode off.
        ;; The toggle's hook.
        (defcustom ,hook nil
         ,(format "Hook run at the end of function `%s'." mode-name)
-        :group ,(cadr group)
+        ,@group
         :type 'hook)
 
        ;; Define the minor-mode keymap.
@@ -225,11 +242,11 @@ With zero or negative ARG turn mode off.
                       ,(if keymap keymap-sym
                          `(if (boundp ',keymap-sym)
                               (symbol-value ',keymap-sym))))
-       
+
        ;; If the mode is global, call the function according to the default.
-       ,(if (and globalp (null init-value))
-           `(if (and load-file-name ,mode)
-                (eval-after-load load-file-name '(,mode 1)))))))
+       ,(if globalp
+           `(if (and load-file-name (not (equal ,init-value ,mode)))
+                (eval-after-load load-file-name '(,mode (if ,mode 1 -1))))))))
 \f
 ;;;
 ;;; make global minor mode
@@ -261,8 +278,10 @@ KEYS is a list of CL-style keyword arguments:
     (unless group
       ;; We might as well provide a best-guess default group.
       (setq group
-           `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""
-                                                        (symbol-name mode))))))
+           `(:group ',(or (custom-current-group)
+                          (intern (replace-regexp-in-string
+                                   "-mode\\'" "" (symbol-name mode)))))))
+
     `(progn
        ;; The actual global minor-mode
        (define-minor-mode ,global-mode
@@ -332,7 +351,7 @@ 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 suppress)
+  (let (inherit dense)
     (while args
       (let ((key (pop args))
            (val (pop args)))
@@ -341,7 +360,6 @@ ARGS is a list of additional keyword arguments."
         (:dense (setq dense val))
         (:inherit (setq inherit val))
         (:group)
-        ;;((eq key :suppress) (setq suppress val))
         (t (message "Unknown argument %s in defmap" key)))))
     (unless (keymapp m)
       (setq bs (append m bs))