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 |