Mercurial > emacs
annotate lisp/facemenu.el @ 110594:76b6c21279ec
Don¸«£t give write_mask to select for W32.
process.c (wait_reading_process_output): Don't pass write_mask to select
if SELECT_CANT_DO_WRITE_MASK is defined.
(SELECT_CANT_DO_WRITE_MASK): Define if SELECT_CANT_DO_WRITE_MASK.
author | Jan D <jan.h.d@swipnet.se> |
---|---|
date | Sun, 26 Sep 2010 22:48:13 +0200 |
parents | 280c8ae2476d |
children | 127f4f5efa50 |
rev | line source |
---|---|
13337 | 1 ;;; facemenu.el --- create a face menu for interactively adding fonts to text |
14169 | 2 |
64762
41bb365f41c4
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64211
diff
changeset
|
3 ;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
8743 | 5 |
25278 | 6 ;; Author: Boris Goldowsky <boris@gnu.org> |
8743 | 7 ;; Keywords: faces |
110015
280c8ae2476d
Add "Package:" file headers to denote built-in packages.
Chong Yidong <cyd@stupidchicken.com>
parents:
109881
diff
changeset
|
8 ;; Package: emacs |
8743 | 9 |
10 ;; This file is part of GNU Emacs. | |
11 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94149
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
8743 | 13 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94149
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94149
diff
changeset
|
15 ;; (at your option) any later version. |
8743 | 16 |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94149
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
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 ;; |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
41 ;; Faces can be selected from the keyboard as well. |
60466
53053dc21ae7
(global-map): Bind M-o, not M-g.
Richard M. Stallman <rms@gnu.org>
parents:
59484
diff
changeset
|
42 ;; The standard keybindings are M-o (or ESC o) + letter: |
53053dc21ae7
(global-map): Bind M-o, not M-g.
Richard M. Stallman <rms@gnu.org>
parents:
59484
diff
changeset
|
43 ;; M-o i = "set italic", M-o 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 |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
69 ;; `facemenu-new-faces-at-end'. List faces that you want to use in documents |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
70 ;; in `facemenu-listed-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 | |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
89 (eval-when-compile |
43295
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
90 (require 'help) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
91 (require 'button)) |
ce2590f06ba0
2002-02-14 Per Abrahamsen <abraham@dina.kvl.dk>
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
42948
diff
changeset
|
92 |
17505
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
93 ;; Global bindings: |
c2640d101ca9
(facemenu-update): Don't make global bindings here.
Richard M. Stallman <rms@gnu.org>
parents:
17073
diff
changeset
|
94 (define-key global-map [C-down-mouse-2] 'facemenu-menu) |
60466
53053dc21ae7
(global-map): Bind M-o, not M-g.
Richard M. Stallman <rms@gnu.org>
parents:
59484
diff
changeset
|
95 (define-key global-map "\M-o" 'facemenu-keymap) |
8743 | 96 |
19009 | 97 (defgroup facemenu nil |
64011
ca0386c4cfd5
(facemenu): Finish `defgroup' description with period.
Juanma Barranquero <lekktu@gmail.com>
parents:
63897
diff
changeset
|
98 "Create a face menu for interactively adding fonts to text." |
19009 | 99 :group 'faces |
100 :prefix "facemenu-") | |
101 | |
102 (defcustom facemenu-keybindings | |
105939
a0f778f4a995
* term/x-win.el (x-gtk-stock-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105870
diff
changeset
|
103 (mapcar 'purecopy |
8743 | 104 '((default . "d") |
105 (bold . "b") | |
106 (italic . "i") | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
107 (bold-italic . "l") ; {bold} intersect {italic} = {l} |
105939
a0f778f4a995
* term/x-win.el (x-gtk-stock-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105870
diff
changeset
|
108 (underline . "u"))) |
41799 | 109 "Alist of interesting faces and keybindings. |
8743 | 110 Each element is itself a list: the car is the name of the face, |
111 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
|
112 the binding is made in `facemenu-keymap'. |
8743 | 113 |
114 The faces specifically mentioned in this list are put at the top of | |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
115 the menu, in the order specified. All other faces which are defined |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
116 in `facemenu-listed-faces' are listed after them, but get no |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
117 keyboard equivalents. |
8743 | 118 |
119 If you change this variable after loading facemenu.el, you will need to call | |
19009 | 120 `facemenu-update' to make it take effect." |
121 :type '(repeat (cons face string)) | |
122 :group 'facemenu) | |
8743 | 123 |
19009 | 124 (defcustom facemenu-new-faces-at-end t |
100171 | 125 "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
|
126 This should be nil to put them at the top of the menu, or t to put them |
19009 | 127 just before \"Other\" at the end." |
128 :type 'boolean | |
129 :group 'facemenu) | |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
130 |
74422
a756f7ecaf2e
(facemenu-unlisted-faces): Define as obsolete variable.
Chong Yidong <cyd@stupidchicken.com>
parents:
74281
diff
changeset
|
131 (defvar facemenu-unlisted-faces |
a756f7ecaf2e
(facemenu-unlisted-faces): Define as obsolete variable.
Chong Yidong <cyd@stupidchicken.com>
parents:
74281
diff
changeset
|
132 `(modeline region secondary-selection highlight scratch-face |
a756f7ecaf2e
(facemenu-unlisted-faces): Define as obsolete variable.
Chong Yidong <cyd@stupidchicken.com>
parents:
74281
diff
changeset
|
133 ,(purecopy "^font-lock-") ,(purecopy "^gnus-") ,(purecopy "^message-") |
a756f7ecaf2e
(facemenu-unlisted-faces): Define as obsolete variable.
Chong Yidong <cyd@stupidchicken.com>
parents:
74281
diff
changeset
|
134 ,(purecopy "^ediff-") ,(purecopy "^term-") ,(purecopy "^vc-") |
a756f7ecaf2e
(facemenu-unlisted-faces): Define as obsolete variable.
Chong Yidong <cyd@stupidchicken.com>
parents:
74281
diff
changeset
|
135 ,(purecopy "^widget-") ,(purecopy "^custom-") ,(purecopy "^vm-")) |
74423
fb9de3443cda
(facemenu-unlisted-faces): Put obsolescence info in the call to
Juanma Barranquero <lekktu@gmail.com>
parents:
74422
diff
changeset
|
136 "*List of faces that are of no interest to the user.") |
fb9de3443cda
(facemenu-unlisted-faces): Put obsolescence info in the call to
Juanma Barranquero <lekktu@gmail.com>
parents:
74422
diff
changeset
|
137 (make-obsolete-variable 'facemenu-unlisted-faces 'facemenu-listed-faces |
94149
17500cca17c4
(facemenu-unlisted-faces): Fix obsolescence description.
Juanma Barranquero <lekktu@gmail.com>
parents:
93975
diff
changeset
|
138 "22.1,\n and has no effect on the Face menu") |
74422
a756f7ecaf2e
(facemenu-unlisted-faces): Define as obsolete variable.
Chong Yidong <cyd@stupidchicken.com>
parents:
74281
diff
changeset
|
139 |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
140 (defcustom facemenu-listed-faces nil |
100171 | 141 "List of faces to include in the Face menu. |
72338
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
142 Each element should be a symbol, the name of a face. |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
143 The \"basic \" faces in `facemenu-keybindings' are automatically |
72338
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
144 added to the Face menu, and need not be in this list. |
19558
56079fac4d24
(facemenu-unlisted-faces): Expand variable
Richard M. Stallman <rms@gnu.org>
parents:
19009
diff
changeset
|
145 |
72338
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
146 This value takes effect when you load facemenu.el. If the |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
147 list includes symbols which are not defined as faces, they |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
148 are ignored; however, subsequently defining or creating |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
149 those faces adds them to the menu then. You can call |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
150 `facemenu-update' to recalculate the menu contents, such as |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
151 if you change the value of this variable, |
8743 | 152 |
72338
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
153 If this variable is t, all faces that you apply to text |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
154 using the face menu commands (even by name), and all faces |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
155 that you define or create, are added to the menu. You may |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
156 find it useful to set this variable to t temporarily while |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
157 you define some faces, so that they will be added. However, |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
158 if the value is no longer t and you call `facemenu-update', |
1bac8eb0facf
(facemenu-listed-faces): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72335
diff
changeset
|
159 it will remove any faces not explicitly in the list." |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
160 :type '(choice (const :tag "List all faces" t) |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
161 (const :tag "None" nil) |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
162 (repeat symbol)) |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
163 :group 'facemenu |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
164 :version "22.1") |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
165 |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
166 (defvar facemenu-face-menu |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
167 (let ((map (make-sparse-keymap "Face"))) |
105870
26baacb565b0
* textmodes/tex-mode.el (tex-alt-dvi-print-command)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105821
diff
changeset
|
168 (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-face)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
169 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
170 "Menu keymap for faces.") |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
171 (defalias 'facemenu-face-menu facemenu-face-menu) |
63769
cae70b5066ae
(facemenu-enable-faces-p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
60522
diff
changeset
|
172 (put 'facemenu-face-menu 'menu-enable '(facemenu-enable-faces-p)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
173 |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
174 (defvar facemenu-foreground-menu |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
175 (let ((map (make-sparse-keymap "Foreground Color"))) |
105870
26baacb565b0
* textmodes/tex-mode.el (tex-alt-dvi-print-command)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105821
diff
changeset
|
176 (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-foreground)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
177 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
178 "Menu keymap for foreground colors.") |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
179 (defalias 'facemenu-foreground-menu facemenu-foreground-menu) |
63769
cae70b5066ae
(facemenu-enable-faces-p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
60522
diff
changeset
|
180 (put 'facemenu-foreground-menu 'menu-enable '(facemenu-enable-faces-p)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
181 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
182 (defvar facemenu-background-menu |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
183 (let ((map (make-sparse-keymap "Background Color"))) |
105870
26baacb565b0
* textmodes/tex-mode.el (tex-alt-dvi-print-command)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105821
diff
changeset
|
184 (define-key map "o" (cons (purecopy "Other...") 'facemenu-set-background)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
185 map) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
186 "Menu keymap for background colors.") |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
187 (defalias 'facemenu-background-menu facemenu-background-menu) |
63769
cae70b5066ae
(facemenu-enable-faces-p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
60522
diff
changeset
|
188 (put 'facemenu-background-menu 'menu-enable '(facemenu-enable-faces-p)) |
cae70b5066ae
(facemenu-enable-faces-p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
60522
diff
changeset
|
189 |
cae70b5066ae
(facemenu-enable-faces-p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
60522
diff
changeset
|
190 ;;; Condition for enabling menu items that set faces. |
cae70b5066ae
(facemenu-enable-faces-p): New function.
Richard M. Stallman <rms@gnu.org>
parents:
60522
diff
changeset
|
191 (defun facemenu-enable-faces-p () |
105821
18698b6aca31
* textmodes/sgml-mode.el (sgml-mode-facemenu-add-face-function):
Chong Yidong <cyd@stupidchicken.com>
parents:
105820
diff
changeset
|
192 ;; Enable the facemenu if facemenu-add-face-function is defined |
18698b6aca31
* textmodes/sgml-mode.el (sgml-mode-facemenu-add-face-function):
Chong Yidong <cyd@stupidchicken.com>
parents:
105820
diff
changeset
|
193 ;; (e.g. in Tex-mode and SGML mode), or if font-lock is off. |
18698b6aca31
* textmodes/sgml-mode.el (sgml-mode-facemenu-add-face-function):
Chong Yidong <cyd@stupidchicken.com>
parents:
105820
diff
changeset
|
194 (or (not (and font-lock-mode font-lock-defaults)) |
18698b6aca31
* textmodes/sgml-mode.el (sgml-mode-facemenu-add-face-function):
Chong Yidong <cyd@stupidchicken.com>
parents:
105820
diff
changeset
|
195 facemenu-add-face-function)) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
196 |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
197 (defvar facemenu-special-menu |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
198 (let ((map (make-sparse-keymap "Special"))) |
27494 | 199 (define-key map [?s] (cons (purecopy "Remove Special") |
200 'facemenu-remove-special)) | |
201 (define-key map [?t] (cons (purecopy "Intangible") | |
202 'facemenu-set-intangible)) | |
203 (define-key map [?v] (cons (purecopy "Invisible") | |
204 'facemenu-set-invisible)) | |
205 (define-key map [?r] (cons (purecopy "Read-Only") | |
206 'facemenu-set-read-only)) | |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
207 map) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
208 "Menu keymap for non-face text-properties.") |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
209 (defalias 'facemenu-special-menu facemenu-special-menu) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
210 |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
211 (defvar facemenu-justification-menu |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
212 (let ((map (make-sparse-keymap "Justification"))) |
27494 | 213 (define-key map [?c] (cons (purecopy "Center") 'set-justification-center)) |
214 (define-key map [?b] (cons (purecopy "Full") 'set-justification-full)) | |
215 (define-key map [?r] (cons (purecopy "Right") 'set-justification-right)) | |
216 (define-key map [?l] (cons (purecopy "Left") 'set-justification-left)) | |
217 (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
|
218 map) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
219 "Submenu for text justification commands.") |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
220 (defalias 'facemenu-justification-menu facemenu-justification-menu) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
221 |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
222 (defvar facemenu-indentation-menu |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
223 (let ((map (make-sparse-keymap "Indentation"))) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
224 (define-key map [decrease-right-margin] |
27494 | 225 (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
|
226 (define-key map [increase-right-margin] |
27494 | 227 (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
|
228 (define-key map [decrease-left-margin] |
27494 | 229 (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
|
230 (define-key map [increase-left-margin] |
27494 | 231 (cons (purecopy "Indent More") 'increase-left-margin)) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
232 map) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
233 "Submenu for indentation commands.") |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
234 (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
|
235 |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
236 ;; This is split up to avoid an overlong line in loaddefs.el. |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
237 (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
|
238 "Facemenu top-level menu keymap.") |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
239 (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
|
240 (let ((map facemenu-menu)) |
27494 | 241 (define-key map [dc] (cons (purecopy "Display Colors") 'list-colors-display)) |
242 (define-key map [df] (cons (purecopy "Display Faces") 'list-faces-display)) | |
45869
fb2ae7bd271d
(facemenu-map): Rename to Describe Text
Richard M. Stallman <rms@gnu.org>
parents:
45207
diff
changeset
|
243 (define-key map [dp] (cons (purecopy "Describe Properties") |
fb2ae7bd271d
(facemenu-map): Rename to Describe Text
Richard M. Stallman <rms@gnu.org>
parents:
45207
diff
changeset
|
244 'describe-text-properties)) |
27494 | 245 (define-key map [ra] (cons (purecopy "Remove Text Properties") |
246 'facemenu-remove-all)) | |
247 (define-key map [rm] (cons (purecopy "Remove Face Properties") | |
248 'facemenu-remove-face-props)) | |
249 (define-key map [s1] (list (purecopy "--")))) | |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
250 (let ((map facemenu-menu)) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
251 (define-key map [in] (cons (purecopy "Indentation") |
27494 | 252 'facemenu-indentation-menu)) |
253 (define-key map [ju] (cons (purecopy "Justification") | |
254 'facemenu-justification-menu)) | |
255 (define-key map [s2] (list (purecopy "--"))) | |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
256 (define-key map [sp] (cons (purecopy "Special Properties") |
27494 | 257 'facemenu-special-menu)) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
258 (define-key map [bg] (cons (purecopy "Background Color") |
27494 | 259 'facemenu-background-menu)) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
260 (define-key map [fg] (cons (purecopy "Foreground Color") |
27494 | 261 'facemenu-foreground-menu)) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
262 (define-key map [fc] (cons (purecopy "Face") |
27494 | 263 'facemenu-face-menu))) |
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 |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
266 (defvar facemenu-keymap |
10520
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)) |
92939
f0b6eb7a4cc3
* font-lock.el (featurep): Remove test, not useful anymore.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
87649
diff
changeset
|
269 (define-key map "\M-o" 'font-lock-fontify-block) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
270 map) |
11091
c968d4c026b7
Doc fix + autoload cookies.
Boris Goldowsky <boris@gnu.org>
parents:
11081
diff
changeset
|
271 "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
|
272 `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
|
273 requested in `facemenu-keybindings'.") |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
274 (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
|
275 |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
276 |
19009 | 277 (defcustom facemenu-add-face-function nil |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
278 "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
|
279 This function is passed the FACE to set and END of text to change, and must |
19009 | 280 return a string which is inserted. It may set `facemenu-end-add-face'." |
281 :type '(choice (const :tag "None" nil) | |
282 function) | |
283 :group 'facemenu) | |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
284 |
19009 | 285 (defcustom facemenu-end-add-face nil |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
286 "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
|
287 This function is passed the FACE to set, and must return a string which is |
19009 | 288 inserted." |
289 :type '(choice (const :tag "None" nil) | |
290 string | |
291 function) | |
292 :group 'facemenu) | |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
293 |
19009 | 294 (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
|
295 "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
|
296 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
|
297 May also be t meaning to use `facemenu-add-face-function'." |
19009 | 298 :type '(choice (const :tag "None" nil) |
299 (const :tag "Use add-face" t) | |
300 function) | |
301 :group 'facemenu) | |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
302 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
303 ;;; Internal Variables |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
304 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
305 (defvar facemenu-color-alist nil |
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. |
71369
71f07d141fe2
(facemenu-color-alist): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
68651
diff
changeset
|
307 If this is nil, then the value of (defined-colors) is used.") |
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 |
8743 | 319 (defun facemenu-set-face (face &optional start end) |
72335
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
320 "Apply FACE to the region or next character typed. |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
321 |
72335
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
322 If the region is active (normally true except in Transient |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
323 Mark mode) and nonempty, and there is no prefix argument, |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
324 this command applies FACE to the region. Otherwise, it applies FACE |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
325 to the faces to use for the next character |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
326 inserted. (Moving point or switching buffers before typing |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
327 a character to insert cancels the specification.) |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
328 |
72335
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
329 If FACE is `default', to \"apply\" it means clearing |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
330 the list of faces to be used. For any other value of FACE, |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
331 to \"apply\" it means putting FACE at the front of the list |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
332 of faces to be used, and removing any faces further |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
333 along in the list that would be completely overridden by |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
334 preceding faces (including FACE). |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
335 |
72335
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
336 This command can also add FACE to the menu of faces, |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
337 if `facemenu-listed-faces' says to do that." |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
338 (interactive (list (progn |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
339 (barf-if-buffer-read-only) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
340 (read-face-name "Use face")) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
341 (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
|
342 (region-beginning)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
343 (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
|
344 (region-end)))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
345 (facemenu-add-new-face face) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
346 (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
|
347 |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
348 (defun facemenu-set-foreground (color &optional start end) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
349 "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
|
350 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
|
351 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
352 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
|
353 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
|
354 requested face. |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
355 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
356 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
|
357 inserted. Moving point or switching buffers before |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
358 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
|
359 (interactive (list (progn |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
360 (barf-if-buffer-read-only) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
361 (facemenu-read-color "Foreground color: ")) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
362 (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
|
363 (region-beginning)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
364 (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
|
365 (region-end)))) |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
366 (facemenu-set-face-from-menu |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
367 (facemenu-add-new-color color 'facemenu-foreground-menu) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
368 start end)) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
369 |
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
370 (defun facemenu-set-background (color &optional start end) |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
371 "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
|
372 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
|
373 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
374 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
|
375 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
|
376 requested face. |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
377 |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
378 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
|
379 inserted. Moving point or switching buffers before |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
380 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
|
381 (interactive (list (progn |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
382 (barf-if-buffer-read-only) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
383 (facemenu-read-color "Background color: ")) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
384 (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
|
385 (region-beginning)) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
386 (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
|
387 (region-end)))) |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
388 (facemenu-set-face-from-menu |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
389 (facemenu-add-new-color color 'facemenu-background-menu) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
390 start end)) |
8743 | 391 |
392 (defun facemenu-set-face-from-menu (face start end) | |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
393 "Set the FACE of the region or next character typed. |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
394 This function is designed to be called from a menu; FACE is determined |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
395 using the event type of the menu entry. If FACE is a symbol whose |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
396 name starts with \"fg:\" or \"bg:\", then this functions sets the |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
397 foreground or background to the color specified by the rest of the |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
398 symbol's name. Any other symbol is considered the name of a face. |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
399 |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
400 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
|
401 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
|
402 requested face. |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
403 |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
404 Otherwise, this command specifies the face for the next character |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
405 inserted. Moving point or switching buffers before typing a character |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
406 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
|
407 (interactive (list last-command-event |
12014
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-beginning)) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
410 (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
|
411 (region-end)))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
412 (barf-if-buffer-read-only) |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
413 (facemenu-add-face |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
414 (let ((fn (symbol-name face))) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
415 (if (string-match "\\`\\([fb]\\)g:\\(.+\\)" fn) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
416 (list (list (if (string= (match-string 1 fn) "f") |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
417 :foreground |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
418 :background) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
419 (match-string 2 fn))) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
420 face)) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
421 start end)) |
8743 | 422 |
423 (defun facemenu-set-invisible (start end) | |
424 "Make the region invisible. | |
425 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
|
426 `facemenu-remove-special'." |
8743 | 427 (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
|
428 (add-text-properties start end '(invisible t))) |
8743 | 429 |
430 (defun facemenu-set-intangible (start end) | |
431 "Make the region intangible: disallow moving into it. | |
432 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
|
433 `facemenu-remove-special'." |
8743 | 434 (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
|
435 (add-text-properties start end '(intangible t))) |
8743 | 436 |
437 (defun facemenu-set-read-only (start end) | |
438 "Make the region unmodifiable. | |
439 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
|
440 `facemenu-remove-special'." |
8743 | 441 (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
|
442 (add-text-properties start end '(read-only t))) |
8743 | 443 |
20443
76ea51acad22
(facemenu-remove-face-props): Renamed from
Karl Heuer <kwzh@gnu.org>
parents:
19686
diff
changeset
|
444 (defun facemenu-remove-face-props (start end) |
76ea51acad22
(facemenu-remove-face-props): Renamed from
Karl Heuer <kwzh@gnu.org>
parents:
19686
diff
changeset
|
445 "Remove `face' and `mouse-face' text properties." |
8743 | 446 (interactive "*r") ; error if buffer is read-only despite the next line. |
447 (let ((inhibit-read-only t)) | |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
448 (remove-text-properties |
20443
76ea51acad22
(facemenu-remove-face-props): Renamed from
Karl Heuer <kwzh@gnu.org>
parents:
19686
diff
changeset
|
449 start end '(face nil mouse-face nil)))) |
8743 | 450 |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
451 (defun facemenu-remove-all (start end) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
452 "Remove all text properties from the region." |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
453 (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
|
454 (let ((inhibit-read-only t)) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
455 (set-text-properties start end nil))) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
456 |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
457 (defun facemenu-remove-special (start end) |
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
458 "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
|
459 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
|
460 (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
|
461 (let ((inhibit-read-only t)) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
462 (remove-text-properties |
12014
e4932082046a
(facemenu-special-menu): Use characters, not symbols.
Karl Heuer <kwzh@gnu.org>
parents:
11830
diff
changeset
|
463 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
|
464 |
11372
874b91f4adc4
(facemenu-read-color): Don't ignore PROMPT arg. Make arg optional.
Boris Goldowsky <boris@gnu.org>
parents:
11234
diff
changeset
|
465 (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
|
466 "Read a color using the minibuffer." |
64211
11c1d62f46ae
(facemenu-read-color): Do case-insensitive matching.
Richard M. Stallman <rms@gnu.org>
parents:
64091
diff
changeset
|
467 (let* ((completion-ignore-case t) |
104294
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
468 (color-list (or facemenu-color-alist (defined-colors))) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
469 (completer |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
470 (lambda (string pred all-completions) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
471 (if all-completions |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
472 (or (all-completions string color-list pred) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
473 (if (color-defined-p string) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
474 (list string))) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
475 (or (try-completion string color-list pred) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
476 (if (color-defined-p string) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
477 string))))) |
6ee860194ef5
* facemenu.el (facemenu-read-color): Use a completion function
Chong Yidong <cyd@stupidchicken.com>
parents:
103020
diff
changeset
|
478 (col (completing-read (or prompt "Color: ") completer nil t))) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
479 (if (equal "" col) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
480 nil |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
481 col))) |
8743 | 482 |
108990
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
483 (defun color-rgb-to-hsv (r g b) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
484 "For R, G, B color components return a list of hue, saturation, value. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
485 R, G, B input values should be in [0..65535] range. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
486 Output values for hue are integers in [0..360] range. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
487 Output values for saturation and value are integers in [0..100] range." |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
488 (let* ((r (/ r 65535.0)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
489 (g (/ g 65535.0)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
490 (b (/ b 65535.0)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
491 (max (max r g b)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
492 (min (min r g b)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
493 (h (cond ((= max min) 0) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
494 ((= max r) (mod (+ (* 60 (/ (- g b) (- max min))) 360) 360)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
495 ((= max g) (+ (* 60 (/ (- b r) (- max min))) 120)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
496 ((= max b) (+ (* 60 (/ (- r g) (- max min))) 240)))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
497 (s (cond ((= max 0) 0) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
498 (t (- 1 (/ min max))))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
499 (v max)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
500 (list (round h) (round s 0.01) (round v 0.01)))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
501 |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
502 (defcustom list-colors-sort nil |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
503 "Color sort order for `list-colors-display'. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
504 `nil' means default implementation-dependent order (defined in `x-colors'). |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
505 `name' sorts by color name. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
506 `rgb' sorts by red, green, blue components. |
108992
0c1f025545a1
* facemenu.el (list-colors-sort): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
108990
diff
changeset
|
507 `(rgb-dist . COLOR)' sorts by the RGB distance to the specified color. |
108990
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
508 `hsv' sorts by hue, saturation, value. |
108992
0c1f025545a1
* facemenu.el (list-colors-sort): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
108990
diff
changeset
|
509 `(hsv-dist . COLOR)' sorts by the HSV distance to the specified color |
108990
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
510 and excludes grayscale colors." |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
511 :type '(choice (const :tag "Unsorted" nil) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
512 (const :tag "Color Name" name) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
513 (const :tag "Red-Green-Blue" rgb) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
514 (cons :tag "Distance on RGB cube" |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
515 (const :tag "Distance from Color" rgb-dist) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
516 (color :tag "Source Color Name")) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
517 (const :tag "Hue-Saturation-Value" hsv) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
518 (cons :tag "Distance on HSV cylinder" |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
519 (const :tag "Distance from Color" hsv-dist) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
520 (color :tag "Source Color Name"))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
521 :group 'facemenu |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
522 :version "24.1") |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
523 |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
524 (defun list-colors-sort-key (color) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
525 "Return a list of keys for sorting colors depending on `list-colors-sort'. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
526 COLOR is the name of the color. When return value is nil, |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
527 filter out the color from the output." |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
528 (cond |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
529 ((null list-colors-sort) color) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
530 ((eq list-colors-sort 'name) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
531 (downcase color)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
532 ((eq list-colors-sort 'rgb) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
533 (color-values color)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
534 ((eq (car-safe list-colors-sort) 'rgb-dist) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
535 (color-distance color (cdr list-colors-sort))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
536 ((eq list-colors-sort 'hsv) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
537 (apply 'color-rgb-to-hsv (color-values color))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
538 ((eq (car-safe list-colors-sort) 'hsv-dist) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
539 (let* ((c-rgb (color-values color)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
540 (c-hsv (apply 'color-rgb-to-hsv c-rgb)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
541 (o-hsv (apply 'color-rgb-to-hsv |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
542 (color-values (cdr list-colors-sort))))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
543 (unless (and (eq (nth 0 c-rgb) (nth 1 c-rgb)) ; exclude grayscale |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
544 (eq (nth 1 c-rgb) (nth 2 c-rgb))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
545 ;; 3D Euclidean distance (sqrt is not needed for sorting) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
546 (+ (expt (- 180 (abs (- 180 (abs (- (nth 0 c-hsv) ; wrap hue |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
547 (nth 0 o-hsv)))))) 2) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
548 (expt (- (nth 1 c-hsv) (nth 1 o-hsv)) 2) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
549 (expt (- (nth 2 c-hsv) (nth 2 o-hsv)) 2))))))) |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
550 |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
551 (defun list-colors-display (&optional list buffer-name callback) |
11465
9fa2f8b87890
(list-colors-display): Minor clarification.
Richard M. Stallman <rms@gnu.org>
parents:
11372
diff
changeset
|
552 "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
|
553 If the optional argument LIST is non-nil, it should be a list of |
59482
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
554 colors to display. Otherwise, this command computes a list of |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
555 colors that the current display can handle. |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
556 |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
557 If the optional argument BUFFER-NAME is nil, it defaults to |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
558 *Colors*. |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
559 |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
560 If the optional argument CALLBACK is non-nil, it should be a |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
561 function to call each time the user types RET or clicks on a |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
562 color. The function should accept a single argument, the color |
108990
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
563 name. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
564 |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
565 You can change the color sort order by customizing `list-colors-sort'." |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
566 (interactive) |
42948
74d5b26ad460
(list-colors-display): If the argument is nil, don't
Eli Zaretskii <eliz@gnu.org>
parents:
42488
diff
changeset
|
567 (when (and (null list) (> (display-color-cells) 0)) |
59482
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
568 (setq list (list-colors-duplicates (defined-colors))) |
108990
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
569 (when list-colors-sort |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
570 ;; Schwartzian transform with `(color key1 key2 key3 ...)'. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
571 (setq list (mapcar |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
572 'car |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
573 (sort (delq nil (mapcar |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
574 (lambda (c) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
575 (let ((key (list-colors-sort-key |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
576 (car c)))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
577 (when key |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
578 (cons c (if (consp key) key |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
579 (list key)))))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
580 list)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
581 (lambda (a b) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
582 (let* ((a-keys (cdr a)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
583 (b-keys (cdr b)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
584 (a-key (car a-keys)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
585 (b-key (car b-keys))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
586 ;; Skip common keys at the beginning of key lists. |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
587 (while (and a-key b-key (equal a-key b-key)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
588 (setq a-keys (cdr a-keys) a-key (car a-keys) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
589 b-keys (cdr b-keys) b-key (car b-keys))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
590 (cond |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
591 ((and (numberp a-key) (numberp b-key)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
592 (< a-key b-key)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
593 ((and (stringp a-key) (stringp b-key)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
594 (string< a-key b-key))))))))) |
45207
a8c6bd4220a5
(list-colors-display): Don't use `display-color-cells' unless the
Miles Bader <miles@gnu.org>
parents:
45021
diff
changeset
|
595 (when (memq (display-visual-class) '(gray-scale pseudo-color direct-color)) |
a8c6bd4220a5
(list-colors-display): Don't use `display-color-cells' unless the
Miles Bader <miles@gnu.org>
parents:
45021
diff
changeset
|
596 ;; Don't show more than what the display can handle. |
a8c6bd4220a5
(list-colors-display): Don't use `display-color-cells' unless the
Miles Bader <miles@gnu.org>
parents:
45021
diff
changeset
|
597 (let ((lc (nthcdr (1- (display-color-cells)) list))) |
a8c6bd4220a5
(list-colors-display): Don't use `display-color-cells' unless the
Miles Bader <miles@gnu.org>
parents:
45021
diff
changeset
|
598 (if lc |
a8c6bd4220a5
(list-colors-display): Don't use `display-color-cells' unless the
Miles Bader <miles@gnu.org>
parents:
45021
diff
changeset
|
599 (setcdr lc nil))))) |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
600 (let ((buf (get-buffer-create "*Colors*"))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
601 (with-current-buffer buf |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
602 (erase-buffer) |
59482
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
603 (setq truncate-lines t) |
109013
d94083f6e4e9
* lisp/facemenu.el (list-colors-display): Call `pop-to-buffer' before
Juri Linkov <juri@jurta.org>
parents:
108992
diff
changeset
|
604 ;; Display buffer before generating content to allow |
d94083f6e4e9
* lisp/facemenu.el (list-colors-display): Call `pop-to-buffer' before
Juri Linkov <juri@jurta.org>
parents:
108992
diff
changeset
|
605 ;; `list-colors-print' to get the right window-width. |
d94083f6e4e9
* lisp/facemenu.el (list-colors-display): Call `pop-to-buffer' before
Juri Linkov <juri@jurta.org>
parents:
108992
diff
changeset
|
606 (pop-to-buffer buf) |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
607 (list-colors-print list callback) |
109013
d94083f6e4e9
* lisp/facemenu.el (list-colors-display): Call `pop-to-buffer' before
Juri Linkov <juri@jurta.org>
parents:
108992
diff
changeset
|
608 (set-buffer-modified-p nil))) |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
609 (if callback |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
610 (message "Click on a color to select it."))) |
59484
c6ded43591fd
* facemenu.el (list-colors-print): New function created from code
Juri Linkov <juri@jurta.org>
parents:
59482
diff
changeset
|
611 |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
612 (defun list-colors-print (list &optional callback) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
613 (let ((callback-fn |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
614 (if callback |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
615 `(lambda (button) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
616 (funcall ,callback (button-get button 'color-name)))))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
617 (dolist (color list) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
618 (if (consp color) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
619 (if (cdr color) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
620 (setq color (sort color (lambda (a b) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
621 (string< (downcase a) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
622 (downcase b)))))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
623 (setq color (list color))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
624 (let* ((opoint (point)) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
625 (color-values (color-values (car color))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
626 (light-p (>= (apply 'max color-values) |
108979
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
627 (* (car (color-values "white")) .5))) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
628 (max-len (max (- (window-width) 33) 20))) |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
629 (insert (car color)) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
630 (indent-to 22) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
631 (put-text-property opoint (point) 'face `(:background ,(car color))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
632 (put-text-property |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
633 (prog1 (point) |
108979
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
634 (insert " ") |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
635 (if (cdr color) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
636 ;; Insert as many color names as possible, fitting max-len. |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
637 (let ((names (list (car color))) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
638 (others (cdr color)) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
639 (len (length (car color))) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
640 newlen) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
641 (while (and others |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
642 (< (setq newlen (+ len 2 (length (car others)))) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
643 max-len)) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
644 (setq len newlen) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
645 (push (pop others) names)) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
646 (insert (mapconcat 'identity (nreverse names) ", "))) |
6d1b80d173b3
Add all rgb.txt color names to x-colors.
Chong Yidong <cyd@stupidchicken.com>
parents:
107382
diff
changeset
|
647 (insert (car color)))) |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
648 (point) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
649 'face (list :foreground (car color))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
650 (indent-to (max (- (window-width) 8) 44)) |
108990
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
651 (insert (propertize |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
652 (apply 'format "#%02x%02x%02x" |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
653 (mapcar (lambda (c) (lsh c -8)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
654 color-values)) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
655 'mouse-face 'highlight |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
656 'help-echo |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
657 (let ((hsv (apply 'color-rgb-to-hsv |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
658 (color-values (car color))))) |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
659 (format "H:%d S:%d V:%d" |
8f3a9d4ebe87
Add sort option `list-colors-sort'. (Bug#6332)
Juri Linkov <juri@jurta.org>
parents:
108979
diff
changeset
|
660 (nth 0 hsv) (nth 1 hsv) (nth 2 hsv))))) |
107382
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
661 (when callback |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
662 (make-text-button |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
663 opoint (point) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
664 'follow-link t |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
665 'mouse-face (list :background (car color) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
666 :foreground (if light-p "black" "white")) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
667 'color-name (car color) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
668 'action callback-fn))) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
669 (insert "\n")) |
96ec3562df8f
Allow using list-colors-display to set colors in the Color widget.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
670 (goto-char (point-min)))) |
59484
c6ded43591fd
* facemenu.el (list-colors-print): New function created from code
Juri Linkov <juri@jurta.org>
parents:
59482
diff
changeset
|
671 |
59482
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
672 |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
673 (defun list-colors-duplicates (&optional list) |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
674 "Return a list of colors with grouped duplicate colors. |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
675 If a color has no duplicates, then the element of the returned list |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
676 has the form '(COLOR-NAME). The element of the returned list with |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
677 duplicate colors has the form '(COLOR-NAME DUPLICATE-COLOR-NAME ...). |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
678 This function uses the predicate `facemenu-color-equal' to compare |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
679 color names. If the optional argument LIST is non-nil, it should |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
680 be a list of colors to display. Otherwise, this function uses |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
681 a list of colors that the current display can handle." |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
682 (let* ((list (mapcar 'list (or list (defined-colors)))) |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
683 (l list)) |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
684 (while (cdr l) |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
685 (if (and (facemenu-color-equal (car (car l)) (car (car (cdr l)))) |
103020
7fb0884440b3
(list-colors-duplicates): w32-default-color-map is a function.
Jason Rumney <jasonr@gnu.org>
parents:
100908
diff
changeset
|
686 (not (if (fboundp 'w32-default-color-map) |
7fb0884440b3
(list-colors-duplicates): w32-default-color-map is a function.
Jason Rumney <jasonr@gnu.org>
parents:
100908
diff
changeset
|
687 (not (assoc (car (car l)) (w32-default-color-map)))))) |
59482
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
688 (progn |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
689 (setcdr (car l) (cons (car (car (cdr l))) (cdr (car l)))) |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
690 (setcdr l (cdr (cdr l)))) |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
691 (setq l (cdr l)))) |
6b794a66a256
(list-colors-display): Add new arg buffer-name.
Juri Linkov <juri@jurta.org>
parents:
56936
diff
changeset
|
692 list)) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
693 |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
694 (defun facemenu-color-equal (a b) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
695 "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
|
696 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
|
697 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
|
698 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
|
699 determine the correct answer." |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
700 (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
|
701 ((equal (color-values a) (color-values b))))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
702 |
109881
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
703 |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
704 (defvar facemenu-self-insert-data nil) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
705 |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
706 (defun facemenu-post-self-insert-function () |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
707 (when (and (car facemenu-self-insert-data) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
708 (eq last-command (cdr facemenu-self-insert-data))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
709 (put-text-property (1- (point)) (point) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
710 'face (car facemenu-self-insert-data)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
711 (setq facemenu-self-insert-data nil)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
712 (remove-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
713 |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
714 (defun facemenu-set-self-insert-face (face) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
715 "Arrange for the next self-inserted char to have face `face'." |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
716 (setq facemenu-self-insert-data (cons face this-command)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
717 (add-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
718 |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
719 (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
|
720 "Add FACE to text between START and END. |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
721 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
|
722 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
|
723 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
|
724 that will be removed from the list. |
43902
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
725 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
|
726 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
|
727 |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
728 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
|
729 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
|
730 effect. See `facemenu-remove-face-function'." |
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
731 (interactive "*xFace: \nr") |
109881
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
732 (cond |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
733 ((and (eq face 'default) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
734 (not (eq facemenu-remove-face-function t))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
735 (if facemenu-remove-face-function |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
736 (funcall facemenu-remove-face-function start end) |
13923
35e379a3952e
(facemenu-read-color, list-colors-display)
Richard M. Stallman <rms@gnu.org>
parents:
13495
diff
changeset
|
737 (if (and start (< start end)) |
109881
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
738 (remove-text-properties start end '(face default)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
739 (facemenu-set-self-insert-face 'default)))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
740 (facemenu-add-face-function |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
741 (save-excursion |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
742 (if end (goto-char end)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
743 (save-excursion |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
744 (if start (goto-char start)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
745 (insert-before-markers |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
746 (funcall facemenu-add-face-function face end))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
747 (if facemenu-end-add-face |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
748 (insert (if (stringp facemenu-end-add-face) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
749 facemenu-end-add-face |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
750 (funcall facemenu-end-add-face face)))))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
751 ((and start (< start end)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
752 (let ((part-start start) part-end) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
753 (while (not (= part-start end)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
754 (setq part-end (next-single-property-change part-start 'face |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
755 nil end)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
756 (let ((prev (get-text-property part-start 'face))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
757 (put-text-property part-start part-end 'face |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
758 (if (null prev) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
759 face |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
760 (facemenu-active-faces |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
761 (cons face |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
762 (if (listp prev) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
763 prev |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
764 (list prev))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
765 ;; Specify the selected frame |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
766 ;; because nil would mean to use |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
767 ;; the new-frame default settings, |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
768 ;; and those are usually nil. |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
769 (selected-frame))))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
770 (setq part-start part-end)))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
771 (t |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
772 (facemenu-set-self-insert-face |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
773 (if (eq last-command (cdr facemenu-self-insert-data)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
774 (cons face (if (listp (car facemenu-self-insert-data)) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
775 (car facemenu-self-insert-data) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
776 (list (car facemenu-self-insert-data)))) |
3db1493a6f89
New post-self-insert-hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
109013
diff
changeset
|
777 face)))) |
63814
db398a23f0d0
(facemenu-add-face): Warn when font-lock is active.
Richard M. Stallman <rms@gnu.org>
parents:
63792
diff
changeset
|
778 (unless (facemenu-enable-faces-p) |
db398a23f0d0
(facemenu-add-face): Warn when font-lock is active.
Richard M. Stallman <rms@gnu.org>
parents:
63792
diff
changeset
|
779 (message "Font-lock mode will override any faces you set in this buffer"))) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
780 |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
781 (defun facemenu-active-faces (face-list &optional frame) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
782 "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
|
783 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
|
784 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
|
785 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
|
786 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
|
787 (let* ((mask-atts (copy-sequence |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
788 (if (consp (car face-list)) |
42488
cbf9d3debb0a
(facemenu-active-faces):
Richard M. Stallman <rms@gnu.org>
parents:
41799
diff
changeset
|
789 (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
|
790 (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
|
791 (check-face (car face-list)))))) |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
792 (active-list (list (car face-list))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
793 (face-list (cdr face-list)) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
794 (mask-len (length mask-atts))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
795 (while face-list |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
796 (if (let ((face-atts |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
797 (if (consp (car face-list)) |
42488
cbf9d3debb0a
(facemenu-active-faces):
Richard M. Stallman <rms@gnu.org>
parents:
41799
diff
changeset
|
798 (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
|
799 (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
|
800 (check-face (car face-list))))) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
801 (i mask-len) |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
802 (useful nil)) |
56936
6257efe5587a
(facemenu-active-faces): Change condition of inner `while' loop to
Luc Teirlinck <teirllm@auburn.edu>
parents:
55705
diff
changeset
|
803 (while (>= (setq i (1- i)) 0) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
804 (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
|
805 (memq (aref mask-atts i) '(nil unspecified)) |
13495
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
806 (aset mask-atts i (setq useful t)))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
807 useful) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
808 (setq active-list (cons (car face-list) active-list))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
809 (setq face-list (cdr face-list))) |
fcfb5f397b49
(facemenu-active-faces): Replaces function
Karl Heuer <kwzh@gnu.org>
parents:
13433
diff
changeset
|
810 (nreverse active-list))) |
9494
9a4ed505445e
(facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents:
8953
diff
changeset
|
811 |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
812 (defun facemenu-add-new-face (face) |
72335
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
813 "Add FACE (a face) to the Face menu if `facemenu-listed-faces' says so. |
d6694b6039c1
(facemenu-add-face): Pass frame to facemenu-active-faces.
Richard M. Stallman <rms@gnu.org>
parents:
71568
diff
changeset
|
814 This is called whenever you create a new face, and at other times." |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
815 (let* (name |
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
816 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
|
817 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
|
818 (key (cdr (assoc face facemenu-keybindings))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
819 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
|
820 (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
|
821 (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
|
822 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
|
823 (setq name face |
40280
e14f2ec78074
(facemenu-add-new-face): Fix variable names.
Miles Bader <miles@gnu.org>
parents:
40275
diff
changeset
|
824 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
|
825 (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
|
826 (setq docstring |
105870
26baacb565b0
* textmodes/tex-mode.el (tex-alt-dvi-print-command)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105821
diff
changeset
|
827 (purecopy (format "Select face `%s' for subsequent insertion. |
74281
0c96941203c0
(facemenu-add-new-face): Improve doc strings of constructed commands.
Richard M. Stallman <rms@gnu.org>
parents:
73412
diff
changeset
|
828 If the mark is active and there is no prefix argument, |
0c96941203c0
(facemenu-add-new-face): Improve doc strings of constructed commands.
Richard M. Stallman <rms@gnu.org>
parents:
73412
diff
changeset
|
829 apply face `%s' to the region instead. |
0c96941203c0
(facemenu-add-new-face): Improve doc strings of constructed commands.
Richard M. Stallman <rms@gnu.org>
parents:
73412
diff
changeset
|
830 This command was defined by `facemenu-add-new-face'." |
105870
26baacb565b0
* textmodes/tex-mode.el (tex-alt-dvi-print-command)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105821
diff
changeset
|
831 name name))) |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
832 (cond ((facemenu-iterate ; check if equivalent face is already in the menu |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
833 (lambda (m) (and (listp m) |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
834 (symbolp (car m)) |
73412
fb5c7e2b2689
(facemenu-add-new-face): Defend against symbol that isn't a face name.
Richard M. Stallman <rms@gnu.org>
parents:
72338
diff
changeset
|
835 ;; Avoid error in face-equal |
fb5c7e2b2689
(facemenu-add-new-face): Defend against symbol that isn't a face name.
Richard M. Stallman <rms@gnu.org>
parents:
72338
diff
changeset
|
836 ;; when a non-face is erroneously present. |
fb5c7e2b2689
(facemenu-add-new-face): Defend against symbol that isn't a face name.
Richard M. Stallman <rms@gnu.org>
parents:
72338
diff
changeset
|
837 (facep (car m)) |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
838 (face-equal (car m) symbol))) |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
839 (cdr (symbol-function menu)))) |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
840 ;; Faces with a keyboard equivalent. These go at the front. |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
841 (key |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
842 (setq function (intern (concat "facemenu-set-" name))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
843 (fset function |
17555
6e2928cff18e
(facemenu-add-new-face): Rewrite to give each
Richard M. Stallman <rms@gnu.org>
parents:
17505
diff
changeset
|
844 `(lambda () |
6e2928cff18e
(facemenu-add-new-face): Rewrite to give each
Richard M. Stallman <rms@gnu.org>
parents:
17505
diff
changeset
|
845 ,docstring |
6e2928cff18e
(facemenu-add-new-face): Rewrite to give each
Richard M. Stallman <rms@gnu.org>
parents:
17505
diff
changeset
|
846 (interactive) |
43902
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
847 (facemenu-set-face |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
848 (quote ,symbol) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
849 (if (and mark-active (not current-prefix-arg)) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
850 (region-beginning)) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
851 (if (and mark-active (not current-prefix-arg)) |
e0e6df854822
(facemenu-add-new-face):
Richard M. Stallman <rms@gnu.org>
parents:
43412
diff
changeset
|
852 (region-end))))) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
853 (define-key 'facemenu-keymap key (cons name function)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
854 (define-key menu key (cons name function))) |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
855 ;; Faces with no keyboard equivalent. Figure out where to put it: |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
856 ((or (eq t facemenu-listed-faces) |
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
857 (memq symbol facemenu-listed-faces)) |
40275
113233ecd44a
(facemenu-unlisted-faces): Improve doc strings
Richard M. Stallman <rms@gnu.org>
parents:
35633
diff
changeset
|
858 (setq key (vector symbol) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
859 function 'facemenu-set-face-from-menu |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
860 menu-val (symbol-function menu)) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
861 (if (and facemenu-new-faces-at-end |
71568
8d6af1c1c365
* facemenu.el (facemenu-listed-faces): New var.
Chong Yidong <cyd@stupidchicken.com>
parents:
71369
diff
changeset
|
862 (> (length menu-val) 3)) |
10520
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
863 (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
|
864 (car (nth (- (length menu-val) 3) menu-val))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
865 (define-key menu key (cons name function)))))) |
3d30caa4b459
(facemenu-keybindings, facemenu-face-menu):
Richard M. Stallman <rms@gnu.org>
parents:
10238
diff
changeset
|
866 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
|
867 |
63792
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
868 (defun facemenu-add-new-color (color menu) |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
869 "Add COLOR (a color name string) to the appropriate Face menu. |
63792
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
870 MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'. |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
871 Return the event type (a symbol) of the added menu entry. |
44611
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
872 |
e4a2909015d3
(facemenu-add-new-face): Use this only for faces. Delete arg MENU.
Richard M. Stallman <rms@gnu.org>
parents:
44593
diff
changeset
|
873 This is called whenever you use a new color." |
63792
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
874 (let (symbol docstring) |
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
875 (unless (color-defined-p color) |
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
876 (error "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
|
877 (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
|
878 (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
|
879 (format "Select foreground color %s for subsequent insertion." |
63792
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
880 color) |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
881 symbol (intern (concat "fg:" 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
|
882 ((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
|
883 (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
|
884 (format "Select background color %s for subsequent insertion." |
63792
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
885 color) |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
886 symbol (intern (concat "bg:" color)))) |
63792
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
887 (t (error "MENU should be `facemenu-foreground-menu' or `facemenu-background-menu'"))) |
63897
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
888 (unless (facemenu-iterate ; Check if color is already in the menu. |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
889 (lambda (m) (and (listp m) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
890 (eq (car m) symbol))) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
891 (cdr (symbol-function menu))) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
892 ;; Color is not in the menu. Figure out where to put it. |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
893 (let ((key (vector symbol)) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
894 (function 'facemenu-set-face-from-menu) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
895 (menu-val (symbol-function menu))) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
896 (if (and facemenu-new-faces-at-end |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
897 (> (length menu-val) 3)) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
898 (define-key-after menu-val key (cons color function) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
899 (car (nth (- (length menu-val) 3) menu-val))) |
f8e70842f12b
(facemenu-unlisted-faces): Delete foreground and background color
Lute Kamstra <lute@gnu.org>
parents:
63814
diff
changeset
|
900 (define-key menu key (cons color function))))) |
63792
8e5d2e4fa77a
(facemenu-unlisted-faces): Add foreground and background color faces.
Lute Kamstra <lute@gnu.org>
parents:
63769
diff
changeset
|
901 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
|
902 |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
903 (defun facemenu-complete-face-list (&optional oldlist) |
15358
91b8056dcd35
(facemenu-complete-face-list): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
14901
diff
changeset
|
904 "Return list of all faces that look different. |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
905 Starts with given ALIST of faces, and adds elements only if they display |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
906 differently from any face already on the list. |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
907 The faces on ALIST will end up at the end of the returned list, in reverse |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
908 order." |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
909 (let ((list (nreverse (mapcar 'car oldlist)))) |
49588
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
910 (facemenu-iterate |
37645a051842
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
46248
diff
changeset
|
911 (lambda (new-face) |
9623
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
912 (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
|
913 (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
|
914 nil) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
915 (nreverse (face-list))) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
916 list)) |
fe1c170fa35a
(facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents:
9494
diff
changeset
|
917 |
30092
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
918 (defun facemenu-iterate (func list) |
8743 | 919 "Apply FUNC to each element of LIST until one returns non-nil. |
920 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
|
921 (while (and list (not (funcall func (car list)))) |
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
922 (setq list (cdr list))) |
6d383cf4bb99
Docstrings fixes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29050
diff
changeset
|
923 (car list)) |
8743 | 924 |
925 (facemenu-update) | |
926 | |
46248
345d4d775bf0
Move `provide' to the end.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45869
diff
changeset
|
927 (provide 'facemenu) |
52401 | 928 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
929 ;; arch-tag: 85f6d02b-9085-420e-b651-0678f0e9c7eb |
8743 | 930 ;;; facemenu.el ends here |