annotate lisp/facemenu.el @ 8767:441af4b664ac

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