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 23:51:29 +0200 Message-ID: <87tvdz8hpa.fsf@gmail.com> References: <87lfzu9hsl.fsf@gmail.com> <87a7g8owim.fsf@gmail.com> <87ftpqq1kl.fsf_-_@gmail.com> <87a7frj1qg.fsf_-_@gmail.com> <87d0knshkm.fsf@gmail.com> <87pnonh4lr.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="266002"; 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 23:52:20 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 1hPwOJ-00171Y-GM for geb-bug-gnu-emacs@m.gmane.org; Sun, 12 May 2019 23:52:19 +0200 Original-Received: from localhost ([127.0.0.1]:47683 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hPwOF-0001VH-DL for geb-bug-gnu-emacs@m.gmane.org; Sun, 12 May 2019 17:52:15 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:57897) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hPwO5-0001V6-AL for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 17:52:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hPwO3-0003RT-ES for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 17:52:05 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:58248) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hPwO3-0003Q9-5W for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 17:52:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hPwO1-0007Ow-Vk for bug-gnu-emacs@gnu.org; Sun, 12 May 2019 17:52: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 21:52: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.155769790328424 (code B ref 35476); Sun, 12 May 2019 21:52:01 +0000 Original-Received: (at 35476) by debbugs.gnu.org; 12 May 2019 21:51:43 +0000 Original-Received: from localhost ([127.0.0.1]:43559 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hPwNi-0007ON-ME for submit@debbugs.gnu.org; Sun, 12 May 2019 17:51:43 -0400 Original-Received: from mail-wr1-f42.google.com ([209.85.221.42]:34385) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hPwNg-0007O7-Ve for 35476@debbugs.gnu.org; Sun, 12 May 2019 17:51:41 -0400 Original-Received: by mail-wr1-f42.google.com with SMTP id f8so3423534wrt.1 for <35476@debbugs.gnu.org>; Sun, 12 May 2019 14:51:40 -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=aQX1Wm4HdyaSZaJ26eKAkCeGNaOKr6iKk5ySRjxq5iA=; b=u+0sNThmi/jJN7Z2bWerryAjVa6Q+fTlNSoF39lrVr//7KeuuYB0wu56jNU4xBrUgM nycSHqKei8PqqiUYS98RtHG+TsCSaf9UFHQp/yLHUp/Nj0zyZlTBOFjT3G1zfSD1FnJj ykRI95va3CU1cnLODGNHOuRYyckbue/BrJ1YL2jI1YLvvE/Ikh4L14gt/mCZRHf1yFKP N9ouwynhW3x52638W1fSdRnOcaoB8vArw896Dy+lRvNU5p/GfdhRDYAzAnj0Vd18RPtr LkwNaxNCeljWzQjoAce6J3Tg4hV4MLO/ciYGRMK8XSrQsuSgaOuAGMuw5e/Vivw3Brwd xxew== 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=aQX1Wm4HdyaSZaJ26eKAkCeGNaOKr6iKk5ySRjxq5iA=; b=PCgpvHZtRwcOcYPm7GcKBTfULSS9JvmBaDLNeJy7nMduAep7Vgy7SPqqXj4e9bmS3W TTF1c9dVYVjObd3eidPveK5rjywAQQg0ymU+hWckEWVkTqt0ES3V/viP8jZJKKSP52Ja weqQbYdiSIISKB4//Be6tTgzcLO+EPNDFmthsT9QIkrI2a0hX1lDflH2Ua8mFTIVQeyz K2aGaUWORAHnzVr15Xh3lUBtk/PxDA7wi8eqgv9glOwti1aSXL6Qp/x4mx5XeMctJWCt vqV4WvR/74E39qeLl/v4mOQCacAJbpTXdJx0sEuzFgek5iY7XDqoKPKMNcMRmj0x/Ht5 u/sg== X-Gm-Message-State: APjAAAVW9llQJ+HW9hTgd/+FIUZd1CNMnGKrJXDsJEKxH4Z2FrWfnidi RyK1+UoDIOR9r4qfg7/2Q27+nDxP X-Google-Smtp-Source: APXvYqxYLIezQbnky0T9HrCLmxN2H7azFfNZWmiR8poFEbWvxe/DFs4+AI2Gz1YsZOTvwzkJKC06vw== X-Received: by 2002:a5d:4d11:: with SMTP id z17mr11825658wrt.308.1557697893621; Sun, 12 May 2019 14:51:33 -0700 (PDT) Original-Received: from my-little-tumbleweed (71.142.13.109.rev.sfr.net. [109.13.142.71]) by smtp.gmail.com with ESMTPSA id d6sm11589694wrp.9.2019.05.12.14.51.32 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Sun, 12 May 2019 14:51:32 -0700 (PDT) In-Reply-To: <87pnonh4lr.fsf@gmail.com> (Noam Postavsky's message of "Sun, 12 May 2019 15:09:36 -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:159160 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Noam Postavsky writes: > It's best to avoid using hashes in commit messages, as they're > translated to ChangeLog files which might read from the tarball (i.e., > without a git repo to hand). CONTRIBUTE talks about using "action > stamps" but I think date+title is more readable. Which would be: > 2019-04-29 "Refrain from splicing anonymous faces in text properties". Ah, right, didn't think of the children^WChangeLog. I went for date+title. =20=20 Can e.g. git-show(1) understand action stamps? I glanced at gitrevisions(7) but nothing suggests Git knows anything about this format. It sure would make a hypothetical vc-revision-at-point command easier to implement=E2=80=A6 (Or, going the opposite route, maybe the git-log-to-ChangeLog machinery could translate hashes to action stamps?) >> +(provide 'font-lock-tests) > > I don't think there is any reason to `provide' a feature in a test file > (I know some other test files do that, but I don't see why), test files > are generally not loaded via require. Done. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Stop-splicing-anonymous-faces-in-font-lock-append-te.patch >From 6a0a431fb0ed7ccfe27daf853eed48ac73017e1a 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 2019-04-29 "Refrain from splicing anonymous faces in text properties", 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 | 41 ++++++++++++++++++++++++++++++++++++ 2 files changed, 47 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..5d127039ff --- /dev/null +++ b/test/lisp/font-lock-tests.el @@ -0,0 +1,41 @@ +;;; 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))))) + +;; font-lock-tests.el ends here -- 2.21.0 --=-=-= Content-Type: text/plain >> Subject: [PATCH 2/2] Extract common code for adding text properties > >> + (let ((new-value (if append >> + (append (if (listp prev) prev (list prev)) val) >> + (append val (if (listp prev) prev (list prev)))))) > > I would suggest to factor out the (if (listp prev) prev (list prev)) > from these expressions. And done. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Extract-common-code-for-adding-text-properties.patch >From bd45ee71a3880e681f637ea6a2b11fd9e06e51ce 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 | 47 ++++++++++++++++++++--------------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 95ca2f99c2..3991a4ee8e 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,26 @@ 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* ((list-prev (if (listp prev) prev (list prev))) + (new-value (if append + (append list-prev val) + (append val 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.21.0 --=-=-= Content-Type: text/plain Thank you for the review! Let me know if there are further nits to pick. --=-=-=--