;;; easy-mmode.el --- easy definition for major and minor modes
-;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 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
;; 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:
:lighter SPEC Same as the LIGHTER argument.
:keymap MAP Same as the KEYMAP argument.
:require SYM Same as in `defcustom'.
+:variable PLACE The location (as can be used with `setf') to use instead
+ of the variable MODE to store the state of the mode.
For example, you could write
(define-minor-mode foo-mode \"If enabled, foo on you!\"
(type nil)
(extra-args nil)
(extra-keywords nil)
+ (variable nil)
+ (modefun mode)
(require t)
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
(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))))
(:type (setq type (list :type (pop body))))
(:require (setq require (pop body)))
(:keymap (setq keymap (pop body)))
+ (:variable (setq variable (setq mode (pop body))))
(t (push keyw extra-keywords) (push (pop body) extra-keywords))))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
`(progn
;; Define the variable to enable or disable the mode.
- ,(if (not globalp)
- `(progn
- (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
+ ,(cond
+ ;; If :variable is specified, then the var will be
+ ;; declared elsewhere.
+ (variable nil)
+ ((not globalp)
+ `(progn
+ (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
Use the command `%s' to change this variable." pretty-name mode))
- (make-variable-buffer-local ',mode))
-
+ (make-variable-buffer-local ',mode)))
+ (t
(let ((base-doc-string
(concat "Non-nil if %s is enabled.
See the command `%s' for a description of this minor mode."
,@group
,@type
,@(unless (eq require t) `(:require ,require))
- ,@(nreverse extra-keywords))))
+ ,@(nreverse extra-keywords)))))
;; The actual function.
- (defun ,mode (&optional arg ,@extra-args)
+ (defun ,modefun (&optional arg ,@extra-args)
,(or doc
(format (concat "Toggle %s on or off.
Interactively, with no prefix argument, toggle the mode.
;; repeat-command still does the toggling correctly.
(interactive (list (or current-prefix-arg 'toggle)))
(let ((,last-message (current-message)))
- (setq ,mode
- (cond
- ((eq arg 'toggle) (not ,mode))
- (arg (> (prefix-numeric-value arg) 0))
- (t
- (if (null ,mode) t
- (message
- "Toggling %s off; better pass an explicit argument."
- ',mode)
- nil))))
+ (,(if (symbolp mode) 'setq 'setf) ,mode
+ (if (eq arg 'toggle)
+ (not ,mode)
+ ;; A nil argument also means ON now.
+ (> (prefix-numeric-value arg) 0)))
,@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,
(t (error "Invalid keymap %S" ,keymap))))
,(format "Keymap for `%s'." mode-name)))
- (add-minor-mode ',mode ',lighter
- ,(if keymap keymap-sym
- `(if (boundp ',keymap-sym)
- (symbol-value ',keymap-sym)))))))
+ ,(unless variable
+ `(add-minor-mode ',mode ',lighter
+ ,(if keymap keymap-sym
+ `(if (boundp ',keymap-sym) ,keymap-sym)))))))
\f
;;;
;;; make global minor mode
(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)
(progn
(add-hook 'after-change-major-mode-hook
',MODE-enable-in-buffers)
+ (add-hook 'fundamental-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 'fundamental-mode-hook ',MODE-enable-in-buffers)
(remove-hook 'find-file-hook ',MODE-check-buffers)
(remove-hook 'change-major-mode-hook ',MODE-cmhh))
(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))))))
+ (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)))))))
(put ',MODE-enable-in-buffers 'definition-name ',global-mode)
(defun ,MODE-check-buffers ()
;;; 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)
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)))
(: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)))
;;;###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))
(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)))
HCoop / bpt / emacs.git / blobdiff