bug#35476: [PATCH] 27.0.50; font-lock-{append,prepend}-text-property and anonymous faces

bug#35476: [PATCH] 27.0.50; font-lock-{append,prepend}-text-property and anonymous faces

[Kévin Le Gouguec]

[-- Attachment #1: Type: text/plain, Size: 1622 bytes --]

Hello,

This is a follow-up to the mails I sent to emacs-orgmode[1] and
help-gnu-emacs[2].

tl;dr I believe font-lock-{append,prepend}-text-property do not handle
anonymous faces correctly: they splice their attributes, producing
lists mixing keyword attributes and named faces such as this one:

    (:strike-through t org-level-1)

The patch I attach changes this to:

    ((:strike-through t) org-level-1)

To summarize my findings:

1. With org.el from Emacs's master branch (commit 88c91f53df), in an
   Org buffer with a heading such as this one:

        * *foo* /bar/ _baz_ +quux+
  
   foo (resp. bar and baz) show both the heading face and the bold
   (resp. italic and underline) decoration, whereas quux only shows
   the strike-through decoration, without the heading face.

2. C-u C-x = on quux says:

    > face        (:strike-through t org-level-1)

   A hasty look at org.el showed that it used
   `font-lock-prepend-text-property`.  I sent a trivial patch to
   emacs-orgmode which uses `font-lock-append-text-property` instead,
   although I wasn't sure that it was sound.  With this patch, C-u
   C-x = says instead:
   
    > face        (org-level-1 :strike-through t)

   … and quux shows both the org-level-1 foreground and the
   strike-through decoration.

3. On help-gnu-emacs, Stefan confirmed that my patch relies on
   undefined behavior.

4. Meanwhile, Nicolas applied it to the org-mode repository (commit
   42abf5c69).

I have now come to the conclusion that a patch such as the one I
attached in this report might be more appropriate.

[-- Attachment #2: 0001-Refrain-from-splicing-anonymous-faces-in-text-proper.patch --]
[-- Type: text/x-diff, Size: 3710 bytes --]

From 7990c65193473784bae6769ae9a2baf233234269 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Sun, 28 Apr 2019 18:48:36 +0200
Subject: [PATCH] Refrain from splicing anonymous faces in text properties
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Otherwise named faces that follow are not displayed anymore.  E.g. in
an Org buffer with this content:

    * /foo/ *bar* _baz_ +quux+

Before this commit, the 'face property on quux was:

    (:strike-through t org-level-1)

… and the org-level-1 foreground was not displayed.  This commit makes
the 'face property become:

    ((:strike-through t) org-level-1)

… which lets quux display both the strike-through decoration and the
org-level-1 foreground.

* lisp/font-lock.el (font-lock-append-text-property)
(font-lock-prepend-text-property): Wrap anonymous faces in a
single-elemnt list so that `append' does not splice them.
---
 lisp/font-lock.el | 22 ++++++++++++++++++----
 1 file changed, 18 insertions(+), 4 deletions(-)

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 1475911195..e0e55d859d 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1392,16 +1392,23 @@ font-lock-prepend-text-property
 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."
-  (let ((val (if (listp value) value (list value))) next prev)
+  (let ((val (if (listp value) value (list value)))
+        (is-face-prop (memq prop '(face font-lock-face)))
+        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))
+      (and is-face-prop
 	   (listp prev)
 	   (or (keywordp (car prev))
 	       (memq (car prev) '(foreground-color background-color)))
 	   (setq prev (list prev)))
+      ;; Wrap an anonymous face into a single-element list, so that
+      ;; `append' does not splice it.
+      (and is-face-prop
+           (keywordp (car val))
+           (setq val (list val)))
       (put-text-property start next prop
 			 (append val (if (listp prev) prev (list prev)))
 			 object)
@@ -1412,16 +1419,23 @@ 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 (listp value) value (list value)))
+        (is-face-prop (memq prop '(face font-lock-face)))
+        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))
+      (and is-face-prop
 	   (listp prev)
 	   (or (keywordp (car prev))
 	       (memq (car prev) '(foreground-color background-color)))
 	   (setq prev (list prev)))
+      ;; Wrap an anonymous face into a single-element list, so that
+      ;; `append' does not splice it.
+      (and is-face-prop
+           (keywordp (car val))
+           (setq val (list val)))
       (put-text-property start next prop
 			 (append (if (listp prev) prev (list prev)) val)
 			 object)
-- 
2.20.1


[-- Attachment #3: Type: text/plain, Size: 7033 bytes --]


I am not an expert on font-lock though, so this patch might not be
correct.  <excuses>Also, since I'm on a laptop running on battery
power, I don't intend to run make check right now.</excuses>  I am
sharing this patch in case someone well-versed in font-lock finds it
"obviously correct".

If that is the case, I have two more questions for additional patches:

1. Would it make sense to stuff most of these two functions's code
   into a third function called e.g.

        font-lock--add-text-property (start end prop value object append)

   in order to reduce duplication?

2. I guess some new automated tests would be appreciated?


Thank you for your time.

Kévin


[1]: http://lists.gnu.org/archive/html/emacs-orgmode/2019-04/msg00101.html
[2]: http://lists.gnu.org/archive/html/help-gnu-emacs/2019-04/msg00240.html



In GNU Emacs 27.0.50 (build 1, i686-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2019-04-18 built on nc10-laptop
Repository revision: a18336a8dc754fa1c68e16dd8009466cf409271b
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.11902000
System Description: BunsenLabs GNU/Linux 9.8 (Helium)

Recent messages:
Saving file /home/peniblec/drafts/font-lock.md...
Wrote /home/peniblec/drafts/font-lock.md
Saving file /home/peniblec/drafts/font-lock.md...
Wrote /home/peniblec/drafts/font-lock.md
Mark set
Saving file /home/peniblec/drafts/font-lock.md...
Wrote /home/peniblec/drafts/font-lock.md
next-line: End of buffer [4 times]
Mark set [3 times]
Undo!

Configured using:
 'configure --with-xwidgets'

Configured features:
XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS GSETTINGS GLIB
NOTIFY INOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT LIBOTF
XFT ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 XDBE XIM THREADS XWIDGETS JSON
PDUMPER LCMS2 GMP

Important settings:
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Markdown

Minor modes in effect:
  global-magit-file-mode: t
  magit-file-mode: t
  magit-auto-revert-mode: t
  global-git-commit-mode: t
  async-bytecomp-package-mode: t
  shell-dirtrack-mode: t
  show-paren-mode: t
  minibuffer-depth-indicate-mode: t
  icomplete-mode: t
  global-page-break-lines-mode: t
  page-break-lines-mode: t
  electric-pair-mode: t
  diff-hl-flydiff-mode: t
  global-diff-hl-mode: t
  diff-hl-mode: t
  delete-selection-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  column-number-mode: t
  line-number-mode: t
  auto-fill-function: do-auto-fill
  visual-line-mode: t
  transient-mark-mode: t

Load-path shadows:
None found.

Features:
(shadow emacsbug dired-aux help-fns radix-tree cl-print debug backtrace
flyspell ediff-merg ediff-wind ediff-diff ediff-mult ediff-help
ediff-init ediff-util ediff vc-mtn vc-hg org-indent org-rmail org-mhe
org-irc org-info org-gnus org-docview doc-view jka-compr image-mode
org-bibtex bibtex org-bbdb org-w3m org-element avl-tree generator org
org-macro org-footnote org-pcomplete org-list org-faces org-entities
org-version ob-emacs-lisp ob ob-tangle org-src ob-ref ob-lob ob-table
ob-keys ob-exp ob-comint ob-core ob-eval org-compat org-macs
org-loaddefs find-func cal-menu calendar cal-loaddefs ispell magit-patch
cus-edit whitespace bug-reference diff-hl-dired mailalias smtpmail
sendmail nnir markdown-mode rx color thingatpt noutline outline misearch
multi-isearch magit-extras executable magit-submodule magit-obsolete
magit-blame magit-stash magit-bisect magit-push magit-pull magit-fetch
magit-clone magit-remote magit-commit magit-sequence magit-notes
magit-worktree magit-tag magit-merge magit-branch magit-reset
magit-files magit-refs magit-status magit magit-repos magit-apply
magit-wip magit-log which-func imenu magit-diff smerge-mode magit-core
magit-autorevert autorevert filenotify magit-margin magit-transient
magit-process magit-mode transient git-commit magit-git magit-section
magit-utils crm log-edit pcvs-util add-log with-editor async-bytecomp
async shell pcomplete server dash sort gnus-cite mail-extr gnus-async
gnus-bcklg qp gnus-ml nndraft nnmh nnfolder utf-7 epa-file gnutls
network-stream nsm gnus-agent gnus-srvr gnus-score score-mode nnvirtual
gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime smime dig mailcap nntp
gnus-cache gnus-sum gnus-group gnus-undo gnus-start gnus-cloud nnimap
nnmail mail-source utf7 netrc nnoo parse-time gnus-spec gnus-int
gnus-range message rmc puny dired dired-loaddefs format-spec rfc822 mml
mml-sec epa derived epg mm-decode mm-bodies mm-encode mail-parse rfc2231
mailabbrev gmm-utils mailheader gnus-win gnus nnheader gnus-util rmail
rmail-loaddefs rfc2047 rfc2045 ietf-drums text-property-search time-date
mail-utils mm-util mail-prsvr wid-edit vc-git vc-bzr vc-src vc-sccs
vc-svn vc-cvs vc-rcs project delight advice eighters-theme quail
cl-extra help-mode rg rg-ibuffer rg-result wgrep-rg wgrep s rg-history
rg-header rg-compat ibuf-ext ibuffer ibuffer-loaddefs grep compile
comint ansi-color ring edmacro kmacro disp-table paren mb-depth
icomplete page-break-lines elec-pair diff-hl-flydiff diff diff-hl vc-dir
ewoc vc vc-dispatcher diff-mode easy-mmode delsel cus-start cus-load
mule-util tex-site info package easymenu epg-config url-handlers
url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs
password-cache json subr-x map url-vars seq byte-opt gv bytecomp
byte-compile cconv cl-loaddefs cl-lib tooltip eldoc electric uniquify
ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win
term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe
tabulated-list replace newcomment text-mode elisp-mode lisp-mode
prog-mode register page menu-bar rfn-eshadow isearch timer select
scroll-bar mouse jit-lock font-lock syntax facemenu font-core
term/tty-colors frame cl-generic cham georgian utf-8-lang misc-lang
vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932
hebrew greek romanian slovak czech european ethiopic indian cyrillic
chinese composite charscript charprop case-table epa-hook jka-cmpr-hook
help simple abbrev obarray minibuffer cl-preloaded nadvice loaddefs
button faces cus-face macroexp files text-properties overlay sha1 md5
base64 format env code-pages mule custom widget hashtable-print-readable
backquote threads dbusbind inotify lcms2 dynamic-setting
system-font-setting font-render-setting xwidget-internal move-toolbar
gtk x-toolkit x multi-tty make-network-process emacs)

Memory information:
((conses 8 340103 79587)
 (symbols 24 31862 1)
 (strings 16 105392 12481)
 (string-bytes 1 3497604)
 (vectors 8 55552)
 (vector-slots 4 1313923 80148)
 (floats 8 495 324)
 (intervals 28 3532 1391)
 (buffers 564 52))

bug#35476: Test suite

[Kévin Le Gouguec]

[-- Attachment #1: Type: text/plain, Size: 451 bytes --]

As part of the discussion on help-gnu-emacs[1], Stefan applied a simpler
patch in commit f478082f9f, only for font-lock-prepend-text-property
though.  Does it make sense to do the same in
font-lock-append-text-property?

As a learning experience with ERT, I wrote the attached test suite; with
the current master branch, only the prepend test passes, the other
fails.  Applying the same change in font-lock-append-text-property lets
both tests pass.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-a-test-suite-for-anonymous-face-handling-in-text.patch --]
[-- Type: text/x-patch, Size: 2480 bytes --]

From 7bd1a551de8cef452a7ade7eaa055d38bf3a0800 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
Date: Tue, 30 Apr 2019 08:00:34 +0200
Subject: [PATCH] Add a test suite for anonymous face handling in text
 properties

* test/lisp/font-lock-tests.el: New test suite.  Only
font-lock-test-prepend-anonymous-face passes as of f478082f9f.
---
 test/lisp/font-lock-tests.el | 43 ++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)
 create mode 100644 test/lisp/font-lock-tests.el

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 <https://www.gnu.org/licenses/>.
+
+;;; 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.21.0


[-- Attachment #3: Type: text/plain, Size: 121 bytes --]


Apologies for posting all over the place.


[1]: http://lists.gnu.org/archive/html/help-gnu-emacs/2019-04/msg00289.html

bug#35476: [BUMP] Some questions before closing

[Kévin Le Gouguec]

Hi!

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?

Thank your for your time.

Kévin

bug#35476: font-lock-{append, prepend}-text-property and anonymous faces

[Noam Postavsky]

Kévin Le Gouguec <kevin.legouguec@gmail.com> 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?

bug#35476: font-lock-{append, prepend}-text-property and anonymous faces

[Kévin Le Gouguec]

[-- Attachment #1: Type: text/plain, Size: 624 bytes --]

Noam Postavsky <npostavs@gmail.com> writes:

> Kévin Le Gouguec <kevin.legouguec@gmail.com> 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:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Stop-splicing-anonymous-faces-in-font-lock-append-te.patch --]
[-- Type: text/x-diff, Size: 3555 bytes --]

From f5a4ad71152bee3c2ad15aa4d08b625d61bc6e9c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
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 <https://www.gnu.org/licenses/>.
+
+;;; 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


[-- Attachment #3: Type: text/plain, Size: 94 bytes --]


Further refactoring (not really necessary; feel free to close the report
without applying):


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Extract-common-code-for-adding-text-properties.patch --]
[-- Type: text/x-diff, Size: 4125 bytes --]

From c53e415941e67cd227902b5998e40b7ef88acedc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
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


[-- Attachment #5: Type: text/plain, Size: 883 bytes --]


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.

bug#35476: font-lock-{append, prepend}-text-property and anonymous faces

[Noam Postavsky]

Looks basically good, I just have a few nitpicks below.

> 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

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

> +(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.

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

bug#35476: font-lock-{append, prepend}-text-property and anonymous faces

[Kévin Le Gouguec]

[-- Attachment #1: Type: text/plain, Size: 1068 bytes --]

Noam Postavsky <npostavs@gmail.com> 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.
  
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…

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Stop-splicing-anonymous-faces-in-font-lock-append-te.patch --]
[-- Type: text/x-patch, Size: 3587 bytes --]

From 6a0a431fb0ed7ccfe27daf853eed48ac73017e1a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
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 <https://www.gnu.org/licenses/>.
+
+;;; 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


[-- Attachment #3: Type: text/plain, Size: 382 bytes --]


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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Extract-common-code-for-adding-text-properties.patch --]
[-- Type: text/x-patch, Size: 4138 bytes --]

From bd45ee71a3880e681f637ea6a2b11fd9e06e51ce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com>
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


[-- Attachment #5: Type: text/plain, Size: 75 bytes --]


Thank you for the review!  Let me know if there are further nits to
pick.

bug#35476: font-lock-{append, prepend}-text-property and anonymous faces

[Noam Postavsky]

tags 35476 fixed
close 35476 27.1
quit

Kévin Le Gouguec <kevin.legouguec@gmail.com> writes:

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

I forgot to answer this before.  There's two issues here:

1. The default value of load-prefer-newer means that of you change a .el
file without recompiling it, Emacs will load the .elc file instead.

2. For font-lock.el in particular, it's preloaded, so even if you
recompile it, font-lock.elc isn't loaded again, you need to redump
Emacs.

So generally, the way to test changes is

    make && make -C test font-lock-tests

Although it should also work to load the modified .el file explicitly
(untested, but):

    make -C test EMACS_EXTRAOPT='-l font-lock.el' font-lock-tests

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

:D
  
> Can e.g. git-show(1) understand action stamps?  I glanced at
> gitrevisions(7) but nothing suggests Git knows anything about this
> format.

I don't think so.  The last time I brought this up on emacs-devel there
was some suggestion that cgit (a git web frontend) would learn to
recognize them eventually, but I'm not sure if anything is really moving
in that direction.

> (Or, going the opposite route, maybe the git-log-to-ChangeLog machinery
> could translate hashes to action stamps?)

Maybe, although personally, as a human reader, I prefer date+title to
both hashes and action stamps, even when reading from git.  Yes, it's
quicker to find a commit given a hash, but that still requires at least
pressing RET or clicking or something like that.  Quite often, just
seeing the title is enough to understand what's meant and I don't need
to dig further.

> Thank you for the review!  Let me know if there are further nits to
> pick.

I think we're good here, pushed to master.

417c52b0b7 2019-05-13T20:41:02-04:00 "Extract common code for adding text properties"
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=417c52b0b7fbf5cb02d229e81b7aaaacf2082bde

59ad303e8f 2019-05-13T20:41:02-04:00 "Stop splicing anonymous faces in font-lock-append-text-property"
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=59ad303e8f3bb174ce326c76a9e7649f602120db

bug#35476: font-lock-{append, prepend}-text-property and anonymous faces

[Kévin Le Gouguec]

Noam Postavsky <npostavs@gmail.com> writes:

> Kévin Le Gouguec <kevin.legouguec@gmail.com> writes:
>
>> [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.
>
> I forgot to answer this before.  There's two issues here:
>
> 1. The default value of load-prefer-newer means that of you change a .el
> file without recompiling it, Emacs will load the .elc file instead.
>
> 2. For font-lock.el in particular, it's preloaded, so even if you
> recompile it, font-lock.elc isn't loaded again, you need to redump
> Emacs.

Duly noted, I'll watch out for that in the future.

> So generally, the way to test changes is
>
>     make && make -C test font-lock-tests
>
> Although it should also work to load the modified .el file explicitly
> (untested, but):
>
>     make -C test EMACS_EXTRAOPT='-l font-lock.el' font-lock-tests

Just tried with and without EMACS_EXTRAOPT, and it does seem to work
around the problem.

>> Can e.g. git-show(1) understand action stamps?  I glanced at
>> gitrevisions(7) but nothing suggests Git knows anything about this
>> format.
>
> I don't think so.  The last time I brought this up on emacs-devel there
> was some suggestion that cgit (a git web frontend) would learn to
> recognize them eventually, but I'm not sure if anything is really moving
> in that direction.
>
>> (Or, going the opposite route, maybe the git-log-to-ChangeLog machinery
>> could translate hashes to action stamps?)
>
> Maybe, although personally, as a human reader, I prefer date+title to
> both hashes and action stamps, even when reading from git.  Yes, it's
> quicker to find a commit given a hash, but that still requires at least
> pressing RET or clicking or something like that.  Quite often, just
> seeing the title is enough to understand what's meant and I don't need
> to dig further.

OK.  FWIW, since I like to give context to my messages and I expect to
be doing the hash ↦ date+title dance a lot, this command seems to do the
job adequately for commit $c:

    git show --no-patch --date=short --format=format:'%ad "%s"' $c

Now to write some Lisp to make that available from vc and magit buffers…

(one-liner for action stamps left as exercise to the reader)

> I think we're good here, pushed to master.

Thanks!