Mercurial > emacs
comparison 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.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Fri, 10 Nov 1995 18:59:43 +0000 |
parents | 21a9f15132d7 |
children | 35e379a3952e |
comparison
equal
deleted
inserted
replaced
13494:43a8534fe07c | 13495:fcfb5f397b49 |
---|---|
122 "Where in the menu to insert newly-created faces. | 122 "Where in the menu to insert newly-created faces. |
123 This should be nil to put them at the top of the menu, or t to put them | 123 This should be nil to put them at the top of the menu, or t to put them |
124 just before \"Other\" at the end.") | 124 just before \"Other\" at the end.") |
125 | 125 |
126 (defvar facemenu-unlisted-faces | 126 (defvar facemenu-unlisted-faces |
127 '(modeline region secondary-selection highlight scratch-face | 127 '(modeline region secondary-selection highlight scratch-face) |
128 font-lock-comment-face font-lock-string-face font-lock-keyword-face | |
129 font-lock-function-name-face font-lock-variable-name-face | |
130 font-lock-type-face font-lock-reference-face) | |
131 "List of faces not to include in the Face menu. | 128 "List of faces not to include in the Face menu. |
132 Set this before loading facemenu.el, or call `facemenu-update' after | 129 You can set this list before loading facemenu.el, or add a face to it before |
133 changing it. | 130 creating that face if you do not want it to be listed. If you change the |
131 variable so as to eliminate faces that have already been added to the menu, | |
132 call `facemenu-update' to recalculate the menu contents. | |
134 | 133 |
135 If this variable is t, no faces will be added to the menu. This is useful for | 134 If this variable is t, no faces will be added to the menu. This is useful for |
136 temporarily turning off the feature that automatically adds faces to the menu | 135 temporarily turning off the feature that automatically adds faces to the menu |
137 when they are created.") | 136 when they are created.") |
138 | 137 |
481 (setq part-end (next-single-property-change part-start 'face nil end)) | 480 (setq part-end (next-single-property-change part-start 'face nil end)) |
482 (let ((prev (get-text-property part-start 'face))) | 481 (let ((prev (get-text-property part-start 'face))) |
483 (put-text-property part-start part-end 'face | 482 (put-text-property part-start part-end 'face |
484 (if (null prev) | 483 (if (null prev) |
485 face | 484 face |
486 (facemenu-discard-redundant-faces | 485 (facemenu-active-faces |
487 (cons face | 486 (cons face |
488 (if (listp prev) prev (list prev))))))) | 487 (if (listp prev) prev (list prev))))))) |
489 (setq part-start part-end))))) | 488 (setq part-start part-end))))) |
490 | 489 |
491 (defun facemenu-discard-redundant-faces (face-list &optional mask) | 490 (defun facemenu-active-faces (face-list &optional frame) |
492 "Remove from FACE-LIST any faces that won't show at all. | 491 "Return from FACE-LIST those faces that would be used for display. |
493 This means they have no non-nil elements that aren't also non-nil in an | 492 This means each face attribute is not specified in a face earlier in FACE-LIST |
494 earlier face." | 493 and such a face is therefore active when used to display text. |
495 (let ((useful nil)) | 494 If the optional argument FRAME is given, use the faces in that frame; otherwise |
496 (cond ((null face-list) nil) | 495 use the selected frame. If t, then the global, non-frame faces are used." |
497 ((null mask) | 496 (let* ((mask-atts (copy-sequence (internal-get-face (car face-list) frame))) |
498 (cons (car face-list) | 497 (active-list (list (car face-list))) |
499 (facemenu-discard-redundant-faces | 498 (face-list (cdr face-list)) |
500 (cdr face-list) | 499 (mask-len (length mask-atts))) |
501 (copy-sequence (internal-get-face (car face-list)))))) | 500 (while face-list |
502 ((let ((i (length mask)) | 501 (if (let ((face-atts (internal-get-face (car face-list) frame)) |
503 (face (internal-get-face (car face-list)))) | 502 (i mask-len) (useful nil)) |
504 (while (>= (setq i (1- i)) 0) | 503 (while (> (setq i (1- i)) 1) |
505 (if (and (aref face i) | 504 (and (aref face-atts i) (not (aref mask-atts i)) |
506 (not (aref mask i))) | 505 (aset mask-atts i (setq useful t)))) |
507 (progn (setq useful t) | 506 useful) |
508 (aset mask i t)))) | 507 (setq active-list (cons (car face-list) active-list))) |
509 useful) | 508 (setq face-list (cdr face-list))) |
510 (cons (car face-list) | 509 (nreverse active-list))) |
511 (facemenu-discard-redundant-faces (cdr face-list) mask))) | |
512 (t (facemenu-discard-redundant-faces (cdr face-list) mask))))) | |
513 | 510 |
514 (defun facemenu-get-face (symbol) | 511 (defun facemenu-get-face (symbol) |
515 "Make sure FACE exists. | 512 "Make sure FACE exists. |
516 If not, it is created. If it is created and is of the form `fg:color', then | 513 If not, it is created. If it is created and is of the form `fg:color', then |
517 set the foreground to that color. If of the form `bg:color', set the | 514 set the foreground to that color. If of the form `bg:color', set the |