X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f56789436283d90804b406c8e205d53cd83b4baa..5dd1c041c7fdb876b52bf33f41e8aeb119282cef:/lisp/emacs-lisp/easy-mmode.el diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 0892af1bb3..b22e49dac3 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -1,7 +1,7 @@ ;;; easy-mmode.el --- easy definition for major and minor modes -;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. +;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, +;; 2006 Free Software Foundation, Inc. ;; Author: Georges Brun-Cottan ;; Maintainer: Stefan Monnier @@ -22,8 +22,8 @@ ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -101,9 +101,9 @@ Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. The above three arguments can be skipped if keyword arguments are 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 hook variable - `mode-HOOK'. +BODY contains code to execute each time the mode is activated or deactivated. + It is executed after toggling the mode, + and before running the hook variable `mode-HOOK'. 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): @@ -139,10 +139,14 @@ For example, you could write (setq body (list* lighter keymap body) lighter nil keymap nil)) ((keywordp keymap) (push keymap body) (setq keymap nil))) - (let* ((mode-name (symbol-name mode)) + (let* ((last-message (current-message)) + (mode-name (symbol-name mode)) (pretty-name (easy-mmode-pretty-mode-name mode lighter)) (globalp nil) + (set nil) + (initialize nil) (group nil) + (type nil) (extra-args nil) (extra-keywords nil) (require t) @@ -159,7 +163,10 @@ For example, you could write (:lighter (setq lighter (pop body))) (:global (setq globalp (pop body))) (:extra-args (setq extra-args (pop body))) + (:set (setq set (list :set (pop body)))) + (:initialize (setq initialize (list :initialize (pop body)))) (:group (setq group (nconc group (list :group (pop body))))) + (:type (setq type (list :type (pop body)))) (:require (setq require (pop body))) (:keymap (setq keymap (pop body))) (t (push keyw extra-keywords) (push (pop body) extra-keywords)))) @@ -167,12 +174,19 @@ For example, you could write (setq keymap-sym (if (and keymap (symbolp keymap)) keymap (intern (concat mode-name "-map")))) + (unless set (setq set '(:set 'custom-set-minor-mode))) + + (unless initialize + (setq initialize '(:initialize 'custom-initialize-default))) + (unless group ;; We might as well provide a best-guess default group. (setq group `(:group ',(intern (replace-regexp-in-string "-mode\\'" "" mode-name))))) - + + (unless type (setq type '(:type 'boolean))) + `(progn ;; Define the variable to enable or disable the mode. ,(if (not globalp) @@ -181,26 +195,21 @@ For example, you could write Use the command `%s' to change this variable." pretty-name mode)) (make-variable-buffer-local ',mode)) - (let ((curfile (or (and (boundp 'byte-compile-current-file) - byte-compile-current-file) - load-file-name))) - `(defcustom ,mode ,init-value - ,(format "Non-nil if %s is enabled. -See the command `%s' for a description of this minor-mode. + (let ((base-doc-string + (concat "Non-nil if %s is enabled. +See the command `%s' for a description of this minor-mode." + (if body " Setting this variable directly does not take effect; -use either \\[customize] or the function `%s'." - pretty-name mode mode) - :set 'custom-set-minor-mode - :initialize 'custom-initialize-default +either customize it (see the info node `Easy Customization') +or call the function `%s'.")))) + `(defcustom ,mode ,init-value + ,(format base-doc-string pretty-name mode mode) + ,@set + ,@initialize ,@group - :type 'boolean - ,@(cond - ((not (and curfile require)) nil) - ((not (eq require t)) `(:require ,require)) - (t `(:require - ',(intern (file-name-nondirectory - (file-name-sans-extension curfile)))))) - ,@(nreverse extra-keywords)))) + ,@type + ,@(unless (eq require t) `(:require ,require)) + ,@(nreverse extra-keywords)))) ;; The actual function. (defun ,mode (&optional arg ,@extra-args) @@ -229,7 +238,10 @@ With zero or negative ARG turn mode off. (if (called-interactively-p) (progn ,(if globalp `(customize-mark-as-set ',mode)) - (unless (current-message) + ;; Avoid overwriting a message shown by the body, + ;; but do overwrite previous messages. + (unless ,(and (current-message) + (not (equal last-message (current-message)))) (message ,(format "%s %%sabled" pretty-name) (if ,mode "en" "dis"))))) (force-mode-line-update) @@ -252,12 +264,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 the mode is global, call the function according to the default. - ,(if globalp - `(if (and load-file-name (not (equal ,init-value ,mode))) - (eval-after-load load-file-name '(,mode (if ,mode 1 -1)))))))) + (symbol-value ',keymap-sym))))))) ;;; ;;; make global minor mode @@ -270,22 +277,42 @@ With zero or negative ARG turn mode off. "Make GLOBAL-MODE out of the buffer-local minor MODE. TURN-ON is a function that will be called with no args in every buffer and that should try to turn MODE on if applicable for that buffer. -KEYS is a list of CL-style keyword arguments: -:group to specify the custom group." +KEYS is a list of CL-style keyword arguments. As the minor mode + defined by this function is always global, any :global keyword is + ignored. Other keywords have the same meaning as in `define-minor-mode', + which see. In particular, :group specifies the custom group. + The most useful keywords are those that are passed on to the + `defcustom'. It normally makes no sense to pass the :lighter + or :keymap keywords to `define-global-minor-mode', since these + are usually passed to the buffer-local version of the minor mode. + +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." + (let* ((global-mode-name (symbol-name global-mode)) (pretty-name (easy-mmode-pretty-mode-name mode)) (pretty-global-name (easy-mmode-pretty-mode-name global-mode)) (group nil) - (extra-args nil) - (buffers (intern (concat global-mode-name "-buffers"))) - (cmmh (intern (concat global-mode-name "-cmmh")))) + (extra-keywords nil) + (MODE-buffers (intern (concat global-mode-name "-buffers"))) + (MODE-enable-in-buffers + (intern (concat global-mode-name "-enable-in-buffers"))) + (MODE-check-buffers + (intern (concat global-mode-name "-check-buffers"))) + (MODE-cmhh (intern (concat global-mode-name "-cmhh"))) + (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode"))) + keyw) ;; Check keys. - (while (keywordp (car keys)) - (case (pop keys) - (:extra-args (setq extra-args (pop keys))) + (while (keywordp (setq keyw (car keys))) + (setq keys (cdr keys)) + (case keyw (:group (setq group (nconc group (list :group (pop keys))))) - (t (setq keys (cdr keys))))) + (:global (setq keys (cdr keys))) + (t (push keyw extra-keywords) (push (pop keys) extra-keywords)))) (unless group ;; We might as well provide a best-guess default group. @@ -294,6 +321,8 @@ KEYS is a list of CL-style keyword arguments: "-mode\\'" "" (symbol-name mode)))))) `(progn + (defvar ,MODE-major-mode nil) + (make-variable-buffer-local ',MODE-major-mode) ;; The actual global minor-mode (define-minor-mode ,global-mode ,(format "Toggle %s in every buffer. @@ -301,15 +330,18 @@ With prefix ARG, turn %s on if and only if ARG is positive. %s is actually not turned on in every buffer but only in those in which `%s' turns it on." pretty-name pretty-global-name pretty-name turn-on) - :global t :extra-args ,extra-args ,@group + :global t ,@group ,@(nreverse extra-keywords) ;; Setup hook to handle future mode changes and new buffers. (if ,global-mode (progn - (add-hook 'find-file-hook ',buffers) - (add-hook 'change-major-mode-hook ',cmmh)) - (remove-hook 'find-file-hook ',buffers) - (remove-hook 'change-major-mode-hook ',cmmh)) + (add-hook 'after-change-major-mode-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 'find-file-hook ',MODE-check-buffers) + (remove-hook 'change-major-mode-hook ',MODE-cmhh)) ;; Go through existing buffers. (dolist (buf (buffer-list)) @@ -321,22 +353,33 @@ in which `%s' turns it on." :autoload-end ;; List of buffers left to process. - (defvar ,buffers nil) + (defvar ,MODE-buffers nil) ;; The function that calls TURN-ON in each buffer. - (defun ,buffers () - (remove-hook 'post-command-hook ',buffers) - (while ,buffers - (let ((buf (pop ,buffers))) - (when (buffer-live-p buf) - (with-current-buffer buf (,turn-on)))))) - (put ',buffers 'definition-name ',global-mode) + (defun ,MODE-enable-in-buffers () + (dolist (buf ,MODE-buffers) + (when (buffer-live-p buf) + (with-current-buffer buf + (if ,mode + (unless (eq ,MODE-major-mode major-mode) + (,mode -1) + (,turn-on) + (setq ,MODE-major-mode major-mode)) + (,turn-on) + (setq ,MODE-major-mode major-mode)))))) + (put ',MODE-enable-in-buffers 'definition-name ',global-mode) + + (defun ,MODE-check-buffers () + (,MODE-enable-in-buffers) + (setq ,MODE-buffers nil) + (remove-hook 'post-command-hook ',MODE-check-buffers)) + (put ',MODE-check-buffers 'definition-name ',global-mode) ;; The function that catches kill-all-local-variables. - (defun ,cmmh () - (add-to-list ',buffers (current-buffer)) - (add-hook 'post-command-hook ',buffers)) - (put ',cmmh 'definition-name ',global-mode)))) + (defun ,MODE-cmhh () + (add-to-list ',MODE-buffers (current-buffer)) + (add-hook 'post-command-hook ',MODE-check-buffers)) + (put ',MODE-cmhh 'definition-name ',global-mode)))) ;;; ;;; easy-mmode-defmap @@ -477,6 +520,7 @@ found, do widen first and then call NARROWFUN with no args after moving." (unless (pos-visible-in-window-p endpt nil t) (recenter '(0)))))) ,re-narrow-maybe))) + (put ',next-sym 'definition-name ',base) (defun ,prev-sym (&optional count) ,(format "Go to the previous COUNT'th %s" (or name base-name)) (interactive) @@ -486,7 +530,8 @@ found, do widen first and then call NARROWFUN with no args after moving." ,check-narrow-maybe (unless (re-search-backward ,re nil t count) (error "No previous %s" ,name)) - ,re-narrow-maybe)))))) + ,re-narrow-maybe))) + (put ',prev-sym 'definition-name ',base)))) (provide 'easy-mmode)