Re: Combining face and map stuff

[Miles Bader <miles@gnu.org>]

You can also have face properties that are lists of
faces/face-attributes, and add or remove stuff from these.

Some example functions below, `add-to-face-property' and
`remove-from-face-property', with which you can do stuff like:

  (add-to-face-property 'variable-pitch START END)
  (add-to-face-property '(:weight bold) (+ START 5) (- END 10))
  ...
  (remove-from-face-property 'variable-pitch START END)
  ...


(defun single-face-p (face)
  "Return non-nil if FACE seems to be a single face or face-attribute list
\(as oppposed to a list of faces/face-attribute-lists)."
  (or (symbolp face)			; face-symbol
      (and (listp face)
	   (keywordp (car face))	; (:attr val ...)
	   (keywordp (cadr face)))))	; (face-symbol :attr val ...)

(defun add-to-face-property (face start end)
  "Add FACE to the face text-property of the region from START to END.
Any existing face text-properties are preserved by adding FACE to
the beginning of a list, making the existin value into a list if
necessary first.  It can be removed with `remove-from-face-property'."
  (while (< start end)
    (let ((next (next-char-property-change start end)))
      (let ((cur (get-char-property start 'face)))
        (when (single-face-p cur)
	  (setq cur (list cur)))
        (push face cur)
	(put-text-property start next 'face cur))
      (setq start next))))

(defun remove-from-face-property (face start end)
  "Remove FACE from the face text-property of the region from START to END.
The assumption is that it was added previously by `add-to-face-property'."
  (while (< start end)
    (let ((next (next-char-property-change start end)))
      (let ((cur (get-char-property start 'face)))
	(when (single-face-p cur)
	  (setq cur (list cur)))
	(when (member face cur)
	  (put-text-property start next 'face (remove face cur))))
      (setq start next))))


-miles

-- 
History, n. An account mostly false, of events mostly unimportant, which are
brought about by rulers mostly knaves, and soldiers mostly fools.