X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ffe832ea680b4820f5ff399191f7f2d41350ee2e..f44379e7feb79dd734318706abe5a000cff34c9b:/lisp/emacs-lisp/easy-mmode.el diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index aa1956b8a2..238f2fa551 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, -;; 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 ;; Maintainer: Stefan Monnier @@ -10,10 +10,10 @@ ;; 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 @@ -21,9 +21,7 @@ ;; 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 . ;;; Commentary: @@ -118,6 +116,8 @@ BODY contains code to execute each time the mode is activated or deactivated. :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!\" @@ -149,6 +149,8 @@ For example, you could write (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"))) @@ -160,7 +162,7 @@ For example, you could write (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)))) @@ -169,6 +171,7 @@ For example, you could write (: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 @@ -189,12 +192,16 @@ For example, you could write `(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." @@ -209,10 +216,10 @@ or call the function `%s'.")))) ,@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. @@ -223,20 +230,15 @@ With zero or negative ARG turn mode off. ;; 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, @@ -263,10 +265,10 @@ With zero or negative ARG turn mode off. (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))))))) ;;; ;;; make global minor mode @@ -329,9 +331,13 @@ call another major mode in their body." (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) @@ -342,9 +348,11 @@ See `%s' for more information on %s." (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)) @@ -365,13 +373,14 @@ See `%s' for more information on %s." (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 () @@ -390,17 +399,18 @@ See `%s' for more information on %s." ;;; 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) @@ -409,8 +419,17 @@ BS must be a list of (KEY . BINDING) where 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))) @@ -418,11 +437,14 @@ ARGS is a list of additional keyword arguments." (: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))) @@ -442,6 +464,9 @@ ARGS is a list of additional keyword arguments." ;;;###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)) @@ -520,7 +545,7 @@ BODY is executed after moving to the destination location." (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)))