From c8ff22f0d995eb4a5954d7ef122885f02e38a7f2 Mon Sep 17 00:00:00 2001
From: Augusto Stoffel <arstoffel@gmail.com>
Date: Tue, 8 Mar 2022 11:23:56 +0100
Subject: [PATCH] New customization variable 'font-lock-ignore'

---
 lisp/font-lock.el | 88 +++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 85 insertions(+), 3 deletions(-)

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index d8a1fe399b..8526f6ca6a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -206,6 +206,7 @@
 
 ;;; Code:
 
+(require 'seq)
 (require 'syntax)
 (eval-when-compile (require 'cl-lib))
 
@@ -279,6 +280,42 @@ font-lock-maximum-decoration
 				      (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 single 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.  However, if a rule is preceded by `!', then the
+     rules preceding it don't apply for a font-lock keyword matching
+     the negated rule.
+
+In each buffer, font lock keywords that match at least one
+applicable rule are disabled.  Rules preceded by `!' reverse the
+effect of a previous exclusion."
+  :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 @@ font-lock-compile-keywords
       (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,52 @@ font-lock-choose-keywords
 	(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)
+     (if-let ((regexp (when (string-match-p "[*?]" (symbol-name rule))
+                        (wildcard-to-regexp (symbol-name rule)))))
+         (seq-some (lambda (obj)
+                     (when (symbolp obj)
+                       (string-match-p regexp (symbol-name obj))))
+                   (flatten-tree keyword))
+       (memq rule (flatten-tree keyword))))
+    ((pred stringp) (when (stringp (car keyword))
+                      (string-match-p (concat "\\`\\(?:" (car keyword) "\\)")
+                                      rule)))
+    (`(or . ,rules) (catch 'font-lock--match
+                      (let ((remaining (reverse rules)))
+                        (while remaining
+                          (pcase-exhaustive remaining
+                            (`(,rule ! . ,rest)
+                             (if (font-lock--match-keyword rule keyword)
+                                 (throw 'font-lock--match nil)
+                               (setq remaining rest)))
+                            (`(,rule . ,rest)
+                             (if (font-lock--match-keyword rule keyword)
+                                 (throw 'font-lock--match t)
+                               (setq remaining rest))))))))
+    (`(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 (seq-mapcat (pcase-lambda (`(,mode . ,rules))
+                                (when (or (and (boundp mode) mode)
+                                          (derived-mode-p mode))
+                                  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
-- 
2.35.1