Re: foreground menu bug

[Lute Kamstra <Lute.Kamstra.lists@xs4all.nl>]

Hi Werner,

> [emacs CVS 2005-06-12 with GTK]
>
> If I mark a text region and select the menu entry
>
>   Edit->Text Properties->Foreground Color->Other...
>
> I can select a colour (say, red) and everything is fine.
>
> After doing that, the colour `red' is added to the last submenu so
> that it can be accessed as
>
>   Edit->Text Properties->Foreground Color->red
>
> Doing this on another region, it is *not* coloured.
>
> IMHO, this is a bug.

Could you test this patch?

Lute.


Index: lisp/facemenu.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/facemenu.el,v
retrieving revision 1.77
diff -c -r1.77 facemenu.el
*** lisp/facemenu.el	8 Mar 2005 21:47:03 -0000	1.77
--- lisp/facemenu.el	20 Jun 2005 08:24:46 -0000
***************
*** 358,367 ****
  			 (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))
  
  ;;;###autoload
  (defun facemenu-set-background (color &optional start end)
--- 358,365 ----
  			 (region-beginning))
  		     (if (and mark-active (not current-prefix-arg))
  			 (region-end))))
!   (facemenu-add-face (facemenu-add-new-color color 'facemenu-foreground-menu)
! 		     start end))
  
  ;;;###autoload
  (defun facemenu-set-background (color &optional start end)
***************
*** 382,391 ****
  			 (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))
  
  ;;;###autoload
  (defun facemenu-set-face-from-menu (face start end)
--- 380,387 ----
  			 (region-beginning))
  		     (if (and mark-active (not current-prefix-arg))
  			 (region-end))))
!   (facemenu-add-face (facemenu-add-new-color color 'facemenu-background-menu)
! 		     start end))
  
  ;;;###autoload
  (defun facemenu-set-face-from-menu (face start end)
***************
*** 406,412 ****
  		     (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)))
--- 402,407 ----
***************
*** 641,654 ****
        (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.
  
--- 636,641 ----
***************
*** 708,754 ****
  	     (define-key menu key (cons name function))))))
    nil) ; Return nil for facemenu-iterate
  
! (defun facemenu-add-new-color (color &optional menu)
    "Add COLOR (a color name string) to the appropriate Face menu.
! MENU should be `facemenu-foreground-menu' or
! `facemenu-background-menu'.
  
  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))
! 
      (cond ((eq menu 'facemenu-foreground-menu)
  	   (setq docstring
  		 (format "Select foreground color %s for subsequent insertion."
! 			 name)))
  	  ((eq menu 'facemenu-background-menu)
  	   (setq docstring
  		 (format "Select background color %s for subsequent insertion."
! 			 name))))
      (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
  
  (defun facemenu-complete-face-list (&optional oldlist)
    "Return list of all faces that look different.
--- 695,738 ----
  	     (define-key menu key (cons name function))))))
    nil) ; Return nil for facemenu-iterate
  
! (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'.
! Create the appropriate face and return it.
  
  This is called whenever you use a new color."
!   (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."
! 			 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."
! 			 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:
! 	   (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.