From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Augusto Stoffel Newsgroups: gmane.emacs.devel Subject: Re: Toning down font-lock Date: Tue, 08 Mar 2022 12:50:38 +0100 Message-ID: <87lexkbr3l.fsf@gmail.com> References: <87v8wscm4x.fsf@gmail.com> <87czixa7ky.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="4624"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.91 (gnu/linux) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Tue Mar 08 12:58:56 2022 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nRYUR-0000zn-I9 for ged-emacs-devel@m.gmane-mx.org; Tue, 08 Mar 2022 12:58:55 +0100 Original-Received: from localhost ([::1]:54222 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nRYUQ-0001y2-6c for ged-emacs-devel@m.gmane-mx.org; Tue, 08 Mar 2022 06:58:54 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:47732) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nRYMV-0007nL-St for emacs-devel@gnu.org; Tue, 08 Mar 2022 06:50:43 -0500 Original-Received: from [2a00:1450:4864:20::630] (port=46896 helo=mail-ej1-x630.google.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nRYMU-0008RR-4n for emacs-devel@gnu.org; Tue, 08 Mar 2022 06:50:43 -0500 Original-Received: by mail-ej1-x630.google.com with SMTP id qx21so38590141ejb.13 for ; Tue, 08 Mar 2022 03:50:41 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=UYWchdTJA0zluaQChKlk95yBnsabvogUfybqiNkVWJU=; b=gK1dJdFJHoGVQlCI2n9LytN83/UUTsegRd/rtJNxKTyB3/xux6Dwt7VvDQRJy5nxrO xOoIgfzlHiQBJnUPr/KqU6ImiRFYO4625a8nHnFbyCxMUPRICBoF0/X/nOhDx25mRfiq 2QA8pLMKyXIZDhOdEol9o8j5bewbbw2NrHuvYYLtfSSTCBVfDF1PE66vnyd0he7cDr7+ ocqa1vWK7zHcRMBGfpvrtot5H6N4rDpZWFVinBrfWn079gVj1A9E3qKwXzG/Nd96ytoJ WIzKpTjUngzVKafBKalYOGggC/Q/Q3vOnfLmb3dIUUmQQiMsTTb/6InAQyns808kwNbk sK4w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=UYWchdTJA0zluaQChKlk95yBnsabvogUfybqiNkVWJU=; b=fk6AECug9hMgBaIGyHeSPBA5OfoRvuT7rBfDNi7Xsn7ehfAM2BC+/z2mj025zaiH+q 26C82l37cbn2zfxngGgCKVHftrAExmoNB2e/BxZ6Be1AsI3+pjP/NSbfEC7zBwMSHa/B 1HUGsp1NmB1aE/r2pAZ7avDYwkZUN71wkzxGezAWf5G84LJJFtAmm/mQZx7qsbRX/5xu mFKhTLCioxpBLsrlzx8sQpL1JfSa9g7ZqgGwMRnGjSztBkYnWDuh65NWIRTZJePHWQQX GhZNvF1nPNZPCplHMAld4PdnKw4u/IadR11l47IafSPEjc7tl2mkXawn2xGFPQ0A5PCq rCvA== X-Gm-Message-State: AOAM531wHamCiqwnhdQSFKN+tcbCFW8meYKtJ8uLhMiLY3YDnEG0O8fj hrLXe9kk/lnf2vKiC9b6aw36z/PR0VA= X-Google-Smtp-Source: ABdhPJyc28JcfKMse5XyhPy4EWT4kHyM+hHIIQl/XSuvr67hQDRobz2pQSf627ohCAl42aSogwX+JA== X-Received: by 2002:a17:906:974d:b0:6db:5745:e170 with SMTP id o13-20020a170906974d00b006db5745e170mr1159000ejy.276.1646740240285; Tue, 08 Mar 2022 03:50:40 -0800 (PST) Original-Received: from ars3 ([2a02:8109:8ac0:56d0::758e]) by smtp.gmail.com with ESMTPSA id y18-20020a170906471200b006da8a883b5fsm5721441ejq.54.2022.03.08.03.50.39 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 08 Mar 2022 03:50:39 -0800 (PST) In-Reply-To: (Stefan Monnier's message of "Mon, 07 Mar 2022 18:55:54 -0500") X-Host-Lookup-Failed: Reverse DNS lookup failed for 2a00:1450:4864:20::630 (failed) Received-SPF: pass client-ip=2a00:1450:4864:20::630; envelope-from=arstoffel@gmail.com; helo=mail-ej1-x630.google.com X-Spam_score_int: -6 X-Spam_score: -0.7 X-Spam_bar: / X-Spam_report: (-0.7 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, PDS_HP_HELO_NORDNS=0.659, RCVD_IN_DNSWL_NONE=-0.0001, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:286922 Archived-At: --=-=-= Content-Type: text/plain On Mon, 7 Mar 2022 at 18:55, Stefan Monnier 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")))) ``` --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-New-customization-variable-font-lock-ignore.patch >From ba5880aec952cabd13ae532ea6b11bb43d568f09 Mon Sep 17 00:00:00 2001 From: Augusto Stoffel 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 --=-=-=--