Mercurial > emacs
annotate lisp/facemenu.el @ 44728:7a3ac6c387fe
CC Mode update to version 5.29. This is for testing; it's not a released
version.
author | Martin Stjernholm <mast@lysator.liu.se> |
---|---|
date | Mon, 22 Apr 2002 00:35:36 +0000 |
parents | dec3101535fc |
children | beb07a65a445 |
rev | line source |
---|---|
13337 | 1 ;;; facemenu.el --- create a face menu for interactively adding fonts to text |
14169 | 2 |
43295
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
3 ;; Copyright (c) 1994, 1995, 1996, 2001, 2002 Free Software Foundation, Inc. |
8743 | 4 |
25278 | 5 ;; Author: Boris Goldowsky <boris@gnu.org> |
8743 | 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 | |
14169 | 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. | |
8743 | 24 |
25 ;;; Commentary: | |
14169 | 26 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
27 ;; 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
|
28 ;; set the face used for a region of the buffer. Some faces also have |
43902
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
29 ;; keybindings, which are shown in the menu. |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
30 ;; |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
31 ;; The menu also contains submenus for indentation and justification-changing |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
32 ;; commands. |
8743 | 33 |
34 ;;; Usage: | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
35 ;; 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
|
36 ;; 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
|
37 ;; 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
|
38 ;; 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
|
39 ;; modifications before inserting or typing anything. |
8743 | 40 ;; |
41 ;; Faces can be selected from the keyboard as well. | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
42 ;; The standard keybindings are M-g (or ESC g) + letter: |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
43 ;; M-g i = "set italic", M-g b = "set bold", etc. |
8743 | 44 |
45 ;;; Customization: | |
46 ;; An alternative set of keybindings that may be easier to type can be set up | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
47 ;; using "Alt" or "Hyper" keys. This requires that you either have or create |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
48 ;; an Alt or Hyper key on your keyboard. On my keyboard, there is a key |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
49 ;; labeled "Alt", but to make it act as an Alt key I have to put this command |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
50 ;; into my .xinitrc: |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
51 ;; xmodmap -e "add Mod3 = Alt_L" |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
52 ;; Or, I can make it into a Hyper key with this: |
8743 | 53 ;; xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L" |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
54 ;; Check with local X-perts for how to do it on your system. |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
55 ;; Then you can define your keybindings with code like this in your .emacs: |
8743 | 56 ;; (setq facemenu-keybindings |
57 ;; '((default . [?\H-d]) | |
58 ;; (bold . [?\H-b]) | |
59 ;; (italic . [?\H-i]) | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
60 ;; (bold-italic . [?\H-l]) |
8743 | 61 ;; (underline . [?\H-u]))) |
17505
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
62 ;; (facemenu-update) |
8743 | 63 ;; (setq facemenu-keymap global-map) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
64 ;; (define-key global-map [?\H-c] 'facemenu-set-foreground) ; set fg color |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
65 ;; (define-key global-map [?\H-C] 'facemenu-set-background) ; set bg color |
8743 | 66 ;; |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
67 ;; The order of the faces that appear in the menu and their keybindings can be |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
68 ;; controlled by setting the variables `facemenu-keybindings' and |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
69 ;; `facemenu-new-faces-at-end'. List faces that you don't use in documents |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
70 ;; (eg, `region') in `facemenu-unlisted-faces'. |
8743 | 71 |
72 ;;; Known Problems: | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
73 ;; Bold and Italic do not combine to create bold-italic if you select them |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
74 ;; both, although most other combinations (eg bold + underline + some color) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
75 ;; do the intuitive thing. |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
76 ;; |
8743 | 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 | |
43295
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
91 (eval-when-compile |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
92 (require 'help) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
93 (require 'button)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
94 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
95 ;;; Provide some binding for startup: |
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
96 ;;;###autoload (define-key global-map "\M-g" 'facemenu-keymap) |
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
97 ;;;###autoload (autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap) |
17505
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
98 |
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
99 ;; Global bindings: |
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
100 (define-key global-map [C-down-mouse-2] 'facemenu-menu) |
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
101 (define-key global-map "\M-g" 'facemenu-keymap) |
8743 | 102 |
19009 | 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 | |
8743 | 109 '((default . "d") |
110 (bold . "b") | |
111 (italic . "i") | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
112 (bold-italic . "l") ; {bold} intersect {italic} = {l} |
8743 | 113 (underline . "u")) |
41799 | 114 "Alist of interesting faces and keybindings. |
8743 | 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; | |
17505
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
117 the binding is made in `facemenu-keymap'. |
8743 | 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 | |
19009 | 125 `facemenu-update' to make it take effect." |
126 :type '(repeat (cons face string)) | |
127 :group 'facemenu) | |
8743 | 128 |
19009 | 129 (defcustom facemenu-new-faces-at-end t |
17505
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
130 "*Where in the menu to insert newly-created faces. |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
131 This should be nil to put them at the top of the menu, or t to put them |
19009 | 132 just before \"Other\" at the end." |
133 :type 'boolean | |
134 :group 'facemenu) | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
135 |
19009 | 136 (defcustom facemenu-unlisted-faces |
34331
7b91d8c3787f
(facemenu-unlisted-faces): Fix value.
Dave Love <fx@gnu.org>
parents:
30092
diff
changeset
|
137 `(modeline region secondary-selection highlight scratch-face |
7b91d8c3787f
(facemenu-unlisted-faces): Fix value.
Dave Love <fx@gnu.org>
parents:
30092
diff
changeset
|
138 ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-") |
7b91d8c3787f
(facemenu-unlisted-faces): Fix value.
Dave Love <fx@gnu.org>
parents:
30092
diff
changeset
|
139 ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-") |
7b91d8c3787f
(facemenu-unlisted-faces): Fix value.
Dave Love <fx@gnu.org>
parents:
30092
diff
changeset
|
140 ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")) |
17505
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
141 "*List of faces not to include in the Face menu. |
19558
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
142 Each element may be either a symbol, which is the name of a face, or a string, |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
143 which is a regular expression to be matched against face names. Matching |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
144 faces will not be added to the menu. |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
145 |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
146 You can set this list before loading facemenu.el, or add a face to it before |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
147 creating that face if you do not want it to be listed. If you change the |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
148 variable so as to eliminate faces that have already been added to the menu, |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
149 call `facemenu-update' to recalculate the menu contents. |
8743 | 150 |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
151 If this variable is t, no faces will be added to the menu. This is useful for |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
152 temporarily turning off the feature that automatically adds faces to the menu |
19009 | 153 when they are created." |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
154 :type '(choice (const :tag "Don't add faces" t) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
155 (const :tag "None (do add any face)" nil) |
19558
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
156 (repeat (choice symbol regexp))) |
19009 | 157 :group 'facemenu) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
158 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
159 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
160 (defvar facemenu-face-menu |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
161 (let ((map (make-sparse-keymap "Face"))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
162 (define-key map "o" (cons "Other..." 'facemenu-set-face)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
163 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
164 "Menu keymap for faces.") |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
165 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
166 (defalias 'facemenu-face-menu facemenu-face-menu) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
167 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
168 ;;;###autoload |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
169 (defvar facemenu-foreground-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
170 (let ((map (make-sparse-keymap "Foreground Color"))) |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
171 (define-key map "o" (cons "Other..." 'facemenu-set-foreground)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
172 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
173 "Menu keymap for foreground colors.") |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
174 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
175 (defalias 'facemenu-foreground-menu facemenu-foreground-menu) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
176 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
177 ;;;###autoload |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
178 (defvar facemenu-background-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
179 (let ((map (make-sparse-keymap "Background Color"))) |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
180 (define-key map "o" (cons "Other..." 'facemenu-set-background)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
181 map) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
182 "Menu keymap for background colors.") |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
183 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
184 (defalias 'facemenu-background-menu facemenu-background-menu) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
185 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
186 ;;;###autoload |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
187 (defvar facemenu-special-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
188 (let ((map (make-sparse-keymap "Special"))) |
27494 | 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)) | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
197 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
198 "Menu keymap for non-face text-properties.") |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
199 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
200 (defalias 'facemenu-special-menu facemenu-special-menu) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
201 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
202 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
203 (defvar facemenu-justification-menu |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
204 (let ((map (make-sparse-keymap "Justification"))) |
27494 | 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)) | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
210 map) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
211 "Submenu for text justification commands.") |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
212 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
213 (defalias 'facemenu-justification-menu facemenu-justification-menu) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
214 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
215 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
216 (defvar facemenu-indentation-menu |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
217 (let ((map (make-sparse-keymap "Indentation"))) |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
218 (define-key map [decrease-right-margin] |
27494 | 219 (cons (purecopy "Indent Right Less") 'decrease-right-margin)) |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
220 (define-key map [increase-right-margin] |
27494 | 221 (cons (purecopy "Indent Right More") 'increase-right-margin)) |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
222 (define-key map [decrease-left-margin] |
27494 | 223 (cons (purecopy "Indent Less") 'decrease-left-margin)) |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
224 (define-key map [increase-left-margin] |
27494 | 225 (cons (purecopy "Indent More") 'increase-left-margin)) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
226 map) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
227 "Submenu for indentation commands.") |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
228 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
229 (defalias 'facemenu-indentation-menu facemenu-indentation-menu) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
230 |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
231 ;; This is split up to avoid an overlong line in loaddefs.el. |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
232 ;;;###autoload |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
233 (defvar facemenu-menu nil |
9874
2bf88bd23cbb
(facemenu-update): Use C-down-mouse-2 for the menu.
Richard M. Stallman <rms@gnu.org>
parents:
9623
diff
changeset
|
234 "Facemenu top-level menu keymap.") |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
235 ;;;###autoload |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
236 (setq facemenu-menu (make-sparse-keymap "Text Properties")) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
237 ;;;###autoload |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
238 (let ((map facemenu-menu)) |
27494 | 239 (define-key map [dc] (cons (purecopy "Display Colors") 'list-colors-display)) |
240 (define-key map [df] (cons (purecopy "Display Faces") 'list-faces-display)) | |
43295
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
241 (define-key map [dp] (cons (purecopy "Describe Text") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
242 'describe-text-at)) |
27494 | 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 "--")))) | |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
248 ;;;###autoload |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
249 (let ((map facemenu-menu)) |
27494 | 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))) | |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
263 ;;;###autoload |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
264 (defalias 'facemenu-menu facemenu-menu) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
265 |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
266 (defvar facemenu-keymap |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
267 (let ((map (make-sparse-keymap "Set face"))) |
27494 | 268 (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face)) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
269 map) |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
270 "Keymap for face-changing commands. |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
271 `Facemenu-update' fills in the keymap according to the bindings |
9874
2bf88bd23cbb
(facemenu-update): Use C-down-mouse-2 for the menu.
Richard M. Stallman <rms@gnu.org>
parents:
9623
diff
changeset
|
272 requested in `facemenu-keybindings'.") |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
273 (defalias 'facemenu-keymap facemenu-keymap) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
274 |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
275 |
19009 | 276 (defcustom facemenu-add-face-function nil |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
277 "Function called at beginning of text to change or nil. |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
278 This function is passed the FACE to set and END of text to change, and must |
19009 | 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) | |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
283 |
19009 | 284 (defcustom facemenu-end-add-face nil |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
285 "String to insert or function called at end of text to change or nil. |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
286 This function is passed the FACE to set, and must return a string which is |
19009 | 287 inserted." |
288 :type '(choice (const :tag "None" nil) | |
289 string | |
290 function) | |
291 :group 'facemenu) | |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
292 |
19009 | 293 (defcustom facemenu-remove-face-function nil |
17505
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
294 "When non-nil, this is a function called to remove faces. |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
295 This function is passed the START and END of text to change. |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
296 May also be t meaning to use `facemenu-add-face-function'." |
19009 | 297 :type '(choice (const :tag "None" nil) |
298 (const :tag "Use add-face" t) | |
299 function) | |
300 :group 'facemenu) | |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
301 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
302 ;;; Internal Variables |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
303 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
304 (defvar facemenu-color-alist nil |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
305 ;; 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
|
306 "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
|
307 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
|
308 |
8743 | 309 (defun facemenu-update () |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
310 "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
|
311 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
|
312 variables." |
8743 | 313 (interactive) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
314 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
315 ;; 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
|
316 (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
|
317 (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
|
318 |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
319 ;;;###autoload |
8743 | 320 (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
|
321 "Add FACE to the region or next character typed. |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
322 This adds FACE to the top of the face list; any faces lower on the list that |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
323 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
|
324 |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
325 Interactively, reads the face name with the minibuffer. |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
326 |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
327 If the region is active (normally true except in Transient Mark mode) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
328 and there is no prefix argument, this command sets the region to the |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
329 requested face. |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
330 |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
331 Otherwise, this command specifies the face for the next character |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
332 inserted. Moving point or switching buffers before |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
333 typing a character to insert cancels the specification." |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
334 (interactive (list (progn |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
335 (barf-if-buffer-read-only) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
336 (read-face-name "Use face")) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
337 (if (and mark-active (not current-prefix-arg)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
338 (region-beginning)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
339 (if (and mark-active (not current-prefix-arg)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
340 (region-end)))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
341 (facemenu-add-new-face face) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
342 (facemenu-add-face face start end)) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
343 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
344 ;;;###autoload |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
345 (defun facemenu-set-foreground (color &optional start end) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
346 "Set the foreground COLOR of the region or next character typed. |
43902
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
347 This command reads the color in the minibuffer. |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
348 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
349 If the region is active (normally true except in Transient Mark mode) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
350 and there is no prefix argument, this command sets the region to the |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
351 requested face. |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
352 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
353 Otherwise, this command specifies the face for the next character |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
354 inserted. Moving point or switching buffers before |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
355 typing a character to insert cancels the specification." |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
356 (interactive (list (progn |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
357 (barf-if-buffer-read-only) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
358 (facemenu-read-color "Foreground color: ")) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
359 (if (and mark-active (not current-prefix-arg)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
360 (region-beginning)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
361 (if (and mark-active (not current-prefix-arg)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
362 (region-end)))) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
363 (unless (color-defined-p color) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
364 (message "Color `%s' undefined" color)) |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
365 (facemenu-add-new-color color 'facemenu-foreground-menu) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
366 (facemenu-add-face (list (list :foreground color)) start end)) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
367 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
368 ;;;###autoload |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
369 (defun facemenu-set-background (color &optional start end) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
370 "Set the background COLOR of the region or next character typed. |
43902
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
371 This command reads the color in the minibuffer. |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
372 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
373 If the region is active (normally true except in Transient Mark mode) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
374 and there is no prefix argument, this command sets the region to the |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
375 requested face. |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
376 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
377 Otherwise, this command specifies the face for the next character |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
378 inserted. Moving point or switching buffers before |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
379 typing a character to insert cancels the specification." |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
380 (interactive (list (progn |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
381 (barf-if-buffer-read-only) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
382 (facemenu-read-color "Background color: ")) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
383 (if (and mark-active (not current-prefix-arg)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
384 (region-beginning)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
385 (if (and mark-active (not current-prefix-arg)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
386 (region-end)))) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
387 (unless (color-defined-p color) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
388 (message "Color `%s' undefined" color)) |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
389 (facemenu-add-new-color color 'facemenu-background-menu) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
390 (facemenu-add-face (list (list :background color)) start end)) |
8743 | 391 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
392 ;;;###autoload |
8743 | 393 (defun facemenu-set-face-from-menu (face start end) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
394 "Set the FACE of the region or next character typed. |
8743 | 395 This function is designed to be called from a menu; the face to use |
396 is the menu item's name. | |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
397 |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
398 If the region is active (normally true except in Transient Mark mode) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
399 and there is no prefix argument, this command sets the region to the |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
400 requested face. |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
401 |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
402 Otherwise, this command specifies the face for the next character |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
403 inserted. Moving point or switching buffers before |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
404 typing a character to insert cancels the specification." |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
405 (interactive (list last-command-event |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
406 (if (and mark-active (not current-prefix-arg)) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
407 (region-beginning)) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
408 (if (and mark-active (not current-prefix-arg)) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
409 (region-end)))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
410 (barf-if-buffer-read-only) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
411 (facemenu-get-face face) |
8743 | 412 (if start |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
413 (facemenu-add-face face start end) |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
414 (facemenu-add-face face))) |
8743 | 415 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
416 ;;;###autoload |
8743 | 417 (defun facemenu-set-invisible (start end) |
418 "Make the region invisible. | |
419 This sets the `invisible' text property; it can be undone with | |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
420 `facemenu-remove-special'." |
8743 | 421 (interactive "r") |
17073
5e66b1087c94
Change put-text-property with constant args to add-text-properties for efficiency. Suggested by Stavros Macrakis <s.macrakis@opengroup.org>
Boris Goldowsky <boris@gnu.org>
parents:
16590
diff
changeset
|
422 (add-text-properties start end '(invisible t))) |
8743 | 423 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
424 ;;;###autoload |
8743 | 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 | |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
428 `facemenu-remove-special'." |
8743 | 429 (interactive "r") |
17073
5e66b1087c94
Change put-text-property with constant args to add-text-properties for efficiency. Suggested by Stavros Macrakis <s.macrakis@opengroup.org>
Boris Goldowsky <boris@gnu.org>
parents:
16590
diff
changeset
|
430 (add-text-properties start end '(intangible t))) |
8743 | 431 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
432 ;;;###autoload |
8743 | 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 | |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
436 `facemenu-remove-special'." |
8743 | 437 (interactive "r") |
17073
5e66b1087c94
Change put-text-property with constant args to add-text-properties for efficiency. Suggested by Stavros Macrakis <s.macrakis@opengroup.org>
Boris Goldowsky <boris@gnu.org>
parents:
16590
diff
changeset
|
438 (add-text-properties start end '(read-only t))) |
8743 | 439 |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
440 ;;;###autoload |
20443
76ea51acad22
(facemenu-remove-face-props): Renamed from
Karl Heuer <kwzh@gnu.org>
parents:
19686
diff
changeset
|
441 (defun facemenu-remove-face-props (start end) |
76ea51acad22
(facemenu-remove-face-props): Renamed from
Karl Heuer <kwzh@gnu.org>
parents:
19686
diff
changeset
|
442 "Remove `face' and `mouse-face' text properties." |
8743 | 443 (interactive "*r") ; error if buffer is read-only despite the next line. |
444 (let ((inhibit-read-only t)) | |
445 (remove-text-properties | |
20443
76ea51acad22
(facemenu-remove-face-props): Renamed from
Karl Heuer <kwzh@gnu.org>
parents:
19686
diff
changeset
|
446 start end '(face nil mouse-face nil)))) |
8743 | 447 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
448 ;;;###autoload |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
449 (defun facemenu-remove-all (start end) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
450 "Remove all text properties from the region." |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
451 (interactive "*r") ; error if buffer is read-only despite the next line. |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
452 (let ((inhibit-read-only t)) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
453 (set-text-properties start end nil))) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
454 |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
455 ;;;###autoload |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
456 (defun facemenu-remove-special (start end) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
457 "Remove all the \"special\" text properties from the region. |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
458 These special properties include `invisible', `intangible' and `read-only'." |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
459 (interactive "*r") ; error if buffer is read-only despite the next line. |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
460 (let ((inhibit-read-only t)) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
461 (remove-text-properties |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
462 start end '(invisible nil intangible nil read-only nil)))) |
44678
dec3101535fc
(list-text-properties-at): Command deleted.
Richard M. Stallman <rms@gnu.org>
parents:
44660
diff
changeset
|
463 |
43295
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
464 ;;; Describe-Text Mode. |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
465 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
466 (defun describe-text-done () |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
467 "Delete the current window or bury the current buffer." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
468 (interactive) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
469 (if (> (count-windows) 1) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
470 (delete-window) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
471 (bury-buffer))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
472 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
473 (defvar describe-text-mode-map |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
474 (let ((map (make-sparse-keymap))) |
43412
ce181770fa8e
2002-02-19 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
43295
diff
changeset
|
475 (set-keymap-parent map widget-keymap) |
43295
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
476 map) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
477 "Keymap for `describe-text-mode'.") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
478 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
479 (defcustom describe-text-mode-hook nil |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
480 "List of hook functions ran by `describe-text-mode'." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
481 :type 'hook) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
482 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
483 (defun describe-text-mode () |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
484 "Major mode for buffers created by `describe-text-at'. |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
485 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
486 \\{describe-text-mode-map} |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
487 Entry to this mode calls the value of `describe-text-mode-hook' |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
488 if that value is non-nil." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
489 (kill-all-local-variables) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
490 (setq major-mode 'describe-text-mode |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
491 mode-name "Describe-Text") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
492 (use-local-map describe-text-mode-map) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
493 (widget-setup) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
494 (run-hooks 'describe-text-mode-hook)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
495 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
496 ;;; Describe-Text Utilities. |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
497 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
498 (defun describe-text-widget (widget) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
499 "Insert text to describe WIDGET in the current buffer." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
500 (widget-create 'link |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
501 :notify `(lambda (&rest ignore) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
502 (widget-browse ',widget)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
503 (format "%S" (if (symbolp widget) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
504 widget |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
505 (car widget)))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
506 (widget-insert " ") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
507 (widget-create 'info-link :tag "widget" "(widget)Top")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
508 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
509 (defun describe-text-sexp (sexp) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
510 "Insert a short description of SEXP in the current buffer." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
511 (let ((pp (condition-case signal |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
512 (pp-to-string sexp) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
513 (error (prin1-to-string signal))))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
514 (when (string-match "\n\\'" pp) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
515 (setq pp (substring pp 0 (1- (length pp))))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
516 (if (cond ((string-match "\n" pp) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
517 nil) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
518 ((> (length pp) (- (window-width) (current-column))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
519 nil) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
520 (t t)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
521 (widget-insert pp) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
522 (widget-create 'push-button |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
523 :tag "show" |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
524 :action (lambda (widget &optional event) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
525 (with-output-to-temp-buffer |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
526 "*Pp Eval Output*" |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
527 (princ (widget-get widget :value)))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
528 pp)))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
529 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
530 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
531 (defun describe-text-properties (properties) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
532 "Insert a description of PROPERTIES in the current buffer. |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
533 PROPERTIES should be a list of overlay or text properties. |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
534 The `category' property is made into a widget button that call |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
535 `describe-text-category' when pushed." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
536 (while properties |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
537 (widget-insert (format " %-20s " (car properties))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
538 (let ((key (nth 0 properties)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
539 (value (nth 1 properties))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
540 (cond ((eq key 'category) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
541 (widget-create 'link |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
542 :notify `(lambda (&rest ignore) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
543 (describe-text-category ',value)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
544 (format "%S" value))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
545 ((widgetp value) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
546 (describe-text-widget value)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
547 (t |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
548 (describe-text-sexp value)))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
549 (widget-insert "\n") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
550 (setq properties (cdr (cdr properties))))) |
44678
dec3101535fc
(list-text-properties-at): Command deleted.
Richard M. Stallman <rms@gnu.org>
parents:
44660
diff
changeset
|
551 |
43295
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
552 ;;; Describe-Text Commands. |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
553 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
554 (defun describe-text-category (category) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
555 "Describe a text property category." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
556 (interactive "S") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
557 (when (get-buffer "*Text Category*") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
558 (kill-buffer "*Text Category*")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
559 (save-excursion |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
560 (with-output-to-temp-buffer "*Text Category*" |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
561 (set-buffer "*Text Category*") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
562 (widget-insert "Category " (format "%S" category) ":\n\n") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
563 (describe-text-properties (symbol-plist category)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
564 (describe-text-mode) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
565 (goto-char (point-min))))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
566 |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
567 ;;;###autoload |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
568 (defun describe-text-at (pos) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
569 "Describe widgets, buttons, overlays and text properties at POS." |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
570 (interactive "d") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
571 (when (eq (current-buffer) (get-buffer "*Text Description*")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
572 (error "Can't do self inspection")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
573 (let* ((properties (text-properties-at pos)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
574 (overlays (overlays-at pos)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
575 overlay |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
576 (wid-field (get-char-property pos 'field)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
577 (wid-button (get-char-property pos 'button)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
578 (wid-doc (get-char-property pos 'widget-doc)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
579 ;; If button.el is not loaded, we have no buttons in the text. |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
580 (button (and (fboundp 'button-at) (button-at pos))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
581 (button-type (and button (button-type button))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
582 (button-label (and button (button-label button))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
583 (widget (or wid-field wid-button wid-doc))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
584 (if (not (or properties overlays)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
585 (message "This is plain text.") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
586 (when (get-buffer "*Text Description*") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
587 (kill-buffer "*Text Description*")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
588 (save-excursion |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
589 (with-output-to-temp-buffer "*Text Description*" |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
590 (set-buffer "*Text Description*") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
591 (widget-insert "Text content at position " (format "%d" pos) ":\n\n") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
592 ;; Widgets |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
593 (when (widgetp widget) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
594 (widget-insert (cond (wid-field "This is an editable text area") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
595 (wid-button "This is an active area") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
596 (wid-doc "This is documentation text"))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
597 (widget-insert " of a ") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
598 (describe-text-widget widget) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
599 (widget-insert ".\n\n")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
600 ;; Buttons |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
601 (when (and button (not (widgetp wid-button))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
602 (widget-insert "Here is a " (format "%S" button-type) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
603 " button labeled `" button-label "'.\n\n")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
604 ;; Overlays |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
605 (when overlays |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
606 (if (eq (length overlays) 1) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
607 (widget-insert "There is an overlay here:\n") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
608 (widget-insert "There are " (format "%d" (length overlays)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
609 " overlays here:\n")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
610 (dolist (overlay overlays) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
611 (widget-insert " From " (format "%d" (overlay-start overlay)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
612 " to " (format "%d" (overlay-end overlay)) "\n") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
613 (describe-text-properties (overlay-properties overlay))) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
614 (widget-insert "\n")) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
615 ;; Text properties |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
616 (when properties |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
617 (widget-insert "There are text properties here:\n") |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
618 (describe-text-properties properties)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
619 (describe-text-mode) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
620 (goto-char (point-min))))))) |
44678
dec3101535fc
(list-text-properties-at): Command deleted.
Richard M. Stallman <rms@gnu.org>
parents:
44660
diff
changeset
|
621 |
11081
b651fb9a8216
(list-text-properties-at): New fn.
Boris Goldowsky <boris@gnu.org>
parents:
10814
diff
changeset
|
622 ;;;###autoload |
11372
874b91f4adc4
(facemenu-read-color): Don't ignore PROMPT arg. Make arg optional.
Boris Goldowsky <boris@gnu.org>
parents:
11234
diff
changeset
|
623 (defun facemenu-read-color (&optional prompt) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
624 "Read a color using the minibuffer." |
11372
874b91f4adc4
(facemenu-read-color): Don't ignore PROMPT arg. Make arg optional.
Boris Goldowsky <boris@gnu.org>
parents:
11234
diff
changeset
|
625 (let ((col (completing-read (or prompt "Color: ") |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
626 (or facemenu-color-alist |
26736
a0674327c167
Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents:
25278
diff
changeset
|
627 (mapcar 'list (defined-colors))) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
628 nil t))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
629 (if (equal "" col) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
630 nil |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
631 col))) |
8743 | 632 |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
633 ;;;###autoload |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
634 (defun list-colors-display (&optional list) |
11465
9fa2f8b87890
(list-colors-display): Minor clarification.
Richard M. Stallman <rms@gnu.org>
parents:
11372
diff
changeset
|
635 "Display names of defined colors, and show what they look like. |
9fa2f8b87890
(list-colors-display): Minor clarification.
Richard M. Stallman <rms@gnu.org>
parents:
11372
diff
changeset
|
636 If the optional argument LIST is non-nil, it should be a list of |
9fa2f8b87890
(list-colors-display): Minor clarification.
Richard M. Stallman <rms@gnu.org>
parents:
11372
diff
changeset
|
637 colors to display. Otherwise, this command computes a list |
9fa2f8b87890
(list-colors-display): Minor clarification.
Richard M. Stallman <rms@gnu.org>
parents:
11372
diff
changeset
|
638 of colors that the current display can handle." |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
639 (interactive) |
42948
74d5b26ad460
(list-colors-display): If the argument is nil, don't
Eli Zaretskii <eliz@gnu.org>
parents:
42488
diff
changeset
|
640 (when (and (null list) (> (display-color-cells) 0)) |
26736
a0674327c167
Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents:
25278
diff
changeset
|
641 (setq list (defined-colors)) |
25138
b005bf702615
(list-colors-display): Make it work on ttys.
Dave Love <fx@gnu.org>
parents:
20443
diff
changeset
|
642 ;; Delete duplicate colors. |
b005bf702615
(list-colors-display): Make it work on ttys.
Dave Love <fx@gnu.org>
parents:
20443
diff
changeset
|
643 (let ((l list)) |
b005bf702615
(list-colors-display): Make it work on ttys.
Dave Love <fx@gnu.org>
parents:
20443
diff
changeset
|
644 (while (cdr l) |
b005bf702615
(list-colors-display): Make it work on ttys.
Dave Love <fx@gnu.org>
parents:
20443
diff
changeset
|
645 (if (facemenu-color-equal (car l) (car (cdr l))) |
b005bf702615
(list-colors-display): Make it work on ttys.
Dave Love <fx@gnu.org>
parents:
20443
diff
changeset
|
646 (setcdr l (cdr (cdr l))) |
42948
74d5b26ad460
(list-colors-display): If the argument is nil, don't
Eli Zaretskii <eliz@gnu.org>
parents:
42488
diff
changeset
|
647 (setq l (cdr l))))) |
74d5b26ad460
(list-colors-display): If the argument is nil, don't
Eli Zaretskii <eliz@gnu.org>
parents:
42488
diff
changeset
|
648 ;; Don't show more than what the display can handle. |
74d5b26ad460
(list-colors-display): If the argument is nil, don't
Eli Zaretskii <eliz@gnu.org>
parents:
42488
diff
changeset
|
649 (let ((lc (nthcdr (1- (display-color-cells)) list))) |
74d5b26ad460
(list-colors-display): If the argument is nil, don't
Eli Zaretskii <eliz@gnu.org>
parents:
42488
diff
changeset
|
650 (if lc |
74d5b26ad460
(list-colors-display): If the argument is nil, don't
Eli Zaretskii <eliz@gnu.org>
parents:
42488
diff
changeset
|
651 (setcdr lc nil)))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
652 (with-output-to-temp-buffer "*Colors*" |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
653 (save-excursion |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
654 (set-buffer standard-output) |
19558
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
655 (let (s) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
656 (while list |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
657 (setq s (point)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
658 (insert (car list)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
659 (indent-to 20) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
660 (put-text-property s (point) 'face |
19558
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
661 (cons 'background-color (car list))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
662 (setq s (point)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
663 (insert " " (car list) "\n") |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
664 (put-text-property s (point) 'face |
19558
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
665 (cons 'foreground-color (car list))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
666 (setq list (cdr list))))))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
667 |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
668 (defun facemenu-color-equal (a b) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
669 "Return t if colors A and B are the same color. |
11465
9fa2f8b87890
(list-colors-display): Minor clarification.
Richard M. Stallman <rms@gnu.org>
parents:
11372
diff
changeset
|
670 A and B should be strings naming colors. |
26736
a0674327c167
Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents:
25278
diff
changeset
|
671 This function queries the display system to find out what the color |
a0674327c167
Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents:
25278
diff
changeset
|
672 names mean. It returns nil if the colors differ or if it can't |
11465
9fa2f8b87890
(list-colors-display): Minor clarification.
Richard M. Stallman <rms@gnu.org>
parents:
11372
diff
changeset
|
673 determine the correct answer." |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
674 (cond ((equal a b) t) |
26736
a0674327c167
Changes for automatic remapping of X colors on terminal frames:
Eli Zaretskii <eliz@gnu.org>
parents:
25278
diff
changeset
|
675 ((equal (color-values a) (color-values b))))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
676 |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
677 (defun facemenu-add-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
|
678 "Add FACE to text between START and END. |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
679 If START is nil or START to END is empty, add FACE to next typed character |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
680 instead. For each section of that region that has a different face property, |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
681 FACE will be consed onto it, and other faces that are completely hidden by |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
682 that will be removed from the list. |
43902
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
683 If `facemenu-add-face-function' and maybe `facemenu-end-add-face' are non-nil, |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
684 they are used to set the face information. |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
685 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
686 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
|
687 text property. Otherwise, selecting the default face would not have any |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
688 effect. See `facemenu-remove-face-function'." |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
689 (interactive "*xFace: \nr") |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
690 (if (and (eq face 'default) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
691 (not (eq facemenu-remove-face-function t))) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
692 (if facemenu-remove-face-function |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
693 (funcall facemenu-remove-face-function start end) |
14154
e16dc69d909a
(facemenu-add-face): Adding default to no region
Richard M. Stallman <rms@gnu.org>
parents:
13923
diff
changeset
|
694 (if (and start (< start end)) |
e16dc69d909a
(facemenu-add-face): Adding default to no region
Richard M. Stallman <rms@gnu.org>
parents:
13923
diff
changeset
|
695 (remove-text-properties start end '(face default)) |
e16dc69d909a
(facemenu-add-face): Adding default to no region
Richard M. Stallman <rms@gnu.org>
parents:
13923
diff
changeset
|
696 (setq self-insert-face 'default |
e16dc69d909a
(facemenu-add-face): Adding default to no region
Richard M. Stallman <rms@gnu.org>
parents:
13923
diff
changeset
|
697 self-insert-face-command this-command))) |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
698 (if facemenu-add-face-function |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
699 (save-excursion |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
700 (if end (goto-char end)) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
701 (save-excursion |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
702 (if start (goto-char start)) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
703 (insert-before-markers |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
704 (funcall facemenu-add-face-function face end))) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
705 (if facemenu-end-add-face |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
706 (insert (if (stringp facemenu-end-add-face) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
707 facemenu-end-add-face |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
708 (funcall facemenu-end-add-face face))))) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
709 (if (and start (< start end)) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
710 (let ((part-start start) part-end) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
711 (while (not (= part-start end)) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
712 (setq part-end (next-single-property-change part-start 'face |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
713 nil end)) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
714 (let ((prev (get-text-property part-start 'face))) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
715 (put-text-property part-start part-end 'face |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
716 (if (null prev) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
717 face |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
718 (facemenu-active-faces |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
719 (cons face |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
720 (if (listp prev) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
721 prev |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
722 (list prev))))))) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
723 (setq part-start part-end))) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
724 (setq self-insert-face (if (eq last-command self-insert-face-command) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
725 (cons face (if (listp self-insert-face) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
726 self-insert-face |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
727 (list self-insert-face))) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
728 face) |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
729 self-insert-face-command this-command))))) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
730 |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
731 (defun facemenu-active-faces (face-list &optional frame) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
732 "Return from FACE-LIST those faces that would be used for display. |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
733 This means each face attribute is not specified in a face earlier in FACE-LIST |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
734 and such a face is therefore active when used to display text. |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
735 If the optional argument FRAME is given, use the faces in that frame; otherwise |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
736 use the selected frame. If t, then the global, non-frame faces are used." |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
737 (let* ((mask-atts (copy-sequence |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
738 (if (consp (car face-list)) |
42488
cbf9d3debb0a
(facemenu-active-faces):
Richard M. Stallman <rms@gnu.org>
parents:
41799
diff
changeset
|
739 (face-attributes-as-vector (car face-list)) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
740 (or (internal-lisp-face-p (car face-list) frame) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
741 (check-face (car face-list)))))) |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
742 (active-list (list (car face-list))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
743 (face-list (cdr face-list)) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
744 (mask-len (length mask-atts))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
745 (while face-list |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
746 (if (let ((face-atts |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
747 (if (consp (car face-list)) |
42488
cbf9d3debb0a
(facemenu-active-faces):
Richard M. Stallman <rms@gnu.org>
parents:
41799
diff
changeset
|
748 (face-attributes-as-vector (car face-list)) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
749 (or (internal-lisp-face-p (car face-list) frame) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
750 (check-face (car face-list))))) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
751 (i mask-len) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
752 (useful nil)) |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
753 (while (> (setq i (1- i)) 1) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
754 (and (not (memq (aref face-atts i) '(nil unspecified))) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
755 (memq (aref mask-atts i) '(nil unspecified)) |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
756 (aset mask-atts i (setq useful t)))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
757 useful) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
758 (setq active-list (cons (car face-list) active-list))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
759 (setq face-list (cdr face-list))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
760 (nreverse active-list))) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
761 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
762 (defun facemenu-get-face (symbol) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
763 "Make sure FACE exists. |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
764 If not, create it and add it to the appropriate menu. Return the SYMBOL." |
44128
f98a45180266
(facemenu-get-face): Remove unised variable `foreground'.
Eli Zaretskii <eliz@gnu.org>
parents:
43902
diff
changeset
|
765 (let ((name (symbol-name symbol))) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
766 (cond ((facep symbol)) |
19686
a6ea17425718
(facemenu-get-face): Just warn when given an
Richard M. Stallman <rms@gnu.org>
parents:
19558
diff
changeset
|
767 (t (make-face symbol)))) |
a6ea17425718
(facemenu-get-face): Just warn when given an
Richard M. Stallman <rms@gnu.org>
parents:
19558
diff
changeset
|
768 symbol) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
769 |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
770 (defun facemenu-add-new-face (face) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
771 "Add FACE (a face) to the Face menu. |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
772 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
773 This is called whenever you create a new face." |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
774 (let* (name |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
775 symbol |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
776 menu docstring |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
777 (key (cdr (assoc face facemenu-keybindings))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
778 function menu-val) |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
779 (if (symbolp face) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
780 (setq name (symbol-name face) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
781 symbol face) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
782 (setq name face |
40280
e14f2ec78074
(facemenu-add-new-face): Fix variable names.
Miles Bader <miles@gnu.org>
parents:
40275
diff
changeset
|
783 symbol (intern name))) |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
784 (setq menu 'facemenu-face-menu) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
785 (setq docstring |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
786 (format "Select face `%s' for subsequent insertion." |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
787 name)) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
788 (cond ((eq t facemenu-unlisted-faces)) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
789 ((memq symbol facemenu-unlisted-faces)) |
19558
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
790 ;; test against regexps in facemenu-unlisted-faces |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
791 ((let ((unlisted facemenu-unlisted-faces) |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
792 (matched nil)) |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
793 (while (and unlisted (not matched)) |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
794 (if (and (stringp (car unlisted)) |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
795 (string-match (car unlisted) name)) |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
796 (setq matched t) |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
797 (setq unlisted (cdr unlisted)))) |
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
798 matched)) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
799 (key ; has a keyboard equivalent. These go at the front. |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
800 (setq function (intern (concat "facemenu-set-" name))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
801 (fset function |
17555
6e2928cff18e
(facemenu-add-new-face): Rewrite to give each
Richard M. Stallman <rms@gnu.org>
parents:
17505
diff
changeset
|
802 `(lambda () |
6e2928cff18e
(facemenu-add-new-face): Rewrite to give each
Richard M. Stallman <rms@gnu.org>
parents:
17505
diff
changeset
|
803 ,docstring |
6e2928cff18e
(facemenu-add-new-face): Rewrite to give each
Richard M. Stallman <rms@gnu.org>
parents:
17505
diff
changeset
|
804 (interactive) |
43902
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
805 (facemenu-set-face |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
806 (quote ,symbol) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
807 (if (and mark-active (not current-prefix-arg)) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
808 (region-beginning)) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
809 (if (and mark-active (not current-prefix-arg)) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
810 (region-end))))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
811 (define-key 'facemenu-keymap key (cons name function)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
812 (define-key menu key (cons name function))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
813 ((facemenu-iterate ; check if equivalent face is already in the menu |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
814 (lambda (m) (and (listp m) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
815 (symbolp (car m)) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
816 (face-equal (car m) symbol))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
817 (cdr (symbol-function menu)))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
818 (t ; No keyboard equivalent. Figure out where to put it: |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
819 (setq key (vector symbol) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
820 function 'facemenu-set-face-from-menu |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
821 menu-val (symbol-function menu)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
822 (if (and facemenu-new-faces-at-end |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
823 (> (length menu-val) 3)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
824 (define-key-after menu-val key (cons name function) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
825 (car (nth (- (length menu-val) 3) menu-val))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
826 (define-key menu key (cons name function)))))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
827 nil) ; Return nil for facemenu-iterate |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
828 |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
829 (defun facemenu-add-new-color (color &optional menu) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
830 "Add COLOR (a color name string) to the appropriate Face menu. |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
831 MENU should be `facemenu-foreground-menu' or |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
832 `facemenu-background-menu'. |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
833 |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
834 This is called whenever you use a new color." |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
835 (let* (name |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
836 symbol |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
837 docstring |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
838 function menu-val key |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
839 (color-p (memq menu '(facemenu-foreground-menu |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
840 facemenu-background-menu)))) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
841 (unless (stringp color) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
842 (error "%s is not a color" color)) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
843 (setq name color |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
844 symbol (intern name)) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
845 |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
846 (cond ((eq menu 'facemenu-foreground-menu) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
847 (setq docstring |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
848 (format "Select foreground color %s for subsequent insertion." |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
849 name))) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
850 ((eq menu 'facemenu-background-menu) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
851 (setq docstring |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
852 (format "Select background color %s for subsequent insertion." |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
853 name)))) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
854 (cond ((facemenu-iterate ; check if equivalent face is already in the menu |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
855 (lambda (m) (and (listp m) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
856 (symbolp (car m)) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
857 (stringp (cadr m)) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
858 (string-equal (cadr m) color))) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
859 (cdr (symbol-function menu)))) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
860 (t ; No keyboard equivalent. Figure out where to put it: |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
861 (setq key (vector symbol) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
862 function 'facemenu-set-face-from-menu |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
863 menu-val (symbol-function menu)) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
864 (if (and facemenu-new-faces-at-end |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
865 (> (length menu-val) 3)) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
866 (define-key-after menu-val key (cons name function) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
867 (car (nth (- (length menu-val) 3) menu-val))) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
868 (define-key menu key (cons name function)))))) |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
869 nil) ; Return nil for facemenu-iterate |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
870 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
871 (defun facemenu-complete-face-list (&optional oldlist) |
15358
91b8056dcd35
(facemenu-complete-face-list): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
14901
diff
changeset
|
872 "Return list of all faces that look different. |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
873 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
|
874 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
|
875 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
|
876 order." |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
877 (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
|
878 (facemenu-iterate |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
879 (lambda (new-face) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
880 (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
|
881 (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
|
882 nil) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
883 (nreverse (face-list))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
884 list)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
885 |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
886 (defun facemenu-iterate (func list) |
8743 | 887 "Apply FUNC to each element of LIST until one returns non-nil. |
888 Returns the non-nil value it found, or nil if all were nil." | |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
889 (while (and list (not (funcall func (car list)))) |
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
890 (setq list (cdr list))) |
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
891 (car list)) |
8743 | 892 |
893 (facemenu-update) | |
894 | |
895 ;;; facemenu.el ends here |