From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: =?UTF-8?Q?K=C3=A9vin?= Le Gouguec Newsgroups: gmane.emacs.bugs Subject: bug#35476: font-lock-{append, prepend}-text-property and anonymous faces Date: Sun, 12 May 2019 19:34:01 +0200 Message-ID: <87d0knshkm.fsf@gmail.com> References: <87lfzu9hsl.fsf@gmail.com> <87a7g8owim.fsf@gmail.com> <87ftpqq1kl.fsf_-_@gmail.com> <87a7frj1qg.fsf_-_@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="13811"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: 35476@debbugs.gnu.org To: Noam Postavsky Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun May 12 19:35:14 2019 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.89) (envelope-from ) id 1hPsNV-0003S3-90 for geb-bug-gnu-emacs@m.gmane.org; Sun, 12 May 2019 19:35:13 +0200 Original-Received: from localhost ([127.0.0.1]:45625 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hPsNU-0008I3-2c for geb-bug-gnu-emacs@m.gmane.org; Sun, 12 May 2019 13:35:12 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:55182) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hPsNM-0008Hk-PQ for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 13:35:06 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hPsNL-0002oW-0h for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 13:35:04 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:57917) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hPsNK-0002oG-P5 for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 13:35:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hPsNJ-0007Hd-RR for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 13:35:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: =?UTF-8?Q?K=C3=A9vin?= Le Gouguec Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 12 May 2019 17:35:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 35476 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 35476-submit@debbugs.gnu.org id=B35476.155768246127937 (code B ref 35476); Sun, 12 May 2019 17:35:01 +0000 Original-Received: (at 35476) by debbugs.gnu.org; 12 May 2019 17:34:21 +0000 Original-Received: from localhost ([127.0.0.1]:43228 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hPsMb-0007GT-W2 for submit@debbugs.gnu.org; Sun, 12 May 2019 13:34:21 -0400 Original-Received: from mail-wm1-f41.google.com ([209.85.128.41]:38506) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hPsMZ-0007GG-Lj for 35476@debbugs.gnu.org; Sun, 12 May 2019 13:34:16 -0400 Original-Received: by mail-wm1-f41.google.com with SMTP id f2so11541408wmj.3 for <35476@debbugs.gnu.org>; Sun, 12 May 2019 10:34:15 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=eXGXRA1oEe1xo+uVCGTrXmkDOFvA+1j28cSxSueyQzI=; b=kr4Ae2paaUOgf7sDQAiH5gfASv5tL2UaFSFaVxq/yn4ox+4c9DfGXYOwKbbpgKN4D2 aY+Seo8ttFORFskNFLbhitbhEzKk4WnWVqD+gGRDkabm0FE6Jnp8YummRwTSWB/s1Um0 /MBabCQobVVHDU+cYSjAczLa2sWyLd3dFn3+ke+joWYhYql9h3NsWuIDZuq322K1U5oN n8nOZpUZU+lPOalcXnZ/g0B6qpiClw8iwrHXMWudNxji5cdJ5chJnlAug9kaPO9ovYvL eqcpJnD8ppb7oczfslusbSYNLXim6K8+7j5m1f9qkReHwvljShLF3XA0BIta8yOKX7L+ Ef9g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=eXGXRA1oEe1xo+uVCGTrXmkDOFvA+1j28cSxSueyQzI=; b=lXZPggAE+Tbhn4CsvpLM6Yhd5l87Elj89ZviDZZJOUu1gzIhFQxCDGX+mrSrGvz9eA TXGPPFX5jIi/db0w1Isw0zPuIofaJ+G250djyLScsJkuHMx/0hZ0zgjmJ3NzNpb0eTTT w3+y4kqJmVsYJgi/iFjmbTdWXc9CcFExgw9cjfg/pgYIVg6t3zf/Tg93Bm5Q96a6Q2fk f09WDav5QzOpSYSg74jT6gJJFXczLhIruj9ssR5s30EdSmBE0MAo1nC20wtuUqRlmON7 Wd88mFts0KaRsKrO/EC8kxQaIzCx7ntEttyDTGmZ2j30yKb+gkZIIYbBGfi1+0aJOtI0 ddrA== X-Gm-Message-State: APjAAAVDDc8QsPSSoYeKgWW+z6k9AuYMYXAV1V3DBSHTSJ+fZsbVR1iK VgHWfXO13q4XpUjjiPL4hKv3DqPK X-Google-Smtp-Source: APXvYqzrGTJF539K51oH55xUat95U3EaiLazcU5vOcIyKWTagHNnpo5tBMMKnNT2avHtR0vsCMfP5g== X-Received: by 2002:a1c:20c9:: with SMTP id g192mr12878102wmg.76.1557682449596; Sun, 12 May 2019 10:34:09 -0700 (PDT) Original-Received: from nc10-laptop ([109.190.253.11]) by smtp.gmail.com with ESMTPSA id d17sm7713955wrw.73.2019.05.12.10.34.06 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 12 May 2019 10:34:08 -0700 (PDT) In-Reply-To: <87a7frj1qg.fsf_-_@gmail.com> (Noam Postavsky's message of "Sun, 12 May 2019 08:28:39 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:159145 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Noam Postavsky writes: > K=C3=A9vin Le Gouguec writes: > >> Now that Stefan committed a fix to Emacs 27, and Nicolas a workaround >> to org-mode, this bug report can probably be closed; I just have a few >> questions left: >> >> 1. Shouldn't Stefan's fix also be applied to >> font-lock-append-text-property? >> >> 2. Is it worth adding the test suite I posted in bug#35476#8 to the >> Emacs repository? > > I'd say the answers are yes and yes. So would you mind adding the fix > for font-lock-append-text-property to your patch? Fix and test suite: --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Stop-splicing-anonymous-faces-in-font-lock-append-te.patch >From f5a4ad71152bee3c2ad15aa4d08b625d61bc6e9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sun, 12 May 2019 18:36:09 +0200 Subject: [PATCH 1/2] Stop splicing anonymous faces in font-lock-append-text-property This is the same fix as f478082, which was only applied to font-lock-prepend-text-property. * lisp/font-lock.el (font-lock-append-text-property): Distinguish list of faces from property list. * test/lisp/font-lock-tests.el: New test suite. (Bug#35476) --- lisp/font-lock.el | 7 +++++- test/lisp/font-lock-tests.el | 43 ++++++++++++++++++++++++++++++++++++ 2 files changed, 49 insertions(+), 1 deletion(-) create mode 100644 test/lisp/font-lock-tests.el diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 7ff4e606fa..95ca2f99c2 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1417,7 +1417,12 @@ font-lock-append-text-property Arguments PROP and VALUE specify the property and value to append to the value already in place. The resulting property values are always lists. Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) + (let ((val (if (and (listp value) (not (keywordp (car value)))) + ;; Already a list of faces. + value + ;; A single face (e.g. a plist of face properties). + (list value))) + next prev) (while (/= start end) (setq next (next-single-property-change start prop object end) prev (get-text-property start prop object)) diff --git a/test/lisp/font-lock-tests.el b/test/lisp/font-lock-tests.el new file mode 100644 index 0000000000..ad282f6cad --- /dev/null +++ b/test/lisp/font-lock-tests.el @@ -0,0 +1,43 @@ +;;; font-lock-tests.el --- Test suite for font-lock. -*- lexical-binding: t -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: +(require 'ert) + +(ert-deftest font-lock-test-append-anonymous-face () + "Ensure `font-lock-append-text-property' does not splice anonymous faces." + (with-temp-buffer + (insert "foo") + (add-text-properties 1 3 '(face italic)) + (font-lock-append-text-property 1 3 'face '(:strike-through t)) + (should (equal (get-text-property 1 'face (current-buffer)) + '(italic (:strike-through t)))))) + +(ert-deftest font-lock-test-prepend-anonymous-face () + "Ensure `font-lock-prepend-text-property' does not splice anonymous faces." + (with-temp-buffer + (insert "foo") + (add-text-properties 1 3 '(face italic)) + (font-lock-prepend-text-property 1 3 'face '(:strike-through t)) + (should (equal (get-text-property 1 'face (current-buffer)) + '((:strike-through t) italic))))) + +(provide 'font-lock-tests) + +;; font-lock-tests.el ends here -- 2.20.1 --=-=-= Content-Type: text/plain Further refactoring (not really necessary; feel free to close the report without applying): --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0002-Extract-common-code-for-adding-text-properties.patch >From c53e415941e67cd227902b5998e40b7ef88acedc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Sun, 12 May 2019 18:55:01 +0200 Subject: [PATCH 2/2] Extract common code for adding text properties * lisp/font-lock.el (font-lock--add-text-property): New function. (font-lock-prepend-text-property) (font-lock-append-text-property): Use it. (Bug#35476) --- lisp/font-lock.el | 46 +++++++++++++++++++--------------------------- 1 file changed, 19 insertions(+), 27 deletions(-) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 95ca2f99c2..6be765d563 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1387,11 +1387,13 @@ font-lock-fontify-block ;; below and given a `font-lock-' prefix. Those that are not used are defined ;; in Lisp below and commented out. sm. -(defun font-lock-prepend-text-property (start end prop value &optional object) - "Prepend to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to prepend to the value -already in place. The resulting property values are always lists. -Optional argument OBJECT is the string or buffer containing the text." +(defun font-lock--add-text-property (start end prop value object append) + "Add an element to a property of the text from START to END. +Arguments PROP and VALUE specify the property and value to add to +the value already in place. The resulting property values are +always lists. Argument OBJECT is the string or buffer containing +the text. If argument APPEND is non-nil, VALUE will be appended, +otherwise it will be prepended." (let ((val (if (and (listp value) (not (keywordp (car value)))) ;; Already a list of faces. value @@ -1407,35 +1409,25 @@ font-lock-prepend-text-property (or (keywordp (car prev)) (memq (car prev) '(foreground-color background-color))) (setq prev (list prev))) - (put-text-property start next prop - (append val (if (listp prev) prev (list prev))) - object) + (let ((new-value (if append + (append (if (listp prev) prev (list prev)) val) + (append val (if (listp prev) prev (list prev)))))) + (put-text-property start next prop new-value object)) (setq start next)))) +(defun font-lock-prepend-text-property (start end prop value &optional object) + "Prepend to one property of the text from START to END. +Arguments PROP and VALUE specify the property and value to prepend to the value +already in place. The resulting property values are always lists. +Optional argument OBJECT is the string or buffer containing the text." + (font-lock--add-text-property start end prop value object nil)) + (defun font-lock-append-text-property (start end prop value &optional object) "Append to one property of the text from START to END. Arguments PROP and VALUE specify the property and value to append to the value already in place. The resulting property values are always lists. Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (and (listp value) (not (keywordp (car value)))) - ;; Already a list of faces. - value - ;; A single face (e.g. a plist of face properties). - (list value))) - next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - ;; Canonicalize old forms of face property. - (and (memq prop '(face font-lock-face)) - (listp prev) - (or (keywordp (car prev)) - (memq (car prev) '(foreground-color background-color))) - (setq prev (list prev))) - (put-text-property start next prop - (append (if (listp prev) prev (list prev)) val) - object) - (setq start next)))) + (font-lock--add-text-property start end prop value object t)) (defun font-lock-fillin-text-property (start end prop value &optional object) "Fill in one property of the text from START to END. -- 2.20.1 --=-=-= Content-Type: text/plain Both patches were only "lightly" tested, i.e. by C-x C-e'ing every function and test, then calling ert-run-tests-interactively; AFAICT the tests pass[1]. Haven't run a full 'make check' yet (M-: insert-excuse 'battery); I don't think anything broke when Stefan committed the fix to font-lock-prepend-text-property though. Still pretty new to this, so let me know if I messed up anything (e.g. commit message format, conventions when adding files, functions or tests). Thank you for your time. [1] Although running 'make lisp/font-lock-tests' in the test/ folder fails on the append test. Could it be that the Makefile runs the tests against the old font-lock.el that is installed on my system, rather than the new one in my repository? I took a look at the test_template in test/Makefile, but I could not understand what the machinery loads at a glance. --=-=-=--