|
428
|
1 ;; font-menu.el --- Managing menus of fonts.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
|
|
|
5 ;; Copyright (C) 1997 Sun Microsystems
|
|
|
6
|
|
|
7 ;; Adapted from x-font-menu.el by Andy Piper <andy@xemacs.org>
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
12 ;; under the terms of the GNU General Public License as published by
|
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
16 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
19 ;; General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
444
|
22 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
428
|
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
|
25
|
|
|
26 ;; This file contains the device-nospecific font menu stuff
|
|
|
27
|
|
|
28 ;;; Commentary:
|
|
|
29 ;;;
|
|
|
30 ;;; Creates three menus, "Font", "Size", and "Weight", and puts them on the
|
|
|
31 ;;; "Options" menu. The contents of these menus are the superset of those
|
|
|
32 ;;; properties available on any fonts, but only the intersection of the three
|
|
|
33 ;;; sets is selectable at one time.
|
|
|
34 ;;;
|
|
|
35 ;;; Known Problems:
|
|
|
36 ;;; ===============
|
|
|
37 ;;; Items on the Font menu are selectable if and only if that font exists in
|
|
|
38 ;;; the same size and weight as the current font. This means that some fonts
|
|
|
39 ;;; are simply not reachable from some other fonts - if only one font comes
|
|
|
40 ;;; in only one point size (like "Nil", which comes only in 2), you will never
|
|
|
41 ;;; be able to select it. It would be better if the items on the Fonts menu
|
|
|
42 ;;; were always selectable, and selecting them would set the size to be the
|
|
|
43 ;;; closest size to the current font's size.
|
|
|
44 ;;;
|
|
440
|
45 ;;; This attempts to change all other faces in an analogous way to the change
|
|
428
|
46 ;;; that was made to the default face; if it can't, it will skip over the face.
|
|
|
47 ;;; However, this could leave incongruous font sizes around, which may cause
|
|
|
48 ;;; some nonreversibility problems if further changes are made. Perhaps it
|
|
|
49 ;;; should remember the initial fonts of all faces, and derive all subsequent
|
|
|
50 ;;; fonts from that initial state.
|
|
|
51 ;;;
|
|
|
52 ;;; xfontsel(1) is a lot more flexible (but probably harder to understand).
|
|
|
53 ;;;
|
|
|
54 ;;; The code to construct menus from all of the x11 fonts available from the
|
|
|
55 ;;; server is autoloaded and executed the very first time that one of the Font
|
|
|
56 ;;; menus is selected on each device. That is, if XEmacs has frames on two
|
|
|
57 ;;; different devices, then separate font menu information will be maintained
|
|
|
58 ;;; for each X display. If the font path changes after emacs has already
|
|
|
59 ;;; asked the X server on a particular display for its list of fonts, this
|
|
|
60 ;;; won't notice. Also, the first time that a font menu is posted on each
|
|
|
61 ;;; display will entail a lengthy delay, but that's better than slowing down
|
|
|
62 ;;; XEmacs startup. At any time (i.e.: after a font-path change or
|
|
|
63 ;;; immediately after device creation), you can call
|
|
|
64 ;;; `reset-device-font-menus' to rebuild the menus from all currently
|
|
|
65 ;;; available fonts.
|
|
|
66 ;;;
|
|
|
67 ;;; There are at least three kinds of fonts under X11r5:
|
|
|
68 ;;;
|
|
|
69 ;;; - bitmap fonts, which can be assumed to look as good as possible;
|
|
|
70 ;;; - bitmap fonts which have been (or can be) automatically scaled to
|
|
|
71 ;;; a new size, and which almost always look awful;
|
|
|
72 ;;; - and true outline fonts, which should look ok at any size, but in
|
|
|
73 ;;; practice (on at least some systems) look awful at any size, and
|
|
|
74 ;;; even in theory are unlikely ever to look as good as non-scaled
|
|
|
75 ;;; bitmap fonts.
|
|
|
76 ;;;
|
|
|
77 ;;; It would be nice to get this code to look for non-scaled bitmap fonts
|
|
|
78 ;;; first, then outline fonts, then scaled bitmap fonts as a last resort.
|
|
|
79 ;;; But it's not clear to me how to tell them apart based on their truenames
|
|
|
80 ;;; and/or the result of XListFonts(). I welcome any and all explanations
|
|
|
81 ;;; of the subtleties involved...
|
|
|
82 ;;;
|
|
|
83 ;;;
|
|
|
84 ;;; If You Think You'Re Seeing A Bug:
|
|
|
85 ;;; =================================
|
|
|
86 ;;; When reporting problems, send the following information:
|
|
|
87 ;;;
|
|
|
88 ;;; - Exactly what behavior you're seeing;
|
|
|
89 ;;; - The output of the `xlsfonts' program;
|
|
|
90 ;;; - The value of the variable `device-fonts-cache';
|
|
|
91 ;;; - The values of the following expressions, both before and after
|
|
|
92 ;;; making a selection from any of the fonts-related menus:
|
|
|
93 ;;; (face-font 'default)
|
|
|
94 ;;; (font-truename (face-font 'default))
|
|
|
95 ;;; (font-properties (face-font 'default))
|
|
|
96 ;;; - The values of the following variables after making a selection:
|
|
|
97 ;;; font-menu-preferred-resolution
|
|
|
98 ;;; font-menu-registry-encoding
|
|
|
99 ;;;
|
|
|
100 ;;; There is a common misconception that "*-courier-medium-r-*-11-*", also
|
|
|
101 ;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1",
|
|
|
102 ;;; is an 11-point font. It is not -- it is an 11-pixel font at 100dpi,
|
|
|
103 ;;; which is an 8-point font (the number after -11- is the size in tenths
|
|
|
104 ;;; of points). So if you expect to be seeing an "11" entry in the "Size"
|
|
|
105 ;;; menu and are not, this may be why.
|
|
|
106 ;;;
|
|
|
107 ;;; In the real world (aka Solaris), one has to deal with fonts that
|
|
|
108 ;;; appear to be medium-i but are really light-r, and fonts that
|
|
|
109 ;;; resolve to different resolutions depending on the charset:
|
|
|
110 ;;;
|
|
|
111 ;;; (font-instance-truename
|
|
|
112 ;;; (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*"))
|
|
|
113 ;;; ==>
|
|
|
114 ;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0"
|
|
|
115 ;;;
|
|
2527
|
116 ;;; (font-list "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*")
|
|
428
|
117 ;;; ==>
|
|
|
118 ;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1"
|
|
|
119 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0"
|
|
|
120 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0")
|
|
|
121
|
|
|
122 ;;;###autoload
|
|
|
123 (defcustom font-menu-ignore-scaled-fonts nil
|
|
2297
|
124 "*If non-nil, the font menu shows only bitmap fonts.
|
|
|
125
|
|
|
126 Bitmap fonts at their design size are generally noticably higher quality than
|
|
|
127 scaled fonts, unless the device is capable of interpreting antialiasing hints.
|
|
|
128 In general, setting this option non-`nil' is useful mostly on older X servers.
|
|
|
129
|
|
|
130 Not all devices make the distinction between bitmap and scaled fonts."
|
|
428
|
131 :type 'boolean
|
|
|
132 :group 'font-menu)
|
|
|
133
|
|
|
134 ;;;###autoload
|
|
|
135 (defcustom font-menu-this-frame-only-p nil
|
|
2297
|
136 "*If non-nil, the menu affects the default font only on the selected frame."
|
|
428
|
137 :type 'boolean
|
|
|
138 :group 'font-menu)
|
|
|
139
|
|
1701
|
140 (defcustom font-menu-max-number nil
|
|
2297
|
141 "The maximum number of fonts retrieved from the display."
|
|
1701
|
142 :type 'integer
|
|
|
143 :group 'font-menu)
|
|
|
144
|
|
771
|
145 (defvaralias 'font-menu-max-items 'menu-max-items)
|
|
|
146 (defvaralias 'font-menu-submenu-name-format 'menu-submenu-name-format)
|
|
428
|
147
|
|
2297
|
148 ;; #### Need to update for fontconfig/Xft? Document form for MS Windows.
|
|
444
|
149 (defvar font-menu-preferred-resolution
|
|
428
|
150 (make-specifier-and-init 'generic '((global ((mswindows) . ":")
|
|
1102
|
151 ((gtk) . "*-*")
|
|
428
|
152 ((x) . "*-*"))) t)
|
|
2297
|
153 "Generic specifier containing preferred resolution as a string.
|
|
|
154 Do not `setq' this variable; use `set-specifier'.
|
|
|
155
|
|
|
156 For X11 and GTK devices, the instance value will be interpolated into an
|
|
|
157 XLFD, and looks like \"75-75\").")
|
|
428
|
158
|
|
|
159 (defvar font-menu-size-scaling
|
|
|
160 (make-specifier-and-init 'integer '((global ((mswindows) . 1)
|
|
1102
|
161 ((gtk) . 10)
|
|
428
|
162 ((x) . 10))) t)
|
|
2297
|
163 "Generic specifier containing scale factor for font sizes. Don't touch.
|
|
|
164
|
|
|
165 This is really a device type constant. Some devices specify size in points
|
|
|
166 \(MS Windows), others in decipoints (X11).")
|
|
428
|
167
|
|
2297
|
168 (defvar device-fonts-cache nil
|
|
|
169 "Alist mapping devices to font lists and font menus. Don't use this.
|
|
|
170
|
|
|
171 Instead, use the function `device-fonts-cache' which lazily updates this
|
|
|
172 variable, and returns the value for the selected device.
|
|
|
173
|
|
|
174 Each element has the form (DEVICE . [FONT-LIST FAMILY SIZE WEIGHT]) where
|
|
|
175 FAMILY, SIZE, and WEIGHT denote menus.")
|
|
428
|
176
|
|
|
177 (defsubst device-fonts-cache ()
|
|
|
178 (or (cdr (assq (selected-device) device-fonts-cache))
|
|
|
179 (and (reset-device-font-menus (selected-device))
|
|
|
180 (cdr (assq (selected-device) device-fonts-cache)))))
|
|
|
181
|
|
|
182 ;;;###autoload
|
|
|
183 (fset 'install-font-menus 'reset-device-font-menus)
|
|
|
184 (make-obsolete 'install-font-menus 'reset-device-font-menus)
|
|
|
185
|
|
|
186 ;;;###autoload
|
|
|
187 (defun reset-device-font-menus (&optional device debug)
|
|
|
188 "Generates the `Font', `Size', and `Weight' submenus for the Options menu.
|
|
|
189 This is run the first time that a font-menu is needed for each device.
|
|
2297
|
190
|
|
428
|
191 If you don't like the lazy invocation of this function, you can add it to
|
|
|
192 `create-device-hook' and that will make the font menus respond more quickly
|
|
444
|
193 when they are selected for the first time. If you add fonts to your system,
|
|
428
|
194 or if you change your font path, you can call this to re-initialize the menus."
|
|
|
195 (if (or noninteractive
|
|
|
196 (not (or device (setq device (selected-device)))))
|
|
|
197 nil
|
|
2297
|
198 (message "Getting list of fonts from server... ")
|
|
428
|
199 (call-device-method 'reset-device-font-menus device device debug)
|
|
|
200 (message "Getting list of fonts from server... done.")))
|
|
|
201
|
|
|
202 ;;;###autoload
|
|
|
203 (defun font-menu-family-constructor (ignored)
|
|
|
204 (catch 'menu
|
|
|
205 (unless (console-on-window-system-p)
|
|
|
206 (throw 'menu '(["Cannot parse current font" ding nil])))
|
|
|
207 (let* ((dcache (device-fonts-cache))
|
|
|
208 (font-data (font-menu-font-data 'default dcache))
|
|
|
209 (entry (aref font-data 0))
|
|
|
210 (family (aref font-data 1))
|
|
|
211 (size (aref font-data 2))
|
|
|
212 (weight (aref font-data 3))
|
|
|
213 f)
|
|
|
214 (unless family
|
|
|
215 (throw 'menu '(["Cannot parse current font" ding nil])))
|
|
|
216 ;; Items on the Font menu are enabled iff that font exists in
|
|
|
217 ;; the same size and weight as the current font (scalable fonts
|
|
|
218 ;; exist in every size). Only the current font is marked as
|
|
|
219 ;; selected.
|
|
771
|
220 (menu-split-long-menu
|
|
428
|
221 (mapcar
|
|
|
222 (lambda (item)
|
|
442
|
223 (setq f (menu-item-strip-accelerator-spec (aref item 0))
|
|
428
|
224 entry (vassoc f (aref dcache 0)))
|
|
|
225 (if (and (or (member weight (aref entry 1))
|
|
|
226 ;; mswindows often allows any weight
|
|
|
227 (member "" (aref entry 1)))
|
|
|
228 (or (member size (aref entry 2))
|
|
|
229 (and (not font-menu-ignore-scaled-fonts)
|
|
|
230 (member 0 (aref entry 2)))))
|
|
|
231 (enable-menu-item item)
|
|
|
232 (disable-menu-item item))
|
|
|
233 (if (string-equal family f)
|
|
|
234 (select-toggle-menu-item item)
|
|
|
235 (deselect-toggle-menu-item item))
|
|
|
236 item)
|
|
|
237 (aref dcache 1))))))
|
|
|
238
|
|
|
239 (define-device-method* font-menu-font-data)
|
|
|
240
|
|
|
241 ;;;###autoload
|
|
|
242 (defun font-menu-size-constructor (ignored)
|
|
|
243 (catch 'menu
|
|
|
244 (unless (console-on-window-system-p)
|
|
|
245 (throw 'menu '(["Cannot parse current font" ding nil])))
|
|
|
246 (let* ((dcache (device-fonts-cache))
|
|
|
247 (font-data (font-menu-font-data 'default dcache))
|
|
|
248 (entry (aref font-data 0))
|
|
|
249 (family (aref font-data 1))
|
|
|
250 (size (aref font-data 2))
|
|
|
251 ;;(weight (aref font-data 3))
|
|
|
252 s)
|
|
|
253 (unless family
|
|
|
254 (throw 'menu '(["Cannot parse current font" ding nil])))
|
|
|
255 ;; Items on the Size menu are enabled iff current font has
|
|
|
256 ;; that size. Only the size of the current font is selected.
|
|
|
257 ;; (If the current font comes in size 0, it is scalable, and
|
|
|
258 ;; thus has every size.)
|
|
|
259 (mapcar
|
|
|
260 (lambda (item)
|
|
|
261 (setq s (nth 3 (aref item 1)))
|
|
|
262 (if (or (member s (aref entry 2))
|
|
|
263 (and (not font-menu-ignore-scaled-fonts)
|
|
|
264 (member 0 (aref entry 2))))
|
|
|
265 (enable-menu-item item)
|
|
|
266 (disable-menu-item item))
|
|
|
267 (if (eq size s)
|
|
|
268 (select-toggle-menu-item item)
|
|
|
269 (deselect-toggle-menu-item item))
|
|
|
270 item)
|
|
442
|
271 (submenu-generate-accelerator-spec (aref dcache 2))))))
|
|
428
|
272
|
|
|
273 ;;;###autoload
|
|
|
274 (defun font-menu-weight-constructor (ignored)
|
|
|
275 (catch 'menu
|
|
|
276 (unless (console-on-window-system-p)
|
|
|
277 (throw 'menu '(["Cannot parse current font" ding nil])))
|
|
|
278 (let* ((dcache (device-fonts-cache))
|
|
|
279 (font-data (font-menu-font-data 'default dcache))
|
|
|
280 (entry (aref font-data 0))
|
|
|
281 (family (aref font-data 1))
|
|
|
282 ;;(size (aref font-data 2))
|
|
|
283 (weight (aref font-data 3))
|
|
|
284 w)
|
|
|
285 (unless family
|
|
|
286 (throw 'menu '(["Cannot parse current font" ding nil])))
|
|
|
287 ;; Items on the Weight menu are enabled iff current font
|
|
|
288 ;; has that weight. Only the weight of the current font
|
|
|
289 ;; is selected.
|
|
|
290 (mapcar
|
|
|
291 (lambda (item)
|
|
|
292 (setq w (aref item 0))
|
|
|
293 (if (member w (aref entry 1))
|
|
|
294 (enable-menu-item item)
|
|
|
295 (disable-menu-item item))
|
|
|
296 (if (string-equal weight w)
|
|
|
297 (select-toggle-menu-item item)
|
|
|
298 (deselect-toggle-menu-item item))
|
|
|
299 item)
|
|
442
|
300 (submenu-generate-accelerator-spec (aref dcache 3))))))
|
|
428
|
301
|
|
|
302
|
|
|
303 ;;; Changing font sizes
|
|
|
304
|
|
|
305 (defun font-menu-set-font (family weight size)
|
|
|
306 ;; This is what gets run when an item is selected from any of the three
|
|
|
307 ;; fonts menus. It needs to be rather clever.
|
|
|
308 ;; (size is measured in 10ths of points.)
|
|
|
309 (let* ((dcache (device-fonts-cache))
|
|
|
310 (font-data (font-menu-font-data 'default dcache))
|
|
|
311 (from-family (aref font-data 1))
|
|
|
312 (from-size (aref font-data 2))
|
|
1102
|
313 (from-weight (aref font-data 3))
|
|
428
|
314 (from-slant (aref font-data 4))
|
|
442
|
315 (face-list-to-change (delq 'default (face-list)))
|
|
|
316 new-default-face-font)
|
|
428
|
317 (unless from-family
|
|
|
318 (signal 'error '("couldn't parse font name for default face")))
|
|
|
319 (when weight
|
|
|
320 (signal 'error '("Setting weight currently not supported")))
|
|
|
321 (setq new-default-face-font
|
|
872
|
322 (font-instance-name
|
|
|
323 (font-menu-load-font
|
|
|
324 (or family from-family)
|
|
|
325 (or weight from-weight)
|
|
|
326 (or size from-size)
|
|
|
327 from-slant
|
|
|
328 (specifier-instance
|
|
|
329 font-menu-preferred-resolution (selected-device)))))
|
|
|
330 ;; #### This is such a gross hack. The border-glyph face under
|
|
428
|
331 ;; mswindows is in a symbol font. Thus it will not appear in the
|
|
|
332 ;; cache - being a junk family. What we should do is change the
|
|
|
333 ;; size but not the family, but this is more work than I care to
|
|
|
334 ;; invest at the moment.
|
|
|
335 (when (eq (device-type) 'mswindows)
|
|
|
336 (setq face-list-to-change
|
|
|
337 (delq 'border-glyph face-list-to-change)))
|
|
|
338 (dolist (face face-list-to-change)
|
|
|
339 (when (face-font-instance face)
|
|
|
340 (message "Changing font of `%s'..." face)
|
|
|
341 (condition-case c
|
|
|
342 (font-menu-change-face face
|
|
|
343 from-family from-weight from-size
|
|
1102
|
344 (or family from-family)
|
|
|
345 (or weight from-weight)
|
|
|
346 (or size from-size))
|
|
428
|
347 (error
|
|
|
348 (display-error c nil)
|
|
|
349 (sit-for 1)))))
|
|
|
350 ;; Set the default face's font after hacking the other faces, so that
|
|
|
351 ;; the frame size doesn't change until we are all done.
|
|
|
352
|
|
|
353 ;; If we need to be frame local we do the changes ourselves.
|
|
|
354 (if font-menu-this-frame-only-p
|
|
|
355 ;;; WMP - we need to honor font-menu-this-frame-only-p here!
|
|
|
356 (set-face-font 'default new-default-face-font
|
|
|
357 (and font-menu-this-frame-only-p (selected-frame)))
|
|
|
358 ;; OK Let Customize do it.
|
|
|
359 (custom-set-face-update-spec 'default
|
|
442
|
360 (list (list 'type (device-type)))
|
|
1102
|
361 (list :family (or family from-family)
|
|
442
|
362 :size (concat
|
|
|
363 (int-to-string
|
|
|
364 (/ (or size from-size)
|
|
|
365 (specifier-instance font-menu-size-scaling
|
|
|
366 (selected-device))))
|
|
444
|
367 "pt")))
|
|
428
|
368 (message "Font %s" (face-font-name 'default)))))
|
|
|
369
|
|
|
370
|
|
2297
|
371 ;; #### This should be called `font-menu-maybe-change-face'
|
|
|
372 ;; I wonder if a better API wouldn't (face attribute from to)
|
|
428
|
373 (defun font-menu-change-face (face
|
|
|
374 from-family from-weight from-size
|
|
|
375 to-family to-weight to-size)
|
|
2297
|
376 "Maybe update the font of FACE per TO-FAMILY, TO-WEIGHT, and TO-SIZE."
|
|
446
|
377 (check-type face symbol)
|
|
428
|
378 (let* ((dcache (device-fonts-cache))
|
|
|
379 (font-data (font-menu-font-data face dcache))
|
|
|
380 (face-family (aref font-data 1))
|
|
|
381 (face-size (aref font-data 2))
|
|
|
382 (face-weight (aref font-data 3))
|
|
|
383 (face-slant (aref font-data 4)))
|
|
|
384
|
|
2297
|
385 (or face-family
|
|
|
386 (signal 'error (list "couldn't parse font name for face" face)))
|
|
428
|
387
|
|
|
388 ;; If this face matches the old default face in the attribute we
|
|
|
389 ;; are changing, then change it to the new attribute along that
|
|
|
390 ;; dimension. Also, the face must have its own global attribute.
|
|
|
391 ;; If its value is inherited, we don't touch it. If any of this
|
|
|
392 ;; is not true, we leave it alone.
|
|
|
393 (when (and (face-font face 'global)
|
|
444
|
394 (cond
|
|
428
|
395 (to-family (string-equal face-family from-family))
|
|
|
396 (to-weight (string-equal face-weight from-weight))
|
|
|
397 (to-size (= face-size from-size))))
|
|
|
398 (set-face-font face
|
|
872
|
399 (font-instance-name
|
|
|
400 (font-menu-load-font (or to-family face-family)
|
|
|
401 (or to-weight face-weight)
|
|
|
402 (or to-size face-size)
|
|
|
403 face-slant
|
|
|
404 (specifier-instance
|
|
|
405 font-menu-preferred-resolution
|
|
|
406 (selected-device))))
|
|
428
|
407 (and font-menu-this-frame-only-p
|
|
|
408 (selected-frame))))))
|
|
|
409
|
|
|
410 (define-device-method font-menu-load-font)
|
|
|
411
|
|
|
412 (defun flush-device-fonts-cache (device)
|
|
|
413 ;; by Stig@hackvan.com
|
|
|
414 (let ((elt (assq device device-fonts-cache)))
|
|
|
415 (and elt
|
|
|
416 (setq device-fonts-cache (delq elt device-fonts-cache)))))
|
|
|
417
|
|
|
418 (add-hook 'delete-device-hook 'flush-device-fonts-cache)
|
|
|
419
|
|
|
420 (provide 'font-menu)
|
|
|
421
|
|
|
422 ;; font-menu ends here
|
