[Emacs-diffs] master 59ad303 1/2: Stop splicing anonymous faces in font-lock-append-text-property

[Noam Postavsky]

branch: master
commit 59ad303e8f3bb174ce326c76a9e7649f602120db
Author: Kévin Le Gouguec <address@hidden>
Commit: Noam Postavsky <address@hidden>

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

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 7ff4e60..95ca2f9 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1417,7 +1417,12 @@ Optional argument OBJECT is the string or buffer 
containing the text."
 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 0000000..5d12703
--- /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