Mercurial > emacs
comparison lisp/facemenu.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 37645a051842 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; facemenu.el --- create a face menu for interactively adding fonts to text | 1 ;;; facemenu.el --- create a face menu for interactively adding fonts to text |
2 | 2 |
3 ;; Copyright (c) 1994, 1995, 1996, 2001, 2002 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004, |
4 ;; 2005 Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: Boris Goldowsky <boris@gnu.org> | 6 ;; Author: Boris Goldowsky <boris@gnu.org> |
6 ;; Keywords: faces | 7 ;; Keywords: faces |
7 | 8 |
8 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 ;; GNU General Public License for more details. | 19 ;; GNU General Public License for more details. |
19 | 20 |
20 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02110-1301, USA. |
24 | 25 |
25 ;;; Commentary: | 26 ;;; Commentary: |
26 | 27 |
27 ;; This file defines a menu of faces (bold, italic, etc) which allows you to | 28 ;; This file defines a menu of faces (bold, italic, etc) which allows you to |
28 ;; set the face used for a region of the buffer. Some faces also have | 29 ;; set the face used for a region of the buffer. Some faces also have |
37 ;; region is not active, the face will be remembered and used for the next | 38 ;; region is not active, the face will be remembered and used for the next |
38 ;; insertion. It will be forgotten if you move point or make other | 39 ;; insertion. It will be forgotten if you move point or make other |
39 ;; modifications before inserting or typing anything. | 40 ;; modifications before inserting or typing anything. |
40 ;; | 41 ;; |
41 ;; Faces can be selected from the keyboard as well. | 42 ;; Faces can be selected from the keyboard as well. |
42 ;; The standard keybindings are M-g (or ESC g) + letter: | 43 ;; The standard keybindings are M-o (or ESC o) + letter: |
43 ;; M-g i = "set italic", M-g b = "set bold", etc. | 44 ;; M-o i = "set italic", M-o b = "set bold", etc. |
44 | 45 |
45 ;;; Customization: | 46 ;;; Customization: |
46 ;; An alternative set of keybindings that may be easier to type can be set up | 47 ;; An alternative set of keybindings that may be easier to type can be set up |
47 ;; using "Alt" or "Hyper" keys. This requires that you either have or create | 48 ;; using "Alt" or "Hyper" keys. This requires that you either have or create |
48 ;; an Alt or Hyper key on your keyboard. On my keyboard, there is a key | 49 ;; an Alt or Hyper key on your keyboard. On my keyboard, there is a key |
89 (eval-when-compile | 90 (eval-when-compile |
90 (require 'help) | 91 (require 'help) |
91 (require 'button)) | 92 (require 'button)) |
92 | 93 |
93 ;;; Provide some binding for startup: | 94 ;;; Provide some binding for startup: |
94 ;;;###autoload (define-key global-map "\M-g" 'facemenu-keymap) | 95 ;;;###autoload (define-key global-map "\M-o" 'facemenu-keymap) |
95 ;;;###autoload (autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap) | 96 ;;;###autoload (autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap) |
96 | 97 |
97 ;; Global bindings: | 98 ;; Global bindings: |
98 (define-key global-map [C-down-mouse-2] 'facemenu-menu) | 99 (define-key global-map [C-down-mouse-2] 'facemenu-menu) |
99 (define-key global-map "\M-g" 'facemenu-keymap) | 100 (define-key global-map "\M-o" 'facemenu-keymap) |
100 | 101 |
101 (defgroup facemenu nil | 102 (defgroup facemenu nil |
102 "Create a face menu for interactively adding fonts to text" | 103 "Create a face menu for interactively adding fonts to text." |
103 :group 'faces | 104 :group 'faces |
104 :prefix "facemenu-") | 105 :prefix "facemenu-") |
105 | 106 |
106 (defcustom facemenu-keybindings | 107 (defcustom facemenu-keybindings |
107 '((default . "d") | 108 '((default . "d") |
160 (define-key map "o" (cons "Other..." 'facemenu-set-face)) | 161 (define-key map "o" (cons "Other..." 'facemenu-set-face)) |
161 map) | 162 map) |
162 "Menu keymap for faces.") | 163 "Menu keymap for faces.") |
163 ;;;###autoload | 164 ;;;###autoload |
164 (defalias 'facemenu-face-menu facemenu-face-menu) | 165 (defalias 'facemenu-face-menu facemenu-face-menu) |
166 (put 'facemenu-face-menu 'menu-enable '(facemenu-enable-faces-p)) | |
165 | 167 |
166 ;;;###autoload | 168 ;;;###autoload |
167 (defvar facemenu-foreground-menu | 169 (defvar facemenu-foreground-menu |
168 (let ((map (make-sparse-keymap "Foreground Color"))) | 170 (let ((map (make-sparse-keymap "Foreground Color"))) |
169 (define-key map "o" (cons "Other..." 'facemenu-set-foreground)) | 171 (define-key map "o" (cons "Other..." 'facemenu-set-foreground)) |
170 map) | 172 map) |
171 "Menu keymap for foreground colors.") | 173 "Menu keymap for foreground colors.") |
172 ;;;###autoload | 174 ;;;###autoload |
173 (defalias 'facemenu-foreground-menu facemenu-foreground-menu) | 175 (defalias 'facemenu-foreground-menu facemenu-foreground-menu) |
176 (put 'facemenu-foreground-menu 'menu-enable '(facemenu-enable-faces-p)) | |
174 | 177 |
175 ;;;###autoload | 178 ;;;###autoload |
176 (defvar facemenu-background-menu | 179 (defvar facemenu-background-menu |
177 (let ((map (make-sparse-keymap "Background Color"))) | 180 (let ((map (make-sparse-keymap "Background Color"))) |
178 (define-key map "o" (cons "Other..." 'facemenu-set-background)) | 181 (define-key map "o" (cons "Other..." 'facemenu-set-background)) |
179 map) | 182 map) |
180 "Menu keymap for background colors.") | 183 "Menu keymap for background colors.") |
181 ;;;###autoload | 184 ;;;###autoload |
182 (defalias 'facemenu-background-menu facemenu-background-menu) | 185 (defalias 'facemenu-background-menu facemenu-background-menu) |
186 (put 'facemenu-background-menu 'menu-enable '(facemenu-enable-faces-p)) | |
187 | |
188 ;;; Condition for enabling menu items that set faces. | |
189 (defun facemenu-enable-faces-p () | |
190 (not (and font-lock-mode font-lock-defaults))) | |
183 | 191 |
184 ;;;###autoload | 192 ;;;###autoload |
185 (defvar facemenu-special-menu | 193 (defvar facemenu-special-menu |
186 (let ((map (make-sparse-keymap "Special"))) | 194 (let ((map (make-sparse-keymap "Special"))) |
187 (define-key map [?s] (cons (purecopy "Remove Special") | 195 (define-key map [?s] (cons (purecopy "Remove Special") |
356 (facemenu-read-color "Foreground color: ")) | 364 (facemenu-read-color "Foreground color: ")) |
357 (if (and mark-active (not current-prefix-arg)) | 365 (if (and mark-active (not current-prefix-arg)) |
358 (region-beginning)) | 366 (region-beginning)) |
359 (if (and mark-active (not current-prefix-arg)) | 367 (if (and mark-active (not current-prefix-arg)) |
360 (region-end)))) | 368 (region-end)))) |
361 (unless (color-defined-p color) | 369 (facemenu-set-face-from-menu |
362 (message "Color `%s' undefined" color)) | 370 (facemenu-add-new-color color 'facemenu-foreground-menu) |
363 (facemenu-add-new-color color 'facemenu-foreground-menu) | 371 start end)) |
364 (facemenu-add-face (list (list :foreground color)) start end)) | |
365 | 372 |
366 ;;;###autoload | 373 ;;;###autoload |
367 (defun facemenu-set-background (color &optional start end) | 374 (defun facemenu-set-background (color &optional start end) |
368 "Set the background COLOR of the region or next character typed. | 375 "Set the background COLOR of the region or next character typed. |
369 This command reads the color in the minibuffer. | 376 This command reads the color in the minibuffer. |
380 (facemenu-read-color "Background color: ")) | 387 (facemenu-read-color "Background color: ")) |
381 (if (and mark-active (not current-prefix-arg)) | 388 (if (and mark-active (not current-prefix-arg)) |
382 (region-beginning)) | 389 (region-beginning)) |
383 (if (and mark-active (not current-prefix-arg)) | 390 (if (and mark-active (not current-prefix-arg)) |
384 (region-end)))) | 391 (region-end)))) |
385 (unless (color-defined-p color) | 392 (facemenu-set-face-from-menu |
386 (message "Color `%s' undefined" color)) | 393 (facemenu-add-new-color color 'facemenu-background-menu) |
387 (facemenu-add-new-color color 'facemenu-background-menu) | 394 start end)) |
388 (facemenu-add-face (list (list :background color)) start end)) | |
389 | 395 |
390 ;;;###autoload | 396 ;;;###autoload |
391 (defun facemenu-set-face-from-menu (face start end) | 397 (defun facemenu-set-face-from-menu (face start end) |
392 "Set the FACE of the region or next character typed. | 398 "Set the FACE of the region or next character typed. |
393 This function is designed to be called from a menu; the face to use | 399 This function is designed to be called from a menu; FACE is determined |
394 is the menu item's name. | 400 using the event type of the menu entry. If FACE is a symbol whose |
401 name starts with \"fg:\" or \"bg:\", then this functions sets the | |
402 foreground or background to the color specified by the rest of the | |
403 symbol's name. Any other symbol is considered the name of a face. | |
395 | 404 |
396 If the region is active (normally true except in Transient Mark mode) | 405 If the region is active (normally true except in Transient Mark mode) |
397 and there is no prefix argument, this command sets the region to the | 406 and there is no prefix argument, this command sets the region to the |
398 requested face. | 407 requested face. |
399 | 408 |
400 Otherwise, this command specifies the face for the next character | 409 Otherwise, this command specifies the face for the next character |
401 inserted. Moving point or switching buffers before | 410 inserted. Moving point or switching buffers before typing a character |
402 typing a character to insert cancels the specification." | 411 to insert cancels the specification." |
403 (interactive (list last-command-event | 412 (interactive (list last-command-event |
404 (if (and mark-active (not current-prefix-arg)) | 413 (if (and mark-active (not current-prefix-arg)) |
405 (region-beginning)) | 414 (region-beginning)) |
406 (if (and mark-active (not current-prefix-arg)) | 415 (if (and mark-active (not current-prefix-arg)) |
407 (region-end)))) | 416 (region-end)))) |
408 (barf-if-buffer-read-only) | 417 (barf-if-buffer-read-only) |
409 (facemenu-get-face face) | 418 (facemenu-add-face |
410 (if start | 419 (let ((fn (symbol-name face))) |
411 (facemenu-add-face face start end) | 420 (if (string-match "\\`\\([fb]\\)g:\\(.+\\)" fn) |
412 (facemenu-add-face face))) | 421 (list (list (if (string= (match-string 1 fn) "f") |
422 :foreground | |
423 :background) | |
424 (match-string 2 fn))) | |
425 face)) | |
426 start end)) | |
413 | 427 |
414 ;;;###autoload | 428 ;;;###autoload |
415 (defun facemenu-set-invisible (start end) | 429 (defun facemenu-set-invisible (start end) |
416 "Make the region invisible. | 430 "Make the region invisible. |
417 This sets the `invisible' text property; it can be undone with | 431 This sets the `invisible' text property; it can be undone with |
460 start end '(invisible nil intangible nil read-only nil)))) | 474 start end '(invisible nil intangible nil read-only nil)))) |
461 | 475 |
462 ;;;###autoload | 476 ;;;###autoload |
463 (defun facemenu-read-color (&optional prompt) | 477 (defun facemenu-read-color (&optional prompt) |
464 "Read a color using the minibuffer." | 478 "Read a color using the minibuffer." |
465 (let ((col (completing-read (or prompt "Color: ") | 479 (let* ((completion-ignore-case t) |
466 (or facemenu-color-alist | 480 (col (completing-read (or prompt "Color: ") |
467 (defined-colors)) | 481 (or facemenu-color-alist |
468 nil t))) | 482 (defined-colors)) |
483 nil t))) | |
469 (if (equal "" col) | 484 (if (equal "" col) |
470 nil | 485 nil |
471 col))) | 486 col))) |
472 | 487 |
473 ;;;###autoload | 488 ;;;###autoload |
474 (defun list-colors-display (&optional list) | 489 (defun list-colors-display (&optional list buffer-name) |
475 "Display names of defined colors, and show what they look like. | 490 "Display names of defined colors, and show what they look like. |
476 If the optional argument LIST is non-nil, it should be a list of | 491 If the optional argument LIST is non-nil, it should be a list of |
477 colors to display. Otherwise, this command computes a list | 492 colors to display. Otherwise, this command computes a list of |
478 of colors that the current display can handle." | 493 colors that the current display can handle. If the optional |
494 argument BUFFER-NAME is nil, it defaults to *Colors*." | |
479 (interactive) | 495 (interactive) |
480 (when (and (null list) (> (display-color-cells) 0)) | 496 (when (and (null list) (> (display-color-cells) 0)) |
481 (setq list (defined-colors)) | 497 (setq list (list-colors-duplicates (defined-colors))) |
482 ;; Delete duplicate colors. | |
483 (let ((l list)) | |
484 (while (cdr l) | |
485 (if (facemenu-color-equal (car l) (car (cdr l))) | |
486 (setcdr l (cdr (cdr l))) | |
487 (setq l (cdr l))))) | |
488 (when (memq (display-visual-class) '(gray-scale pseudo-color direct-color)) | 498 (when (memq (display-visual-class) '(gray-scale pseudo-color direct-color)) |
489 ;; Don't show more than what the display can handle. | 499 ;; Don't show more than what the display can handle. |
490 (let ((lc (nthcdr (1- (display-color-cells)) list))) | 500 (let ((lc (nthcdr (1- (display-color-cells)) list))) |
491 (if lc | 501 (if lc |
492 (setcdr lc nil))))) | 502 (setcdr lc nil))))) |
493 (with-output-to-temp-buffer "*Colors*" | 503 (with-output-to-temp-buffer (or buffer-name "*Colors*") |
494 (save-excursion | 504 (save-excursion |
495 (set-buffer standard-output) | 505 (set-buffer standard-output) |
496 (let (s) | 506 (setq truncate-lines t) |
497 (while list | 507 (if temp-buffer-show-function |
498 (setq s (point)) | 508 (list-colors-print list) |
499 (insert (car list)) | 509 ;; Call list-colors-print from temp-buffer-show-hook |
500 (indent-to 20) | 510 ;; to get the right value of window-width in list-colors-print |
501 (put-text-property s (point) 'face | 511 ;; after the buffer is displayed. |
502 (cons 'background-color (car list))) | 512 (add-hook 'temp-buffer-show-hook |
503 (setq s (point)) | 513 (lambda () (list-colors-print list)) nil t))))) |
504 (insert " " (car list) "\n") | 514 |
505 (put-text-property s (point) 'face | 515 (defun list-colors-print (list) |
506 (cons 'foreground-color (car list))) | 516 (dolist (color list) |
507 (setq list (cdr list))))))) | 517 (if (consp color) |
518 (if (cdr color) | |
519 (setq color (sort color (lambda (a b) | |
520 (string< (downcase a) | |
521 (downcase b)))))) | |
522 (setq color (list color))) | |
523 (put-text-property | |
524 (prog1 (point) | |
525 (insert (car color)) | |
526 (indent-to 22)) | |
527 (point) | |
528 'face (cons 'background-color (car color))) | |
529 (put-text-property | |
530 (prog1 (point) | |
531 (insert " " (if (cdr color) | |
532 (mapconcat 'identity (cdr color) ", ") | |
533 (car color)))) | |
534 (point) | |
535 'face (cons 'foreground-color (car color))) | |
536 (indent-to (max (- (window-width) 8) 44)) | |
537 (insert (apply 'format "#%02x%02x%02x" | |
538 (mapcar (lambda (c) (lsh c -8)) | |
539 (color-values (car color))))) | |
540 | |
541 (insert "\n")) | |
542 (goto-char (point-min))) | |
543 | |
544 (defun list-colors-duplicates (&optional list) | |
545 "Return a list of colors with grouped duplicate colors. | |
546 If a color has no duplicates, then the element of the returned list | |
547 has the form '(COLOR-NAME). The element of the returned list with | |
548 duplicate colors has the form '(COLOR-NAME DUPLICATE-COLOR-NAME ...). | |
549 This function uses the predicate `facemenu-color-equal' to compare | |
550 color names. If the optional argument LIST is non-nil, it should | |
551 be a list of colors to display. Otherwise, this function uses | |
552 a list of colors that the current display can handle." | |
553 (let* ((list (mapcar 'list (or list (defined-colors)))) | |
554 (l list)) | |
555 (while (cdr l) | |
556 (if (and (facemenu-color-equal (car (car l)) (car (car (cdr l)))) | |
557 (not (if (boundp 'w32-default-color-map) | |
558 (not (assoc (car (car l)) w32-default-color-map))))) | |
559 (progn | |
560 (setcdr (car l) (cons (car (car (cdr l))) (cdr (car l)))) | |
561 (setcdr l (cdr (cdr l)))) | |
562 (setq l (cdr l)))) | |
563 list)) | |
508 | 564 |
509 (defun facemenu-color-equal (a b) | 565 (defun facemenu-color-equal (a b) |
510 "Return t if colors A and B are the same color. | 566 "Return t if colors A and B are the same color. |
511 A and B should be strings naming colors. | 567 A and B should be strings naming colors. |
512 This function queries the display system to find out what the color | 568 This function queries the display system to find out what the color |
565 (setq self-insert-face (if (eq last-command self-insert-face-command) | 621 (setq self-insert-face (if (eq last-command self-insert-face-command) |
566 (cons face (if (listp self-insert-face) | 622 (cons face (if (listp self-insert-face) |
567 self-insert-face | 623 self-insert-face |
568 (list self-insert-face))) | 624 (list self-insert-face))) |
569 face) | 625 face) |
570 self-insert-face-command this-command))))) | 626 self-insert-face-command this-command)))) |
627 (unless (facemenu-enable-faces-p) | |
628 (message "Font-lock mode will override any faces you set in this buffer"))) | |
571 | 629 |
572 (defun facemenu-active-faces (face-list &optional frame) | 630 (defun facemenu-active-faces (face-list &optional frame) |
573 "Return from FACE-LIST those faces that would be used for display. | 631 "Return from FACE-LIST those faces that would be used for display. |
574 This means each face attribute is not specified in a face earlier in FACE-LIST | 632 This means each face attribute is not specified in a face earlier in FACE-LIST |
575 and such a face is therefore active when used to display text. | 633 and such a face is therefore active when used to display text. |
589 (face-attributes-as-vector (car face-list)) | 647 (face-attributes-as-vector (car face-list)) |
590 (or (internal-lisp-face-p (car face-list) frame) | 648 (or (internal-lisp-face-p (car face-list) frame) |
591 (check-face (car face-list))))) | 649 (check-face (car face-list))))) |
592 (i mask-len) | 650 (i mask-len) |
593 (useful nil)) | 651 (useful nil)) |
594 (while (> (setq i (1- i)) 1) | 652 (while (>= (setq i (1- i)) 0) |
595 (and (not (memq (aref face-atts i) '(nil unspecified))) | 653 (and (not (memq (aref face-atts i) '(nil unspecified))) |
596 (memq (aref mask-atts i) '(nil unspecified)) | 654 (memq (aref mask-atts i) '(nil unspecified)) |
597 (aset mask-atts i (setq useful t)))) | 655 (aset mask-atts i (setq useful t)))) |
598 useful) | 656 useful) |
599 (setq active-list (cons (car face-list) active-list))) | 657 (setq active-list (cons (car face-list) active-list))) |
600 (setq face-list (cdr face-list))) | 658 (setq face-list (cdr face-list))) |
601 (nreverse active-list))) | 659 (nreverse active-list))) |
602 | |
603 (defun facemenu-get-face (symbol) | |
604 "Make sure FACE exists. | |
605 If not, create it and add it to the appropriate menu. Return the SYMBOL." | |
606 (let ((name (symbol-name symbol))) | |
607 (cond ((facep symbol)) | |
608 (t (make-face symbol)))) | |
609 symbol) | |
610 | 660 |
611 (defun facemenu-add-new-face (face) | 661 (defun facemenu-add-new-face (face) |
612 "Add FACE (a face) to the Face menu. | 662 "Add FACE (a face) to the Face menu. |
613 | 663 |
614 This is called whenever you create a new face." | 664 This is called whenever you create a new face." |
665 (define-key-after menu-val key (cons name function) | 715 (define-key-after menu-val key (cons name function) |
666 (car (nth (- (length menu-val) 3) menu-val))) | 716 (car (nth (- (length menu-val) 3) menu-val))) |
667 (define-key menu key (cons name function)))))) | 717 (define-key menu key (cons name function)))))) |
668 nil) ; Return nil for facemenu-iterate | 718 nil) ; Return nil for facemenu-iterate |
669 | 719 |
670 (defun facemenu-add-new-color (color &optional menu) | 720 (defun facemenu-add-new-color (color menu) |
671 "Add COLOR (a color name string) to the appropriate Face menu. | 721 "Add COLOR (a color name string) to the appropriate Face menu. |
672 MENU should be `facemenu-foreground-menu' or | 722 MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'. |
673 `facemenu-background-menu'. | 723 Return the event type (a symbol) of the added menu entry. |
674 | 724 |
675 This is called whenever you use a new color." | 725 This is called whenever you use a new color." |
676 (let* (name | 726 (let (symbol docstring) |
677 symbol | 727 (unless (color-defined-p color) |
678 docstring | 728 (error "Color `%s' undefined" color)) |
679 function menu-val key | |
680 (color-p (memq menu '(facemenu-foreground-menu | |
681 facemenu-background-menu)))) | |
682 (unless (stringp color) | |
683 (error "%s is not a color" color)) | |
684 (setq name color | |
685 symbol (intern name)) | |
686 | |
687 (cond ((eq menu 'facemenu-foreground-menu) | 729 (cond ((eq menu 'facemenu-foreground-menu) |
688 (setq docstring | 730 (setq docstring |
689 (format "Select foreground color %s for subsequent insertion." | 731 (format "Select foreground color %s for subsequent insertion." |
690 name))) | 732 color) |
733 symbol (intern (concat "fg:" color)))) | |
691 ((eq menu 'facemenu-background-menu) | 734 ((eq menu 'facemenu-background-menu) |
692 (setq docstring | 735 (setq docstring |
693 (format "Select background color %s for subsequent insertion." | 736 (format "Select background color %s for subsequent insertion." |
694 name)))) | 737 color) |
695 (cond ((facemenu-iterate ; check if equivalent face is already in the menu | 738 symbol (intern (concat "bg:" color)))) |
696 (lambda (m) (and (listp m) | 739 (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'"))) |
697 (symbolp (car m)) | 740 (unless (facemenu-iterate ; Check if color is already in the menu. |
698 (stringp (cadr m)) | 741 (lambda (m) (and (listp m) |
699 (string-equal (cadr m) color))) | 742 (eq (car m) symbol))) |
700 (cdr (symbol-function menu)))) | 743 (cdr (symbol-function menu))) |
701 (t ; No keyboard equivalent. Figure out where to put it: | 744 ;; Color is not in the menu. Figure out where to put it. |
702 (setq key (vector symbol) | 745 (let ((key (vector symbol)) |
703 function 'facemenu-set-face-from-menu | 746 (function 'facemenu-set-face-from-menu) |
704 menu-val (symbol-function menu)) | 747 (menu-val (symbol-function menu))) |
705 (if (and facemenu-new-faces-at-end | 748 (if (and facemenu-new-faces-at-end |
706 (> (length menu-val) 3)) | 749 (> (length menu-val) 3)) |
707 (define-key-after menu-val key (cons name function) | 750 (define-key-after menu-val key (cons color function) |
708 (car (nth (- (length menu-val) 3) menu-val))) | 751 (car (nth (- (length menu-val) 3) menu-val))) |
709 (define-key menu key (cons name function)))))) | 752 (define-key menu key (cons color function))))) |
710 nil) ; Return nil for facemenu-iterate | 753 symbol)) |
711 | 754 |
712 (defun facemenu-complete-face-list (&optional oldlist) | 755 (defun facemenu-complete-face-list (&optional oldlist) |
713 "Return list of all faces that look different. | 756 "Return list of all faces that look different. |
714 Starts with given ALIST of faces, and adds elements only if they display | 757 Starts with given ALIST of faces, and adds elements only if they display |
715 differently from any face already on the list. | 758 differently from any face already on the list. |
732 (car list)) | 775 (car list)) |
733 | 776 |
734 (facemenu-update) | 777 (facemenu-update) |
735 | 778 |
736 (provide 'facemenu) | 779 (provide 'facemenu) |
780 | |
781 ;;; arch-tag: 85f6d02b-9085-420e-b651-0678f0e9c7eb | |
737 ;;; facemenu.el ends here | 782 ;;; facemenu.el ends here |