/[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.80 by rms, Tue Jun 28 18:55:48 2005 UTC revision 1.81 by lute, Fri Jul 1 08:28:26 2005 UTC
# Line 135  just before \"Other\" at the end." Line 135  just before \"Other\" at the end."
135    `(modeline region secondary-selection highlight scratch-face    `(modeline region secondary-selection highlight scratch-face
136      ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")      ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-")
137      ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")      ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-")
138      ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")      ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-"))
     ,(purecopy "^fg:") ,(purecopy "^bg:"))  
139    "*List of faces not to include in the Face menu.    "*List of faces not to include in the Face menu.
140  Each element may be either a symbol, which is the name of a face, or a string,  Each element may be either a symbol, which is the name of a face, or a string,
141  which is a regular expression to be matched against face names.  Matching  which is a regular expression to be matched against face names.  Matching
# Line 366  typing a character to insert cancels the Line 365  typing a character to insert cancels the
365                           (region-beginning))                           (region-beginning))
366                       (if (and mark-active (not current-prefix-arg))                       (if (and mark-active (not current-prefix-arg))
367                           (region-end))))                           (region-end))))
368    (facemenu-add-face (facemenu-add-new-color color 'facemenu-foreground-menu)    (facemenu-set-face-from-menu
369                       start end))     (facemenu-add-new-color color 'facemenu-foreground-menu)
370       start end))
371    
372  ;;;###autoload  ;;;###autoload
373  (defun facemenu-set-background (color &optional start end)  (defun facemenu-set-background (color &optional start end)
# Line 388  typing a character to insert cancels the Line 388  typing a character to insert cancels the
388                           (region-beginning))                           (region-beginning))
389                       (if (and mark-active (not current-prefix-arg))                       (if (and mark-active (not current-prefix-arg))
390                           (region-end))))                           (region-end))))
391    (facemenu-add-face (facemenu-add-new-color color 'facemenu-background-menu)    (facemenu-set-face-from-menu
392                       start end))     (facemenu-add-new-color color 'facemenu-background-menu)
393       start end))
394    
395  ;;;###autoload  ;;;###autoload
396  (defun facemenu-set-face-from-menu (face start end)  (defun facemenu-set-face-from-menu (face start end)
397    "Set the FACE of the region or next character typed.    "Set the FACE of the region or next character typed.
398  This function is designed to be called from a menu; the face to use  This function is designed to be called from a menu; FACE is determined
399  is the menu item's name.  using the event type of the menu entry.  If FACE is a symbol whose
400    name starts with \"fg:\" or \"bg:\", then this functions sets the
401    foreground or background to the color specified by the rest of the
402    symbol's name.  Any other symbol is considered the name of a face.
403    
404  If the region is active (normally true except in Transient Mark mode)  If the region is active (normally true except in Transient Mark mode)
405  and there is no prefix argument, this command sets the region to the  and there is no prefix argument, this command sets the region to the
406  requested face.  requested face.
407    
408  Otherwise, this command specifies the face for the next character  Otherwise, this command specifies the face for the next character
409  inserted.  Moving point or switching buffers before  inserted.  Moving point or switching buffers before typing a character
410  typing a character to insert cancels the specification."  to insert cancels the specification."
411    (interactive (list last-command-event    (interactive (list last-command-event
412                       (if (and mark-active (not current-prefix-arg))                       (if (and mark-active (not current-prefix-arg))
413                           (region-beginning))                           (region-beginning))
414                       (if (and mark-active (not current-prefix-arg))                       (if (and mark-active (not current-prefix-arg))
415                           (region-end))))                           (region-end))))
416    (barf-if-buffer-read-only)    (barf-if-buffer-read-only)
417    (if start    (facemenu-add-face
418        (facemenu-add-face face start end)     (let ((fn (symbol-name face)))
419      (facemenu-add-face face)))       (if (string-match "\\`\\([fb]\\)g:\\(.+\\)" fn)
420             (list (list (if (string= (match-string 1 fn) "f")
421                             :foreground
422                           :background)
423                         (match-string 2 fn)))
424           face))
425       start end))
426    
427  ;;;###autoload  ;;;###autoload
428  (defun facemenu-set-invisible (start end)  (defun facemenu-set-invisible (start end)
# Line 708  This is called whenever you create a new Line 718  This is called whenever you create a new
718  (defun facemenu-add-new-color (color menu)  (defun facemenu-add-new-color (color menu)
719    "Add COLOR (a color name string) to the appropriate Face menu.    "Add COLOR (a color name string) to the appropriate Face menu.
720  MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'.  MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'.
721  Create the appropriate face and return it.  Return the event type (a symbol) of the added menu entry.
722    
723  This is called whenever you use a new color."  This is called whenever you use a new color."
724    (let (symbol docstring)    (let (symbol docstring)
# Line 718  This is called whenever you use a new co Line 728  This is called whenever you use a new co
728             (setq docstring             (setq docstring
729                   (format "Select foreground color %s for subsequent insertion."                   (format "Select foreground color %s for subsequent insertion."
730                           color)                           color)
731                   symbol (intern (concat "fg:" color)))                   symbol (intern (concat "fg:" color))))
            (set-face-foreground (make-face symbol) color))  
732            ((eq menu 'facemenu-background-menu)            ((eq menu 'facemenu-background-menu)
733             (setq docstring             (setq docstring
734                   (format "Select background color %s for subsequent insertion."                   (format "Select background color %s for subsequent insertion."
735                           color)                           color)
736                   symbol (intern (concat "bg:" color)))                   symbol (intern (concat "bg:" color))))
            (set-face-background (make-face symbol) color))  
737            (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'")))            (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'")))
738      (cond ((facemenu-iterate ; check if equivalent face is already in the menu      (unless (facemenu-iterate ; Check if color is already in the menu.
739              (lambda (m) (and (listp m)               (lambda (m) (and (listp m)
740                               (symbolp (car m))                                (eq (car m) symbol)))
741                               (stringp (cadr m))               (cdr (symbol-function menu)))
742                               (string-equal (cadr m) color)))        ;; Color is not in the menu.  Figure out where to put it.
743              (cdr (symbol-function menu))))        (let ((key (vector symbol))
744            (t    ; No keyboard equivalent.  Figure out where to put it:              (function 'facemenu-set-face-from-menu)
745             (let ((key (vector symbol))              (menu-val (symbol-function menu)))
746                   (function 'facemenu-set-face-from-menu)          (if (and facemenu-new-faces-at-end
747                   (menu-val (symbol-function menu)))                   (> (length menu-val) 3))
748               (if (and facemenu-new-faces-at-end              (define-key-after menu-val key (cons color function)
749                        (> (length menu-val) 3))                (car (nth (- (length menu-val) 3) menu-val)))
750                   (define-key-after menu-val key (cons color function)            (define-key menu key (cons color function)))))
                    (car (nth (- (length menu-val) 3) menu-val)))  
                (define-key menu key (cons color function))))))  
751      symbol))      symbol))
752    
753  (defun facemenu-complete-face-list (&optional oldlist)  (defun facemenu-complete-face-list (&optional oldlist)

Legend:
Removed from v.1.80  
changed lines
  Added in v.1.81

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