From 7990c65193473784bae6769ae9a2baf233234269 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= 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