Mercurial > emacs
comparison lisp/facemenu.el @ 44611:e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
(facemenu-add-new-color): New function.
(facemenu-set-foreground, facemenu-set-background):
Use facemenu-add-new-color.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 15 Apr 2002 22:05:30 +0000 |
| parents | cb86689199f8 |
| children | 352a26294253 |
comparison
equal
deleted
inserted
replaced
| 44610:2ce169c14700 | 44611:e4a2909015d3 |
|---|---|
| 361 (region-beginning)) | 361 (region-beginning)) |
| 362 (if (and mark-active (not current-prefix-arg)) | 362 (if (and mark-active (not current-prefix-arg)) |
| 363 (region-end)))) | 363 (region-end)))) |
| 364 (unless (color-defined-p color) | 364 (unless (color-defined-p color) |
| 365 (message "Color `%s' undefined" color)) | 365 (message "Color `%s' undefined" color)) |
| 366 (facemenu-add-new-face color 'facemenu-foreground-menu) | 366 (facemenu-add-new-color color 'facemenu-foreground-menu) |
| 367 (facemenu-add-face (list (list :foreground color)) start end)) | 367 (facemenu-add-face (list (list :foreground color)) start end)) |
| 368 | 368 |
| 369 ;;;###autoload | 369 ;;;###autoload |
| 370 (defun facemenu-set-background (color &optional start end) | 370 (defun facemenu-set-background (color &optional start end) |
| 371 "Set the background COLOR of the region or next character typed. | 371 "Set the background COLOR of the region or next character typed. |
| 385 (region-beginning)) | 385 (region-beginning)) |
| 386 (if (and mark-active (not current-prefix-arg)) | 386 (if (and mark-active (not current-prefix-arg)) |
| 387 (region-end)))) | 387 (region-end)))) |
| 388 (unless (color-defined-p color) | 388 (unless (color-defined-p color) |
| 389 (message "Color `%s' undefined" color)) | 389 (message "Color `%s' undefined" color)) |
| 390 (facemenu-add-new-face color 'facemenu-background-menu) | 390 (facemenu-add-new-color color 'facemenu-background-menu) |
| 391 (facemenu-add-face (list (list :background color)) start end)) | 391 (facemenu-add-face (list (list :background color)) start end)) |
| 392 | 392 |
| 393 ;;;###autoload | 393 ;;;###autoload |
| 394 (defun facemenu-set-face-from-menu (face start end) | 394 (defun facemenu-set-face-from-menu (face start end) |
| 395 "Set the FACE of the region or next character typed. | 395 "Set the FACE of the region or next character typed. |
| 803 (let ((name (symbol-name symbol))) | 803 (let ((name (symbol-name symbol))) |
| 804 (cond ((facep symbol)) | 804 (cond ((facep symbol)) |
| 805 (t (make-face symbol)))) | 805 (t (make-face symbol)))) |
| 806 symbol) | 806 symbol) |
| 807 | 807 |
| 808 (defun facemenu-add-new-face (face-or-color &optional menu) | 808 (defun facemenu-add-new-face (face) |
| 809 "Add FACE-OR-COLOR (a face or a color) to the appropriate Face menu. | 809 "Add FACE (a face) to the Face menu. |
| 810 If MENU is nil, then FACE-OR-COLOR is a face to be added | |
| 811 to `facemenu-face-menu'. If MENU is `facemenu-foreground-menu' | |
| 812 or `facemenu-background-menu', FACE-OR-COLOR is a color | |
| 813 to be added to the specified menu. | |
| 814 | 810 |
| 815 This is called whenever you create a new face." | 811 This is called whenever you create a new face." |
| 816 (let* (name | 812 (let* (name |
| 817 symbol | 813 symbol |
| 818 docstring | 814 menu docstring |
| 819 (key (cdr (assoc face-or-color facemenu-keybindings))) | 815 (key (cdr (assoc face facemenu-keybindings))) |
| 820 function menu-val) | 816 function menu-val) |
| 821 (if (symbolp face-or-color) | 817 (if (symbolp face) |
| 822 (setq name (symbol-name face-or-color) | 818 (setq name (symbol-name face) |
| 823 symbol face-or-color) | 819 symbol face) |
| 824 (setq name face-or-color | 820 (setq name face |
| 825 symbol (intern name))) | 821 symbol (intern name))) |
| 826 (cond ((eq menu 'facemenu-foreground-menu) | 822 (setq menu 'facemenu-face-menu) |
| 827 (setq docstring | 823 (setq docstring |
| 828 (format "Select foreground color %s for subsequent insertion." | 824 (format "Select face `%s' for subsequent insertion." |
| 829 name))) | 825 name)) |
| 830 ((eq menu 'facemenu-background-menu) | |
| 831 (setq docstring | |
| 832 (format "Select background color %s for subsequent insertion." | |
| 833 name))) | |
| 834 (t | |
| 835 (setq menu 'facemenu-face-menu) | |
| 836 (setq docstring | |
| 837 (format "Select face `%s' for subsequent insertion." | |
| 838 name)))) | |
| 839 (cond ((eq t facemenu-unlisted-faces)) | 826 (cond ((eq t facemenu-unlisted-faces)) |
| 840 ((memq symbol facemenu-unlisted-faces)) | 827 ((memq symbol facemenu-unlisted-faces)) |
| 841 ;; test against regexps in facemenu-unlisted-faces | 828 ;; test against regexps in facemenu-unlisted-faces |
| 842 ((let ((unlisted facemenu-unlisted-faces) | 829 ((let ((unlisted facemenu-unlisted-faces) |
| 843 (matched nil)) | 830 (matched nil)) |
| 875 (define-key-after menu-val key (cons name function) | 862 (define-key-after menu-val key (cons name function) |
| 876 (car (nth (- (length menu-val) 3) menu-val))) | 863 (car (nth (- (length menu-val) 3) menu-val))) |
| 877 (define-key menu key (cons name function)))))) | 864 (define-key menu key (cons name function)))))) |
| 878 nil) ; Return nil for facemenu-iterate | 865 nil) ; Return nil for facemenu-iterate |
| 879 | 866 |
| 867 (defun facemenu-add-new-color (color &optional menu) | |
| 868 "Add COLOR (a color name string) to the appropriate Face menu. | |
| 869 MENU should be `facemenu-foreground-menu' or | |
| 870 `facemenu-background-menu'. | |
| 871 | |
| 872 This is called whenever you use a new color." | |
| 873 (let* (name | |
| 874 symbol | |
| 875 docstring | |
| 876 function menu-val key | |
| 877 (color-p (memq menu '(facemenu-foreground-menu | |
| 878 facemenu-background-menu)))) | |
| 879 (unless (stringp color) | |
| 880 (error "%s is not a color" color)) | |
| 881 (setq name color | |
| 882 symbol (intern name)) | |
| 883 | |
| 884 (cond ((eq menu 'facemenu-foreground-menu) | |
| 885 (setq docstring | |
| 886 (format "Select foreground color %s for subsequent insertion." | |
| 887 name))) | |
| 888 ((eq menu 'facemenu-background-menu) | |
| 889 (setq docstring | |
| 890 (format "Select background color %s for subsequent insertion." | |
| 891 name)))) | |
| 892 (cond ((facemenu-iterate ; check if equivalent face is already in the menu | |
| 893 (lambda (m) (and (listp m) | |
| 894 (symbolp (car m)) | |
| 895 (stringp (cadr m)) | |
| 896 (string-equal (cadr m) color))) | |
| 897 (cdr (symbol-function menu)))) | |
| 898 (t ; No keyboard equivalent. Figure out where to put it: | |
| 899 (setq key (vector symbol) | |
| 900 function 'facemenu-set-face-from-menu | |
| 901 menu-val (symbol-function menu)) | |
| 902 (if (and facemenu-new-faces-at-end | |
| 903 (> (length menu-val) 3)) | |
| 904 (define-key-after menu-val key (cons name function) | |
| 905 (car (nth (- (length menu-val) 3) menu-val))) | |
| 906 (define-key menu key (cons name function)))))) | |
| 907 nil) ; Return nil for facemenu-iterate | |
| 908 | |
| 880 (defun facemenu-complete-face-list (&optional oldlist) | 909 (defun facemenu-complete-face-list (&optional oldlist) |
| 881 "Return list of all faces that look different. | 910 "Return list of all faces that look different. |
| 882 Starts with given ALIST of faces, and adds elements only if they display | 911 Starts with given ALIST of faces, and adds elements only if they display |
| 883 differently from any face already on the list. | 912 differently from any face already on the list. |
| 884 The faces on ALIST will end up at the end of the returned list, in reverse | 913 The faces on ALIST will end up at the end of the returned list, in reverse |