emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/facemenu.el


From: Richard M. Stallman
Subject: [Emacs-diffs] Changes to emacs/lisp/facemenu.el
Date: Mon, 15 Apr 2002 18:05:30 -0400

Index: emacs/lisp/facemenu.el
diff -c emacs/lisp/facemenu.el:1.62 emacs/lisp/facemenu.el:1.63
*** emacs/lisp/facemenu.el:1.62 Mon Apr 15 06:25:03 2002
--- emacs/lisp/facemenu.el      Mon Apr 15 18:05:30 2002
***************
*** 363,369 ****
                         (region-end))))
    (unless (color-defined-p color)
      (message "Color `%s' undefined" color))
!   (facemenu-add-new-face color 'facemenu-foreground-menu)
    (facemenu-add-face (list (list :foreground color)) start end))
  
  ;;;###autoload
--- 363,369 ----
                         (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
***************
*** 387,393 ****
                         (region-end))))
    (unless (color-defined-p color)
      (message "Color `%s' undefined" color))
!   (facemenu-add-new-face color 'facemenu-background-menu)
    (facemenu-add-face (list (list :background color)) start end))
  
  ;;;###autoload
--- 387,393 ----
                         (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
***************
*** 805,841 ****
          (t (make-face symbol))))
    symbol)
  
! (defun facemenu-add-new-face (face-or-color &optional menu)
!   "Add FACE-OR-COLOR (a face or a color) to the appropriate 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.
  
  This is called whenever you create a new face."
    (let* (name
         symbol
!        docstring
!        (key (cdr (assoc face-or-color facemenu-keybindings)))
         function menu-val)
!     (if (symbolp face-or-color)
!       (setq name (symbol-name face-or-color)
!             symbol face-or-color)
!       (setq name face-or-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)))
!         (t
!          (setq menu 'facemenu-face-menu)
!          (setq docstring
!                (format "Select face `%s' for subsequent insertion."
!                        name))))
      (cond ((eq t facemenu-unlisted-faces))
          ((memq symbol facemenu-unlisted-faces))
          ;; test against regexps in facemenu-unlisted-faces
--- 805,828 ----
          (t (make-face symbol))))
    symbol)
  
! (defun facemenu-add-new-face (face)
!   "Add FACE (a face) to the Face menu.
  
  This is called whenever you create a new face."
    (let* (name
         symbol
!        menu docstring
!        (key (cdr (assoc face facemenu-keybindings)))
         function menu-val)
!     (if (symbolp face)
!       (setq name (symbol-name face)
!             symbol face)
!       (setq name face
            symbol (intern name)))
!     (setq menu 'facemenu-face-menu)
!     (setq docstring
!         (format "Select face `%s' for subsequent insertion."
!                 name))
      (cond ((eq t facemenu-unlisted-faces))
          ((memq symbol facemenu-unlisted-faces))
          ;; test against regexps in facemenu-unlisted-faces
***************
*** 865,870 ****
--- 852,899 ----
            (lambda (m) (and (listp m) 
                             (symbolp (car m))
                             (face-equal (car m) symbol)))
+           (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-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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]