Mercurial > emacs
annotate lisp/facemenu.el @ 8850:90773ae84a4f
(facemenu-update): Reverse the menu order again.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 17 Sep 1994 03:32:48 +0000 |
parents | d7115dce85f9 |
children | 231a4d114799 |
rev | line source |
---|---|
8743 | 1 ;;; facemenu.el -- Create a face menu for interactively adding fonts to text |
2 ;; Copyright (c) 1994 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Boris Goldowsky <boris@cs.rochester.edu> | |
5 ;; Keywords: faces | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | |
23 ;;; Commentary: | |
24 ;; This file defines a menu of faces (bold, italic, etc) which | |
25 ;; allows you to set the face used for a region of the buffer. | |
26 ;; Some faces also have keybindings, which are shown in the menu. | |
27 | |
28 ;;; Installation: | |
29 ;; Put this file somewhere on emacs's load-path, and put | |
30 ;; (require 'facemenu) | |
31 ;; in your .emacs file. | |
32 | |
33 ;;; Usage: | |
34 ;; Selecting a face from the menu or typing the keyboard equivalent | |
35 ;; will change the region to use that face. | |
36 ;; If you use transient-mark-mode and the region is not active, the | |
37 ;; face will be remembered and used for the next insertion. It will | |
38 ;; be forgotten if you move point or make other modifications before | |
39 ;; inserting or typing anything. | |
40 ;; | |
41 ;; Faces can be selected from the keyboard as well. | |
42 ;; The standard keybindings are M-s (or ESC s) + letter: | |
43 ;; M-s i = "set italic", M-s b = "set bold", etc. | |
44 | |
45 ;;; Customization: | |
46 ;; An alternative set of keybindings that may be easier to type can be set up | |
47 ;; using "Hyper" keys. This requires that you set up a hyper-key on your | |
48 ;; keyboard. On my system, putting the following command in my .xinitrc: | |
49 ;; xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L" | |
50 ;; makes the key labelled "Alt" act as a hyper key, but check with local | |
51 ;; X-perts for how to do it on your system. If you do this, then put the | |
52 ;; following in your .emacs before the (require 'facemenu): | |
53 ;; (setq facemenu-keybindings | |
54 ;; '((default . [?\H-d]) | |
55 ;; (bold . [?\H-b]) | |
56 ;; (italic . [?\H-i]) | |
57 ;; (bold-italic . [?\H-o]) | |
58 ;; (underline . [?\H-u]))) | |
59 ;; (setq facemenu-keymap global-map) | |
60 ;; (setq facemenu-key nil) | |
61 ;; | |
62 ;; In general, the order of the faces that appear in the menu and their | |
63 ;; keybindings can be controlled by setting the variable | |
64 ;; `facemenu-keybindings'. Faces that you never want to add to your | |
65 ;; document (e.g., `region') are listed in `facemenu-unlisted-faces'. | |
66 | |
67 ;;; Known Problems: | |
68 ;; Only works with Emacs 19.23 and later. | |
69 ;; | |
70 ;; There is at present no way to display what the faces look like in | |
71 ;; the menu itself. | |
72 ;; | |
73 ;; `list-faces-display' shows the faces in a different order than | |
74 ;; this menu, which could be confusing. I do /not/ sort the list | |
75 ;; alphabetically, because I like the default order: it puts the most | |
76 ;; basic, common fonts first. | |
77 ;; | |
78 ;; Please send me any other problems, comments or ideas. | |
79 | |
80 ;;; Code: | |
81 | |
82 (provide 'facemenu) | |
83 | |
84 (defvar facemenu-key "\M-s" | |
85 "Prefix to use for facemenu commands.") | |
86 | |
87 (defvar facemenu-keymap nil | |
88 "Map for keybindings of face commands. | |
89 If nil, `facemenu-update' will create one. | |
90 `Facemenu-update' also fills in the keymap according to the bindings | |
91 requested in facemenu-keybindings.") | |
92 | |
93 (defvar facemenu-keybindings | |
94 '((default . "d") | |
95 (bold . "b") | |
96 (italic . "i") | |
97 (bold-italic . "o") ; O for "Oblique" or "bOld"... | |
98 (underline . "u")) | |
99 "Alist of interesting faces and keybindings. | |
100 Each element is itself a list: the car is the name of the face, | |
101 the next element is the key to use as a keyboard equivalent of the menu item; | |
102 the binding is made in facemenu-keymap. | |
103 | |
104 The faces specifically mentioned in this list are put at the top of | |
105 the menu, in the order specified. All other faces which are defined, | |
106 except for those in `facemenu-unlisted-faces', are listed after them, | |
107 but get no keyboard equivalents. | |
108 | |
109 If you change this variable after loading facemenu.el, you will need to call | |
110 `facemenu-update' to make it take effect.") | |
111 | |
112 (defvar facemenu-unlisted-faces | |
113 '(modeline region secondary-selection highlight scratch-face) | |
114 "Faces that are not included in the Face menu. | |
115 Set this before loading facemenu.el, or call `facemenu-update' after | |
116 changing it.") | |
117 | |
118 (defvar facemenu-next nil) ; set when we are going to set a face on next char. | |
119 (defvar facemenu-loc nil) | |
120 | |
121 (defun facemenu-update () | |
122 "Add or update the \"Face\" menu in the menu bar." | |
123 (interactive) | |
124 | |
125 ;; Set up keymaps | |
126 (fset 'facemenu-menu (setq facemenu-menu (make-sparse-keymap "Face"))) | |
127 (if (null facemenu-keymap) | |
128 (fset 'facemenu-keymap | |
129 (setq facemenu-keymap (make-sparse-keymap "Set face")))) | |
130 (if facemenu-key | |
131 (define-key global-map facemenu-key facemenu-keymap)) | |
132 | |
133 ;; Define basic keys | |
8747
d7115dce85f9
(facemenu-update): Don't use quoted constant lists
Richard M. Stallman <rms@gnu.org>
parents:
8743
diff
changeset
|
134 ;; We construct this list structure explicitly because a quoted constant |
d7115dce85f9
(facemenu-update): Don't use quoted constant lists
Richard M. Stallman <rms@gnu.org>
parents:
8743
diff
changeset
|
135 ;; would be pure. |
8850
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
136 (define-key facemenu-menu [update] (cons "Update Menu" 'facemenu-update)) |
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
137 (define-key facemenu-menu [display] (cons "Display" 'list-faces-display)) |
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
138 (define-key facemenu-menu [sep1] (list "-------------")) |
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
139 (define-key facemenu-menu [remove] (cons "Remove Properties" |
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
140 'facemenu-remove-all)) |
8747
d7115dce85f9
(facemenu-update): Don't use quoted constant lists
Richard M. Stallman <rms@gnu.org>
parents:
8743
diff
changeset
|
141 (define-key facemenu-menu [read-only] (cons "Read-Only" |
d7115dce85f9
(facemenu-update): Don't use quoted constant lists
Richard M. Stallman <rms@gnu.org>
parents:
8743
diff
changeset
|
142 'facemenu-set-read-only)) |
8850
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
143 (define-key facemenu-menu [invisible] (cons "Invisible" |
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
144 'facemenu-set-invisible)) |
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
145 (define-key facemenu-menu [sep2] (list "---Special---")) |
90773ae84a4f
(facemenu-update): Reverse the menu order again.
Richard M. Stallman <rms@gnu.org>
parents:
8747
diff
changeset
|
146 (define-key facemenu-menu [other] (cons "Other..." 'facemenu-set-face)) |
8743 | 147 |
148 ;; Define commands for face-changing | |
149 (facemenu-iterate | |
150 (function | |
151 (lambda (f) | |
152 (let ((face (car f)) | |
153 (name (symbol-name (car f))) | |
154 (key (cdr f))) | |
155 (cond ((memq face facemenu-unlisted-faces) | |
156 nil) | |
157 ((null key) (define-key facemenu-menu (vector face) | |
158 (cons name 'facemenu-set-face-from-menu))) | |
159 (t (let ((function (intern (concat "facemenu-set-" name)))) | |
160 (fset function | |
161 (` (lambda () (interactive) | |
162 (facemenu-set-face (quote (, face)))))) | |
163 (define-key facemenu-keymap key (cons name function)) | |
164 (define-key facemenu-menu key (cons name function)))))) | |
165 nil)) | |
166 (facemenu-complete-face-list facemenu-keybindings)) | |
167 | |
168 (define-key global-map (vector 'menu-bar 'Face) | |
169 (cons "Face" facemenu-menu))) | |
170 | |
171 ; We'd really like to name the menu items as follows, | |
172 ; but we can't since menu entries don't display text properties (yet?) | |
173 ; (let ((s (copy-sequence (symbol-name face)))) | |
174 ; (put-text-property 0 (1- (length s)) | |
175 ; 'face face s) | |
176 ; s) | |
177 | |
178 ;;;###autoload | |
179 (defun facemenu-set-face (face &optional start end) | |
180 "Set the face of the region or next character typed. | |
181 The face to be used is prompted for. | |
182 If the region is active, it will be set to the requested face. If | |
183 it is inactive \(even if mark-even-if-inactive is set) the next | |
184 character that is typed \(via `self-insert-command') will be set to | |
185 the the selected face. Moving point or switching buffers before | |
186 typing a character cancels the request." | |
187 (interactive (list (read-face-name "Use face: "))) | |
188 (if mark-active | |
189 (put-text-property (or start (region-beginning)) | |
190 (or end (region-end)) | |
191 'face face) | |
192 (setq facemenu-next face facemenu-loc (point)))) | |
193 | |
194 (defun facemenu-set-face-from-menu (face start end) | |
195 "Set the face of the region or next character typed. | |
196 This function is designed to be called from a menu; the face to use | |
197 is the menu item's name. | |
198 If the region is active, it will be set to the requested face. If | |
199 it is inactive \(even if mark-even-if-inactive is set) the next | |
200 character that is typed \(via `self-insert-command') will be set to | |
201 the the selected face. Moving point or switching buffers before | |
202 typing a character cancels the request." | |
203 (interactive (let ((keys (this-command-keys))) | |
204 (list (elt keys (1- (length keys))) | |
205 (if mark-active (region-beginning)) | |
206 (if mark-active (region-end))))) | |
207 (if start | |
208 (put-text-property start end 'face face) | |
209 (setq facemenu-next face facemenu-loc (point)))) | |
210 | |
211 (defun facemenu-set-invisible (start end) | |
212 "Make the region invisible. | |
213 This sets the `invisible' text property; it can be undone with | |
214 `facemenu-remove-all'." | |
215 (interactive "r") | |
216 (put-text-property start end 'invisible t)) | |
217 | |
218 (defun facemenu-set-intangible (start end) | |
219 "Make the region intangible: disallow moving into it. | |
220 This sets the `intangible' text property; it can be undone with | |
221 `facemenu-remove-all'." | |
222 (interactive "r") | |
223 (put-text-property start end 'intangible t)) | |
224 | |
225 (defun facemenu-set-read-only (start end) | |
226 "Make the region unmodifiable. | |
227 This sets the `read-only' text property; it can be undone with | |
228 `facemenu-remove-all'." | |
229 (interactive "r") | |
230 (put-text-property start end 'read-only t)) | |
231 | |
232 (defun facemenu-remove-all (start end) | |
233 "Remove all text properties that facemenu added to region." | |
234 (interactive "*r") ; error if buffer is read-only despite the next line. | |
235 (let ((inhibit-read-only t)) | |
236 (remove-text-properties | |
237 start end '(face nil invisible nil intangible nil | |
238 read-only nil category nil)))) | |
239 | |
240 (defun facemenu-after-change (begin end old-length) | |
241 "May set the face of just-inserted text to user's request. | |
242 This only happens if the change is an insertion, and | |
243 `facemenu-set-face[-from-menu]' was called with point at the | |
244 beginning of the insertion." | |
245 (if (null facemenu-next) ; exit immediately if no work | |
246 nil | |
247 (if (and (= 0 old-length) ; insertion | |
248 (= facemenu-loc begin)) ; point wasn't moved in between | |
249 (put-text-property begin end 'face facemenu-next)) | |
250 (setq facemenu-next nil))) | |
251 | |
252 | |
253 (defun facemenu-complete-face-list (&optional oldlist) | |
254 "Return alist of all faces that are look different. | |
255 Starts with given LIST of faces, and adds elements only if they display | |
256 differently from any face already on the list. | |
257 The original LIST will end up at the end of the returned list, in reverse | |
258 order. The elements added will have null cdrs." | |
259 (let ((list nil)) | |
260 (facemenu-iterate | |
261 (function | |
262 (lambda (item) | |
263 (if (internal-find-face (car item)) | |
264 (setq list (cons item list))) | |
265 nil)) | |
266 oldlist) | |
267 (facemenu-iterate | |
268 (function | |
269 (lambda (new-face) | |
270 (if (not (facemenu-iterate | |
271 (function | |
272 (lambda (item) (face-equal (car item) new-face t))) | |
273 list)) | |
274 (setq list (cons (cons new-face nil) list))) | |
275 nil)) | |
276 (nreverse (face-list))) | |
277 list)) | |
278 | |
279 (defun facemenu-iterate (func iterate-list) | |
280 "Apply FUNC to each element of LIST until one returns non-nil. | |
281 Returns the non-nil value it found, or nil if all were nil." | |
282 (while (and iterate-list (not (funcall func (car iterate-list)))) | |
283 (setq iterate-list (cdr iterate-list))) | |
284 (car iterate-list)) | |
285 | |
286 (facemenu-update) | |
287 (add-hook 'menu-bar-final-items 'Face) | |
288 (add-hook 'after-change-functions 'facemenu-after-change) | |
289 | |
290 ;;; facemenu.el ends here | |
291 |