diff lisp/facemenu.el @ 13495:fcfb5f397b49

(facemenu-active-faces): Replaces function `facemenu-discard-redundant-faces'. This version, written by Simon Marshall, is faster and does not require optional argument for recursive re-entry. New argument FRAME allows check to be done relative to face definitions in any frame. (facemenu-unlisted-faces): Remove font-lock faces from the default list. The list of face names was out of sync; to prevent this from happenning again I made font-lock.el, and other packages that create "private" faces, put them on the list themselves. This should give them a better chance of being updated when the packages are changed.

--- a/lisp/facemenu.el	Fri Nov 10 18:58:59 1995 +0000
+++ b/lisp/facemenu.el	Fri Nov 10 18:59:43 1995 +0000
@@ -124,13 +124,12 @@
 just before \"Other\" at the end.")
 
 (defvar facemenu-unlisted-faces
-  '(modeline region secondary-selection highlight scratch-face
-    font-lock-comment-face font-lock-string-face font-lock-keyword-face
-    font-lock-function-name-face font-lock-variable-name-face
-    font-lock-type-face font-lock-reference-face)
+  '(modeline region secondary-selection highlight scratch-face)
   "List of faces not to include in the Face menu.
-Set this before loading facemenu.el, or call `facemenu-update' after
-changing it.
+You can set this list before loading facemenu.el, or add a face to it before
+creating that face if you do not want it to be listed.  If you change the
+variable so as to eliminate faces that have already been added to the menu,
+call `facemenu-update' to recalculate the menu contents.
 
 If this variable is t, no faces will be added to the menu.  This is useful for
 temporarily turning off the feature that automatically adds faces to the menu
@@ -483,33 +482,31 @@
 	  (put-text-property part-start part-end 'face
 			     (if (null prev)
 				 face
-			       (facemenu-discard-redundant-faces
+			       (facemenu-active-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)))))
+(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)))
 
 (defun facemenu-get-face (symbol)
   "Make sure FACE exists.