Paste number 349159: bug with add-face-text-property (emacs)

Paste number 349159: bug with add-face-text-property (emacs)
Pasted by: sebastiencs
When:2 years, 3 days ago
Share:Tweet this! | http://paste.lisp.org/+7HEV
Channel:None
Paste contents:
Raw Source | XML | Display As

(defconst my-icons-in-terminal-alist
  '(
    ( oct_flame . "\xe092" )
    ))

(defun my-icons-in-terminal (name &rest attributes)
  "."
  (let* ((list-attributes '(:family "icons-in-terminal"))
;;;  (let* ((list-attributes (list :family "icons-in-terminal"))
	 (face (or (plist-get attributes :inherit) (plist-get attributes :face)))
	 (foreground (plist-get attributes :foreground))
	 (distant-foreground (plist-get attributes :distant-foreground))
	 (background (plist-get attributes :background))
	 (width (plist-get attributes :width))
	 (height (plist-get attributes :height))
	 (underline (plist-get attributes :underline))
	 (overline (plist-get attributes :overline))
	 (box (plist-get attributes :box))
	 (raise (or (plist-get attributes :raise) -0.05)))
    (when face (push `(:inherit ,face) list-attributes))
    (when foreground (push `(:foreground ,foreground) list-attributes))
    (when distant-foreground (push `(:distant-foreground ,distant-foreground) list-attributes))
    (when background (push `(:background ,background) list-attributes))
    (when width (push `(:width ,width) list-attributes))
    (when height (push `(:height ,height) list-attributes))
    (when underline (push `(:underline ,underline) list-attributes))
    (when overline (push `(:overline ,overline) list-attributes))
    (when box (push `(:box ,box) list-attributes))
    (propertize (alist-get name my-icons-in-terminal-alist)
		'face list-attributes
		'display `(raise ,raise)
		'font-lock-ignore t)))

(defun sidebar-make-header ()
  "."
  (my-icons-in-terminal 'oct_flame :raise -0.07 :height 1.3))

(defun sidebar-set-header ()
  "."
  (let* ((string (sidebar-make-header)))
    (add-face-text-property 0 (length string) '(:background "red") t string)
    string
    ))

(setq header-line-format (list '(:eval (sidebar-set-header))))

(force-mode-line-update)

;; Evaluate this buffer
;; Open your *Messages* buffer in another window, see the messages: Invalid face attribute (:background "red") (:background "red") [18496 times]

;; Evaluate this sexp:
;; (my-icons-in-terminal 'oct_flame)
;; Every time it's evaluated, (:background "red") is added one more time to the list of face (just with this sexp, we're not using add-face-text-property here):
;; #("" 0 1 (font-lock-ignore t display (raise -0.05) face (:family "icons-in-terminal" (:background "red") (:background "red") ....)))

;; If I set the argument APPEND of add-face-text-property to nil, the bug doesn't appear
;; In the function my-icons-in-terminal, if I remove the lines (when ...), the bug doesn't appear
;; If I initialize the variable list-attributes to (list :family "...") instead of '(:family) in my-icons-in-terminal,
;;   it doesn't appear.

;;

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.