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 |
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) |
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) |
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) |
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) |