Mercurial > hg > xemacs-beta
annotate lisp/font-menu.el @ 5896:2865c4f6fab2
Fix shell syntax error.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Tue, 05 May 2015 03:48:07 +0900 |
| parents | 4dee0387b9de |
| children |
| rev | line source |
|---|---|
| 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
14 ;; option) any later version. |
| 428 | 15 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
19 ;; for more details. |
| 428 | 20 |
| 21 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
3918
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 23 |
| 24 ;; This file contains the device-nospecific font menu stuff | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 ;;; | |
| 28 ;;; Creates three menus, "Font", "Size", and "Weight", and puts them on the | |
| 29 ;;; "Options" menu. The contents of these menus are the superset of those | |
| 30 ;;; properties available on any fonts, but only the intersection of the three | |
| 31 ;;; sets is selectable at one time. | |
| 32 ;;; | |
| 33 ;;; Known Problems: | |
| 34 ;;; =============== | |
| 35 ;;; Items on the Font menu are selectable if and only if that font exists in | |
| 36 ;;; the same size and weight as the current font. This means that some fonts | |
| 37 ;;; are simply not reachable from some other fonts - if only one font comes | |
| 38 ;;; in only one point size (like "Nil", which comes only in 2), you will never | |
| 39 ;;; be able to select it. It would be better if the items on the Fonts menu | |
| 40 ;;; were always selectable, and selecting them would set the size to be the | |
| 41 ;;; closest size to the current font's size. | |
| 42 ;;; | |
| 440 | 43 ;;; This attempts to change all other faces in an analogous way to the change |
| 428 | 44 ;;; that was made to the default face; if it can't, it will skip over the face. |
| 45 ;;; However, this could leave incongruous font sizes around, which may cause | |
| 46 ;;; some nonreversibility problems if further changes are made. Perhaps it | |
| 47 ;;; should remember the initial fonts of all faces, and derive all subsequent | |
| 48 ;;; fonts from that initial state. | |
| 49 ;;; | |
| 50 ;;; xfontsel(1) is a lot more flexible (but probably harder to understand). | |
| 51 ;;; | |
| 52 ;;; The code to construct menus from all of the x11 fonts available from the | |
| 53 ;;; server is autoloaded and executed the very first time that one of the Font | |
| 54 ;;; menus is selected on each device. That is, if XEmacs has frames on two | |
| 55 ;;; different devices, then separate font menu information will be maintained | |
| 56 ;;; for each X display. If the font path changes after emacs has already | |
| 57 ;;; asked the X server on a particular display for its list of fonts, this | |
| 58 ;;; won't notice. Also, the first time that a font menu is posted on each | |
| 59 ;;; display will entail a lengthy delay, but that's better than slowing down | |
| 60 ;;; XEmacs startup. At any time (i.e.: after a font-path change or | |
| 61 ;;; immediately after device creation), you can call | |
| 62 ;;; `reset-device-font-menus' to rebuild the menus from all currently | |
| 63 ;;; available fonts. | |
| 64 ;;; | |
| 65 ;;; There are at least three kinds of fonts under X11r5: | |
| 66 ;;; | |
| 67 ;;; - bitmap fonts, which can be assumed to look as good as possible; | |
| 68 ;;; - bitmap fonts which have been (or can be) automatically scaled to | |
| 69 ;;; a new size, and which almost always look awful; | |
| 70 ;;; - and true outline fonts, which should look ok at any size, but in | |
| 71 ;;; practice (on at least some systems) look awful at any size, and | |
| 72 ;;; even in theory are unlikely ever to look as good as non-scaled | |
| 73 ;;; bitmap fonts. | |
| 74 ;;; | |
| 75 ;;; It would be nice to get this code to look for non-scaled bitmap fonts | |
| 76 ;;; first, then outline fonts, then scaled bitmap fonts as a last resort. | |
| 77 ;;; But it's not clear to me how to tell them apart based on their truenames | |
| 78 ;;; and/or the result of XListFonts(). I welcome any and all explanations | |
| 79 ;;; of the subtleties involved... | |
| 80 ;;; | |
| 81 ;;; | |
| 82 ;;; If You Think You'Re Seeing A Bug: | |
| 83 ;;; ================================= | |
| 84 ;;; When reporting problems, send the following information: | |
| 85 ;;; | |
| 86 ;;; - Exactly what behavior you're seeing; | |
| 87 ;;; - The output of the `xlsfonts' program; | |
| 88 ;;; - The value of the variable `device-fonts-cache'; | |
| 89 ;;; - The values of the following expressions, both before and after | |
| 90 ;;; making a selection from any of the fonts-related menus: | |
| 91 ;;; (face-font 'default) | |
| 92 ;;; (font-truename (face-font 'default)) | |
| 93 ;;; (font-properties (face-font 'default)) | |
| 94 ;;; - The values of the following variables after making a selection: | |
| 95 ;;; font-menu-preferred-resolution | |
| 96 ;;; font-menu-registry-encoding | |
| 97 ;;; | |
| 98 ;;; There is a common misconception that "*-courier-medium-r-*-11-*", also | |
| 99 ;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1", | |
| 100 ;;; is an 11-point font. It is not -- it is an 11-pixel font at 100dpi, | |
| 101 ;;; which is an 8-point font (the number after -11- is the size in tenths | |
| 102 ;;; of points). So if you expect to be seeing an "11" entry in the "Size" | |
| 103 ;;; menu and are not, this may be why. | |
| 104 ;;; | |
| 105 ;;; In the real world (aka Solaris), one has to deal with fonts that | |
| 106 ;;; appear to be medium-i but are really light-r, and fonts that | |
| 107 ;;; resolve to different resolutions depending on the charset: | |
| 108 ;;; | |
| 109 ;;; (font-instance-truename | |
| 110 ;;; (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*")) | |
| 111 ;;; ==> | |
| 112 ;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0" | |
| 113 ;;; | |
| 2527 | 114 ;;; (font-list "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*") |
| 428 | 115 ;;; ==> |
| 116 ;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1" | |
| 117 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0" | |
| 118 ;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0") | |
| 119 | |
| 120 ;;;###autoload | |
| 121 (defcustom font-menu-ignore-scaled-fonts nil | |
| 2297 | 122 "*If non-nil, the font menu shows only bitmap fonts. |
| 123 | |
|
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
3918
diff
changeset
|
124 Bitmap fonts at their design size are generally noticeably higher quality than |
| 2297 | 125 scaled fonts, unless the device is capable of interpreting antialiasing hints. |
| 126 In general, setting this option non-`nil' is useful mostly on older X servers. | |
| 127 | |
| 128 Not all devices make the distinction between bitmap and scaled fonts." | |
| 428 | 129 :type 'boolean |
| 130 :group 'font-menu) | |
| 131 | |
| 132 ;;;###autoload | |
| 133 (defcustom font-menu-this-frame-only-p nil | |
| 2297 | 134 "*If non-nil, the menu affects the default font only on the selected frame." |
| 428 | 135 :type 'boolean |
| 136 :group 'font-menu) | |
| 137 | |
| 1701 | 138 (defcustom font-menu-max-number nil |
| 2297 | 139 "The maximum number of fonts retrieved from the display." |
| 1701 | 140 :type 'integer |
| 141 :group 'font-menu) | |
| 142 | |
| 771 | 143 (defvaralias 'font-menu-max-items 'menu-max-items) |
| 144 (defvaralias 'font-menu-submenu-name-format 'menu-submenu-name-format) | |
| 428 | 145 |
| 2297 | 146 ;; #### Need to update for fontconfig/Xft? Document form for MS Windows. |
| 444 | 147 (defvar font-menu-preferred-resolution |
| 428 | 148 (make-specifier-and-init 'generic '((global ((mswindows) . ":") |
| 1102 | 149 ((gtk) . "*-*") |
| 428 | 150 ((x) . "*-*"))) t) |
| 2297 | 151 "Generic specifier containing preferred resolution as a string. |
| 152 Do not `setq' this variable; use `set-specifier'. | |
| 153 | |
| 154 For X11 and GTK devices, the instance value will be interpolated into an | |
| 155 XLFD, and looks like \"75-75\").") | |
| 428 | 156 |
| 157 (defvar font-menu-size-scaling | |
| 158 (make-specifier-and-init 'integer '((global ((mswindows) . 1) | |
| 1102 | 159 ((gtk) . 10) |
| 428 | 160 ((x) . 10))) t) |
| 2297 | 161 "Generic specifier containing scale factor for font sizes. Don't touch. |
| 162 | |
| 163 This is really a device type constant. Some devices specify size in points | |
| 164 \(MS Windows), others in decipoints (X11).") | |
| 428 | 165 |
| 2297 | 166 (defvar device-fonts-cache nil |
| 167 "Alist mapping devices to font lists and font menus. Don't use this. | |
| 168 | |
| 169 Instead, use the function `device-fonts-cache' which lazily updates this | |
| 170 variable, and returns the value for the selected device. | |
| 171 | |
| 172 Each element has the form (DEVICE . [FONT-LIST FAMILY SIZE WEIGHT]) where | |
| 173 FAMILY, SIZE, and WEIGHT denote menus.") | |
| 428 | 174 |
| 175 (defsubst device-fonts-cache () | |
| 176 (or (cdr (assq (selected-device) device-fonts-cache)) | |
| 177 (and (reset-device-font-menus (selected-device)) | |
| 178 (cdr (assq (selected-device) device-fonts-cache))))) | |
| 179 | |
| 180 ;;;###autoload | |
| 181 (fset 'install-font-menus 'reset-device-font-menus) | |
| 182 (make-obsolete 'install-font-menus 'reset-device-font-menus) | |
| 183 | |
| 184 ;;;###autoload | |
| 185 (defun reset-device-font-menus (&optional device debug) | |
| 186 "Generates the `Font', `Size', and `Weight' submenus for the Options menu. | |
| 187 This is run the first time that a font-menu is needed for each device. | |
| 2297 | 188 |
| 428 | 189 If you don't like the lazy invocation of this function, you can add it to |
| 190 `create-device-hook' and that will make the font menus respond more quickly | |
| 444 | 191 when they are selected for the first time. If you add fonts to your system, |
| 428 | 192 or if you change your font path, you can call this to re-initialize the menus." |
| 193 (if (or noninteractive | |
| 194 (not (or device (setq device (selected-device))))) | |
| 195 nil | |
| 2297 | 196 (message "Getting list of fonts from server... ") |
| 428 | 197 (call-device-method 'reset-device-font-menus device device debug) |
| 198 (message "Getting list of fonts from server... done."))) | |
| 199 | |
| 200 ;;;###autoload | |
| 201 (defun font-menu-family-constructor (ignored) | |
| 202 (catch 'menu | |
| 203 (unless (console-on-window-system-p) | |
| 204 (throw 'menu '(["Cannot parse current font" ding nil]))) | |
| 205 (let* ((dcache (device-fonts-cache)) | |
| 206 (font-data (font-menu-font-data 'default dcache)) | |
| 207 (entry (aref font-data 0)) | |
| 208 (family (aref font-data 1)) | |
| 209 (size (aref font-data 2)) | |
| 210 (weight (aref font-data 3)) | |
| 211 f) | |
| 212 (unless family | |
| 213 (throw 'menu '(["Cannot parse current font" ding nil]))) | |
| 214 ;; Items on the Font menu are enabled iff that font exists in | |
| 215 ;; the same size and weight as the current font (scalable fonts | |
| 216 ;; exist in every size). Only the current font is marked as | |
| 217 ;; selected. | |
| 771 | 218 (menu-split-long-menu |
| 428 | 219 (mapcar |
| 220 (lambda (item) | |
| 442 | 221 (setq f (menu-item-strip-accelerator-spec (aref item 0)) |
| 428 | 222 entry (vassoc f (aref dcache 0))) |
| 223 (if (and (or (member weight (aref entry 1)) | |
| 224 ;; mswindows often allows any weight | |
| 225 (member "" (aref entry 1))) | |
| 226 (or (member size (aref entry 2)) | |
| 227 (and (not font-menu-ignore-scaled-fonts) | |
| 228 (member 0 (aref entry 2))))) | |
| 229 (enable-menu-item item) | |
| 230 (disable-menu-item item)) | |
| 231 (if (string-equal family f) | |
| 232 (select-toggle-menu-item item) | |
| 233 (deselect-toggle-menu-item item)) | |
| 234 item) | |
| 235 (aref dcache 1)))))) | |
| 236 | |
| 237 (define-device-method* font-menu-font-data) | |
| 238 | |
| 239 ;;;###autoload | |
| 240 (defun font-menu-size-constructor (ignored) | |
| 241 (catch 'menu | |
| 242 (unless (console-on-window-system-p) | |
| 243 (throw 'menu '(["Cannot parse current font" ding nil]))) | |
| 244 (let* ((dcache (device-fonts-cache)) | |
| 245 (font-data (font-menu-font-data 'default dcache)) | |
| 246 (entry (aref font-data 0)) | |
| 247 (family (aref font-data 1)) | |
| 248 (size (aref font-data 2)) | |
| 249 ;;(weight (aref font-data 3)) | |
| 250 s) | |
| 251 (unless family | |
| 252 (throw 'menu '(["Cannot parse current font" ding nil]))) | |
| 253 ;; Items on the Size menu are enabled iff current font has | |
| 254 ;; that size. Only the size of the current font is selected. | |
| 255 ;; (If the current font comes in size 0, it is scalable, and | |
| 256 ;; thus has every size.) | |
| 257 (mapcar | |
| 258 (lambda (item) | |
| 259 (setq s (nth 3 (aref item 1))) | |
| 260 (if (or (member s (aref entry 2)) | |
| 261 (and (not font-menu-ignore-scaled-fonts) | |
| 262 (member 0 (aref entry 2)))) | |
| 263 (enable-menu-item item) | |
| 264 (disable-menu-item item)) | |
| 3094 | 265 ;; #### God save the Queen! |
| 266 ;; well, if this fails because s or size is non-numeric, fuck 'em | |
| 267 (if (= size (if (featurep 'xft-fonts) (float s) s)) | |
| 428 | 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 |
| 3094 | 348 (message "Error updating font of `%s'" face) |
| 428 | 349 (display-error c nil) |
| 350 (sit-for 1))))) | |
| 351 ;; Set the default face's font after hacking the other faces, so that | |
| 352 ;; the frame size doesn't change until we are all done. | |
| 353 | |
| 354 ;; If we need to be frame local we do the changes ourselves. | |
| 355 (if font-menu-this-frame-only-p | |
| 356 ;;; WMP - we need to honor font-menu-this-frame-only-p here! | |
| 357 (set-face-font 'default new-default-face-font | |
| 358 (and font-menu-this-frame-only-p (selected-frame))) | |
| 359 ;; OK Let Customize do it. | |
| 3094 | 360 (let ((fsize (if (featurep 'xft-fonts) |
| 361 (int-to-string (or size from-size)) | |
| 362 (concat (int-to-string | |
| 363 (/ (or size from-size) | |
| 364 (specifier-instance font-menu-size-scaling | |
| 365 (selected-device)))) | |
| 3918 | 366 "pt"))) |
| 367 new-spec-list) | |
| 368 ;; If the font was initialised from X resources (the tag-set | |
| 369 ;; contains 'x-resource) pretend to Custom that it has | |
| 370 ;; responsibility for those settings. | |
| 371 (map-specifier (face-font 'default) | |
| 372 (lambda (spec locale inst-list arg) | |
| 373 (loop | |
| 374 for (tag-set . inst) | |
| 375 in inst-list | |
| 376 do (setq tag-set (delq 'x-resource tag-set) | |
| 377 tag-set (delq 'custom tag-set) | |
| 378 tag-set (cons 'custom tag-set)) | |
| 379 (push (cons tag-set inst) new-spec-list) | |
| 380 ;; Need to return nil, else map-specifier stops | |
| 381 finally return nil)) | |
| 382 nil nil '(x-resource)) | |
| 383 (remove-specifier (face-font 'default) nil '(x-resource)) | |
| 384 (when new-spec-list | |
| 385 (add-spec-list-to-specifier (face-font 'default) | |
| 386 (list (cons 'global new-spec-list)))) | |
| 3094 | 387 (custom-set-face-update-spec 'default |
| 388 (list (list 'type (device-type))) | |
| 389 (list :family (or family from-family) | |
| 390 :size fsize)))) | |
| 391 (message "Font %s" (face-font-name 'default)))) | |
| 428 | 392 |
| 2297 | 393 ;; #### This should be called `font-menu-maybe-change-face' |
| 394 ;; I wonder if a better API wouldn't (face attribute from to) | |
| 428 | 395 (defun font-menu-change-face (face |
| 396 from-family from-weight from-size | |
| 397 to-family to-weight to-size) | |
| 2297 | 398 "Maybe update the font of FACE per TO-FAMILY, TO-WEIGHT, and TO-SIZE." |
| 446 | 399 (check-type face symbol) |
| 428 | 400 (let* ((dcache (device-fonts-cache)) |
| 401 (font-data (font-menu-font-data face dcache)) | |
| 402 (face-family (aref font-data 1)) | |
| 403 (face-size (aref font-data 2)) | |
| 404 (face-weight (aref font-data 3)) | |
| 405 (face-slant (aref font-data 4))) | |
| 406 | |
| 2297 | 407 (or face-family |
| 408 (signal 'error (list "couldn't parse font name for face" face))) | |
| 428 | 409 |
| 410 ;; If this face matches the old default face in the attribute we | |
| 411 ;; are changing, then change it to the new attribute along that | |
| 412 ;; dimension. Also, the face must have its own global attribute. | |
| 413 ;; If its value is inherited, we don't touch it. If any of this | |
| 414 ;; is not true, we leave it alone. | |
| 415 (when (and (face-font face 'global) | |
| 444 | 416 (cond |
| 428 | 417 (to-family (string-equal face-family from-family)) |
| 418 (to-weight (string-equal face-weight from-weight)) | |
| 419 (to-size (= face-size from-size)))) | |
| 420 (set-face-font face | |
| 872 | 421 (font-instance-name |
| 422 (font-menu-load-font (or to-family face-family) | |
| 423 (or to-weight face-weight) | |
| 424 (or to-size face-size) | |
| 425 face-slant | |
| 426 (specifier-instance | |
| 427 font-menu-preferred-resolution | |
| 428 (selected-device)))) | |
| 428 | 429 (and font-menu-this-frame-only-p |
| 430 (selected-frame)))))) | |
| 431 | |
| 432 (define-device-method font-menu-load-font) | |
| 433 | |
| 434 (defun flush-device-fonts-cache (device) | |
| 435 ;; by Stig@hackvan.com | |
| 436 (let ((elt (assq device device-fonts-cache))) | |
| 437 (and elt | |
| 438 (setq device-fonts-cache (delq elt device-fonts-cache))))) | |
| 439 | |
| 440 (add-hook 'delete-device-hook 'flush-device-fonts-cache) | |
| 441 | |
| 442 (provide 'font-menu) | |
| 443 | |
| 444 ;; font-menu ends here |