/[emacs]/emacs/lisp/facemenu.el
ViewVC logotype

Diff of /emacs/lisp/facemenu.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.62 by andrewi, Mon Apr 15 10:25:03 2002 UTC revision 1.63 by rms, Mon Apr 15 22:05:30 2002 UTC
# Line 363  typing a character to insert cancels the Line 363  typing a character to insert cancels the
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
# Line 387  typing a character to insert cancels the Line 387  typing a character to insert cancels the
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
# Line 805  If not, create it and add it to the appr Line 805  If not, create it and add it to the appr
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
# Line 868  This is called whenever you create a new Line 855  This is called whenever you create a new
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

Legend:
Removed from v.1.62  
changed lines
  Added in v.1.63

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26