363 |
(region-end)))) |
(region-end)))) |
364 |
(unless (color-defined-p color) |
(unless (color-defined-p color) |
365 |
(message "Color `%s' undefined" color)) |
(message "Color `%s' undefined" color)) |
366 |
(facemenu-add-new-face color 'facemenu-foreground-menu) |
(facemenu-add-new-color color 'facemenu-foreground-menu) |
367 |
(facemenu-add-face (list (list :foreground color)) start end)) |
(facemenu-add-face (list (list :foreground color)) start end)) |
368 |
|
|
369 |
;;;###autoload |
;;;###autoload |
387 |
(region-end)))) |
(region-end)))) |
388 |
(unless (color-defined-p color) |
(unless (color-defined-p color) |
389 |
(message "Color `%s' undefined" color)) |
(message "Color `%s' undefined" color)) |
390 |
(facemenu-add-new-face color 'facemenu-background-menu) |
(facemenu-add-new-color color 'facemenu-background-menu) |
391 |
(facemenu-add-face (list (list :background color)) start end)) |
(facemenu-add-face (list (list :background color)) start end)) |
392 |
|
|
393 |
;;;###autoload |
;;;###autoload |
805 |
(t (make-face symbol)))) |
(t (make-face symbol)))) |
806 |
symbol) |
symbol) |
807 |
|
|
808 |
(defun facemenu-add-new-face (face-or-color &optional menu) |
(defun facemenu-add-new-face (face) |
809 |
"Add FACE-OR-COLOR (a face or a color) to the appropriate Face menu. |
"Add FACE (a face) to the Face menu. |
|
If MENU is nil, then FACE-OR-COLOR is a face to be added |
|
|
to `facemenu-face-menu'. If MENU is `facemenu-foreground-menu' |
|
|
or `facemenu-background-menu', FACE-OR-COLOR is a color |
|
|
to be added to the specified menu. |
|
810 |
|
|
811 |
This is called whenever you create a new face." |
This is called whenever you create a new face." |
812 |
(let* (name |
(let* (name |
813 |
symbol |
symbol |
814 |
docstring |
menu docstring |
815 |
(key (cdr (assoc face-or-color facemenu-keybindings))) |
(key (cdr (assoc face facemenu-keybindings))) |
816 |
function menu-val) |
function menu-val) |
817 |
(if (symbolp face-or-color) |
(if (symbolp face) |
818 |
(setq name (symbol-name face-or-color) |
(setq name (symbol-name face) |
819 |
symbol face-or-color) |
symbol face) |
820 |
(setq name face-or-color |
(setq name face |
821 |
symbol (intern name))) |
symbol (intern name))) |
822 |
(cond ((eq menu 'facemenu-foreground-menu) |
(setq menu 'facemenu-face-menu) |
823 |
(setq docstring |
(setq docstring |
824 |
(format "Select foreground color %s for subsequent insertion." |
(format "Select face `%s' for subsequent insertion." |
825 |
name))) |
name)) |
|
((eq menu 'facemenu-background-menu) |
|
|
(setq docstring |
|
|
(format "Select background color %s for subsequent insertion." |
|
|
name))) |
|
|
(t |
|
|
(setq menu 'facemenu-face-menu) |
|
|
(setq docstring |
|
|
(format "Select face `%s' for subsequent insertion." |
|
|
name)))) |
|
826 |
(cond ((eq t facemenu-unlisted-faces)) |
(cond ((eq t facemenu-unlisted-faces)) |
827 |
((memq symbol facemenu-unlisted-faces)) |
((memq symbol facemenu-unlisted-faces)) |
828 |
;; test against regexps in facemenu-unlisted-faces |
;; test against regexps in facemenu-unlisted-faces |
855 |
(cdr (symbol-function menu)))) |
(cdr (symbol-function menu)))) |
856 |
(t ; No keyboard equivalent. Figure out where to put it: |
(t ; No keyboard equivalent. Figure out where to put it: |
857 |
(setq key (vector symbol) |
(setq key (vector symbol) |
858 |
|
function 'facemenu-set-face-from-menu |
859 |
|
menu-val (symbol-function menu)) |
860 |
|
(if (and facemenu-new-faces-at-end |
861 |
|
(> (length menu-val) 3)) |
862 |
|
(define-key-after menu-val key (cons name function) |
863 |
|
(car (nth (- (length menu-val) 3) menu-val))) |
864 |
|
(define-key menu key (cons name function)))))) |
865 |
|
nil) ; Return nil for facemenu-iterate |
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 |
function 'facemenu-set-face-from-menu |
901 |
menu-val (symbol-function menu)) |
menu-val (symbol-function menu)) |
902 |
(if (and facemenu-new-faces-at-end |
(if (and facemenu-new-faces-at-end |