master b8b18cf 3/4: Implement a :predicate parameter for globalized minor modes

[Lars Ingebrigtsen]

branch: master
commit b8b18cf34a04af0f359e01c29333d58848307a13
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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.
---
 doc/lispref/modes.texi                   |  41 ++++++++++--
 etc/NEWS                                 |   5 ++
 lisp/emacs-lisp/easy-mmode.el            | 105 +++++++++++++++++++++++++------
 test/lisp/emacs-lisp/easy-mmode-tests.el |  49 +++++++++++++++
 4 files changed, 177 insertions(+), 23 deletions(-)

diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 022eda0..98aa94e 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -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
 
 
diff --git a/etc/NEWS b/etc/NEWS
index 7dbd3d5..d2d4a04 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1617,6 +1617,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
 argument 'ellipsis', will now indicate truncation using '…' when
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 8c1e5b2..fe85667 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -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
diff --git a/test/lisp/emacs-lisp/easy-mmode-tests.el 
b/test/lisp/emacs-lisp/easy-mmode-tests.el
new file mode 100644
index 0000000..4d7fe94
--- /dev/null
+++ b/test/lisp/emacs-lisp/easy-mmode-tests.el
@@ -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