@defmac define-globalized-minor-mode global-mode mode turn-on keyword-args@dots{} body@dots{}
This defines a global toggle named @var{global-mode} whose meaning is
-to enable or disable the buffer-local minor mode @var{mode} in all
-buffers. It also executes the @var{body} forms. To turn on the minor
-mode in a buffer, it uses the function @var{turn-on}; to turn off the
-minor mode, it calls @var{mode} with @minus{}1 as argument.
+to enable or disable the buffer-local minor mode @var{mode} in all (or
+some; see below) buffers. It also executes the @var{body} forms. To
+turn on the minor mode in a buffer, it uses the function
+@var{turn-on}; to turn off the minor mode, it calls @var{mode} with
+@minus{}1 as argument.
Globally enabling the mode also affects buffers subsequently created
by visiting files, and buffers that use a major mode other than
disable) it in individual buffers. This also allows them to disable a
globally enabled minor mode in a specific major mode, by using that
mode's hook.
+
+If given a @code{:predicate} keyword, a user option called the same as
+the global mode variable, but with @code{-modes} instead of
+@code{-mode} at the end will be created. The variable is used as a
+predicate that specifies which major modes the minor mode should be
+activated in. Valid values include @code{t} (use in all major modes,
+@code{nil} (use in no major modes), or a list of mode names (or
+@code{(not mode-name ...)}) elements (as well as @code{t} and
+@code{nil}).
+
+@example
+(c-mode (not mail-mode message-mode) text-mode)
+@end example
+
+This means ``use in modes derived from @code{c-mode}, and not in
+modes derived from @code{message-mode} or @code{mail-mode}, but do use
+in modes derived from @code{text-mode}, and otherwise no other
+modes''.
+
+@example
+((not c-mode) t)
+@end example
+
+This means ``don't use modes derived from @code{c-mode}, but use
+everywhere else''.
+
+@example
+(text-mode)
+@end example
+
+This means ``use in modes derived from @code{text-mode}, but nowhere
+else''. (There's an implicit @code{nil} element at the end.)
@end defmac
(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
"Make a global mode GLOBAL-MODE corresponding to 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.
-Each of KEY VALUE is a pair 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-globalized-minor-mode', since these are usually passed
- to the buffer-local version of the minor mode.
+and that should try to turn MODE on if applicable for that buffer.
+
+Each of KEY VALUE is a pair of CL-style keyword arguments. :predicate
+specifies which major modes the globalized minor mode should be switched on
+in. 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-globalized-minor-mode', since these are usually passed
+to the buffer-local version of the minor mode.
+
BODY contains code to execute each time the mode is enabled or disabled.
- It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
+It is executed after toggling the mode, and before running
+GLOBAL-MODE-hook.
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
(minor-MODE-hook (intern (concat mode-name "-hook")))
(MODE-set-explicitly (intern (concat mode-name "-set-explicitly")))
(MODE-major-mode (intern (concat (symbol-name mode) "-major-mode")))
- keyw)
+ (MODE-predicate (intern (concat (replace-regexp-in-string
+ "-mode\\'" "" global-mode-name)
+ "-modes")))
+ (turn-on-function `#',turn-on)
+ keyw predicate)
;; Check keys.
(while (keywordp (setq keyw (car body)))
(pcase keyw
(:group (setq group (nconc group (list :group (pop body)))))
(:global (pop body))
+ (:predicate
+ (setq predicate (list (pop body)))
+ (setq turn-on-function
+ `(lambda ()
+ (require 'easy-mmode)
+ (when (easy-mmode--globalized-predicate-p ,(car predicate))
+ (funcall ,turn-on-function)))))
(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
`(progn
%s is enabled in all buffers where
`%s' would do it.
-See `%s' for more information on %s."
+
+See `%s' for more information on
+%s.%s"
pretty-name pretty-global-name
- pretty-name turn-on mode pretty-name)
- :global t ,@group ,@(nreverse extra-keywords)
+ pretty-name turn-on mode pretty-name
+ (if predicate
+ (format "\n\n`%s' is used to control which modes
+this minor mode is used in."
+ MODE-predicate)
+ ""))
+ :global t ,@group ,@(nreverse extra-keywords)
;; Setup hook to handle future mode changes and new buffers.
(if ,global-mode
;; Go through existing buffers.
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1)))))
+ (if ,global-mode (funcall ,turn-on-function)
+ (when ,mode (,mode -1)))))
,@body)
;; Autoloading define-globalized-minor-mode autoloads everything
(if ,mode
(progn
(,mode -1)
- (funcall #',turn-on))
- (funcall #',turn-on))))
+ (funcall ,turn-on-function))
+ (funcall ,turn-on-function))))
(setq ,MODE-major-mode major-mode))))))
(put ',MODE-enable-in-buffers '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))))
+ (put ',MODE-cmhh 'definition-name ',global-mode)
+
+ ,(when predicate
+ `(defcustom ,MODE-predicate ,(car predicate)
+ ,(format "Which major modes `%s' is switched on in.
+This variable can be either t (all major modes), nil (no major modes),
+or a list of modes and (not modes) to switch use this minor mode or
+not. For instance
+
+ (c-mode (not message-mode mail-mode) text-mode)
+
+means \"use this mode in all modes derived from `c-mode', don't use in
+modes derived from `message-mode' or `mail-mode', but do use in other
+modes derived from `text-mode'\". An element with value t means \"use\"
+and nil means \"don't use\". There's an implicit nil at the end of the
+list."
+ mode)
+ :type '(repeat sexp)
+ :group ,group)))))
+
+(defun easy-mmode--globalized-predicate-p (predicate)
+ (cond
+ ((eq predicate t)
+ t)
+ ((eq predicate nil)
+ nil)
+ ((listp predicate)
+ ;; Legacy support for (not a b c).
+ (when (eq (car predicate) 'not)
+ (setq predicate (nconc (mapcar (lambda (e) (list 'not e))
+ (cdr predicate))
+ (list t))))
+ (catch 'found
+ (dolist (elem predicate)
+ (cond
+ ((eq elem t)
+ (throw 'found t))
+ ((eq elem nil)
+ (throw 'found nil))
+ ((and (consp elem)
+ (eq (car elem) 'not))
+ (when (apply #'derived-mode-p (cdr elem))
+ (throw 'found nil)))
+ ((symbolp elem)
+ (when (derived-mode-p elem)
+ (throw 'found t)))))))))
;;;
;;; easy-mmode-defmap
--- /dev/null
+;;; easy-mmode-tests.el --- tests for easy-mmode.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; 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 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
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'easy-mmode)
+(require 'message)
+
+(ert-deftest easy-mmode--globalized-predicate ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (should (eq (easy-mmode--globalized-predicate-p nil) nil))
+ (should (eq (easy-mmode--globalized-predicate-p t) t))
+ (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t))
+ (should (eq (easy-mmode--globalized-predicate-p '(not text-mode)) t))
+ (should (eq (easy-mmode--globalized-predicate-p '((not text-mode))) nil))
+ (should (eq (easy-mmode--globalized-predicate-p '((not text-mode) t)) t))
+ (should (eq (easy-mmode--globalized-predicate-p
+ '(c-mode emacs-lisp-mode))
+ t))
+ (mail-mode)
+ (should (eq (easy-mmode--globalized-predicate-p
+ '(c-mode (not message-mode mail-mode) text-mode))
+ nil))
+ (text-mode)
+ (should (eq (easy-mmode--globalized-predicate-p
+ '(c-mode (not message-mode mail-mode) text-mode))
+ t))))
+
+(provide 'easy-mmode-tests)
+
+;;; easy-mmode-tests.el ends here
projects / emacs.git / commitdiff