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

[Lute Kamstra]

Index: emacs/lisp/facemenu.el
diff -c emacs/lisp/facemenu.el:1.78 emacs/lisp/facemenu.el:1.79
*** emacs/lisp/facemenu.el:1.78 Sat Jun 25 22:24:10 2005
--- emacs/lisp/facemenu.el      Mon Jun 27 07:30:53 2005
***************
*** 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.
  
  ;; Author: Boris Goldowsky <address@hidden>
  ;; Keywords: faces
--- 1,6 ----
  ;;; facemenu.el --- create a face menu for interactively adding fonts to text
  
! ;; Copyright (c) 1994, 1995, 1996, 2001, 2002, 2005 Free Software Foundation, 
Inc.
  
  ;; Author: Boris Goldowsky <address@hidden>
  ;; Keywords: faces
***************
*** 135,141 ****
    `(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-"))
    "*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
--- 135,142 ----
    `(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 "^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,374 ****
                         (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)
--- 366,373 ----
                         (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)
***************
*** 389,398 ****
                         (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)
--- 388,395 ----
                         (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)
***************
*** 413,419 ****
                     (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)))
--- 410,415 ----
***************
*** 648,661 ****
        (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.
  
--- 644,649 ----
***************
*** 715,761 ****
             (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.
--- 703,746 ----
             (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.