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

53
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.")
(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 @@ effect."
(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))))
(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)
(cons (car face-list)
(facemenu-discard-redundant-faces (cdr face-list) mask)))
(t (facemenu-discard-redundant-faces (cdr face-list) mask)))))
(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.