annotate lisp/facemenu.el @ 10052:c51fcff184b7

Initial revision
author Richard M. Stallman <rms@gnu.org>
date Tue, 22 Nov 1994 19:30:44 +0000
parents 2bf88bd23cbb
children 0fcafe7e34cc
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:
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
24 ;; 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
25 ;; set the face used for a region of the buffer. Some faces also have
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
26 ;; keybindings, which are shown in the menu. Faces with names beginning with
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
27 ;; "fg:" or "bg:", as in "fg:red", are treated specially. It is assumed that
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
28 ;; Such faces are assumed to consist only of a foreground (if "fg:") or
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
29 ;; background (if "bg:") color. They are thus put into the color submenus
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
30 ;; rather than the general Face submenu. Such faces can also be created on
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
31 ;; demand from the "Other..." menu items.
8743
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:
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
34 ;; 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
35 ;; 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
36 ;; 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
37 ;; 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
38 ;; modifications before inserting or typing anything.
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;;
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;; Faces can be selected from the keyboard as well.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 ;; The standard keybindings are M-s (or ESC s) + letter:
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 ;; M-s i = "set italic", M-s b = "set bold", etc.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 ;;; Customization:
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 ;; 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
46 ;; 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
47 ;; keyboard. On my system, putting the following command in my .xinitrc:
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 ;; xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L"
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 ;; 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
50 ;; 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
51 ;; following in your .emacs before the (require 'facemenu):
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 ;; (setq facemenu-keybindings
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 ;; '((default . [?\H-d])
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 ;; (bold . [?\H-b])
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 ;; (italic . [?\H-i])
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 ;; (bold-italic . [?\H-o])
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 ;; (underline . [?\H-u])))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 ;; (setq facemenu-keymap global-map)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 ;; (setq facemenu-key nil)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 ;;
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 ;; 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
62 ;; keybindings can be controlled by setting the variable
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 ;; `facemenu-keybindings'. Faces that you never want to add to your
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 ;; document (e.g., `region') are listed in `facemenu-unlisted-faces'.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 ;;; Known Problems:
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 ;; 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
68 ;; the menu itself.
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 ;; `list-faces-display' shows the faces in a different order than
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 ;; this menu, which could be confusing. I do /not/ sort the list
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 ;; alphabetically, because I like the default order: it puts the most
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 ;; basic, common fonts first.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 ;;
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 ;; Please send me any other problems, comments or ideas.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 ;;; Code:
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (provide 'facemenu)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 (defvar facemenu-key "\M-s"
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 "Prefix to use for facemenu commands.")
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-keybindings
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 '((default . "d")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 (bold . "b")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 (italic . "i")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 (bold-italic . "o") ; O for "Oblique" or "bOld"...
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 (underline . "u"))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 "Alist of interesting faces and keybindings.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 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
92 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
93 the binding is made in facemenu-keymap.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 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
96 the menu, in the order specified. All other faces which are defined,
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 except for those in `facemenu-unlisted-faces', are listed after them,
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 but get no keyboard equivalents.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 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
101 `facemenu-update' to make it take effect.")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 (defvar facemenu-unlisted-faces
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 '(modeline region secondary-selection highlight scratch-face)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 "Faces that are not included in the Face menu.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 Set this before loading facemenu.el, or call `facemenu-update' after
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 changing it.")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
109 (defvar facemenu-face-menu
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
110 (let ((map (make-sparse-keymap "Face")))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
111 (define-key map [other] (cons "Other..." 'facemenu-set-face))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
112 map)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
113 "Menu keymap for faces.")
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
114
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
115 (defvar facemenu-foreground-menu
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
116 (let ((map (make-sparse-keymap "Foreground Color")))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
117 (define-key map "o" (cons "Other" 'facemenu-set-foreground))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
118 map)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
119 "Menu keymap for foreground colors.")
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
120
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
121 (defvar facemenu-background-menu
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
122 (let ((map (make-sparse-keymap "Background Color")))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
123 (define-key map "o" (cons "Other" 'facemenu-set-background))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
124 map)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
125 "Menu keymap for background colors")
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
126
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
127 (defvar facemenu-special-menu
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
128 (let ((map (make-sparse-keymap "Special")))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
129 (define-key map [read-only] (cons "Read-Only" 'facemenu-set-read-only))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
130 (define-key map [invisible] (cons "Invisible" 'facemenu-set-invisible))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
131 map)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
132 "Menu keymap for non-face text-properties.")
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
133
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
134 (defvar facemenu-menu
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
135 (let ((map (make-sparse-keymap "Face")))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
136 (define-key map [display] (cons "Display Faces" 'list-faces-display))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
137 (define-key map [remove] (cons "Remove Props" 'facemenu-remove-all))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
138 (define-key map [sep1] (list "-----------------"))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
139 (define-key map [special] (cons "Special Props" facemenu-special-menu))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
140 (define-key map [bg] (cons "Background Color" facemenu-background-menu))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
141 (define-key map [fg] (cons "Foreground Color" facemenu-foreground-menu))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
142 (define-key map [face] (cons "Face" facemenu-face-menu))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
143 map)
9874
2bf88bd23cbb (facemenu-update): Use C-down-mouse-2 for the menu.
Richard M. Stallman <rms@gnu.org>
parents: 9623
diff changeset
144 "Facemenu top-level menu keymap.")
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
145
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
146 (defvar facemenu-keymap (make-sparse-keymap "Set face")
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
147 "Map for keyboard face-changing commands.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
148 `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
149 requested in `facemenu-keybindings'.")
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
150
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
151 ;;; Internal Variables
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
152
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
153 (defvar facemenu-color-alist nil
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
154 ;; Don't initialize here; that doesn't work if preloaded.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
155 "Alist of colors, used for completion.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
156 If null, `facemenu-read-color' will set it.")
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
157
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 (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
159 (defvar facemenu-loc nil)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 (defun facemenu-update ()
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
162 "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
163 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
164 variables."
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (interactive)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
167 ;; Global bindings:
9874
2bf88bd23cbb (facemenu-update): Use C-down-mouse-2 for the menu.
Richard M. Stallman <rms@gnu.org>
parents: 9623
diff changeset
168 (define-key global-map [C-down-mouse-2] facemenu-menu)
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
169 (if facemenu-key (define-key global-map facemenu-key facemenu-keymap))
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
170
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
171 ;; 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
172 (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
173 (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
174
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
175 ;;;###autoload
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (defun facemenu-set-face (face &optional start end)
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
177 "Add FACE to the region or next character typed.
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
178 It will be added to the top of the face list; any faces lower on the list that
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
179 will not show through at all will be removed.
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
180
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
181 Interactively, the face to be used is prompted for.
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
182 If the region is active, it will be set to the requested face. If
8743
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
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
189 (let ((start (or start (region-beginning)))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
190 (end (or end (region-end))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
191 (facemenu-add-face face start end))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
192 (setq facemenu-next face
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
193 facemenu-loc (point))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
194
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
195 ;;;###autoload
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
196 (defun facemenu-set-foreground (color &optional start end)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
197 "Set the foreground color of the region or next character typed.
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
198 The color is prompted for. A face named `fg:color' is used \(or created).
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
199 If the region is active, it will be set to the requested face. If
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
200 it is inactive \(even if mark-even-if-inactive is set) the next
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
201 character that is typed \(via `self-insert-command') will be set to
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
202 the the selected face. Moving point or switching buffers before
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
203 typing a character cancels the request."
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
204 (interactive (list (facemenu-read-color "Foreground color: ")))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
205 (let ((face (intern (concat "fg:" color))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
206 (or (facemenu-get-face face)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
207 (error "Unknown color: %s" color))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
208 (facemenu-set-face face start end)))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
209
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
210 ;;;###autoload
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
211 (defun facemenu-set-background (color &optional start end)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
212 "Set the background color of the region or next character typed.
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
213 The color is prompted for. A face named `bg:color' is used \(or created).
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
214 If the region is active, it will be set to the requested face. If
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
215 it is inactive \(even if mark-even-if-inactive is set) the next
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
216 character that is typed \(via `self-insert-command') will be set to
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
217 the the selected face. Moving point or switching buffers before
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
218 typing a character cancels the request."
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
219 (interactive (list (facemenu-read-color "Background color: ")))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
220 (let ((face (intern (concat "bg:" color))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
221 (or (facemenu-get-face face)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
222 (error "Unknown color: %s" color))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
223 (facemenu-set-face face start end)))
8743
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-face-from-menu (face start end)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 "Set the face of the region or next character typed.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 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
228 is the menu item's name.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 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
230 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
231 character that is typed \(via `self-insert-command') will be set to
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 the the selected face. Moving point or switching buffers before
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 typing a character cancels the request."
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
234 (interactive (list last-command-event
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
235 (if mark-active (region-beginning))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
236 (if mark-active (region-end))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
237 (facemenu-get-face face)
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (if start
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
239 (facemenu-add-face face start end)
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 (setq facemenu-next face facemenu-loc (point))))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 (defun facemenu-set-invisible (start end)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 "Make the region invisible.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 This sets the `invisible' text property; it can be undone with
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 `facemenu-remove-all'."
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 (interactive "r")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (put-text-property start end 'invisible t))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 (defun facemenu-set-intangible (start end)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 "Make the region intangible: disallow moving into it.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 This sets the `intangible' text property; it can be undone with
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 `facemenu-remove-all'."
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (interactive "r")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (put-text-property start end 'intangible t))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (defun facemenu-set-read-only (start end)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 "Make the region unmodifiable.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 This sets the `read-only' text property; it can be undone with
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 `facemenu-remove-all'."
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260 (interactive "r")
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 (put-text-property start end 'read-only t))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 (defun facemenu-remove-all (start end)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 "Remove all text properties that facemenu added to region."
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 (interactive "*r") ; error if buffer is read-only despite the next line.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 (let ((inhibit-read-only t))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 (remove-text-properties
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 start end '(face nil invisible nil intangible nil
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 read-only nil category nil))))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
271 ;;;###autoload
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
272 (defun facemenu-read-color (prompt)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
273 "Read a color using the minibuffer."
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
274 (let ((col (completing-read (or "Color: ")
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
275 (or facemenu-color-alist
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
276 (if (eq 'x window-system)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
277 (mapcar 'list (x-defined-colors))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
278 nil t)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
279 (if (equal "" col)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
280 nil
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
281 col)))
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
283 (defun facemenu-add-face (face start end)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
284 "Add FACE to text between START and END.
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
285 For each section of that region that has a different face property, FACE will
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
286 be consed onto it, and other faces that are completely hidden by that will be
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
287 removed from the list.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
288
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
289 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
290 text property. Otherwise, selecting the default face would not have any
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
291 effect."
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
292 (interactive "*xFace:\nr")
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
293 (if (eq face 'default)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
294 (remove-text-properties start end '(face default))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
295 (let ((part-start start) part-end)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
296 (while (not (= part-start end))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
297 (setq part-end (next-single-property-change part-start 'face nil end))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
298 (let ((prev (get-text-property part-start 'face)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
299 (put-text-property part-start part-end 'face
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
300 (if (null prev)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
301 face
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
302 (facemenu-discard-redundant-faces
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
303 (cons face
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
304 (if (listp prev) prev (list prev)))))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
305 (setq part-start part-end)))))
9494
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
306
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
307 (defun facemenu-discard-redundant-faces (face-list &optional mask)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
308 "Remove from FACE-LIST any faces that won't show at all.
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
309 This means they have no non-nil elements that aren't also non-nil in an
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
310 earlier face."
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
311 (let ((useful nil))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
312 (cond ((null face-list) nil)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
313 ((null mask)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
314 (cons (car face-list)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
315 (facemenu-discard-redundant-faces
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
316 (cdr face-list)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
317 (copy-sequence (internal-get-face (car face-list))))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
318 ((let ((i (length mask))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
319 (face (internal-get-face (car face-list))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
320 (while (>= (setq i (1- i)) 0)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
321 (if (and (aref face i)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
322 (not (aref mask i)))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
323 (progn (setq useful t)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
324 (aset mask i t))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
325 useful)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
326 (cons (car face-list)
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
327 (facemenu-discard-redundant-faces (cdr face-list) mask)))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
328 (t (facemenu-discard-redundant-faces (cdr face-list) mask)))))
9a4ed505445e (facemenu-read-color, facemenu-colors): New fn, var.
Richard M. Stallman <rms@gnu.org>
parents: 8953
diff changeset
329
9623
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
330 (defun facemenu-get-face (symbol)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
331 "Make sure FACE exists.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
332 If not, it is created. If it is created and is of the form `fg:color', then
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
333 set the foreground to that color. If of the form `bg:color', set the
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
334 background. In any case, add it to the appropriate menu. Returns nil if
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
335 given a bad color."
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
336 (or (internal-find-face symbol)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
337 (let* ((face (make-face symbol))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
338 (name (symbol-name symbol))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
339 (color (substring name 3)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
340 (cond ((string-match "^fg:" name)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
341 (set-face-foreground face color)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
342 (and (eq 'x window-system) (x-color-defined-p color)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
343 ((string-match "^bg:" name)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
344 (set-face-background face color)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
345 (and (eq 'x window-system) (x-color-defined-p color)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
346 (t)))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
347
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
348 (defun facemenu-add-new-face (face)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
349 "Add a FACE to the appropriate Face menu.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
350 Automatically called when a new face is created."
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
351 (let* ((name (symbol-name face))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
352 (menu (cond ((string-match "^fg:" name)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
353 (setq name (substring name 3))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
354 facemenu-foreground-menu)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
355 ((string-match "^bg:" name)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
356 (setq name (substring name 3))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
357 facemenu-background-menu)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
358 (t facemenu-face-menu)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
359 key)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
360 (cond ((memq face facemenu-unlisted-faces)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
361 nil)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
362 ((setq key (cdr (assoc face facemenu-keybindings)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
363 (let ((function (intern (concat "facemenu-set-" name))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
364 (fset function
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
365 (` (lambda () (interactive)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
366 (facemenu-set-face (quote (, face))))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
367 (define-key facemenu-keymap key (cons name function))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
368 (define-key menu key (cons name function))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
369 (t (define-key menu (vector face)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
370 (cons name 'facemenu-set-face-from-menu)))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
371 ;; Return nil for facemenu-iterate's benefit:
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
372 nil)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
373
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
374 (defun facemenu-after-change (begin end old-length)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
375 "May set the face of just-inserted text to user's request.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
376 This only happens if the change is an insertion, and
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
377 `facemenu-set-face[-from-menu]' was called with point at the
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
378 beginning of the insertion."
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
379 (if (null facemenu-next) ; exit immediately if no work
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
380 nil
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
381 (if (and (= 0 old-length) ; insertion
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
382 (= facemenu-loc begin)) ; point wasn't moved in between
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
383 (facemenu-add-face facemenu-next begin end))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
384 (setq facemenu-next nil)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
385
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
386 (defun facemenu-complete-face-list (&optional oldlist)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
387 "Return list of all faces that are look different.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
388 Starts with given ALIST of faces, and adds elements only if they display
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
389 differently from any face already on the list.
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
390 The faces on ALIST will end up at the end of the returned list, in reverse
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
391 order."
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
392 (let ((list (nreverse (mapcar 'car oldlist))))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
393 (facemenu-iterate
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
394 (lambda (new-face)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
395 (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
396 (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
397 nil)
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
398 (nreverse (face-list)))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
399 list))
fe1c170fa35a (facemenu-get-face): Don't add to menu here.
Boris Goldowsky <boris@gnu.org>
parents: 9494
diff changeset
400
8743
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 (defun facemenu-iterate (func iterate-list)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 "Apply FUNC to each element of LIST until one returns non-nil.
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 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
404 (while (and iterate-list (not (funcall func (car iterate-list))))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 (setq iterate-list (cdr iterate-list)))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
406 (car iterate-list))
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408 (facemenu-update)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409 (add-hook 'after-change-functions 'facemenu-after-change)
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410
03445a867bed Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 ;;; facemenu.el ends here