Mercurial > emacs
annotate lisp/facemenu.el @ 9702:50dd719378b4
(syms_of_window): Fix missing \n\'s.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Wed, 26 Oct 1994 06:22:14 +0000 |
parents | fe1c170fa35a |
children | 2bf88bd23cbb |
rev | line source |
---|---|
8743 | 1 ;;; facemenu.el -- Create a face menu for interactively adding fonts to text |
2 ;; Copyright (c) 1994 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Boris Goldowsky <boris@cs.rochester.edu> | |
5 ;; Keywords: faces | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | |
23 ;;; Commentary: | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
24 ;; This file defines a menu of faces (bold, italic, etc) which allows you to |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
25 ;; set the face used for a region of the buffer. Some faces also have |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
26 ;; keybindings, which are shown in the menu. Faces with names beginning with |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
27 ;; "fg:" or "bg:", as in "fg:red", are treated specially. It is assumed that |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
28 ;; Such faces are assumed to consist only of a foreground (if "fg:") or |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
29 ;; background (if "bg:") color. They are thus put into the color submenus |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
30 ;; rather than the general Face submenu. Such faces can also be created on |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
31 ;; demand from the "Other..." menu items. |
8743 | 32 |
33 ;;; Installation: | |
34 ;; Put this file somewhere on emacs's load-path, and put | |
35 ;; (require 'facemenu) | |
36 ;; in your .emacs file. | |
37 | |
38 ;;; Usage: | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
39 ;; Selecting a face from the menu or typing the keyboard equivalent will |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
40 ;; change the region to use that face. If you use transient-mark-mode and the |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
41 ;; region is not active, the face will be remembered and used for the next |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
42 ;; insertion. It will be forgotten if you move point or make other |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
43 ;; modifications before inserting or typing anything. |
8743 | 44 ;; |
45 ;; Faces can be selected from the keyboard as well. | |
46 ;; The standard keybindings are M-s (or ESC s) + letter: | |
47 ;; M-s i = "set italic", M-s b = "set bold", etc. | |
48 | |
49 ;;; Customization: | |
50 ;; An alternative set of keybindings that may be easier to type can be set up | |
51 ;; using "Hyper" keys. This requires that you set up a hyper-key on your | |
52 ;; keyboard. On my system, putting the following command in my .xinitrc: | |
53 ;; xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L" | |
54 ;; makes the key labelled "Alt" act as a hyper key, but check with local | |
55 ;; X-perts for how to do it on your system. If you do this, then put the | |
56 ;; following in your .emacs before the (require 'facemenu): | |
57 ;; (setq facemenu-keybindings | |
58 ;; '((default . [?\H-d]) | |
59 ;; (bold . [?\H-b]) | |
60 ;; (italic . [?\H-i]) | |
61 ;; (bold-italic . [?\H-o]) | |
62 ;; (underline . [?\H-u]))) | |
63 ;; (setq facemenu-keymap global-map) | |
64 ;; (setq facemenu-key nil) | |
65 ;; | |
66 ;; In general, the order of the faces that appear in the menu and their | |
67 ;; keybindings can be controlled by setting the variable | |
68 ;; `facemenu-keybindings'. Faces that you never want to add to your | |
69 ;; document (e.g., `region') are listed in `facemenu-unlisted-faces'. | |
70 | |
71 ;;; Known Problems: | |
72 ;; There is at present no way to display what the faces look like in | |
73 ;; the menu itself. | |
74 ;; | |
75 ;; `list-faces-display' shows the faces in a different order than | |
76 ;; this menu, which could be confusing. I do /not/ sort the list | |
77 ;; alphabetically, because I like the default order: it puts the most | |
78 ;; basic, common fonts first. | |
79 ;; | |
80 ;; Please send me any other problems, comments or ideas. | |
81 | |
82 ;;; Code: | |
83 | |
84 (provide 'facemenu) | |
85 | |
86 (defvar facemenu-key "\M-s" | |
87 "Prefix to use for facemenu commands.") | |
88 | |
89 (defvar facemenu-keybindings | |
90 '((default . "d") | |
91 (bold . "b") | |
92 (italic . "i") | |
93 (bold-italic . "o") ; O for "Oblique" or "bOld"... | |
94 (underline . "u")) | |
95 "Alist of interesting faces and keybindings. | |
96 Each element is itself a list: the car is the name of the face, | |
97 the next element is the key to use as a keyboard equivalent of the menu item; | |
98 the binding is made in facemenu-keymap. | |
99 | |
100 The faces specifically mentioned in this list are put at the top of | |
101 the menu, in the order specified. All other faces which are defined, | |
102 except for those in `facemenu-unlisted-faces', are listed after them, | |
103 but get no keyboard equivalents. | |
104 | |
105 If you change this variable after loading facemenu.el, you will need to call | |
106 `facemenu-update' to make it take effect.") | |
107 | |
108 (defvar facemenu-unlisted-faces | |
109 '(modeline region secondary-selection highlight scratch-face) | |
110 "Faces that are not included in the Face menu. | |
111 Set this before loading facemenu.el, or call `facemenu-update' after | |
112 changing it.") | |
113 | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
114 (defvar facemenu-face-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
115 (let ((map (make-sparse-keymap "Face"))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
116 (define-key map [other] (cons "Other..." 'facemenu-set-face)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
117 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
118 "Menu keymap for faces.") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
119 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
120 (defvar facemenu-foreground-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
121 (let ((map (make-sparse-keymap "Foreground Color"))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
122 (define-key map "o" (cons "Other" 'facemenu-set-foreground)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
123 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
124 "Menu keymap for foreground colors.") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
125 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
126 (defvar facemenu-background-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
127 (let ((map (make-sparse-keymap "Background Color"))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
128 (define-key map "o" (cons "Other" 'facemenu-set-background)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
129 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
130 "Menu keymap for background colors") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
131 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
132 (defvar facemenu-special-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
133 (let ((map (make-sparse-keymap "Special"))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
134 (define-key map [read-only] (cons "Read-Only" 'facemenu-set-read-only)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
135 (define-key map [invisible] (cons "Invisible" 'facemenu-set-invisible)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
136 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
137 "Menu keymap for non-face text-properties.") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
138 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
139 (defvar facemenu-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
140 (let ((map (make-sparse-keymap "Face"))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
141 (define-key map [display] (cons "Display Faces" 'list-faces-display)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
142 (define-key map [remove] (cons "Remove Props" 'facemenu-remove-all)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
143 (define-key map [sep1] (list "-----------------")) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
144 (define-key map [special] (cons "Special Props" facemenu-special-menu)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
145 (define-key map [bg] (cons "Background Color" facemenu-background-menu)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
146 (define-key map [fg] (cons "Foreground Color" facemenu-foreground-menu)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
147 (define-key map [face] (cons "Face" facemenu-face-menu)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
148 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
149 "Facemenu top-level menu keymap") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
150 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
151 (defvar facemenu-keymap (make-sparse-keymap "Set face") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
152 "Map for keyboard face-changing commands. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
153 `Facemenu-update' fills in the keymap according to the bindings |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
154 requested in facemenu-keybindings.") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
155 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
156 ;;; Internal Variables |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
157 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
158 (defvar facemenu-color-alist nil |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
159 ;; Don't initialize here; that doesn't work if preloaded. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
160 "Alist of colors, used for completion. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
161 If null, `facemenu-read-color' will set it.") |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
162 |
8743 | 163 (defvar facemenu-next nil) ; set when we are going to set a face on next char. |
164 (defvar facemenu-loc nil) | |
165 | |
166 (defun facemenu-update () | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
167 "Add or update the \"Face\" menu in the menu bar. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
168 You can call this to update things if you change any of the menu configuration |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
169 variables." |
8743 | 170 (interactive) |
171 | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
172 ;; Global bindings: |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
173 (define-key global-map [C-down-mouse-3] facemenu-menu) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
174 (if facemenu-key (define-key global-map facemenu-key facemenu-keymap)) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
175 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
176 ;; Add each defined face to the menu. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
177 (facemenu-iterate 'facemenu-add-new-face |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
178 (facemenu-complete-face-list facemenu-keybindings))) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
179 |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
180 ;;;###autoload |
8743 | 181 (defun facemenu-set-face (face &optional start end) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
182 "Add FACE to the region or next character typed. |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
183 It will be added to the top of the face list; any faces lower on the list that |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
184 will not show through at all will be removed. |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
185 |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
186 Interactively, the face to be used is prompted for. |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
187 If the region is active, it will be set to the requested face. If |
8743 | 188 it is inactive \(even if mark-even-if-inactive is set) the next |
189 character that is typed \(via `self-insert-command') will be set to | |
190 the the selected face. Moving point or switching buffers before | |
191 typing a character cancels the request." | |
192 (interactive (list (read-face-name "Use face: "))) | |
193 (if mark-active | |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
194 (let ((start (or start (region-beginning))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
195 (end (or end (region-end)))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
196 (facemenu-add-face face start end)) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
197 (setq facemenu-next face |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
198 facemenu-loc (point)))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
199 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
200 ;;;###autoload |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
201 (defun facemenu-set-foreground (color &optional start end) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
202 "Set the foreground color of the region or next character typed. |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
203 The color is prompted for. A face named `fg:color' is used \(or created). |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
204 If the region is active, it will be set to the requested face. If |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
205 it is inactive \(even if mark-even-if-inactive is set) the next |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
206 character that is typed \(via `self-insert-command') will be set to |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
207 the the selected face. Moving point or switching buffers before |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
208 typing a character cancels the request." |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
209 (interactive (list (facemenu-read-color "Foreground color: "))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
210 (let ((face (intern (concat "fg:" color)))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
211 (or (facemenu-get-face face) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
212 (error "Unknown color: %s" color)) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
213 (facemenu-set-face face start end))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
214 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
215 ;;;###autoload |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
216 (defun facemenu-set-background (color &optional start end) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
217 "Set the background color of the region or next character typed. |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
218 The color is prompted for. A face named `bg:color' is used \(or created). |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
219 If the region is active, it will be set to the requested face. If |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
220 it is inactive \(even if mark-even-if-inactive is set) the next |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
221 character that is typed \(via `self-insert-command') will be set to |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
222 the the selected face. Moving point or switching buffers before |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
223 typing a character cancels the request." |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
224 (interactive (list (facemenu-read-color "Background color: "))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
225 (let ((face (intern (concat "bg:" color)))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
226 (or (facemenu-get-face face) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
227 (error "Unknown color: %s" color)) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
228 (facemenu-set-face face start end))) |
8743 | 229 |
230 (defun facemenu-set-face-from-menu (face start end) | |
231 "Set the face of the region or next character typed. | |
232 This function is designed to be called from a menu; the face to use | |
233 is the menu item's name. | |
234 If the region is active, it will be set to the requested face. If | |
235 it is inactive \(even if mark-even-if-inactive is set) the next | |
236 character that is typed \(via `self-insert-command') will be set to | |
237 the the selected face. Moving point or switching buffers before | |
238 typing a character cancels the request." | |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
239 (interactive (list last-command-event |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
240 (if mark-active (region-beginning)) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
241 (if mark-active (region-end)))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
242 (facemenu-get-face face) |
8743 | 243 (if start |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
244 (facemenu-add-face face start end) |
8743 | 245 (setq facemenu-next face facemenu-loc (point)))) |
246 | |
247 (defun facemenu-set-invisible (start end) | |
248 "Make the region invisible. | |
249 This sets the `invisible' text property; it can be undone with | |
250 `facemenu-remove-all'." | |
251 (interactive "r") | |
252 (put-text-property start end 'invisible t)) | |
253 | |
254 (defun facemenu-set-intangible (start end) | |
255 "Make the region intangible: disallow moving into it. | |
256 This sets the `intangible' text property; it can be undone with | |
257 `facemenu-remove-all'." | |
258 (interactive "r") | |
259 (put-text-property start end 'intangible t)) | |
260 | |
261 (defun facemenu-set-read-only (start end) | |
262 "Make the region unmodifiable. | |
263 This sets the `read-only' text property; it can be undone with | |
264 `facemenu-remove-all'." | |
265 (interactive "r") | |
266 (put-text-property start end 'read-only t)) | |
267 | |
268 (defun facemenu-remove-all (start end) | |
269 "Remove all text properties that facemenu added to region." | |
270 (interactive "*r") ; error if buffer is read-only despite the next line. | |
271 (let ((inhibit-read-only t)) | |
272 (remove-text-properties | |
273 start end '(face nil invisible nil intangible nil | |
274 read-only nil category nil)))) | |
275 | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
276 ;;;###autoload |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
277 (defun facemenu-read-color (prompt) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
278 "Read a color using the minibuffer." |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
279 (let ((col (completing-read (or "Color: ") |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
280 (or facemenu-color-alist |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
281 (if (eq 'x window-system) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
282 (mapcar 'list (x-defined-colors)))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
283 nil t))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
284 (if (equal "" col) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
285 nil |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
286 col))) |
8743 | 287 |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
288 (defun facemenu-add-face (face start end) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
289 "Add FACE to text between START and END. |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
290 For each section of that region that has a different face property, FACE will |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
291 be consed onto it, and other faces that are completely hidden by that will be |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
292 removed from the list. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
293 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
294 As a special case, if FACE is `default', then the region is left with NO face |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
295 text property. Otherwise, selecting the default face would not have any |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
296 effect." |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
297 (interactive "*xFace:\nr") |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
298 (if (eq face 'default) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
299 (remove-text-properties start end '(face default)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
300 (let ((part-start start) part-end) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
301 (while (not (= part-start end)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
302 (setq part-end (next-single-property-change part-start 'face nil end)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
303 (let ((prev (get-text-property part-start 'face))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
304 (put-text-property part-start part-end 'face |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
305 (if (null prev) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
306 face |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
307 (facemenu-discard-redundant-faces |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
308 (cons face |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
309 (if (listp prev) prev (list prev))))))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
310 (setq part-start part-end))))) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
311 |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
312 (defun facemenu-discard-redundant-faces (face-list &optional mask) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
313 "Remove from FACE-LIST any faces that won't show at all. |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
314 This means they have no non-nil elements that aren't also non-nil in an |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
315 earlier face." |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
316 (let ((useful nil)) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
317 (cond ((null face-list) nil) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
318 ((null mask) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
319 (cons (car face-list) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
320 (facemenu-discard-redundant-faces |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
321 (cdr face-list) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
322 (copy-sequence (internal-get-face (car face-list)))))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
323 ((let ((i (length mask)) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
324 (face (internal-get-face (car face-list)))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
325 (while (>= (setq i (1- i)) 0) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
326 (if (and (aref face i) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
327 (not (aref mask i))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
328 (progn (setq useful t) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
329 (aset mask i t)))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
330 useful) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
331 (cons (car face-list) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
332 (facemenu-discard-redundant-faces (cdr face-list) mask))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
333 (t (facemenu-discard-redundant-faces (cdr face-list) mask))))) |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
334 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
335 (defun facemenu-get-face (symbol) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
336 "Make sure FACE exists. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
337 If not, it is created. If it is created and is of the form `fg:color', then |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
338 set the foreground to that color. If of the form `bg:color', set the |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
339 background. In any case, add it to the appropriate menu. Returns nil if |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
340 given a bad color." |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
341 (or (internal-find-face symbol) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
342 (let* ((face (make-face symbol)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
343 (name (symbol-name symbol)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
344 (color (substring name 3))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
345 (cond ((string-match "^fg:" name) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
346 (set-face-foreground face color) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
347 (and (eq 'x window-system) (x-color-defined-p color))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
348 ((string-match "^bg:" name) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
349 (set-face-background face color) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
350 (and (eq 'x window-system) (x-color-defined-p color))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
351 (t))))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
352 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
353 (defun facemenu-add-new-face (face) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
354 "Add a FACE to the appropriate Face menu. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
355 Automatically called when a new face is created." |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
356 (let* ((name (symbol-name face)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
357 (menu (cond ((string-match "^fg:" name) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
358 (setq name (substring name 3)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
359 facemenu-foreground-menu) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
360 ((string-match "^bg:" name) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
361 (setq name (substring name 3)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
362 facemenu-background-menu) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
363 (t facemenu-face-menu))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
364 key) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
365 (cond ((memq face facemenu-unlisted-faces) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
366 nil) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
367 ((setq key (cdr (assoc face facemenu-keybindings))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
368 (let ((function (intern (concat "facemenu-set-" name)))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
369 (fset function |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
370 (` (lambda () (interactive) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
371 (facemenu-set-face (quote (, face)))))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
372 (define-key facemenu-keymap key (cons name function)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
373 (define-key menu key (cons name function)))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
374 (t (define-key menu (vector face) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
375 (cons name 'facemenu-set-face-from-menu))))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
376 ;; Return nil for facemenu-iterate's benefit: |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
377 nil) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
378 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
379 (defun facemenu-after-change (begin end old-length) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
380 "May set the face of just-inserted text to user's request. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
381 This only happens if the change is an insertion, and |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
382 `facemenu-set-face[-from-menu]' was called with point at the |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
383 beginning of the insertion." |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
384 (if (null facemenu-next) ; exit immediately if no work |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
385 nil |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
386 (if (and (= 0 old-length) ; insertion |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
387 (= facemenu-loc begin)) ; point wasn't moved in between |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
388 (facemenu-add-face facemenu-next begin end)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
389 (setq facemenu-next nil))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
390 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
391 (defun facemenu-complete-face-list (&optional oldlist) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
392 "Return list of all faces that are look different. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
393 Starts with given ALIST of faces, and adds elements only if they display |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
394 differently from any face already on the list. |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
395 The faces on ALIST will end up at the end of the returned list, in reverse |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
396 order." |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
397 (let ((list (nreverse (mapcar 'car oldlist)))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
398 (facemenu-iterate |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
399 (lambda (new-face) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
400 (if (not (memq new-face list)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
401 (setq list (cons new-face list))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
402 nil) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
403 (nreverse (face-list))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
404 list)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
405 |
8743 | 406 (defun facemenu-iterate (func iterate-list) |
407 "Apply FUNC to each element of LIST until one returns non-nil. | |
408 Returns the non-nil value it found, or nil if all were nil." | |
409 (while (and iterate-list (not (funcall func (car iterate-list)))) | |
410 (setq iterate-list (cdr iterate-list))) | |
411 (car iterate-list)) | |
412 | |
413 (facemenu-update) | |
414 (add-hook 'after-change-functions 'facemenu-after-change) | |
415 | |
416 ;;; facemenu.el ends here |