;;; easy-mmode.el --- easy definition for major and minor modes
-;; Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000, 2001, 2003 Free Software Foundation, Inc.
;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
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 hooks.
- BODY can start with a list of CL-style keys specifying additional arguments.
- The following keyword arguments are supported:
-:group GROUP Group name to use for any generated `defcustom'.
+ 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):
+:group GROUP Custom group name to use in all generated `defcustom' forms.
:global GLOBAL If non-nil specifies that the minor mode is not meant to be
- buffer-local. By default, the variable is made buffer-local.
+ buffer-local, so don't make the variable MODE buffer-local.
+ By default, the mode is buffer-local.
:init-value VAL Same as the INIT-VALUE argument.
:lighter SPEC Same as the LIGHTER argument.
-:require SYM Same as defcustom's :require argument."
+:keymap MAP Same as the KEYMAP argument.
+:require SYM Same as in `defcustom'.
+
+For example, you could write
+ (define-minor-mode foo-mode \"If enabled, foo on you!\"
+ :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
+ ...BODY CODE...)"
+ (declare (debug (&define name stringp
+ [&optional [¬ keywordp] sexp
+ &optional [¬ keywordp] sexp
+ &optional [¬ keywordp] sexp]
+ [&rest [keywordp sexp]]
+ def-body)))
+
;; Allow skipping the first three args.
(cond
((keywordp init-value)
(globalp nil)
(group nil)
(extra-args nil)
+ (extra-keywords nil)
(require t)
- (keymap-sym (if (and keymap (symbolp keymap)) keymap
- (intern (concat mode-name "-map"))))
(hook (intern (concat mode-name "-hook")))
(hook-on (intern (concat mode-name "-on-hook")))
- (hook-off (intern (concat mode-name "-off-hook"))))
+ (hook-off (intern (concat mode-name "-off-hook")))
+ keyw keymap-sym)
;; Check keys.
- (while (keywordp (car body))
- (case (pop body)
+ (while (keywordp (setq keyw (car body)))
+ (setq body (cdr body))
+ (case keyw
(:init-value (setq init-value (pop body)))
(:lighter (setq lighter (pop body)))
(:global (setq globalp (pop body)))
(:extra-args (setq extra-args (pop body)))
(:group (setq group (nconc group (list :group (pop body)))))
(:require (setq require (pop body)))
- (t (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 group
;; We might as well provide a best-guess default group.
(setq group
- `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""
- mode-name)))))
- ;; Add default properties to LIGHTER.
- (unless (or (not (stringp lighter)) (get-text-property 0 'local-map lighter)
- (get-text-property 0 'keymap lighter))
- (setq lighter
- (propertize lighter
- 'local-map mode-line-minor-mode-keymap
- 'help-echo "mouse-3: minor mode menu")))
+ `(:group ',(or (custom-current-group)
+ (intern (replace-regexp-in-string
+ "-mode\\'" "" mode-name))))))
`(progn
;; Define the variable to enable or disable the mode.
Setting this variable directly does not take effect;
use either \\[customize] or the function `%s'."
pretty-name mode mode)
- :set (lambda (symbol value) (funcall symbol (or value 0)))
+ :set 'custom-set-minor-mode
:initialize 'custom-initialize-default
,@group
:type 'boolean
((not (eq require t)) `(:require ,require))
(t `(:require
',(intern (file-name-nondirectory
- (file-name-sans-extension curfile)))))))))
+ (file-name-sans-extension curfile))))))
+ ,@(nreverse extra-keywords))))
;; The actual function.
(defun ,mode (&optional arg ,@extra-args)
(if (interactive-p)
(progn
,(if globalp `(customize-mark-as-set ',mode))
- (message ,(format "%s %%sabled" pretty-name)
- (if ,mode "en" "dis"))))
+ (unless (current-message)
+ (message ,(format "%s %%sabled" pretty-name)
+ (if ,mode "en" "dis")))))
(force-mode-line-update)
;; Return the new setting.
,mode)
;; The toggle's hook.
(defcustom ,hook nil
,(format "Hook run at the end of function `%s'." mode-name)
- :group ,(cadr group)
+ ,@group
:type 'hook)
;; Define the minor-mode keymap.
,(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 (and globalp (null init-value))
- `(if (and load-file-name ,mode)
- (eval-after-load load-file-name '(,mode 1)))))))
+ ,(if globalp
+ `(if (and load-file-name (not (equal ,init-value ,mode)))
+ (eval-after-load load-file-name '(,mode (if ,mode 1 -1))))))))
\f
;;;
;;; make global minor mode
(unless group
;; We might as well provide a best-guess default group.
(setq group
- `(:group ',(intern (replace-regexp-in-string "-mode\\'" ""
- (symbol-name mode))))))
+ `(:group ',(or (custom-current-group)
+ (intern (replace-regexp-in-string
+ "-mode\\'" "" (symbol-name mode)))))))
+
`(progn
;; The actual global minor-mode
(define-minor-mode ,global-mode
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 suppress)
+ (let (inherit dense)
(while args
(let ((key (pop args))
(val (pop args)))
(:dense (setq dense val))
(:inherit (setq inherit val))
(:group)
- ;;((eq key :suppress) (setq suppress val))
(t (message "Unknown argument %s in defmap" key)))))
(unless (keymapp m)
(setq bs (append m bs))
(let* ((base-name (symbol-name base))
(prev-sym (intern (concat base-name "-prev")))
(next-sym (intern (concat base-name "-next"))))
- (unless name (setq name (symbol-name base-name)))
+ (unless name (setq name base-name))
`(progn
(add-to-list 'debug-ignored-errors
,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
(if (not (re-search-forward ,re nil t count))
(if (looking-at ,re)
(goto-char (or ,(if endfun `(,endfun)) (point-max)))
- (error ,(format "No next %s" name)))
+ (error "No next %s" ,name))
(goto-char (match-beginning 0))
(when (and (eq (current-buffer) (window-buffer (selected-window)))
(interactive-p))
(unless count (setq count 1))
(if (< count 0) (,next-sym (- count))
(unless (re-search-backward ,re nil t count)
- (error ,(format "No previous %s" name))))))))
+ (error "No previous %s" ,name)))))))
(provide 'easy-mmode)