(facemenu-unlisted-faces): Add foreground and background color faces.

(facemenu-get-face): Delete function.
(facemenu-set-face-from-menu): Don't call facemenu-get-face.
(facemenu-add-new-color): Make second argument mandatory.  Create the
approprate face and return it.  Simplify.
(facemenu-set-foreground, facemenu-set-background): Don't check if
color is defined.  Use return value of facemenu-add-new-color.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 116b018abe16ee90425de5f1357c06977a38bf8c..152a126a5e5d76260861424f2cc1a43c83eb6ef2 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2005-06-27  Lute Kamstra  <lute@gnu.org>
+
+       * facemenu.el (facemenu-unlisted-faces): Add foreground and
+       background color faces.
+       (facemenu-get-face): Delete function.
+       (facemenu-set-face-from-menu): Don't call facemenu-get-face.
+       (facemenu-add-new-color): Make second argument mandatory.  Create
+       the approprate face and return it.  Simplify.
+       (facemenu-set-foreground, facemenu-set-background): Don't check if
+       color is defined.  Use return value of facemenu-add-new-color.
+
 2005-06-26  Nick Roberts  <nickrob@snap.net.nz>
 
        * progmodes/gud.el (gud-filter): Add missing argument to

diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 57dea40266a9443159c2d1438306767eef2d9d5d..18023511c206d9e697ce93be1c25a03917819723 100644 (file)
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -1,6 +1,6 @@
 ;;; facemenu.el --- create a face menu for interactively adding fonts to text
 
-;; Copyright (c) 1994, 1995, 1996, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2005 Free Software Foundation, Inc.
 
 ;; Author: Boris Goldowsky <boris@gnu.org>
 ;; Keywords: faces
@@ -135,7 +135,8 @@ just before \"Other\" at the end."
   `(modeline region secondary-selection highlight scratch-face
     ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")
     ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")
-    ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-"))
+    ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")
+    ,(purecopy "^fg:") ,(purecopy "^bg:"))
   "*List of faces not to include in the Face menu.
 Each element may be either a symbol, which is the name of a face, or a string,
 which is a regular expression to be matched against face names.  Matching
@@ -365,10 +366,8 @@ typing a character to insert cancels the specification."
                         (region-beginning))
                     (if (and mark-active (not current-prefix-arg))
                         (region-end))))
-  (unless (color-defined-p color)
-    (message "Color `%s' undefined" color))
-  (facemenu-add-new-color color 'facemenu-foreground-menu)
-  (facemenu-add-face (list (list :foreground color)) start end))
+  (facemenu-add-face (facemenu-add-new-color color 'facemenu-foreground-menu)
+                    start end))
 
 ;;;###autoload
 (defun facemenu-set-background (color &optional start end)
@@ -389,10 +388,8 @@ typing a character to insert cancels the specification."
                         (region-beginning))
                     (if (and mark-active (not current-prefix-arg))
                         (region-end))))
-  (unless (color-defined-p color)
-    (message "Color `%s' undefined" color))
-  (facemenu-add-new-color color 'facemenu-background-menu)
-  (facemenu-add-face (list (list :background color)) start end))
+  (facemenu-add-face (facemenu-add-new-color color 'facemenu-background-menu)
+                    start end))
 
 ;;;###autoload
 (defun facemenu-set-face-from-menu (face start end)
@@ -413,7 +410,6 @@ typing a character to insert cancels the specification."
                     (if (and mark-active (not current-prefix-arg))
                         (region-end))))
   (barf-if-buffer-read-only)
-  (facemenu-get-face face)
   (if start
       (facemenu-add-face face start end)
     (facemenu-add-face face)))
@@ -648,14 +644,6 @@ use the selected frame.  If t, then the global, non-frame faces are used."
       (setq face-list (cdr face-list)))
     (nreverse active-list)))
 
-(defun facemenu-get-face (symbol)
-  "Make sure FACE exists.
-If not, create it and add it to the appropriate menu.  Return the SYMBOL."
-  (let ((name (symbol-name symbol)))
-    (cond ((facep symbol))
-         (t (make-face symbol))))
-  symbol)
-
 (defun facemenu-add-new-face (face)
   "Add FACE (a face) to the Face menu.
 
@@ -715,47 +703,44 @@ This is called whenever you create a new face."
             (define-key menu key (cons name function))))))
   nil) ; Return nil for facemenu-iterate
 
-(defun facemenu-add-new-color (color &optional menu)
+(defun facemenu-add-new-color (color menu)
   "Add COLOR (a color name string) to the appropriate Face menu.
-MENU should be `facemenu-foreground-menu' or
-`facemenu-background-menu'.
+MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'.
+Create the appropriate face and return it.
 
 This is called whenever you use a new color."
-  (let* (name
-        symbol
-        docstring
-        function menu-val key
-        (color-p (memq menu '(facemenu-foreground-menu
-                              facemenu-background-menu))))
-    (unless (stringp color)
-      (error "%s is not a color" color))
-    (setq name color
-         symbol (intern name))
-
+  (let (symbol docstring)
+    (unless (color-defined-p color)
+      (error "Color `%s' undefined" color))
     (cond ((eq menu 'facemenu-foreground-menu)
           (setq docstring
                 (format "Select foreground color %s for subsequent insertion."
-                        name)))
+                        color)
+                symbol (intern (concat "fg:" color)))
+          (set-face-foreground (make-face symbol) color))
          ((eq menu 'facemenu-background-menu)
           (setq docstring
                 (format "Select background color %s for subsequent insertion."
-                        name))))
+                        color)
+                symbol (intern (concat "bg:" color)))
+          (set-face-background (make-face symbol) color))
+         (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'")))
     (cond ((facemenu-iterate ; check if equivalent face is already in the menu
            (lambda (m) (and (listp m)
                             (symbolp (car m))
                             (stringp (cadr m))
                             (string-equal (cadr m) color)))
            (cdr (symbol-function menu))))
-         (t   ; No keyboard equivalent.  Figure out where to put it:
-          (setq key (vector symbol)
-                function 'facemenu-set-face-from-menu
-                menu-val (symbol-function menu))
-          (if (and facemenu-new-faces-at-end
-                  (> (length menu-val) 3))
-              (define-key-after menu-val key (cons name function)
-                (car (nth (- (length menu-val) 3) menu-val)))
-            (define-key menu key (cons name function))))))
-  nil) ; Return nil for facemenu-iterate
+         (t    ; No keyboard equivalent.  Figure out where to put it:
+          (let ((key (vector symbol))
+                (function 'facemenu-set-face-from-menu)
+                (menu-val (symbol-function menu)))
+            (if (and facemenu-new-faces-at-end
+                     (> (length menu-val) 3))
+                (define-key-after menu-val key (cons color function)
+                  (car (nth (- (length menu-val) 3) menu-val)))
+              (define-key menu key (cons color function))))))
+    symbol))
 
 (defun facemenu-complete-face-list (&optional oldlist)
   "Return list of all faces that look different.