;;; 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 <Georges.Brun-Cottan@inria.fr>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
;; 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:
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):
(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)
(: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))))
(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)
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)
(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)
(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)))))))
\f
;;;
;;; make global minor mode
"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.
"-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.
%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))
: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
(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)
,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)