This is a utility function to replace faces using an assosiation-list
,
This example function only works when faces are referenced as atoms and should be expanded for other cases for full support.
(defun text-property-face-replace (text face-replace-alist)
"Replace faces in TEXT using FACE-REPLACE-ALIST."
(let ((pos-beg 0)
(pos-end (length text)))
(while (< pos-beg pos-end)
(let ((text-props (text-properties-at pos-beg text)))
(let ((prop-iter (memq 'face text-props)))
(when prop-iter
(let ((value-src (car (cdr prop-iter))))
(let ((value-dst
(cond
((listp value-src)
nil) ;; TODO: support `plists' and other complex cases.
(t
(assq value-src face-replace-alist)))))
(when value-dst
(setcdr prop-iter (cons (cdr value-dst) (cdr (cdr prop-iter))))))))))
(setq pos-beg (next-property-change pos-beg text pos-end)))))
Example use:
(defvar text-replace-table
'((font-lock-doc-face . font-lock-warning-face)
(font-lock-comment-face . font-lock-warning-face)
(font-lock-comment-delimiter-face . font-lock-warning-face)
(font-lock-constant-face . font-lock-warning-face)))
(defun text-replace-example ()
"Show replaced face for the current line."
(interactive)
(let ((line (buffer-substring (line-beginning-position) (line-end-position))))
(message "Replaced text: %s" (text-property-face-replace line text-replace-table))))