Function: font-lock--add-text-property

font-lock--add-text-property is a byte-compiled function defined in font-lock.el.gz.

Signature

(font-lock--add-text-property START END PROP VALUE OBJECT APPEND)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/font-lock.el.gz
;;; Additional text property functions.

;; The following text property functions should be builtins.  This means they
;; should be written in C and put with all the other text property functions.
;; In the meantime, those that are used by font-lock.el are defined in Lisp
;; below and given a `font-lock-' prefix.  Those that are not used are defined
;; in Lisp below and commented out.  sm.

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