unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Toning down font-lock
@ 2022-03-05 18:03 Augusto Stoffel
  2022-03-07 16:10 ` Stefan Monnier
  0 siblings, 1 reply; 7+ messages in thread
From: Augusto Stoffel @ 2022-03-05 18:03 UTC (permalink / raw)
  To: emacs-devel

I would like to suggest extending `font-lock-maximum-decoration' so that
setting it to a negative number discards all major-mode keyword
fontification, keeping only syntactic highlight (i.e., strings and
comments).

I've been using such a setting for a long time and it's quite pleasant.

I'm also wondering if there is a more fine-grained mechanism to pick and
choose font-lock rules.  I guess not, so should there be one?

In my setup, I do lose some things that I find useful, such as highlight
of regexp grouping constructs or symbol names inside docstrings.
`font-lock-maximum-decoration' doesn't allow to activate these things
without activating coloring of functions and keywords, which I don't
like.  Making some font-lock faces equal to the default face is also a
very coarse measure, and leads to other problems, since the font-lock
faces are often abused for other purposes.



^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Toning down font-lock
  2022-03-05 18:03 Toning down font-lock Augusto Stoffel
@ 2022-03-07 16:10 ` Stefan Monnier
  2022-03-07 19:25   ` Augusto Stoffel
  0 siblings, 1 reply; 7+ messages in thread
From: Stefan Monnier @ 2022-03-07 16:10 UTC (permalink / raw)
  To: Augusto Stoffel; +Cc: emacs-devel

[ FWIW, I use a "theme" where most font-lock faces use the same colors as
  the default face ;-)
  IOW: black-on-white for most faces, grey-on-white for comments,
  different fonts for strings and keywords, bold for function
  names, ...  ]

> I'm also wondering if there is a more fine-grained mechanism to pick and
> choose font-lock rules.

No, we only have this notion of "level" which is not very useful or even
well defined (does it relate to CPU cost, or gaudiness, or ...).

> I guess not, so should there be one?

Yes.  But I don't think it makes much sense to try and retro-fit into
the current `font-lock-keywords` system, which is already too complex
(yet not flexible enough) for its own good.

I think we should instead introduce a brand new "syntax".  This new
syntax should indeed include a way to give names to some "rules" (or
groups of rules) so they can be enabled/disabled by the user.

Whoever designs this new set of rules would do well to study other
editors's approaches to this problem to benefit from some of the
advantages of the solutions they chose.


        Stefan




^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Toning down font-lock
  2022-03-07 16:10 ` Stefan Monnier
@ 2022-03-07 19:25   ` Augusto Stoffel
  2022-03-07 23:55     ` Stefan Monnier
  0 siblings, 1 reply; 7+ messages in thread
From: Augusto Stoffel @ 2022-03-07 19:25 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 1964 bytes --]

On Mon,  7 Mar 2022 at 11:10, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

> [ FWIW, I use a "theme" where most font-lock faces use the same colors as
>   the default face ;-)
>   IOW: black-on-white for most faces, grey-on-white for comments,
>   different fonts for strings and keywords, bold for function
>   names, ...  ]
>
>> I'm also wondering if there is a more fine-grained mechanism to pick and
>> choose font-lock rules.
>
> No, we only have this notion of "level" which is not very useful or even
> well defined (does it relate to CPU cost, or gaudiness, or ...).
>
>> I guess not, so should there be one?
>
> Yes.  But I don't think it makes much sense to try and retro-fit into
> the current `font-lock-keywords` system, which is already too complex
> (yet not flexible enough) for its own good.

Okay, so I was sketching something like “gitignore for font lock”.  You
can remove a keyword by naming a symbol that appears anywhere in it (say
a face name) or using some fancier selectors.  Or you can cancel a
previous removal by prepending the selector with an exclamation mark.

This is how a user configuration could look like.  I hope you can get
the idea.

```
(font-lock-ignore-mode)

(setq font-lock-ignore-rules
      '((prog-mode
         "^font-lock-.*-face$" ;; Remove all font lock except strings
                               ;; and comments by default.
         ! help-echo) ;; Whatever highlight has a help message must be
                      ;; important.
        (emacs-lisp-mode
         ! (matching ";;;###autoload") ;; Keep highlighting of autoload cookies
         lisp--match-hidden-arg) ;; Out of perversity, remove this keyword
        (makefile-mode
         ! *))) ;; Makefile is chaotic, I need emotional support (bring
                ;; back everything).
```

And here is the code.  It's too much of a hack for core, but maybe
sufficiently useful for a package?


[-- Attachment #2: font-lock-ignore.el --]
[-- Type: application/emacs-lisp, Size: 5427 bytes --]

[-- Attachment #3: Type: text/plain, Size: 715 bytes --]


> I think we should instead introduce a brand new "syntax".  This new
> syntax should indeed include a way to give names to some "rules" (or
> groups of rules) so they can be enabled/disabled by the user.

Okay, but this doesn't seem that hard to retrofit into the current
system.  We could allow a keyword-pair :name SOMETHING in the elements
of `font-lock-keywords' (this metadata can be discarded upon
compilation, so not many changes are needed in font-lock.el).  Then the
user can enable or disable things by name.

> Whoever designs this new set of rules would do well to study other
> editors's approaches to this problem to benefit from some of the
> advantages of the solutions they chose.

This is wise.

^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Toning down font-lock
  2022-03-07 19:25   ` Augusto Stoffel
@ 2022-03-07 23:55     ` Stefan Monnier
  2022-03-08 11:50       ` Augusto Stoffel
  0 siblings, 1 reply; 7+ messages in thread
From: Stefan Monnier @ 2022-03-07 23:55 UTC (permalink / raw)
  To: Augusto Stoffel; +Cc: emacs-devel

> And here is the code.  It's too much of a hack for core, but maybe
> sufficiently useful for a package?

Nice.  I'd suggest you merge `font-lock-ignore--test` and
`font-lock-ignore--test-one` into a single (recursive) function.

I can't see why we shouldn't include it into core.


        Stefan




^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Toning down font-lock
  2022-03-07 23:55     ` Stefan Monnier
@ 2022-03-08 11:50       ` Augusto Stoffel
  2022-03-08 15:18         ` Stefan Monnier
  0 siblings, 1 reply; 7+ messages in thread
From: Augusto Stoffel @ 2022-03-08 11:50 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 910 bytes --]

On Mon,  7 Mar 2022 at 18:55, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

>> And here is the code.  It's too much of a hack for core, but maybe
>> sufficiently useful for a package?
>
> Nice.  I'd suggest you merge `font-lock-ignore--test` and
> `font-lock-ignore--test-one` into a single (recursive) function.

The exclamation marks are not a recursive thing.  But I added `and' and
`not' rules that use recursion.

> I can't see why we shouldn't include it into core.

Okay, well, in this case this is how the patch would look like, modulo
the manual update etc.  (And I need to test more before merging.)

I changed a bit the meaning of the different rules, as explained in the
docstring.  So now you can say

```
(setq font-lock-ignore
      '((prog-mode font-lock-*-face
                   ! help-echo
        ;; Uningnore the rule that matches a defun
        (emacs-lisp-mode ! "(defun"))))

```


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-customization-variable-font-lock-ignore.patch --]
[-- Type: text/x-patch, Size: 5374 bytes --]

From ba5880aec952cabd13ae532ea6b11bb43d568f09 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 | 90 +++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 87 insertions(+), 3 deletions(-)

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index d8a1fe399b..43e4cf6166 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -279,6 +279,38 @@ 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:
+   - A symbol, say a face name.  It matches any font-lock rule
+     mentioning that symbol anywhere.  Asterisks are treated as
+     wildcards.
+   - A string.  It matches any font-lock keyword defined by a regexp
+     that matches STRING.
+   - A form (pred FUNCTION).  It matches if FUNCTION, which is called
+     with the 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.
+   - The symbol `*'.  It matches everything.
+
+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 +1842,11 @@ 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 ,@(if (and font-lock-ignore
+                                              (not syntactic-keywords))
+                                         (font-lock--filter-keywords compiled)
+                                       compiled))))
     (if (and (not syntactic-keywords)
 	     (let ((beg-function (with-no-warnings syntax-begin-function)))
 	       (or (eq beg-function #'beginning-of-defun)
@@ -1883,6 +1917,56 @@ font-lock-choose-keywords
 	(t
 	 (car keywords))))
 
+(defun font-lock--test-keyword (rule keyword)
+  "Test whether font-lock KEYWORD matches a RULE.
+See `font-lock-ignore' for the possible rules."
+  (pcase-exhaustive rule
+    ('* t)
+    ((pred symbolp)
+     (let* ((name (symbol-name rule))
+            (regexp (when (string-match-p "\\*" name)
+                      (let* ((words (mapcar #'regexp-quote
+                                            (split-string name "\\*")))
+                             (joined (string-join words ".*")))
+                      (concat "\\`" joined "\\'")))))
+       (if regexp
+           (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)))
+    (`(pred ,fun) (funcall fun keyword))
+    (`(not ,rule) (not (font-lock--test-keyword rule keyword)))
+    (`(and . ,rules) (seq-every-p (lambda (rule)
+                                    (font-lock--test-keyword rule keyword))
+                                  rules))))
+
+(defun font-lock--filter-keywords (keywords)
+  "Filter a list of KEYWORDS using `font-lock-ignore'."
+  (let* ((rules (reverse
+                 (seq-mapcat (pcase-lambda (`(,mode . ,rules))
+                               (when (or (and (boundp mode) mode)
+                                         (derived-mode-p mode))
+                                 rules))
+                             font-lock-ignore)))
+         (pred (lambda (keyword)
+                 (catch 'font-lock--keep
+                   (let ((remaining rules))
+                     (while remaining
+                       (pcase-exhaustive remaining
+                         (`(,rule ! . ,rest)
+                          (if (font-lock--test-keyword rule keyword)
+                              (throw 'font-lock--keep t)
+                            (setq remaining rest)))
+                         (`(,rule . ,rest)
+                          (if (font-lock--test-keyword rule keyword)
+                              (throw 'font-lock--keep nil)
+                            (setq remaining rest))))))
+                   t))))
+    (seq-filter pred 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


^ permalink raw reply related	[flat|nested] 7+ messages in thread

* Re: Toning down font-lock
  2022-03-08 11:50       ` Augusto Stoffel
@ 2022-03-08 15:18         ` Stefan Monnier
  2022-03-10  7:42           ` Augusto Stoffel
  0 siblings, 1 reply; 7+ messages in thread
From: Stefan Monnier @ 2022-03-08 15:18 UTC (permalink / raw)
  To: Augusto Stoffel; +Cc: emacs-devel

>> Nice.  I'd suggest you merge `font-lock-ignore--test` and
>> `font-lock-ignore--test-one` into a single (recursive) function.
> The exclamation marks are not a recursive thing.
> But I added `and' and `not' rules that use recursion.

Ah, I see I had misunderstood the syntax and semantics of your toplevel,
so indeed to bring it into the recursion, you'd need a new thingy which
might be called maybe `or` with a syntax like (or RULES .. [!] RULE ..).

See some nitpicks below.


        Stefan


> +   - A symbol, say a face name.  It matches any font-lock rule
> +     mentioning that symbol anywhere.  Asterisks are treated as
> +     wildcards.

I suggest we call it a glob pattern so it's a known pattern
matching thingy and we don't need to reinvent and re-document how to
make it match an actual `*`.

> @@ -1810,9 +1842,11 @@ 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 ,@(if (and font-lock-ignore
> +                                              (not syntactic-keywords))
> +                                         (font-lock--filter-keywords compiled)
> +                                       compiled))))

I think I'd move the test of `font-lock-ignore` into
`font-lock--filter-keywords` so it's the only function which consults it.

> @@ -1883,6 +1917,56 @@ font-lock-choose-keywords
>  	(t
>  	 (car keywords))))
>  
> +(defun font-lock--test-keyword (rule keyword)

That sadly doesn't say whether it return nil when it matches or whether
it returns non-nil when it matches.  I suggest to rename it to something
like `font-lock--matches-keyword` so the name clearly say when we return
nil and when we return non-nil.

> +  "Test whether font-lock KEYWORD matches a RULE.
> +See `font-lock-ignore' for the possible rules."

Same comment ;-)

> +  (pcase-exhaustive rule
> +    ('* t)
> +    ((pred symbolp)
> +     (let* ((name (symbol-name rule))
> +            (regexp (when (string-match-p "\\*" name)
> +                      (let* ((words (mapcar #'regexp-quote
> +                                            (split-string name "\\*")))
> +                             (joined (string-join words ".*")))
> +                      (concat "\\`" joined "\\'")))))

We can use `wildcard-to-regexp` here.

> +       (if regexp
> +           (seq-some (lambda (obj)
> +                       (when (symbolp obj)
> +                         (string-match-p regexp (symbol-name obj))))
> +                     (flatten-tree keyword))
> +         (memq rule (flatten-tree keyword)))))

Performance likely doesn't matter, but I suspect it'd be faster if we
recursed over the data-structure rather than flattening it.
E.g. something like

    (named-let search ((obj keyword))
      (cond
       ((consp obj) (or (search (car obj)) (search (cdr obj))))
       ((and obj (symbolp obj))
        (string-match-p regexp (symbol-name obj)))))




^ permalink raw reply	[flat|nested] 7+ messages in thread

* Re: Toning down font-lock
  2022-03-08 15:18         ` Stefan Monnier
@ 2022-03-10  7:42           ` Augusto Stoffel
  0 siblings, 0 replies; 7+ messages in thread
From: Augusto Stoffel @ 2022-03-10  7:42 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 4839 bytes --]

On Tue,  8 Mar 2022 at 10:18, Stefan Monnier <monnier@iro.umontreal.ca> wrote:

>>> Nice.  I'd suggest you merge `font-lock-ignore--test` and
>>> `font-lock-ignore--test-one` into a single (recursive) function.
>> The exclamation marks are not a recursive thing.
>> But I added `and' and `not' rules that use recursion.
>
> Ah, I see I had misunderstood the syntax and semantics of your toplevel,
> so indeed to bring it into the recursion, you'd need a new thingy which
> might be called maybe `or` with a syntax like (or RULES .. [!] RULE ..).

It's the semantics of a gitignore file.  It think it's handy.

Now, in the syntax you suggest,

  (or RULE1 ! RULE2 RULE3)

means

  (or (and RULE1 (not RULE2)) RULE3)

Maybe this is a potentially confusing extension of such a familiar
construct like `or'?  This is why I originally allowed ! at top level
only (and didn't provide a recursive "or" operation, which seems a bit
of overkill).

But then I implemented what you suggest to see how it looks like.  I'll
let you emit an opinion.

> See some nitpicks below.
>
>
>         Stefan
>
>
>> +   - A symbol, say a face name.  It matches any font-lock rule
>> +     mentioning that symbol anywhere.  Asterisks are treated as
>> +     wildcards.
>
> I suggest we call it a glob pattern so it's a known pattern
> matching thingy and we don't need to reinvent and re-document how to
> make it match an actual `*`.

Great, that sounds better.  But just to make sure, do you like the basic
API here:

- A symbol (possibly wildcard characters) defines a rule that matches
  symbols in the font-lock keyword

- A string defines a rule that matches any font-lock keyword which
  matches the said string

>> @@ -1810,9 +1842,11 @@ 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 ,@(if (and font-lock-ignore
>> +                                              (not syntactic-keywords))
>> +                                         (font-lock--filter-keywords compiled)
>> +                                       compiled))))
>
> I think I'd move the test of `font-lock-ignore` into
> `font-lock--filter-keywords` so it's the only function which consults it.

All right.  I've also made the ignore rules apply to syntactic-keywords
as well, which I believe is harmless -- right?

>> @@ -1883,6 +1917,56 @@ font-lock-choose-keywords
>>  	(t
>>  	 (car keywords))))
>>  
>> +(defun font-lock--test-keyword (rule keyword)
>
> That sadly doesn't say whether it return nil when it matches or whether
> it returns non-nil when it matches.  I suggest to rename it to something
> like `font-lock--matches-keyword` so the name clearly say when we return
> nil and when we return non-nil.

Done.

>> +  "Test whether font-lock KEYWORD matches a RULE.
>> +See `font-lock-ignore' for the possible rules."
>
> Same comment ;-)

Done.  The docstring for `font-lock-ignore' can still use some
polishing.

>> +  (pcase-exhaustive rule
>> +    ('* t)
>> +    ((pred symbolp)
>> +     (let* ((name (symbol-name rule))
>> +            (regexp (when (string-match-p "\\*" name)
>> +                      (let* ((words (mapcar #'regexp-quote
>> +                                            (split-string name "\\*")))
>> +                             (joined (string-join words ".*")))
>> +                      (concat "\\`" joined "\\'")))))
>
> We can use `wildcard-to-regexp` here.

Ah, much better!  I swear I did M-x apropos \bglob\b.

>> +       (if regexp
>> +           (seq-some (lambda (obj)
>> +                       (when (symbolp obj)
>> +                         (string-match-p regexp (symbol-name obj))))
>> +                     (flatten-tree keyword))
>> +         (memq rule (flatten-tree keyword)))))
>
> Performance likely doesn't matter, but I suspect it'd be faster if we
> recursed over the data-structure rather than flattening it.
> E.g. something like
>
>     (named-let search ((obj keyword))
>       (cond
>        ((consp obj) (or (search (car obj)) (search (cdr obj))))
>        ((and obj (symbolp obj))
>         (string-match-p regexp (symbol-name obj)))))

Aesthetically, calling `flatten-tree' there bothers me too. But your
algorithm uses recursion even for a flat list...  And a `find-in-tree'
function is not available even in dash, so I guess adding one to subr.el
is out of the question.  (Also I'm already doing a bunch of extra work
by calling `wildcard-to-regexp' on each use of a rule, so it seems weird
to optimize this without also adding a compiler for the rules, which is
way over the top.)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-customization-variable-font-lock-ignore.patch --]
[-- Type: text/x-patch, Size: 5505 bytes --]

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 @@
 \f
 ;;; 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


[-- Attachment #3: Type: text/plain, Size: 95 bytes --]



PS: Can you add this trivial thingy to ELPA?

    https://github.com/astoff/flymake-luacheck

^ permalink raw reply related	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2022-03-10  7:42 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-03-05 18:03 Toning down font-lock Augusto Stoffel
2022-03-07 16:10 ` Stefan Monnier
2022-03-07 19:25   ` Augusto Stoffel
2022-03-07 23:55     ` Stefan Monnier
2022-03-08 11:50       ` Augusto Stoffel
2022-03-08 15:18         ` Stefan Monnier
2022-03-10  7:42           ` Augusto Stoffel

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).