From: Augusto Stoffel Date: Tue, 8 Mar 2022 10:23:56 +0000 (+0100) Subject: New user option 'font-lock-ignore' X-Git-Tag: emacs-29.0.90~1931^2~834 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5c70ff9f470d444738219904f55681b86ff2c910;p=emacs.git 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'. --- diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index c29936d5caa..b61ba56e189 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 aaab0f45170..ade0adad8cc 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 d8a1fe399b6..8af3c30c9a3 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