Implement a :predicate parameter for globalized minor modes

* doc/lispref/modes.texi (Defining Minor Modes): Describe the new
:predicate keyword (bug#44232).

* lisp/emacs-lisp/easy-mmode.el (define-globalized-minor-mode):
Allow a new :predicate keyword.
(easy-mmode--globalized-predicate-p): New function.
This commit is contained in:
Lars Ingebrigtsen 2020-10-26 19:13:14 +01:00
parent 9e8fb4a7cb
commit b8b18cf34a
4 changed files with 177 additions and 23 deletions

View file

@ -1806,10 +1806,11 @@ don't need any.
@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
@ -1830,6 +1831,38 @@ also define a non-globalized version, so that people can use (or
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

View file

@ -1616,6 +1616,11 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el.
* Lisp Changes in Emacs 28.1
+++
** 'define-globalized-minor-mode' now takes a :predicate parameter.
This can be used to control which major modes the minor mode should be
used in.
+++
** 'truncate-string-ellipsis' now uses '…' by default.
Modes that use 'truncate-string-to-width' with non-nil, non-string

View file

@ -375,18 +375,21 @@ No problems result if this variable is not bound.
(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
@ -415,7 +418,11 @@ on if the hook has explicitly disabled it.
(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)))
@ -423,6 +430,13 @@ on if the hook has explicitly disabled it.
(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
@ -442,10 +456,17 @@ ARG is omitted or nil.
%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
@ -461,7 +482,8 @@ See `%s' for more information on %s."
;; 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
@ -497,8 +519,8 @@ See `%s' for more information on %s."
(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)
@ -511,7 +533,52 @@ See `%s' for more information on %s."
(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

View file

@ -0,0 +1,49 @@
;;; 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