annotate lisp/font-menu.el @ 418:e804706bfb8c r21-2-17

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