]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/easy-mmode.el
* lisp/subr.el (set-transient-map): Don't wait for some "nested"
[gnu-emacs] / lisp / emacs-lisp / easy-mmode.el
index ee4e36a9eba31bfc25fea24281436d7584f7c6c7..b5b6566cf665745539b6a59cc2e454f563b64040 100644 (file)
@@ -1,6 +1,6 @@
 ;;; easy-mmode.el --- easy definition for major and minor modes
 
-;; Copyright (C) 1997, 2000-201 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2014 Free Software Foundation, Inc.
 
 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
 ;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -90,12 +90,17 @@ MODE (you can override this with the :variable keyword, see below).
 DOC is the documentation for the mode toggle command.
 
 The defined mode command takes one optional (prefix) argument.
-Interactively with no prefix argument it toggles the mode.
-With a prefix argument, it enables the mode if the argument is
-positive and otherwise disables it.  When called from Lisp, it
-enables the mode if the argument is omitted or nil, and toggles
-the mode if the argument is `toggle'.  If DOC is nil this
-function adds a basic doc-string stating these facts.
+Interactively with no prefix argument, it toggles the mode.
+A prefix argument enables the mode if the argument is positive,
+and disables it otherwise.
+
+When called from Lisp, the mode command toggles the mode if the
+argument is `toggle', disables the mode if the argument is a
+non-positive integer, and enables the mode otherwise (including
+if the argument is omitted or nil or a positive integer).
+
+If DOC is nil, give the mode command a basic doc-string
+documenting what its argument does.
 
 Optional INIT-VALUE is the initial value of the mode's variable.
 Optional LIGHTER is displayed in the mode line when the mode is on.
@@ -127,13 +132,14 @@ BODY contains code to execute each time the mode is enabled or disabled.
 :require SYM   Same as in `defcustom'.
 :variable PLACE        The location to use instead of the variable MODE to store
                the state of the mode.  This can be simply a different
-               named variable, or more generally anything that can be used
-               with the CL macro `setf'.  PLACE can also be of the form
-               \(GET . SET), where GET is an expression that returns the
-               current state, and SET is a function that takes one argument,
-               the new state, and sets it.  If you specify a :variable,
-               this function does not define a MODE variable (nor any of
-               the terms used in :variable).
+               named variable, or a generalized variable.
+               PLACE can also be of the form \(GET . SET), where GET is
+               an expression that returns the current state, and SET is
+               a function that takes one argument, the new state, and
+               sets it.  If you specify a :variable, this function does
+               not define a MODE variable (nor any of the terms used
+               in :variable).
+
 :after-hook     A single lisp form which is evaluated after the mode hooks
                 have been run.  It should not be quoted.
 
@@ -142,7 +148,7 @@ For example, you could write
     :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
     ...BODY CODE...)"
   (declare (doc-string 2)
-           (debug (&define name stringp
+           (debug (&define name string-or-null-p
                           [&optional [&not keywordp] sexp
                            &optional [&not keywordp] sexp
                            &optional [&not keywordp] sexp]
@@ -290,6 +296,12 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
        ;; up-to-here.
        :autoload-end
 
+       (defvar ,hook nil
+         ,(format "Hook run after entering or leaving `%s'.
+No problems result if this variable is not bound.
+`add-hook' automatically binds it.  (This is true for all hook variables.)"
+                  mode))
+
        ;; Define the minor-mode keymap.
        ,(unless (symbolp keymap)       ;nil is also a symbol.
          `(defvar ,keymap-sym
@@ -335,9 +347,14 @@ If MODE's set-up depends on the major mode in effect when it was
 enabled, then disabling and reenabling MODE should make MODE work
 correctly with the current major mode.  This is important to
 prevent problems with derived modes, that is, major modes that
-call another major mode in their body."
+call another major mode in their body.
+
+When a major mode is initialized, MODE is actually turned on just
+after running the major mode's hook.  However, MODE is not turned
+on if the hook has explicitly disabled it."
   (declare (doc-string 2))
   (let* ((global-mode-name (symbol-name global-mode))
+        (mode-name (symbol-name mode))
         (pretty-name (easy-mmode-pretty-mode-name mode))
         (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
         (group nil)
@@ -348,6 +365,8 @@ call another major mode in their body."
         (MODE-check-buffers
          (intern (concat global-mode-name "-check-buffers")))
         (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
+        (minor-MODE-hook (intern (concat mode-name "-hook")))
+        (MODE-set-explicitly (intern (concat mode-name "-set-explicitly")))
         (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
         keyw)
 
@@ -391,25 +410,32 @@ See `%s' for more information on %s."
             (progn
               (add-hook 'after-change-major-mode-hook
                         ',MODE-enable-in-buffers)
-              (add-hook 'change-major-mode-after-body-hook
-                        ',MODE-enable-in-buffers)
               (add-hook 'find-file-hook ',MODE-check-buffers)
               (add-hook 'change-major-mode-hook ',MODE-cmhh))
           (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
-          (remove-hook 'change-major-mode-after-body-hook
-                       ',MODE-enable-in-buffers)
           (remove-hook 'find-file-hook ',MODE-check-buffers)
           (remove-hook 'change-major-mode-hook ',MODE-cmhh))
 
         ;; Go through existing buffers.
         (dolist (buf (buffer-list))
           (with-current-buffer buf
-            (if ,global-mode (,turn-on) (when ,mode (,mode -1))))))
+            (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1))))))
 
        ;; Autoloading define-globalized-minor-mode autoloads everything
        ;; up-to-here.
        :autoload-end
 
+       ;; MODE-set-explicitly is set in MODE-set-explicitly and cleared by
+       ;; kill-all-local-variables.
+       (defvar-local ,MODE-set-explicitly nil)
+       (defun ,MODE-set-explicitly ()
+         (setq ,MODE-set-explicitly t))
+       (put ',MODE-set-explicitly 'definition-name ',global-mode)
+
+       ;; A function which checks whether MODE has been disabled in the major
+       ;; mode hook which has just been run.
+       (add-hook ',minor-MODE-hook ',MODE-set-explicitly)
+
        ;; List of buffers left to process.
        (defvar ,MODE-buffers nil)
 
@@ -418,14 +444,14 @@ See `%s' for more information on %s."
         (dolist (buf ,MODE-buffers)
           (when (buffer-live-p buf)
             (with-current-buffer buf
-               (unless (eq ,MODE-major-mode major-mode)
-                 (if ,mode
-                     (progn
-                       (,mode -1)
-                       (,turn-on)
-                       (setq ,MODE-major-mode major-mode))
-                   (,turn-on)
-                   (setq ,MODE-major-mode major-mode)))))))
+               (unless ,MODE-set-explicitly
+                (unless (eq ,MODE-major-mode major-mode)
+                  (if ,mode
+                      (progn
+                        (,mode -1)
+                        (funcall #',turn-on))
+                    (funcall #',turn-on))))
+              (setq ,MODE-major-mode major-mode)))))
        (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
 
        (defun ,MODE-check-buffers ()
@@ -444,18 +470,9 @@ See `%s' for more information on %s."
 ;;; easy-mmode-defmap
 ;;;
 
-(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)))))))
+(defun easy-mmode-set-keymap-parents (m parents)
+  (set-keymap-parent
+   m (if (cdr parents) (make-composed-keymap parents) (car parents))))
 
 ;;;###autoload
 (defun easy-mmode-define-keymap (bs &optional name m args)
@@ -572,7 +589,7 @@ BODY is executed after moving to the destination location."
                       (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
                         (widen))))
                  ,body
-                 (when was-narrowed (,narrowfun)))))))
+                 (when was-narrowed (funcall #',narrowfun)))))))
     (unless name (setq name base-name))
     `(progn
        (defun ,next-sym (&optional count)
@@ -584,13 +601,13 @@ BODY is executed after moving to the destination location."
            ,(funcall when-narrowed
              `(if (not (re-search-forward ,re nil t count))
                   (if (looking-at ,re)
-                      (goto-char (or ,(if endfun `(,endfun)) (point-max)))
+                      (goto-char (or ,(if endfun `(funcall #',endfun)) (point-max)))
                     (user-error "No next %s" ,name))
                 (goto-char (match-beginning 0))
-                (when (and (eq (current-buffer) (window-buffer (selected-window)))
+                (when (and (eq (current-buffer) (window-buffer))
                            (called-interactively-p 'interactive))
                   (let ((endpt (or (save-excursion
-                                     ,(if endfun `(,endfun)
+                                     ,(if endfun `(funcall #',endfun)
                                         `(re-search-forward ,re nil t 2)))
                                    (point-max))))
                     (unless (pos-visible-in-window-p endpt nil t)