Mercurial > emacs
comparison lisp/facemenu.el @ 90200:f9a65d7ebd29
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-68
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 459-473)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 86-87)
- Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Thu, 07 Jul 2005 12:43:14 +0000 |
parents | bb71c6cf2009 6fb026ad601f |
children | fbb2bea03df9 |
comparison
equal
deleted
inserted
replaced
90199:bb71c6cf2009 | 90200:f9a65d7ebd29 |
---|---|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
18 ;; GNU General Public License for more details. | 18 ;; GNU General Public License for more details. |
19 | 19 |
20 ;; You should have received a copy of the GNU General Public License | 20 ;; You should have received a copy of the GNU General Public License |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 21 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
23 ;; Boston, MA 02111-1307, USA. | 23 ;; Boston, MA 02110-1301, USA. |
24 | 24 |
25 ;;; Commentary: | 25 ;;; Commentary: |
26 | 26 |
27 ;; This file defines a menu of faces (bold, italic, etc) which allows you to | 27 ;; This file defines a menu of faces (bold, italic, etc) which allows you to |
28 ;; set the face used for a region of the buffer. Some faces also have | 28 ;; set the face used for a region of the buffer. Some faces also have |
97 ;; Global bindings: | 97 ;; Global bindings: |
98 (define-key global-map [C-down-mouse-2] 'facemenu-menu) | 98 (define-key global-map [C-down-mouse-2] 'facemenu-menu) |
99 (define-key global-map "\M-o" 'facemenu-keymap) | 99 (define-key global-map "\M-o" 'facemenu-keymap) |
100 | 100 |
101 (defgroup facemenu nil | 101 (defgroup facemenu nil |
102 "Create a face menu for interactively adding fonts to text" | 102 "Create a face menu for interactively adding fonts to text." |
103 :group 'faces | 103 :group 'faces |
104 :prefix "facemenu-") | 104 :prefix "facemenu-") |
105 | 105 |
106 (defcustom facemenu-keybindings | 106 (defcustom facemenu-keybindings |
107 '((default . "d") | 107 '((default . "d") |
133 | 133 |
134 (defcustom facemenu-unlisted-faces | 134 (defcustom facemenu-unlisted-faces |
135 `(modeline region secondary-selection highlight scratch-face | 135 `(modeline region secondary-selection highlight scratch-face |
136 ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-") | 136 ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-") |
137 ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-") | 137 ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-") |
138 ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-") | 138 ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")) |
139 ,(purecopy "^fg:") ,(purecopy "^bg:")) | |
140 "*List of faces not to include in the Face menu. | 139 "*List of faces not to include in the Face menu. |
141 Each element may be either a symbol, which is the name of a face, or a string, | 140 Each element may be either a symbol, which is the name of a face, or a string, |
142 which is a regular expression to be matched against face names. Matching | 141 which is a regular expression to be matched against face names. Matching |
143 faces will not be added to the menu. | 142 faces will not be added to the menu. |
144 | 143 |
364 (facemenu-read-color "Foreground color: ")) | 363 (facemenu-read-color "Foreground color: ")) |
365 (if (and mark-active (not current-prefix-arg)) | 364 (if (and mark-active (not current-prefix-arg)) |
366 (region-beginning)) | 365 (region-beginning)) |
367 (if (and mark-active (not current-prefix-arg)) | 366 (if (and mark-active (not current-prefix-arg)) |
368 (region-end)))) | 367 (region-end)))) |
369 (facemenu-add-face (facemenu-add-new-color color 'facemenu-foreground-menu) | 368 (facemenu-set-face-from-menu |
370 start end)) | 369 (facemenu-add-new-color color 'facemenu-foreground-menu) |
370 start end)) | |
371 | 371 |
372 ;;;###autoload | 372 ;;;###autoload |
373 (defun facemenu-set-background (color &optional start end) | 373 (defun facemenu-set-background (color &optional start end) |
374 "Set the background COLOR of the region or next character typed. | 374 "Set the background COLOR of the region or next character typed. |
375 This command reads the color in the minibuffer. | 375 This command reads the color in the minibuffer. |
386 (facemenu-read-color "Background color: ")) | 386 (facemenu-read-color "Background color: ")) |
387 (if (and mark-active (not current-prefix-arg)) | 387 (if (and mark-active (not current-prefix-arg)) |
388 (region-beginning)) | 388 (region-beginning)) |
389 (if (and mark-active (not current-prefix-arg)) | 389 (if (and mark-active (not current-prefix-arg)) |
390 (region-end)))) | 390 (region-end)))) |
391 (facemenu-add-face (facemenu-add-new-color color 'facemenu-background-menu) | 391 (facemenu-set-face-from-menu |
392 start end)) | 392 (facemenu-add-new-color color 'facemenu-background-menu) |
393 start end)) | |
393 | 394 |
394 ;;;###autoload | 395 ;;;###autoload |
395 (defun facemenu-set-face-from-menu (face start end) | 396 (defun facemenu-set-face-from-menu (face start end) |
396 "Set the FACE of the region or next character typed. | 397 "Set the FACE of the region or next character typed. |
397 This function is designed to be called from a menu; the face to use | 398 This function is designed to be called from a menu; FACE is determined |
398 is the menu item's name. | 399 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. | |
399 | 403 |
400 If the region is active (normally true except in Transient Mark mode) | 404 If the region is active (normally true except in Transient Mark mode) |
401 and there is no prefix argument, this command sets the region to the | 405 and there is no prefix argument, this command sets the region to the |
402 requested face. | 406 requested face. |
403 | 407 |
404 Otherwise, this command specifies the face for the next character | 408 Otherwise, this command specifies the face for the next character |
405 inserted. Moving point or switching buffers before | 409 inserted. Moving point or switching buffers before typing a character |
406 typing a character to insert cancels the specification." | 410 to insert cancels the specification." |
407 (interactive (list last-command-event | 411 (interactive (list last-command-event |
408 (if (and mark-active (not current-prefix-arg)) | 412 (if (and mark-active (not current-prefix-arg)) |
409 (region-beginning)) | 413 (region-beginning)) |
410 (if (and mark-active (not current-prefix-arg)) | 414 (if (and mark-active (not current-prefix-arg)) |
411 (region-end)))) | 415 (region-end)))) |
412 (barf-if-buffer-read-only) | 416 (barf-if-buffer-read-only) |
413 (if start | 417 (facemenu-add-face |
414 (facemenu-add-face face start end) | 418 (let ((fn (symbol-name face))) |
415 (facemenu-add-face face))) | 419 (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)) | |
416 | 426 |
417 ;;;###autoload | 427 ;;;###autoload |
418 (defun facemenu-set-invisible (start end) | 428 (defun facemenu-set-invisible (start end) |
419 "Make the region invisible. | 429 "Make the region invisible. |
420 This sets the `invisible' text property; it can be undone with | 430 This sets the `invisible' text property; it can be undone with |
706 nil) ; Return nil for facemenu-iterate | 716 nil) ; Return nil for facemenu-iterate |
707 | 717 |
708 (defun facemenu-add-new-color (color menu) | 718 (defun facemenu-add-new-color (color menu) |
709 "Add COLOR (a color name string) to the appropriate Face menu. | 719 "Add COLOR (a color name string) to the appropriate Face menu. |
710 MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'. | 720 MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'. |
711 Create the appropriate face and return it. | 721 Return the event type (a symbol) of the added menu entry. |
712 | 722 |
713 This is called whenever you use a new color." | 723 This is called whenever you use a new color." |
714 (let (symbol docstring) | 724 (let (symbol docstring) |
715 (unless (color-defined-p color) | 725 (unless (color-defined-p color) |
716 (error "Color `%s' undefined" color)) | 726 (error "Color `%s' undefined" color)) |
717 (cond ((eq menu 'facemenu-foreground-menu) | 727 (cond ((eq menu 'facemenu-foreground-menu) |
718 (setq docstring | 728 (setq docstring |
719 (format "Select foreground color %s for subsequent insertion." | 729 (format "Select foreground color %s for subsequent insertion." |
720 color) | 730 color) |
721 symbol (intern (concat "fg:" color))) | 731 symbol (intern (concat "fg:" color)))) |
722 (set-face-foreground (make-face symbol) color)) | |
723 ((eq menu 'facemenu-background-menu) | 732 ((eq menu 'facemenu-background-menu) |
724 (setq docstring | 733 (setq docstring |
725 (format "Select background color %s for subsequent insertion." | 734 (format "Select background color %s for subsequent insertion." |
726 color) | 735 color) |
727 symbol (intern (concat "bg:" color))) | 736 symbol (intern (concat "bg:" color)))) |
728 (set-face-background (make-face symbol) color)) | |
729 (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'"))) | 737 (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'"))) |
730 (cond ((facemenu-iterate ; check if equivalent face is already in the menu | 738 (unless (facemenu-iterate ; Check if color is already in the menu. |
731 (lambda (m) (and (listp m) | 739 (lambda (m) (and (listp m) |
732 (symbolp (car m)) | 740 (eq (car m) symbol))) |
733 (stringp (cadr m)) | 741 (cdr (symbol-function menu))) |
734 (string-equal (cadr m) color))) | 742 ;; Color is not in the menu. Figure out where to put it. |
735 (cdr (symbol-function menu)))) | 743 (let ((key (vector symbol)) |
736 (t ; No keyboard equivalent. Figure out where to put it: | 744 (function 'facemenu-set-face-from-menu) |
737 (let ((key (vector symbol)) | 745 (menu-val (symbol-function menu))) |
738 (function 'facemenu-set-face-from-menu) | 746 (if (and facemenu-new-faces-at-end |
739 (menu-val (symbol-function menu))) | 747 (> (length menu-val) 3)) |
740 (if (and facemenu-new-faces-at-end | 748 (define-key-after menu-val key (cons color function) |
741 (> (length menu-val) 3)) | 749 (car (nth (- (length menu-val) 3) menu-val))) |
742 (define-key-after menu-val key (cons color function) | 750 (define-key menu key (cons color function))))) |
743 (car (nth (- (length menu-val) 3) menu-val))) | |
744 (define-key menu key (cons color function)))))) | |
745 symbol)) | 751 symbol)) |
746 | 752 |
747 (defun facemenu-complete-face-list (&optional oldlist) | 753 (defun facemenu-complete-face-list (&optional oldlist) |
748 "Return list of all faces that look different. | 754 "Return list of all faces that look different. |
749 Starts with given ALIST of faces, and adds elements only if they display | 755 Starts with given ALIST of faces, and adds elements only if they display |