Commit | Line | Data |
---|---|---|
be010748 | 1 | ;;; facemenu.el --- create a face menu for interactively adding fonts to text |
b578f267 | 2 | |
0e520006 | 3 | ;; Copyright (c) 1994, 1995, 1996, 2001, 2002 Free Software Foundation, Inc. |
4e8aa578 | 4 | |
5762abec | 5 | ;; Author: Boris Goldowsky <boris@gnu.org> |
4e8aa578 RS |
6 | ;; Keywords: faces |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
4e8aa578 RS |
24 | |
25 | ;;; Commentary: | |
b578f267 | 26 | |
bf7d4561 BG |
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 | |
af1eab21 | 29 | ;; keybindings, which are shown in the menu. |
88d690a9 RS |
30 | ;; |
31 | ;; The menu also contains submenus for indentation and justification-changing | |
32 | ;; commands. | |
4e8aa578 | 33 | |
4e8aa578 | 34 | ;;; Usage: |
bf7d4561 BG |
35 | ;; Selecting a face from the menu or typing the keyboard equivalent will |
36 | ;; change the region to use that face. If you use transient-mark-mode and the | |
37 | ;; region is not active, the face will be remembered and used for the next | |
38 | ;; insertion. It will be forgotten if you move point or make other | |
39 | ;; modifications before inserting or typing anything. | |
4e8aa578 RS |
40 | ;; |
41 | ;; Faces can be selected from the keyboard as well. | |
88d690a9 RS |
42 | ;; The standard keybindings are M-g (or ESC g) + letter: |
43 | ;; M-g i = "set italic", M-g b = "set bold", etc. | |
4e8aa578 RS |
44 | |
45 | ;;; Customization: | |
46 | ;; An alternative set of keybindings that may be easier to type can be set up | |
88d690a9 RS |
47 | ;; using "Alt" or "Hyper" keys. This requires that you either have or create |
48 | ;; an Alt or Hyper key on your keyboard. On my keyboard, there is a key | |
49 | ;; labeled "Alt", but to make it act as an Alt key I have to put this command | |
50 | ;; into my .xinitrc: | |
51 | ;; xmodmap -e "add Mod3 = Alt_L" | |
52 | ;; Or, I can make it into a Hyper key with this: | |
4e8aa578 | 53 | ;; xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L" |
88d690a9 RS |
54 | ;; Check with local X-perts for how to do it on your system. |
55 | ;; Then you can define your keybindings with code like this in your .emacs: | |
4e8aa578 RS |
56 | ;; (setq facemenu-keybindings |
57 | ;; '((default . [?\H-d]) | |
58 | ;; (bold . [?\H-b]) | |
59 | ;; (italic . [?\H-i]) | |
88d690a9 | 60 | ;; (bold-italic . [?\H-l]) |
4e8aa578 | 61 | ;; (underline . [?\H-u]))) |
9086c730 | 62 | ;; (facemenu-update) |
4e8aa578 | 63 | ;; (setq facemenu-keymap global-map) |
88d690a9 RS |
64 | ;; (define-key global-map [?\H-c] 'facemenu-set-foreground) ; set fg color |
65 | ;; (define-key global-map [?\H-C] 'facemenu-set-background) ; set bg color | |
4e8aa578 | 66 | ;; |
88d690a9 RS |
67 | ;; The order of the faces that appear in the menu and their keybindings can be |
68 | ;; controlled by setting the variables `facemenu-keybindings' and | |
69 | ;; `facemenu-new-faces-at-end'. List faces that you don't use in documents | |
70 | ;; (eg, `region') in `facemenu-unlisted-faces'. | |
4e8aa578 RS |
71 | |
72 | ;;; Known Problems: | |
88d690a9 RS |
73 | ;; Bold and Italic do not combine to create bold-italic if you select them |
74 | ;; both, although most other combinations (eg bold + underline + some color) | |
75 | ;; do the intuitive thing. | |
76 | ;; | |
4e8aa578 RS |
77 | ;; There is at present no way to display what the faces look like in |
78 | ;; the menu itself. | |
79 | ;; | |
80 | ;; `list-faces-display' shows the faces in a different order than | |
81 | ;; this menu, which could be confusing. I do /not/ sort the list | |
82 | ;; alphabetically, because I like the default order: it puts the most | |
83 | ;; basic, common fonts first. | |
84 | ;; | |
85 | ;; Please send me any other problems, comments or ideas. | |
86 | ||
87 | ;;; Code: | |
88 | ||
89 | (provide 'facemenu) | |
90 | ||
0e520006 PA |
91 | (eval-when-compile |
92 | (require 'help) | |
93 | (require 'button)) | |
94 | ||
9dc90430 BG |
95 | ;;; Provide some binding for startup: |
96 | ;;;###autoload (define-key global-map "\M-g" 'facemenu-keymap) | |
97 | ;;;###autoload (autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap) | |
9086c730 RS |
98 | |
99 | ;; Global bindings: | |
100 | (define-key global-map [C-down-mouse-2] 'facemenu-menu) | |
101 | (define-key global-map "\M-g" 'facemenu-keymap) | |
4e8aa578 | 102 | |
487e6fcb RS |
103 | (defgroup facemenu nil |
104 | "Create a face menu for interactively adding fonts to text" | |
105 | :group 'faces | |
106 | :prefix "facemenu-") | |
107 | ||
108 | (defcustom facemenu-keybindings | |
4e8aa578 RS |
109 | '((default . "d") |
110 | (bold . "b") | |
111 | (italic . "i") | |
88d690a9 | 112 | (bold-italic . "l") ; {bold} intersect {italic} = {l} |
4e8aa578 | 113 | (underline . "u")) |
220c969f | 114 | "Alist of interesting faces and keybindings. |
4e8aa578 RS |
115 | Each element is itself a list: the car is the name of the face, |
116 | the next element is the key to use as a keyboard equivalent of the menu item; | |
9086c730 | 117 | the binding is made in `facemenu-keymap'. |
4e8aa578 RS |
118 | |
119 | The faces specifically mentioned in this list are put at the top of | |
120 | the menu, in the order specified. All other faces which are defined, | |
121 | except for those in `facemenu-unlisted-faces', are listed after them, | |
122 | but get no keyboard equivalents. | |
123 | ||
124 | If you change this variable after loading facemenu.el, you will need to call | |
487e6fcb RS |
125 | `facemenu-update' to make it take effect." |
126 | :type '(repeat (cons face string)) | |
127 | :group 'facemenu) | |
4e8aa578 | 128 | |
487e6fcb | 129 | (defcustom facemenu-new-faces-at-end t |
9086c730 | 130 | "*Where in the menu to insert newly-created faces. |
88d690a9 | 131 | This should be nil to put them at the top of the menu, or t to put them |
487e6fcb RS |
132 | just before \"Other\" at the end." |
133 | :type 'boolean | |
134 | :group 'facemenu) | |
88d690a9 | 135 | |
487e6fcb | 136 | (defcustom facemenu-unlisted-faces |
74a723de DL |
137 | `(modeline region secondary-selection highlight scratch-face |
138 | ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-") | |
139 | ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-") | |
140 | ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")) | |
9086c730 | 141 | "*List of faces not to include in the Face menu. |
7dc30d5b RS |
142 | Each element may be either a symbol, which is the name of a face, or a string, |
143 | which is a regular expression to be matched against face names. Matching | |
144 | faces will not be added to the menu. | |
145 | ||
5a79ed26 KH |
146 | You can set this list before loading facemenu.el, or add a face to it before |
147 | creating that face if you do not want it to be listed. If you change the | |
148 | variable so as to eliminate faces that have already been added to the menu, | |
149 | call `facemenu-update' to recalculate the menu contents. | |
4e8aa578 | 150 | |
88d690a9 RS |
151 | If this variable is t, no faces will be added to the menu. This is useful for |
152 | temporarily turning off the feature that automatically adds faces to the menu | |
487e6fcb | 153 | when they are created." |
7d8177cf RS |
154 | :type '(choice (const :tag "Don't add faces" t) |
155 | (const :tag "None (do add any face)" nil) | |
7dc30d5b | 156 | (repeat (choice symbol regexp))) |
487e6fcb | 157 | :group 'facemenu) |
88d690a9 | 158 | |
9dc90430 | 159 | ;;;###autoload |
88d690a9 | 160 | (defvar facemenu-face-menu |
bf7d4561 | 161 | (let ((map (make-sparse-keymap "Face"))) |
88d690a9 | 162 | (define-key map "o" (cons "Other..." 'facemenu-set-face)) |
bf7d4561 BG |
163 | map) |
164 | "Menu keymap for faces.") | |
9dc90430 | 165 | ;;;###autoload |
88d690a9 | 166 | (defalias 'facemenu-face-menu facemenu-face-menu) |
bf7d4561 | 167 | |
9dc90430 | 168 | ;;;###autoload |
bf7d4561 BG |
169 | (defvar facemenu-foreground-menu |
170 | (let ((map (make-sparse-keymap "Foreground Color"))) | |
f34eaa2c | 171 | (define-key map "o" (cons "Other..." 'facemenu-set-foreground)) |
bf7d4561 BG |
172 | map) |
173 | "Menu keymap for foreground colors.") | |
9dc90430 | 174 | ;;;###autoload |
88d690a9 | 175 | (defalias 'facemenu-foreground-menu facemenu-foreground-menu) |
bf7d4561 | 176 | |
9dc90430 | 177 | ;;;###autoload |
bf7d4561 BG |
178 | (defvar facemenu-background-menu |
179 | (let ((map (make-sparse-keymap "Background Color"))) | |
f34eaa2c | 180 | (define-key map "o" (cons "Other..." 'facemenu-set-background)) |
bf7d4561 | 181 | map) |
7e6cb513 | 182 | "Menu keymap for background colors.") |
9dc90430 | 183 | ;;;###autoload |
88d690a9 | 184 | (defalias 'facemenu-background-menu facemenu-background-menu) |
bf7d4561 | 185 | |
9dc90430 | 186 | ;;;###autoload |
bf7d4561 BG |
187 | (defvar facemenu-special-menu |
188 | (let ((map (make-sparse-keymap "Special"))) | |
2d07ff84 DL |
189 | (define-key map [?s] (cons (purecopy "Remove Special") |
190 | 'facemenu-remove-special)) | |
191 | (define-key map [?t] (cons (purecopy "Intangible") | |
192 | 'facemenu-set-intangible)) | |
193 | (define-key map [?v] (cons (purecopy "Invisible") | |
194 | 'facemenu-set-invisible)) | |
195 | (define-key map [?r] (cons (purecopy "Read-Only") | |
196 | 'facemenu-set-read-only)) | |
bf7d4561 BG |
197 | map) |
198 | "Menu keymap for non-face text-properties.") | |
9dc90430 | 199 | ;;;###autoload |
88d690a9 RS |
200 | (defalias 'facemenu-special-menu facemenu-special-menu) |
201 | ||
9dc90430 | 202 | ;;;###autoload |
88d690a9 RS |
203 | (defvar facemenu-justification-menu |
204 | (let ((map (make-sparse-keymap "Justification"))) | |
2d07ff84 DL |
205 | (define-key map [?c] (cons (purecopy "Center") 'set-justification-center)) |
206 | (define-key map [?b] (cons (purecopy "Full") 'set-justification-full)) | |
207 | (define-key map [?r] (cons (purecopy "Right") 'set-justification-right)) | |
208 | (define-key map [?l] (cons (purecopy "Left") 'set-justification-left)) | |
209 | (define-key map [?u] (cons (purecopy "Unfilled") 'set-justification-none)) | |
88d690a9 RS |
210 | map) |
211 | "Submenu for text justification commands.") | |
9dc90430 | 212 | ;;;###autoload |
88d690a9 RS |
213 | (defalias 'facemenu-justification-menu facemenu-justification-menu) |
214 | ||
9dc90430 | 215 | ;;;###autoload |
88d690a9 RS |
216 | (defvar facemenu-indentation-menu |
217 | (let ((map (make-sparse-keymap "Indentation"))) | |
f34eaa2c | 218 | (define-key map [decrease-right-margin] |
2d07ff84 | 219 | (cons (purecopy "Indent Right Less") 'decrease-right-margin)) |
f34eaa2c | 220 | (define-key map [increase-right-margin] |
2d07ff84 | 221 | (cons (purecopy "Indent Right More") 'increase-right-margin)) |
f34eaa2c | 222 | (define-key map [decrease-left-margin] |
2d07ff84 | 223 | (cons (purecopy "Indent Less") 'decrease-left-margin)) |
f34eaa2c | 224 | (define-key map [increase-left-margin] |
2d07ff84 | 225 | (cons (purecopy "Indent More") 'increase-left-margin)) |
88d690a9 RS |
226 | map) |
227 | "Submenu for indentation commands.") | |
9dc90430 | 228 | ;;;###autoload |
88d690a9 | 229 | (defalias 'facemenu-indentation-menu facemenu-indentation-menu) |
bf7d4561 | 230 | |
f34eaa2c | 231 | ;; This is split up to avoid an overlong line in loaddefs.el. |
9dc90430 | 232 | ;;;###autoload |
f34eaa2c | 233 | (defvar facemenu-menu nil |
535d2617 | 234 | "Facemenu top-level menu keymap.") |
9dc90430 | 235 | ;;;###autoload |
f34eaa2c KH |
236 | (setq facemenu-menu (make-sparse-keymap "Text Properties")) |
237 | ;;;###autoload | |
238 | (let ((map facemenu-menu)) | |
2d07ff84 DL |
239 | (define-key map [dc] (cons (purecopy "Display Colors") 'list-colors-display)) |
240 | (define-key map [df] (cons (purecopy "Display Faces") 'list-faces-display)) | |
0e520006 PA |
241 | (define-key map [dp] (cons (purecopy "Describe Text") |
242 | 'describe-text-at)) | |
2d07ff84 DL |
243 | (define-key map [ra] (cons (purecopy "Remove Text Properties") |
244 | 'facemenu-remove-all)) | |
245 | (define-key map [rm] (cons (purecopy "Remove Face Properties") | |
246 | 'facemenu-remove-face-props)) | |
247 | (define-key map [s1] (list (purecopy "--")))) | |
f34eaa2c KH |
248 | ;;;###autoload |
249 | (let ((map facemenu-menu)) | |
2d07ff84 DL |
250 | (define-key map [in] (cons (purecopy "Indentation") |
251 | 'facemenu-indentation-menu)) | |
252 | (define-key map [ju] (cons (purecopy "Justification") | |
253 | 'facemenu-justification-menu)) | |
254 | (define-key map [s2] (list (purecopy "--"))) | |
255 | (define-key map [sp] (cons (purecopy "Special Properties") | |
256 | 'facemenu-special-menu)) | |
257 | (define-key map [bg] (cons (purecopy "Background Color") | |
258 | 'facemenu-background-menu)) | |
259 | (define-key map [fg] (cons (purecopy "Foreground Color") | |
260 | 'facemenu-foreground-menu)) | |
261 | (define-key map [fc] (cons (purecopy "Face") | |
262 | 'facemenu-face-menu))) | |
f34eaa2c | 263 | ;;;###autoload |
88d690a9 | 264 | (defalias 'facemenu-menu facemenu-menu) |
bf7d4561 | 265 | |
88d690a9 RS |
266 | (defvar facemenu-keymap |
267 | (let ((map (make-sparse-keymap "Set face"))) | |
2d07ff84 | 268 | (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face)) |
88d690a9 | 269 | map) |
9dc90430 | 270 | "Keymap for face-changing commands. |
bf7d4561 | 271 | `Facemenu-update' fills in the keymap according to the bindings |
535d2617 | 272 | requested in `facemenu-keybindings'.") |
88d690a9 | 273 | (defalias 'facemenu-keymap facemenu-keymap) |
bf7d4561 | 274 | |
cb5bec6e | 275 | |
487e6fcb | 276 | (defcustom facemenu-add-face-function nil |
7e6cb513 | 277 | "Function called at beginning of text to change or nil. |
cb5bec6e | 278 | This function is passed the FACE to set and END of text to change, and must |
487e6fcb RS |
279 | return a string which is inserted. It may set `facemenu-end-add-face'." |
280 | :type '(choice (const :tag "None" nil) | |
281 | function) | |
282 | :group 'facemenu) | |
cb5bec6e | 283 | |
487e6fcb | 284 | (defcustom facemenu-end-add-face nil |
7e6cb513 | 285 | "String to insert or function called at end of text to change or nil. |
cb5bec6e | 286 | This function is passed the FACE to set, and must return a string which is |
487e6fcb RS |
287 | inserted." |
288 | :type '(choice (const :tag "None" nil) | |
289 | string | |
290 | function) | |
291 | :group 'facemenu) | |
cb5bec6e | 292 | |
487e6fcb | 293 | (defcustom facemenu-remove-face-function nil |
9086c730 | 294 | "When non-nil, this is a function called to remove faces. |
cb5bec6e | 295 | This function is passed the START and END of text to change. |
7e6cb513 | 296 | May also be t meaning to use `facemenu-add-face-function'." |
487e6fcb RS |
297 | :type '(choice (const :tag "None" nil) |
298 | (const :tag "Use add-face" t) | |
299 | function) | |
300 | :group 'facemenu) | |
cb5bec6e | 301 | |
bf7d4561 BG |
302 | ;;; Internal Variables |
303 | ||
304 | (defvar facemenu-color-alist nil | |
305 | ;; Don't initialize here; that doesn't work if preloaded. | |
306 | "Alist of colors, used for completion. | |
307 | If null, `facemenu-read-color' will set it.") | |
4a24b314 | 308 | |
4e8aa578 | 309 | (defun facemenu-update () |
bf7d4561 BG |
310 | "Add or update the \"Face\" menu in the menu bar. |
311 | You can call this to update things if you change any of the menu configuration | |
312 | variables." | |
4e8aa578 | 313 | (interactive) |
4e8aa578 | 314 | |
bf7d4561 BG |
315 | ;; Add each defined face to the menu. |
316 | (facemenu-iterate 'facemenu-add-new-face | |
317 | (facemenu-complete-face-list facemenu-keybindings))) | |
4a24b314 | 318 | |
4e8aa578 RS |
319 | ;;;###autoload |
320 | (defun facemenu-set-face (face &optional start end) | |
4a24b314 | 321 | "Add FACE to the region or next character typed. |
7d8177cf | 322 | This adds FACE to the top of the face list; any faces lower on the list that |
4a24b314 RS |
323 | will not show through at all will be removed. |
324 | ||
7d8177cf | 325 | Interactively, reads the face name with the minibuffer. |
f34eaa2c | 326 | |
7d8177cf RS |
327 | If the region is active (normally true except in Transient Mark mode) |
328 | and there is no prefix argument, this command sets the region to the | |
329 | requested face. | |
f34eaa2c KH |
330 | |
331 | Otherwise, this command specifies the face for the next character | |
332 | inserted. Moving point or switching buffers before | |
333 | typing a character to insert cancels the specification." | |
7d8177cf RS |
334 | (interactive (list (progn |
335 | (barf-if-buffer-read-only) | |
336 | (read-face-name "Use face")) | |
337 | (if (and mark-active (not current-prefix-arg)) | |
338 | (region-beginning)) | |
339 | (if (and mark-active (not current-prefix-arg)) | |
340 | (region-end)))) | |
88d690a9 | 341 | (facemenu-add-new-face face) |
7d8177cf | 342 | (facemenu-add-face face start end)) |
4a24b314 | 343 | |
bf7d4561 | 344 | ;;;###autoload |
4a24b314 | 345 | (defun facemenu-set-foreground (color &optional start end) |
7e6cb513 | 346 | "Set the foreground COLOR of the region or next character typed. |
af1eab21 | 347 | This command reads the color in the minibuffer. |
7d8177cf RS |
348 | |
349 | If the region is active (normally true except in Transient Mark mode) | |
350 | and there is no prefix argument, this command sets the region to the | |
351 | requested face. | |
352 | ||
353 | Otherwise, this command specifies the face for the next character | |
354 | inserted. Moving point or switching buffers before | |
355 | typing a character to insert cancels the specification." | |
356 | (interactive (list (progn | |
357 | (barf-if-buffer-read-only) | |
358 | (facemenu-read-color "Foreground color: ")) | |
359 | (if (and mark-active (not current-prefix-arg)) | |
360 | (region-beginning)) | |
361 | (if (and mark-active (not current-prefix-arg)) | |
362 | (region-end)))) | |
363 | (unless (color-defined-p color) | |
364 | (message "Color `%s' undefined" color)) | |
9bf4c4e5 | 365 | (facemenu-add-new-color color 'facemenu-foreground-menu) |
7d8177cf | 366 | (facemenu-add-face (list (list :foreground color)) start end)) |
4a24b314 | 367 | |
bf7d4561 | 368 | ;;;###autoload |
4a24b314 | 369 | (defun facemenu-set-background (color &optional start end) |
7e6cb513 | 370 | "Set the background COLOR of the region or next character typed. |
af1eab21 | 371 | This command reads the color in the minibuffer. |
7d8177cf RS |
372 | |
373 | If the region is active (normally true except in Transient Mark mode) | |
374 | and there is no prefix argument, this command sets the region to the | |
375 | requested face. | |
376 | ||
377 | Otherwise, this command specifies the face for the next character | |
378 | inserted. Moving point or switching buffers before | |
379 | typing a character to insert cancels the specification." | |
380 | (interactive (list (progn | |
381 | (barf-if-buffer-read-only) | |
382 | (facemenu-read-color "Background color: ")) | |
383 | (if (and mark-active (not current-prefix-arg)) | |
384 | (region-beginning)) | |
385 | (if (and mark-active (not current-prefix-arg)) | |
386 | (region-end)))) | |
387 | (unless (color-defined-p color) | |
388 | (message "Color `%s' undefined" color)) | |
9bf4c4e5 | 389 | (facemenu-add-new-color color 'facemenu-background-menu) |
7d8177cf | 390 | (facemenu-add-face (list (list :background color)) start end)) |
4e8aa578 | 391 | |
9dc90430 | 392 | ;;;###autoload |
4e8aa578 | 393 | (defun facemenu-set-face-from-menu (face start end) |
7e6cb513 | 394 | "Set the FACE of the region or next character typed. |
4e8aa578 RS |
395 | This function is designed to be called from a menu; the face to use |
396 | is the menu item's name. | |
f34eaa2c | 397 | |
7d8177cf RS |
398 | If the region is active (normally true except in Transient Mark mode) |
399 | and there is no prefix argument, this command sets the region to the | |
400 | requested face. | |
f34eaa2c KH |
401 | |
402 | Otherwise, this command specifies the face for the next character | |
403 | inserted. Moving point or switching buffers before | |
404 | typing a character to insert cancels the specification." | |
4a24b314 | 405 | (interactive (list last-command-event |
f34eaa2c KH |
406 | (if (and mark-active (not current-prefix-arg)) |
407 | (region-beginning)) | |
408 | (if (and mark-active (not current-prefix-arg)) | |
409 | (region-end)))) | |
88d690a9 | 410 | (barf-if-buffer-read-only) |
4a24b314 | 411 | (facemenu-get-face face) |
4e8aa578 | 412 | (if start |
4a24b314 | 413 | (facemenu-add-face face start end) |
cb5bec6e | 414 | (facemenu-add-face face))) |
4e8aa578 | 415 | |
9dc90430 | 416 | ;;;###autoload |
4e8aa578 RS |
417 | (defun facemenu-set-invisible (start end) |
418 | "Make the region invisible. | |
419 | This sets the `invisible' text property; it can be undone with | |
f34eaa2c | 420 | `facemenu-remove-special'." |
4e8aa578 | 421 | (interactive "r") |
0e3edd7b | 422 | (add-text-properties start end '(invisible t))) |
4e8aa578 | 423 | |
9dc90430 | 424 | ;;;###autoload |
4e8aa578 RS |
425 | (defun facemenu-set-intangible (start end) |
426 | "Make the region intangible: disallow moving into it. | |
427 | This sets the `intangible' text property; it can be undone with | |
f34eaa2c | 428 | `facemenu-remove-special'." |
4e8aa578 | 429 | (interactive "r") |
0e3edd7b | 430 | (add-text-properties start end '(intangible t))) |
4e8aa578 | 431 | |
9dc90430 | 432 | ;;;###autoload |
4e8aa578 RS |
433 | (defun facemenu-set-read-only (start end) |
434 | "Make the region unmodifiable. | |
435 | This sets the `read-only' text property; it can be undone with | |
f34eaa2c | 436 | `facemenu-remove-special'." |
4e8aa578 | 437 | (interactive "r") |
0e3edd7b | 438 | (add-text-properties start end '(read-only t))) |
4e8aa578 | 439 | |
9dc90430 | 440 | ;;;###autoload |
a32d7856 KH |
441 | (defun facemenu-remove-face-props (start end) |
442 | "Remove `face' and `mouse-face' text properties." | |
4e8aa578 RS |
443 | (interactive "*r") ; error if buffer is read-only despite the next line. |
444 | (let ((inhibit-read-only t)) | |
445 | (remove-text-properties | |
a32d7856 | 446 | start end '(face nil mouse-face nil)))) |
4e8aa578 | 447 | |
f34eaa2c KH |
448 | ;;;###autoload |
449 | (defun facemenu-remove-all (start end) | |
450 | "Remove all text properties from the region." | |
451 | (interactive "*r") ; error if buffer is read-only despite the next line. | |
452 | (let ((inhibit-read-only t)) | |
453 | (set-text-properties start end nil))) | |
454 | ||
455 | ;;;###autoload | |
456 | (defun facemenu-remove-special (start end) | |
457 | "Remove all the \"special\" text properties from the region. | |
458 | These special properties include `invisible', `intangible' and `read-only'." | |
459 | (interactive "*r") ; error if buffer is read-only despite the next line. | |
460 | (let ((inhibit-read-only t)) | |
461 | (remove-text-properties | |
462 | start end '(invisible nil intangible nil read-only nil)))) | |
463 | ||
0e520006 PA |
464 | ;;; Describe-Text Mode. |
465 | ||
466 | (defun describe-text-done () | |
467 | "Delete the current window or bury the current buffer." | |
468 | (interactive) | |
469 | (if (> (count-windows) 1) | |
470 | (delete-window) | |
471 | (bury-buffer))) | |
472 | ||
473 | (defvar describe-text-mode-map | |
474 | (let ((map (make-sparse-keymap))) | |
9b2d1d40 | 475 | (set-keymap-parent map widget-keymap) |
0e520006 PA |
476 | map) |
477 | "Keymap for `describe-text-mode'.") | |
478 | ||
479 | (defcustom describe-text-mode-hook nil | |
480 | "List of hook functions ran by `describe-text-mode'." | |
481 | :type 'hook) | |
482 | ||
483 | (defun describe-text-mode () | |
484 | "Major mode for buffers created by `describe-text-at'. | |
485 | ||
486 | \\{describe-text-mode-map} | |
487 | Entry to this mode calls the value of `describe-text-mode-hook' | |
488 | if that value is non-nil." | |
489 | (kill-all-local-variables) | |
490 | (setq major-mode 'describe-text-mode | |
491 | mode-name "Describe-Text") | |
492 | (use-local-map describe-text-mode-map) | |
493 | (widget-setup) | |
494 | (run-hooks 'describe-text-mode-hook)) | |
495 | ||
496 | ;;; Describe-Text Utilities. | |
497 | ||
498 | (defun describe-text-widget (widget) | |
499 | "Insert text to describe WIDGET in the current buffer." | |
500 | (widget-create 'link | |
501 | :notify `(lambda (&rest ignore) | |
502 | (widget-browse ',widget)) | |
503 | (format "%S" (if (symbolp widget) | |
504 | widget | |
505 | (car widget)))) | |
506 | (widget-insert " ") | |
507 | (widget-create 'info-link :tag "widget" "(widget)Top")) | |
508 | ||
509 | (defun describe-text-sexp (sexp) | |
510 | "Insert a short description of SEXP in the current buffer." | |
511 | (let ((pp (condition-case signal | |
512 | (pp-to-string sexp) | |
513 | (error (prin1-to-string signal))))) | |
514 | (when (string-match "\n\\'" pp) | |
515 | (setq pp (substring pp 0 (1- (length pp))))) | |
516 | (if (cond ((string-match "\n" pp) | |
517 | nil) | |
518 | ((> (length pp) (- (window-width) (current-column))) | |
519 | nil) | |
520 | (t t)) | |
521 | (widget-insert pp) | |
522 | (widget-create 'push-button | |
523 | :tag "show" | |
524 | :action (lambda (widget &optional event) | |
525 | (with-output-to-temp-buffer | |
526 | "*Pp Eval Output*" | |
527 | (princ (widget-get widget :value)))) | |
528 | pp)))) | |
529 | ||
530 | ||
531 | (defun describe-text-properties (properties) | |
532 | "Insert a description of PROPERTIES in the current buffer. | |
533 | PROPERTIES should be a list of overlay or text properties. | |
534 | The `category' property is made into a widget button that call | |
535 | `describe-text-category' when pushed." | |
536 | (while properties | |
537 | (widget-insert (format " %-20s " (car properties))) | |
538 | (let ((key (nth 0 properties)) | |
539 | (value (nth 1 properties))) | |
540 | (cond ((eq key 'category) | |
541 | (widget-create 'link | |
542 | :notify `(lambda (&rest ignore) | |
543 | (describe-text-category ',value)) | |
544 | (format "%S" value))) | |
545 | ((widgetp value) | |
546 | (describe-text-widget value)) | |
547 | (t | |
548 | (describe-text-sexp value)))) | |
549 | (widget-insert "\n") | |
550 | (setq properties (cdr (cdr properties))))) | |
551 | ||
552 | ;;; Describe-Text Commands. | |
553 | ||
554 | (defun describe-text-category (category) | |
555 | "Describe a text property category." | |
556 | (interactive "S") | |
557 | (when (get-buffer "*Text Category*") | |
558 | (kill-buffer "*Text Category*")) | |
559 | (save-excursion | |
560 | (with-output-to-temp-buffer "*Text Category*" | |
561 | (set-buffer "*Text Category*") | |
562 | (widget-insert "Category " (format "%S" category) ":\n\n") | |
563 | (describe-text-properties (symbol-plist category)) | |
564 | (describe-text-mode) | |
565 | (goto-char (point-min))))) | |
566 | ||
567 | ;;;###autoload | |
568 | (defun describe-text-at (pos) | |
569 | "Describe widgets, buttons, overlays and text properties at POS." | |
570 | (interactive "d") | |
571 | (when (eq (current-buffer) (get-buffer "*Text Description*")) | |
572 | (error "Can't do self inspection")) | |
573 | (let* ((properties (text-properties-at pos)) | |
574 | (overlays (overlays-at pos)) | |
575 | overlay | |
576 | (wid-field (get-char-property pos 'field)) | |
577 | (wid-button (get-char-property pos 'button)) | |
578 | (wid-doc (get-char-property pos 'widget-doc)) | |
579 | ;; If button.el is not loaded, we have no buttons in the text. | |
580 | (button (and (fboundp 'button-at) (button-at pos))) | |
581 | (button-type (and button (button-type button))) | |
582 | (button-label (and button (button-label button))) | |
583 | (widget (or wid-field wid-button wid-doc))) | |
584 | (if (not (or properties overlays)) | |
585 | (message "This is plain text.") | |
586 | (when (get-buffer "*Text Description*") | |
587 | (kill-buffer "*Text Description*")) | |
588 | (save-excursion | |
589 | (with-output-to-temp-buffer "*Text Description*" | |
590 | (set-buffer "*Text Description*") | |
591 | (widget-insert "Text content at position " (format "%d" pos) ":\n\n") | |
592 | ;; Widgets | |
593 | (when (widgetp widget) | |
594 | (widget-insert (cond (wid-field "This is an editable text area") | |
595 | (wid-button "This is an active area") | |
596 | (wid-doc "This is documentation text"))) | |
597 | (widget-insert " of a ") | |
598 | (describe-text-widget widget) | |
599 | (widget-insert ".\n\n")) | |
600 | ;; Buttons | |
601 | (when (and button (not (widgetp wid-button))) | |
602 | (widget-insert "Here is a " (format "%S" button-type) | |
603 | " button labeled `" button-label "'.\n\n")) | |
604 | ;; Overlays | |
605 | (when overlays | |
606 | (if (eq (length overlays) 1) | |
607 | (widget-insert "There is an overlay here:\n") | |
608 | (widget-insert "There are " (format "%d" (length overlays)) | |
609 | " overlays here:\n")) | |
610 | (dolist (overlay overlays) | |
611 | (widget-insert " From " (format "%d" (overlay-start overlay)) | |
612 | " to " (format "%d" (overlay-end overlay)) "\n") | |
613 | (describe-text-properties (overlay-properties overlay))) | |
614 | (widget-insert "\n")) | |
615 | ;; Text properties | |
616 | (when properties | |
617 | (widget-insert "There are text properties here:\n") | |
618 | (describe-text-properties properties)) | |
619 | (describe-text-mode) | |
620 | (goto-char (point-min))))))) | |
621 | ||
622 | ;;; List Text Properties | |
623 | ||
c0a7db84 BG |
624 | ;;;###autoload |
625 | (defun list-text-properties-at (p) | |
626 | "Pop up a buffer listing text-properties at LOCATION." | |
627 | (interactive "d") | |
cb5bec6e | 628 | (let ((props (text-properties-at p)) |
25a4509f | 629 | category |
cb5bec6e | 630 | str) |
c0a7db84 BG |
631 | (if (null props) |
632 | (message "None") | |
cb5bec6e | 633 | (if (and (not (cdr (cdr props))) |
25a4509f | 634 | (not (eq (car props) 'category)) |
cb5bec6e RS |
635 | (< (length (setq str (format "Text property at %d: %s %S" |
636 | p (car props) (car (cdr props))))) | |
637 | (frame-width))) | |
f2b7756c | 638 | (message "%s" str) |
cb5bec6e RS |
639 | (with-output-to-temp-buffer "*Text Properties*" |
640 | (princ (format "Text properties at %d:\n\n" p)) | |
37d5af8a | 641 | (setq help-xref-stack nil) |
cb5bec6e | 642 | (while props |
25a4509f RS |
643 | (if (eq (car props) 'category) |
644 | (setq category (car (cdr props)))) | |
cb5bec6e RS |
645 | (princ (format "%-20s %S\n" |
646 | (car props) (car (cdr props)))) | |
25a4509f RS |
647 | (setq props (cdr (cdr props)))) |
648 | (if category | |
649 | (progn | |
650 | (setq props (symbol-plist category)) | |
651 | (princ (format "\nCategory %s:\n\n" category)) | |
652 | (while props | |
653 | (princ (format "%-20s %S\n" | |
654 | (car props) (car (cdr props)))) | |
655 | (if (eq (car props) 'category) | |
656 | (setq category (car (cdr props)))) | |
657 | (setq props (cdr (cdr props))))))))))) | |
c0a7db84 | 658 | |
bf7d4561 | 659 | ;;;###autoload |
da627a71 | 660 | (defun facemenu-read-color (&optional prompt) |
bf7d4561 | 661 | "Read a color using the minibuffer." |
da627a71 | 662 | (let ((col (completing-read (or prompt "Color: ") |
bf7d4561 | 663 | (or facemenu-color-alist |
f795f633 | 664 | (mapcar 'list (defined-colors))) |
bf7d4561 BG |
665 | nil t))) |
666 | (if (equal "" col) | |
667 | nil | |
668 | col))) | |
4e8aa578 | 669 | |
88d690a9 RS |
670 | ;;;###autoload |
671 | (defun list-colors-display (&optional list) | |
7c49006b RS |
672 | "Display names of defined colors, and show what they look like. |
673 | If the optional argument LIST is non-nil, it should be a list of | |
674 | colors to display. Otherwise, this command computes a list | |
675 | of colors that the current display can handle." | |
88d690a9 | 676 | (interactive) |
6062889d | 677 | (when (and (null list) (> (display-color-cells) 0)) |
f795f633 | 678 | (setq list (defined-colors)) |
16b6c966 DL |
679 | ;; Delete duplicate colors. |
680 | (let ((l list)) | |
681 | (while (cdr l) | |
682 | (if (facemenu-color-equal (car l) (car (cdr l))) | |
683 | (setcdr l (cdr (cdr l))) | |
6062889d EZ |
684 | (setq l (cdr l))))) |
685 | ;; Don't show more than what the display can handle. | |
686 | (let ((lc (nthcdr (1- (display-color-cells)) list))) | |
687 | (if lc | |
688 | (setcdr lc nil)))) | |
88d690a9 RS |
689 | (with-output-to-temp-buffer "*Colors*" |
690 | (save-excursion | |
691 | (set-buffer standard-output) | |
7dc30d5b | 692 | (let (s) |
88d690a9 RS |
693 | (while list |
694 | (setq s (point)) | |
695 | (insert (car list)) | |
696 | (indent-to 20) | |
697 | (put-text-property s (point) 'face | |
7dc30d5b | 698 | (cons 'background-color (car list))) |
88d690a9 RS |
699 | (setq s (point)) |
700 | (insert " " (car list) "\n") | |
701 | (put-text-property s (point) 'face | |
7dc30d5b | 702 | (cons 'foreground-color (car list))) |
88d690a9 RS |
703 | (setq list (cdr list))))))) |
704 | ||
705 | (defun facemenu-color-equal (a b) | |
706 | "Return t if colors A and B are the same color. | |
7c49006b | 707 | A and B should be strings naming colors. |
f795f633 EZ |
708 | This function queries the display system to find out what the color |
709 | names mean. It returns nil if the colors differ or if it can't | |
7c49006b | 710 | determine the correct answer." |
88d690a9 | 711 | (cond ((equal a b) t) |
f795f633 | 712 | ((equal (color-values a) (color-values b))))) |
88d690a9 | 713 | |
cb5bec6e | 714 | (defun facemenu-add-face (face &optional start end) |
4a24b314 | 715 | "Add FACE to text between START and END. |
7e6cb513 | 716 | If START is nil or START to END is empty, add FACE to next typed character |
cb5bec6e RS |
717 | instead. For each section of that region that has a different face property, |
718 | FACE will be consed onto it, and other faces that are completely hidden by | |
719 | that will be removed from the list. | |
af1eab21 | 720 | If `facemenu-add-face-function' and maybe `facemenu-end-add-face' are non-nil, |
cb5bec6e | 721 | they are used to set the face information. |
bf7d4561 BG |
722 | |
723 | As a special case, if FACE is `default', then the region is left with NO face | |
724 | text property. Otherwise, selecting the default face would not have any | |
cb5bec6e RS |
725 | effect. See `facemenu-remove-face-function'." |
726 | (interactive "*xFace: \nr") | |
727 | (if (and (eq face 'default) | |
728 | (not (eq facemenu-remove-face-function t))) | |
729 | (if facemenu-remove-face-function | |
730 | (funcall facemenu-remove-face-function start end) | |
682e437e RS |
731 | (if (and start (< start end)) |
732 | (remove-text-properties start end '(face default)) | |
733 | (setq self-insert-face 'default | |
734 | self-insert-face-command this-command))) | |
cb5bec6e RS |
735 | (if facemenu-add-face-function |
736 | (save-excursion | |
737 | (if end (goto-char end)) | |
738 | (save-excursion | |
739 | (if start (goto-char start)) | |
740 | (insert-before-markers | |
741 | (funcall facemenu-add-face-function face end))) | |
742 | (if facemenu-end-add-face | |
743 | (insert (if (stringp facemenu-end-add-face) | |
744 | facemenu-end-add-face | |
745 | (funcall facemenu-end-add-face face))))) | |
746 | (if (and start (< start end)) | |
747 | (let ((part-start start) part-end) | |
748 | (while (not (= part-start end)) | |
749 | (setq part-end (next-single-property-change part-start 'face | |
750 | nil end)) | |
751 | (let ((prev (get-text-property part-start 'face))) | |
752 | (put-text-property part-start part-end 'face | |
753 | (if (null prev) | |
754 | face | |
755 | (facemenu-active-faces | |
756 | (cons face | |
757 | (if (listp prev) | |
758 | prev | |
759 | (list prev))))))) | |
760 | (setq part-start part-end))) | |
761 | (setq self-insert-face (if (eq last-command self-insert-face-command) | |
762 | (cons face (if (listp self-insert-face) | |
763 | self-insert-face | |
764 | (list self-insert-face))) | |
765 | face) | |
766 | self-insert-face-command this-command))))) | |
4a24b314 | 767 | |
5a79ed26 KH |
768 | (defun facemenu-active-faces (face-list &optional frame) |
769 | "Return from FACE-LIST those faces that would be used for display. | |
770 | This means each face attribute is not specified in a face earlier in FACE-LIST | |
771 | and such a face is therefore active when used to display text. | |
772 | If the optional argument FRAME is given, use the faces in that frame; otherwise | |
773 | use the selected frame. If t, then the global, non-frame faces are used." | |
7d8177cf RS |
774 | (let* ((mask-atts (copy-sequence |
775 | (if (consp (car face-list)) | |
f790dddf | 776 | (face-attributes-as-vector (car face-list)) |
7d8177cf RS |
777 | (or (internal-lisp-face-p (car face-list) frame) |
778 | (check-face (car face-list)))))) | |
5a79ed26 KH |
779 | (active-list (list (car face-list))) |
780 | (face-list (cdr face-list)) | |
781 | (mask-len (length mask-atts))) | |
782 | (while face-list | |
7d8177cf RS |
783 | (if (let ((face-atts |
784 | (if (consp (car face-list)) | |
f790dddf | 785 | (face-attributes-as-vector (car face-list)) |
7d8177cf RS |
786 | (or (internal-lisp-face-p (car face-list) frame) |
787 | (check-face (car face-list))))) | |
788 | (i mask-len) | |
789 | (useful nil)) | |
5a79ed26 | 790 | (while (> (setq i (1- i)) 1) |
7d8177cf RS |
791 | (and (not (memq (aref face-atts i) '(nil unspecified))) |
792 | (memq (aref mask-atts i) '(nil unspecified)) | |
5a79ed26 KH |
793 | (aset mask-atts i (setq useful t)))) |
794 | useful) | |
795 | (setq active-list (cons (car face-list) active-list))) | |
796 | (setq face-list (cdr face-list))) | |
797 | (nreverse active-list))) | |
4a24b314 | 798 | |
bf7d4561 BG |
799 | (defun facemenu-get-face (symbol) |
800 | "Make sure FACE exists. | |
7d8177cf | 801 | If not, create it and add it to the appropriate menu. Return the SYMBOL." |
c7bce5f2 | 802 | (let ((name (symbol-name symbol))) |
7e6cb513 | 803 | (cond ((facep symbol)) |
0351bce7 RS |
804 | (t (make-face symbol)))) |
805 | symbol) | |
bf7d4561 | 806 | |
9bf4c4e5 RS |
807 | (defun facemenu-add-new-face (face) |
808 | "Add FACE (a face) to the Face menu. | |
7d8177cf RS |
809 | |
810 | This is called whenever you create a new face." | |
811 | (let* (name | |
812 | symbol | |
9bf4c4e5 RS |
813 | menu docstring |
814 | (key (cdr (assoc face facemenu-keybindings))) | |
88d690a9 | 815 | function menu-val) |
9bf4c4e5 RS |
816 | (if (symbolp face) |
817 | (setq name (symbol-name face) | |
818 | symbol face) | |
819 | (setq name face | |
1d792b18 | 820 | symbol (intern name))) |
9bf4c4e5 RS |
821 | (setq menu 'facemenu-face-menu) |
822 | (setq docstring | |
823 | (format "Select face `%s' for subsequent insertion." | |
824 | name)) | |
88d690a9 | 825 | (cond ((eq t facemenu-unlisted-faces)) |
7d8177cf | 826 | ((memq symbol facemenu-unlisted-faces)) |
7dc30d5b RS |
827 | ;; test against regexps in facemenu-unlisted-faces |
828 | ((let ((unlisted facemenu-unlisted-faces) | |
829 | (matched nil)) | |
830 | (while (and unlisted (not matched)) | |
831 | (if (and (stringp (car unlisted)) | |
832 | (string-match (car unlisted) name)) | |
833 | (setq matched t) | |
834 | (setq unlisted (cdr unlisted)))) | |
835 | matched)) | |
88d690a9 RS |
836 | (key ; has a keyboard equivalent. These go at the front. |
837 | (setq function (intern (concat "facemenu-set-" name))) | |
838 | (fset function | |
536f1a10 RS |
839 | `(lambda () |
840 | ,docstring | |
841 | (interactive) | |
af1eab21 RS |
842 | (facemenu-set-face |
843 | (quote ,symbol) | |
844 | (if (and mark-active (not current-prefix-arg)) | |
845 | (region-beginning)) | |
846 | (if (and mark-active (not current-prefix-arg)) | |
847 | (region-end))))) | |
88d690a9 RS |
848 | (define-key 'facemenu-keymap key (cons name function)) |
849 | (define-key menu key (cons name function))) | |
850 | ((facemenu-iterate ; check if equivalent face is already in the menu | |
851 | (lambda (m) (and (listp m) | |
852 | (symbolp (car m)) | |
7d8177cf | 853 | (face-equal (car m) symbol))) |
88d690a9 RS |
854 | (cdr (symbol-function menu)))) |
855 | (t ; No keyboard equivalent. Figure out where to put it: | |
7d8177cf | 856 | (setq key (vector symbol) |
88d690a9 RS |
857 | function 'facemenu-set-face-from-menu |
858 | menu-val (symbol-function menu)) | |
859 | (if (and facemenu-new-faces-at-end | |
860 | (> (length menu-val) 3)) | |
861 | (define-key-after menu-val key (cons name function) | |
9bf4c4e5 RS |
862 | (car (nth (- (length menu-val) 3) menu-val))) |
863 | (define-key menu key (cons name function)))))) | |
864 | nil) ; Return nil for facemenu-iterate | |
865 | ||
866 | (defun facemenu-add-new-color (color &optional menu) | |
867 | "Add COLOR (a color name string) to the appropriate Face menu. | |
868 | MENU should be `facemenu-foreground-menu' or | |
869 | `facemenu-background-menu'. | |
870 | ||
871 | This is called whenever you use a new color." | |
872 | (let* (name | |
873 | symbol | |
874 | docstring | |
875 | function menu-val key | |
876 | (color-p (memq menu '(facemenu-foreground-menu | |
877 | facemenu-background-menu)))) | |
878 | (unless (stringp color) | |
879 | (error "%s is not a color" color)) | |
880 | (setq name color | |
881 | symbol (intern name)) | |
882 | ||
883 | (cond ((eq menu 'facemenu-foreground-menu) | |
884 | (setq docstring | |
885 | (format "Select foreground color %s for subsequent insertion." | |
886 | name))) | |
887 | ((eq menu 'facemenu-background-menu) | |
888 | (setq docstring | |
889 | (format "Select background color %s for subsequent insertion." | |
890 | name)))) | |
891 | (cond ((facemenu-iterate ; check if equivalent face is already in the menu | |
892 | (lambda (m) (and (listp m) | |
893 | (symbolp (car m)) | |
894 | (stringp (cadr m)) | |
895 | (string-equal (cadr m) color))) | |
896 | (cdr (symbol-function menu)))) | |
897 | (t ; No keyboard equivalent. Figure out where to put it: | |
898 | (setq key (vector symbol) | |
899 | function 'facemenu-set-face-from-menu | |
900 | menu-val (symbol-function menu)) | |
901 | (if (and facemenu-new-faces-at-end | |
902 | (> (length menu-val) 3)) | |
903 | (define-key-after menu-val key (cons name function) | |
88d690a9 RS |
904 | (car (nth (- (length menu-val) 3) menu-val))) |
905 | (define-key menu key (cons name function)))))) | |
906 | nil) ; Return nil for facemenu-iterate | |
bf7d4561 | 907 | |
bf7d4561 | 908 | (defun facemenu-complete-face-list (&optional oldlist) |
7cd49450 | 909 | "Return list of all faces that look different. |
bf7d4561 BG |
910 | Starts with given ALIST of faces, and adds elements only if they display |
911 | differently from any face already on the list. | |
912 | The faces on ALIST will end up at the end of the returned list, in reverse | |
913 | order." | |
914 | (let ((list (nreverse (mapcar 'car oldlist)))) | |
915 | (facemenu-iterate | |
916 | (lambda (new-face) | |
917 | (if (not (memq new-face list)) | |
918 | (setq list (cons new-face list))) | |
919 | nil) | |
920 | (nreverse (face-list))) | |
921 | list)) | |
922 | ||
7e6cb513 | 923 | (defun facemenu-iterate (func list) |
4e8aa578 RS |
924 | "Apply FUNC to each element of LIST until one returns non-nil. |
925 | Returns the non-nil value it found, or nil if all were nil." | |
7e6cb513 SM |
926 | (while (and list (not (funcall func (car list)))) |
927 | (setq list (cdr list))) | |
928 | (car list)) | |
4e8aa578 RS |
929 | |
930 | (facemenu-update) | |
4e8aa578 RS |
931 | |
932 | ;;; facemenu.el ends here |