Mercurial > hg > xemacs-beta

comparison lisp/font-menu.el @ 2297:13a418960a88

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-09-22 02:05:42 by stephent] various doc patches <87isa7awrh.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Wed, 22 Sep 2004 02:06:52 +0000
parents a1e328407366
children 491f8cf78a9c
comparison
equal deleted inserted replaced
2296:a58ea4d0d0cd 2297:13a418960a88
119 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0" 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") 120 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0")
121 121
122 ;;;###autoload 122 ;;;###autoload
123 (defcustom font-menu-ignore-scaled-fonts nil 123 (defcustom font-menu-ignore-scaled-fonts nil
124 "*If non-nil, then the font menu will try to show only bitmap fonts." 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."
125 :type 'boolean 131 :type 'boolean
126 :group 'font-menu) 132 :group 'font-menu)
127 133
128 ;;;###autoload 134 ;;;###autoload
129 (defcustom font-menu-this-frame-only-p nil 135 (defcustom font-menu-this-frame-only-p nil
130 "*If non-nil, then changing the default font from the font menu will only 136 "*If non-nil, the menu affects the default font only on the selected frame."
131 affect one frame instead of all frames."
132 :type 'boolean 137 :type 'boolean
133 :group 'font-menu) 138 :group 'font-menu)
134 139
135 (defcustom font-menu-max-number nil 140 (defcustom font-menu-max-number nil
136 "The maximum number of fonts retrieved from the server" 141 "The maximum number of fonts retrieved from the display."
137 :type 'integer 142 :type 'integer
138 :group 'font-menu) 143 :group 'font-menu)
139 144
140 (defvaralias 'font-menu-max-items 'menu-max-items) 145 (defvaralias 'font-menu-max-items 'menu-max-items)
141 (defvaralias 'font-menu-submenu-name-format 'menu-submenu-name-format) 146 (defvaralias 'font-menu-submenu-name-format 'menu-submenu-name-format)
142 147
148 ;; #### Need to update for fontconfig/Xft? Document form for MS Windows.
143 (defvar font-menu-preferred-resolution 149 (defvar font-menu-preferred-resolution
144 (make-specifier-and-init 'generic '((global ((mswindows) . ":") 150 (make-specifier-and-init 'generic '((global ((mswindows) . ":")
145 ((gtk) . "*-*") 151 ((gtk) . "*-*")
146 ((x) . "*-*"))) t) 152 ((x) . "*-*"))) t)
147 "Preferred horizontal and vertical font menu resolution (e.g. \"75:75\").") 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\").")
148 158
149 (defvar font-menu-size-scaling 159 (defvar font-menu-size-scaling
150 (make-specifier-and-init 'integer '((global ((mswindows) . 1) 160 (make-specifier-and-init 'integer '((global ((mswindows) . 1)
151 ((gtk) . 10) 161 ((gtk) . 10)
152 ((x) . 10))) t) 162 ((x) . 10))) t)
153 "Scale factor used in defining font sizes.") 163 "Generic specifier containing scale factor for font sizes. Don't touch.
154 164
155 ;; only call XListFonts (and parse) once per device. 165 This is really a device type constant. Some devices specify size in points
156 ;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...) 166 \(MS Windows), others in decipoints (X11).")
157 (defvar device-fonts-cache nil) 167
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.")
158 176
159 (defsubst device-fonts-cache () 177 (defsubst device-fonts-cache ()
160 (or (cdr (assq (selected-device) device-fonts-cache)) 178 (or (cdr (assq (selected-device) device-fonts-cache))
161 (and (reset-device-font-menus (selected-device)) 179 (and (reset-device-font-menus (selected-device))
162 (cdr (assq (selected-device) device-fonts-cache))))) 180 (cdr (assq (selected-device) device-fonts-cache)))))
167 185
168 ;;;###autoload 186 ;;;###autoload
169 (defun reset-device-font-menus (&optional device debug) 187 (defun reset-device-font-menus (&optional device debug)
170 "Generates the `Font', `Size', and `Weight' submenus for the Options menu. 188 "Generates the `Font', `Size', and `Weight' submenus for the Options menu.
171 This is run the first time that a font-menu is needed for each device. 189 This is run the first time that a font-menu is needed for each device.
190
172 If you don't like the lazy invocation of this function, you can add it to 191 If you don't like the lazy invocation of this function, you can add it to
173 `create-device-hook' and that will make the font menus respond more quickly 192 `create-device-hook' and that will make the font menus respond more quickly
174 when they are selected for the first time. If you add fonts to your system, 193 when they are selected for the first time. If you add fonts to your system,
175 or if you change your font path, you can call this to re-initialize the menus." 194 or if you change your font path, you can call this to re-initialize the menus."
176 (message "Getting list of fonts from server... ")
177 (if (or noninteractive 195 (if (or noninteractive
178 (not (or device (setq device (selected-device))))) 196 (not (or device (setq device (selected-device)))))
179 nil 197 nil
198 (message "Getting list of fonts from server... ")
180 (call-device-method 'reset-device-font-menus device device debug) 199 (call-device-method 'reset-device-font-menus device device debug)
181 (message "Getting list of fonts from server... done."))) 200 (message "Getting list of fonts from server... done.")))
182 201
183 ;;;###autoload 202 ;;;###autoload
184 (defun font-menu-family-constructor (ignored) 203 (defun font-menu-family-constructor (ignored)
347 (selected-device)))) 366 (selected-device))))
348 "pt"))) 367 "pt")))
349 (message "Font %s" (face-font-name 'default))))) 368 (message "Font %s" (face-font-name 'default)))))
350 369
351 370
371 ;; #### This should be called `font-menu-maybe-change-face'
372 ;; I wonder if a better API wouldn't (face attribute from to)
352 (defun font-menu-change-face (face 373 (defun font-menu-change-face (face
353 from-family from-weight from-size 374 from-family from-weight from-size
354 to-family to-weight to-size) 375 to-family to-weight to-size)
376 "Maybe update the font of FACE per TO-FAMILY, TO-WEIGHT, and TO-SIZE."
355 (check-type face symbol) 377 (check-type face symbol)
356 (let* ((dcache (device-fonts-cache)) 378 (let* ((dcache (device-fonts-cache))
357 (font-data (font-menu-font-data face dcache)) 379 (font-data (font-menu-font-data face dcache))
358 (face-family (aref font-data 1)) 380 (face-family (aref font-data 1))
359 (face-size (aref font-data 2)) 381 (face-size (aref font-data 2))
360 (face-weight (aref font-data 3)) 382 (face-weight (aref font-data 3))
361 (face-slant (aref font-data 4))) 383 (face-slant (aref font-data 4)))
362 384
363 (or face-family 385 (or face-family
364 (signal 'error (list "couldn't parse font name for face" face))) 386 (signal 'error (list "couldn't parse font name for face" face)))
365 387
366 ;; If this face matches the old default face in the attribute we 388 ;; If this face matches the old default face in the attribute we
367 ;; are changing, then change it to the new attribute along that 389 ;; are changing, then change it to the new attribute along that
368 ;; dimension. Also, the face must have its own global attribute. 390 ;; dimension. Also, the face must have its own global attribute.
369 ;; If its value is inherited, we don't touch it. If any of this 391 ;; If its value is inherited, we don't touch it. If any of this