master 5c70ff9f47: New user option 'font-lock-ignore'

[Stefan Monnier]

branch: master
commit 5c70ff9f470d444738219904f55681b86ff2c910
Author: Augusto Stoffel <arstoffel@gmail.com>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    New user option 'font-lock-ignore'
    
    * lisp/font-lock (font-lock-ignore): New defcustom.
    (font-lock-compile-keywords): Call 'font-lock--filter-keywords'.
    (font-lock--match-keyword, font-lock--filter-keywords): New functions,
    implement the functionality described in 'font-lock-ignore'.
    * doc/lispref/modes.texi: Describe 'font-lock-ignore'.
---
 doc/lispref/modes.texi | 84 +++++++++++++++++++++++++++++++++++++++++++++++-
 etc/NEWS               |  5 +++
 lisp/font-lock.el      | 86 ++++++++++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 171 insertions(+), 4 deletions(-)

diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index c29936d5ca..b61ba56e18 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -3204,7 +3204,9 @@ Non-@code{nil} means that regular expression matching for 
the sake of
 
   You can use @code{font-lock-add-keywords} to add additional
 search-based fontification rules to a major mode, and
-@code{font-lock-remove-keywords} to remove rules.
+@code{font-lock-remove-keywords} to remove rules.  You can also set
+the @code{font-lock-ignore} variable to disable keywords that match
+certain criteria.
 
 @defun font-lock-add-keywords mode keywords &optional how
 This function adds highlighting @var{keywords}, for the current buffer
@@ -3274,6 +3276,86 @@ mode @emph{and} all modes derived from it, do this 
instead:
       font-lock-keyword-face)))))
 @end smallexample
 
+@defvar font-lock-ignore
+This variable contains rules to selectively disable Font Lock
+keywords.  It is a list with elements of the following form:
+
+@example
+(@var{mode} @var{rule} @dots{})
+@end example
+
+Here, @var{mode} is a symbol, say a major or minor mode.  The
+subsequent rules apply if the current major mode is derived from
+@var{mode} or @var{mode} is bound and true as a variable.  Each
+@var{rule} can be one of the following:
+
+@table @code
+@cindex @var{font-lock-ignore} rules
+@item @var{symbol}
+A symbol, say a face name, matches any Font Lock keyword containing
+the symbol in its definition.  The symbol is interpreted as a glob
+pattern; in particular, @code{*} matches everything.
+
+@item @var{string}
+A string matches any font-lock keyword defined by a regexp that
+matches the string.
+
+@item (pred @var{function})
+A rule of this form matches if @var{function}, called with the
+Font Lock keyword as argument, returns non-@code{nil}.
+
+@item (not @var{rule})
+A rule of this form matches if @var{rule} doesn’t.
+
+@item (and @var{rule} @dots{})
+A rule of this form matches if each @var{rule} matches.
+
+@item (or @var{rule} @dots{})
+A rule of this form matches if some @var{rule} matches.
+
+@item (except @var{rule})
+A rule of this form can only be used at top level or inside an
+@code{or} clause.  It undoes the effect of a previously matching rule.
+@end table
+
+In each buffer, Font Lock keywords that match at least one applicable
+rule are disabled.
+@end defvar
+
+As an example, consider the following setting:
+
+@smallexample
+(setq font-lock-ignore
+      '((prog-mode font-lock-*-face
+                   (except help-echo))
+        (emacs-lisp-mode (except ";;;###autoload)")
+        (whitespace-mode whitespace-empty-at-bob-regexp)
+        (makefile-mode (except *))))
+@end smallexample
+
+Line by line, this does the following:
+
+@enumerate
+@item
+In all programming modes, disable all font-lock keywords that apply
+one of the standard font-lock faces (excluding strings and comments,
+which are covered by syntactic Font Lock).
+
+@item
+However, keep any keywords that add a @code{help-echo} text property.
+
+@item
+In Emacs Lisp mode, also keep the highlighting of autoload cookies,
+which would have been excluded by rule 1.
+
+@item
+In @code{whitespace-mode} (a minor mode), don't highlight an empty
+line at beginning of buffer.
+
+@item
+Finally, in Makefile mode, don't apply any ignore rules.
+@end enumerate
+
 @node Other Font Lock Variables
 @subsection Other Font Lock Variables
 
diff --git a/etc/NEWS b/etc/NEWS
index aaab0f4517..ade0adad8c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1129,6 +1129,11 @@ support for pipelines which will move a lot of data.  
See section
 
 ** Miscellaneous
 
++++
+*** New user option 'font-lock-ignore'.
+This variable provides a mechanism to selectively disable font-lock
+keywords.
+
 +++
 *** New package vtable.el for formatting tabular data.
 This package allows formatting data using variable-pitch fonts.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index d8a1fe399b..8af3c30c9a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -208,6 +208,7 @@
 
 (require 'syntax)
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
 
 ;; Define core `font-lock' group.
 (defgroup font-lock '((jit-lock custom-group))
@@ -279,6 +280,42 @@ decoration for buffers in C++ mode, and level 1 decoration 
otherwise."
                                      (integer :tag "level" 1)))))
   :group 'font-lock)
 
+(defcustom font-lock-ignore nil
+  "Rules to selectively disable font-lock keywords.
+This is a list of rule sets of the form
+
+  (MODE RULE ...)
+
+where:
+
+ - MODE is a symbol, say a major or minor mode.  The subsequent
+   rules apply if the current major mode is derived from MODE or
+   MODE is bound and true as a variable.
+
+ - Each RULE can be one of the following:
+   - A symbol, say a face name.  It matches any font-lock keyword
+     containing the symbol in its definition.  The symbol is
+     interpreted as a glob pattern; in particular, `*' matches
+     everything.
+   - A string.  It matches any font-lock keyword defined by a regexp
+     that matches the string.
+   - A form (pred FUNCTION).  It matches if FUNCTION, which is called
+     with the font-lock keyword as argument, returns non-nil.
+   - A form (not RULE).  It matches if RULE doesn't.
+   - A form (and RULE ...).  It matches if all the provided rules
+     match.
+   - A form (or RULE ...).  It matches if any of the provided rules
+     match.
+   - A form (except RULE ...).  This can be used only at top level or
+     inside an `or' clause.  It undoes the effect of a previous
+     matching rule.
+
+In each buffer, font lock keywords that match at least one
+applicable rule are disabled."
+  :type '(alist :key-type symbol :value-type sexp)
+  :group 'font-lock
+  :version "29.1")
+
 (defcustom font-lock-verbose nil
   "If non-nil, means show status messages for buffer fontification.
 If a number, only buffers greater than this size have fontification messages."
@@ -1810,9 +1847,8 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords 
are used for
       (error "Font-lock trying to use keywords before setting them up"))
   (if (eq (car-safe keywords) t)
       keywords
-    (setq keywords
-         (cons t (cons keywords
-                       (mapcar #'font-lock-compile-keyword keywords))))
+    (let ((compiled (mapcar #'font-lock-compile-keyword keywords)))
+      (setq keywords `(t ,keywords ,@(font-lock--filter-keywords compiled))))
     (if (and (not syntactic-keywords)
             (let ((beg-function (with-no-warnings syntax-begin-function)))
               (or (eq beg-function #'beginning-of-defun)
@@ -1883,6 +1919,50 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is 
equal to
        (t
         (car keywords))))
 
+(defun font-lock--match-keyword (rule keyword)
+  "Return non-nil if font-lock KEYWORD matches RULE.
+See `font-lock-ignore' for the possible rules."
+  (pcase-exhaustive rule
+    ('* t)
+    ((pred symbolp)
+     (let ((regexp (when (string-match-p "[*?]" (symbol-name rule))
+                     (wildcard-to-regexp (symbol-name rule)))))
+       (named-let search ((obj keyword))
+         (cond
+          ((consp obj) (or (search (car obj)) (search (cdr obj))))
+          ((not regexp) (eq rule obj))
+          ((symbolp obj) (string-match-p regexp (symbol-name obj)))))))
+    ((pred stringp) (when (stringp (car keyword))
+                      (string-match-p (concat "\\`\\(?:" (car keyword) "\\)")
+                                      rule)))
+    (`(or . ,rules) (let ((match nil))
+                      (while rules
+                        (pcase-exhaustive (pop rules)
+                          (`(except ,rule)
+                           (when match
+                             (setq match (not (font-lock--match-keyword rule 
keyword)))))
+                          (rule
+                           (unless match
+                             (setq match (font-lock--match-keyword rule 
keyword))))))
+                      match))
+    (`(not ,rule) (not (font-lock--match-keyword rule keyword)))
+    (`(and . ,rules) (seq-every-p (lambda (rule)
+                                    (font-lock--match-keyword rule keyword))
+                                  rules))
+    (`(pred ,fun) (funcall fun keyword))))
+
+(defun font-lock--filter-keywords (keywords)
+  "Filter a list of KEYWORDS using `font-lock-ignore'."
+  (if-let ((rules (mapcan (pcase-lambda (`(,mode . ,rules))
+                            (when (or (and (boundp mode) mode)
+                                      (derived-mode-p mode))
+                              (copy-sequence rules)))
+                          font-lock-ignore)))
+      (seq-filter (lambda (keyword) (not (font-lock--match-keyword
+                                          `(or ,@rules) keyword)))
+                  keywords)
+    keywords))
+
 (defun font-lock-refresh-defaults ()
   "Restart fontification in current buffer after recomputing from defaults.
 Recompute fontification variables using `font-lock-defaults' and