-effect."
- (interactive "*xFace:\nr")
- (if (eq face 'default)
- (remove-text-properties start end '(face default))
- (let ((part-start start) part-end)
- (while (not (= part-start end))
- (setq part-end (next-single-property-change part-start 'face nil end))
- (let ((prev (get-text-property part-start 'face)))
- (put-text-property part-start part-end 'face
- (if (null prev)
- face
- (facemenu-discard-redundant-faces
- (cons face
- (if (listp prev) prev (list prev)))))))
- (setq part-start part-end)))))
-
-(defun facemenu-discard-redundant-faces (face-list &optional mask)
- "Remove from FACE-LIST any faces that won't show at all.
-This means they have no non-nil elements that aren't also non-nil in an
-earlier face."
- (let ((useful nil))
- (cond ((null face-list) nil)
- ((null mask)
- (cons (car face-list)
- (facemenu-discard-redundant-faces
- (cdr face-list)
- (copy-sequence (internal-get-face (car face-list))))))
- ((let ((i (length mask))
- (face (internal-get-face (car face-list))))
- (while (>= (setq i (1- i)) 0)
- (if (and (aref face i)
- (not (aref mask i)))
- (progn (setq useful t)
- (aset mask i t))))
- useful)
- (cons (car face-list)
- (facemenu-discard-redundant-faces (cdr face-list) mask)))
- (t (facemenu-discard-redundant-faces (cdr face-list) mask)))))
+effect. See `facemenu-remove-face-function'."
+ (interactive "*xFace: \nr")
+ (if (and (eq face 'default)
+ (not (eq facemenu-remove-face-function t)))
+ (if facemenu-remove-face-function
+ (funcall facemenu-remove-face-function start end)
+ (if (and start (< start end))
+ (remove-text-properties start end '(face default))
+ (setq self-insert-face 'default
+ self-insert-face-command this-command)))
+ (if facemenu-add-face-function
+ (save-excursion
+ (if end (goto-char end))
+ (save-excursion
+ (if start (goto-char start))
+ (insert-before-markers
+ (funcall facemenu-add-face-function face end)))
+ (if facemenu-end-add-face
+ (insert (if (stringp facemenu-end-add-face)
+ facemenu-end-add-face
+ (funcall facemenu-end-add-face face)))))
+ (if (and start (< start end))
+ (let ((part-start start) part-end)
+ (while (not (= part-start end))
+ (setq part-end (next-single-property-change part-start 'face
+ nil end))
+ (let ((prev (get-text-property part-start 'face)))
+ (put-text-property part-start part-end 'face
+ (if (null prev)
+ face
+ (facemenu-active-faces
+ (cons face
+ (if (listp prev)
+ prev
+ (list prev)))))))
+ (setq part-start part-end)))
+ (setq self-insert-face (if (eq last-command self-insert-face-command)
+ (cons face (if (listp self-insert-face)
+ self-insert-face
+ (list self-insert-face)))
+ face)
+ self-insert-face-command this-command)))))
+
+(defun facemenu-active-faces (face-list &optional frame)
+ "Return from FACE-LIST those faces that would be used for display.
+This means each face attribute is not specified in a face earlier in FACE-LIST
+and such a face is therefore active when used to display text.
+If the optional argument FRAME is given, use the faces in that frame; otherwise
+use the selected frame. If t, then the global, non-frame faces are used."
+ (let* ((mask-atts (copy-sequence (internal-get-face (car face-list) frame)))
+ (active-list (list (car face-list)))
+ (face-list (cdr face-list))
+ (mask-len (length mask-atts)))
+ (while face-list
+ (if (let ((face-atts (internal-get-face (car face-list) frame))
+ (i mask-len) (useful nil))
+ (while (> (setq i (1- i)) 1)
+ (and (aref face-atts i) (not (aref mask-atts i))
+ (aset mask-atts i (setq useful t))))
+ useful)
+ (setq active-list (cons (car face-list) active-list)))
+ (setq face-list (cdr face-list)))
+ (nreverse active-list)))