mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

(facemenu-active-faces): Replaces function

Browse Source 
`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.
This commit is contained in:
Karl Heuer 1995-11-10 18:59:43 +00:00
parent 2ff24a23f4
commit 5a79ed267f
1 changed files with 26 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
lisp/facemenu.el
View File

@ -124,13 +124,12 @@ This should be nil to put them at the top of the menu, or t to put them
just before \"Other\" at the end.") just before \"Other\" at the end.")
(defvar facemenu-unlisted-faces (defvar facemenu-unlisted-faces
'(modeline region secondary-selection highlight scratch-face '(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)
"List of faces not to include in the Face menu. "List of faces not to include in the Face menu.
Set this before loading facemenu.el, or call `facemenu-update' after You can set this list before loading facemenu.el, or add a face to it before
changing it. 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 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 temporarily turning off the feature that automatically adds faces to the menu
@ -483,33 +482,31 @@ effect."
(put-text-property part-start part-end 'face (put-text-property part-start part-end 'face
(if (null prev) (if (null prev)
face face
(facemenu-discard-redundant-faces (facemenu-active-faces
(cons face (cons face
(if (listp prev) prev (list prev))))))) (if (listp prev) prev (list prev)))))))
(setq part-start part-end))))) (setq part-start part-end)))))
(defun facemenu-discard-redundant-faces (face-list &optional mask) (defun facemenu-active-faces (face-list &optional frame)
"Remove from FACE-LIST any faces that won't show at all. "Return from FACE-LIST those faces that would be used for display.
This means they have no non-nil elements that aren't also non-nil in an This means each face attribute is not specified in a face earlier in FACE-LIST
earlier face." and such a face is therefore active when used to display text.
(let ((useful nil)) If the optional argument FRAME is given, use the faces in that frame; otherwise
(cond ((null face-list) nil) use the selected frame. If t, then the global, non-frame faces are used."
((null mask) (let* ((mask-atts (copy-sequence (internal-get-face (car face-list) frame)))
(cons (car face-list) (active-list (list (car face-list)))
(facemenu-discard-redundant-faces (face-list (cdr face-list))
(cdr face-list) (mask-len (length mask-atts)))
(copy-sequence (internal-get-face (car face-list)))))) (while face-list
((let ((i (length mask)) (if (let ((face-atts (internal-get-face (car face-list) frame))
(face (internal-get-face (car face-list)))) (i mask-len) (useful nil))
(while (>= (setq i (1- i)) 0) (while (> (setq i (1- i)) 1)
(if (and (aref face i) (and (aref face-atts i) (not (aref mask-atts i))
(not (aref mask i))) (aset mask-atts i (setq useful t))))
(progn (setq useful t) useful)
(aset mask i t)))) (setq active-list (cons (car face-list) active-list)))
useful) (setq face-list (cdr face-list)))
(cons (car face-list) (nreverse active-list)))
(facemenu-discard-redundant-faces (cdr face-list) mask)))
(t (facemenu-discard-redundant-faces (cdr face-list) mask)))))
(defun facemenu-get-face (symbol) (defun facemenu-get-face (symbol)
"Make sure FACE exists. "Make sure FACE exists.