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'.
This commit is contained in:
Augusto Stoffel 2022-03-08 11:23:56 +01:00 committed by Stefan Monnier
parent 6cb6886840
commit 5c70ff9f47
3 changed files with 171 additions and 4 deletions

View file

@ -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} doesnt.
@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

View file

@ -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.

View file

@ -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