annotate lisp/msw-faces.el @ 2421:ab71ad6ff3dd

[xemacs-hg @ 2004-12-06 03:50:53 by ben] (none) README.packages: Document use of --package-prefix. Fix error in specifying standard package location. make-docfile.c: Use QXE_PATH_MAX. info.el: Correct doc string giving example package path. menubar-items.el: Move Prefix Rectangle command up one level. xemacs/packages.texi: Add long form of Lisp Reference Manual to links. Add links pointing to Lisp Reference Manual for more detailed package discussion. lispref/range-tables.texi: Document range-table changes. internals/internals.texi: Update history section. elhash.c, elhash.h, profile.c: Create inchash_eq() to allow direct incrementing of hash-table entry. Use in profile.c to try to reduce profiling overhead. Increase initial size of profile hash tables to reduce profiling overhead. buffer.c, device-msw.c, dialog-msw.c, dired-msw.c, editfns.c, event-msw.c, events.c, glyphs-msw.c, keymap.c, objects-msw.c, process-nt.c, syswindows.h, text.c, text.h, unexnt.c: Rename xetcs* -> qxetcs* for consistency with qxestr*. Rename ei*_c(_*) -> ei*_ascii(_*) since they work with ASCII-only strings not "C strings", whatever those are. This is the last place where "c" was incorrectly being used for "ascii". dialog-msw.c, dumper.c, event-msw.c, fileio.c, glyphs-gtk.c, glyphs-x.c, nt.c, process-nt.c, realpath.c, sysdep.c, sysfile.h, unexcw.c, unexnext.c, unexnt.c: Try to avoid differences in systems that do or do not include final null byte in PATH_MAX. Create PATH_MAX_INTERNAL and PATH_MAX_EXTERNAL and use them everywhere. Rewrite code in dumper.c to avoid use of PATH_MAX. When necessary in nt.c, use _MAX_PATH instead of MAX_PATH to be consistent with other places. text.c: Code to short-circuit when binary or Unicode was not working due to EOL wrapping. Fix this code to work when either no EOL autodetection or no CR's or LF's in the text. lisp.h, rangetab.c, rangetab.h, regex.c, search.c: Implement different types of ranges (open/closed start and end). Change default to be start-closed, end-open.
author ben
date Mon, 06 Dec 2004 03:52:23 +0000
parents 01c57eb70ae9
children 491f8cf78a9c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; msw-faces.el --- mswindows-specific face stuff.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 442
diff changeset
4 ;;; Copyright (C) 1995, 1996, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Author: Jamie Zawinski
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Modified by: Chuck Thompson
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Modified by: Ben Wing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; Modified by: Martin Buchholz
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; Rewritten for mswindows by: Jonathan Harris
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; along with XEmacs; see the file COPYING. If not, write to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;; This file does the magic to parse mswindows font names, and make sure that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; the default and modeline attributes of new frames are specified enough.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 872
diff changeset
32 (globally-declare-boundp
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 872
diff changeset
33 '(mswindows-font-regexp mswindows-font-regexp-missing-1
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 872
diff changeset
34 mswindows-font-regexp-missing-2 mswindows-font-regexp-missing-3
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 872
diff changeset
35 mswindows-font-regexp-missing-4))
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 872
diff changeset
36
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 793
diff changeset
37 (defun mswindows-init-global-faces ()
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 793
diff changeset
38 (set-face-font 'gui-element "MS Sans Serif:Regular:8" nil 'mswindows))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 442
diff changeset
39
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 (defun mswindows-init-device-faces (device)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
41 (let ((color-default (device-system-metric device 'color-default))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
42 (color-3d-face (device-system-metric device 'color-3d-face)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
43 ; Force creation of the default face font so that if it fails we get
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
44 ; an error now instead of a crash at frame creation.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
45 (unless (face-font-instance 'default device)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
46 (error "Can't find a suitable default font"))
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
47
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
48 ;; Don't set them on the device because then the global setting won't
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
49 ;; override them.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
50 ;; #### Use device tags if we have multiple msprinter devices. (can we?)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
51 (if (car color-default)
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
52 (set-face-foreground 'default (car color-default) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
53 (device-type device)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
54 (if (cdr color-default)
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
55 (set-face-background 'default (cdr color-default) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
56 (device-type device)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
57 (if (car color-3d-face)
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
58 (set-face-foreground 'gui-element (car color-3d-face) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
59 (device-type device)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
60 (if (cdr color-3d-face)
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
61 (set-face-background 'gui-element (cdr color-3d-face) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
62 (device-type device)))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 442
diff changeset
63 ))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (defun mswindows-init-frame-faces (frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; Other functions expect these regexps
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
69 (let
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
70 ((- ":")
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
71 (fontname "\\([a-zA-Z ]*\\)") ; 1
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
72 (style "\\(\\(?:[a-zA-Z]+\\(?: +[a-zA-Z]+\\)*\\)?\\)") ; 2
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
73 (pointsize "\\([0-9]*\\)") ; 3
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
74 (effects "\\(\\(?:[a-zA-Z]+\\(?: +[a-zA-Z]+\\)*\\)?\\)") ; 4
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
75 ;; must match "OEM/DOS"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
76 (charset "\\([a-zA-Z/ ]*\\)") ; 5
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
77 )
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
78 (defconst mswindows-font-regexp
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
79 (concat "^" fontname - style - pointsize - effects - charset "$"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
80 (defconst mswindows-font-regexp-missing-1
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
81 (concat "^" fontname - style - pointsize - effects "$"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
82 (defconst mswindows-font-regexp-missing-2
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
83 (concat "^" fontname - style - pointsize "$"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
84 (defconst mswindows-font-regexp-missing-3
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
85 (concat "^" fontname - style "$"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
86 (defconst mswindows-font-regexp-missing-4
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
87 (concat "^" fontname "$"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
88 )
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ;;; Fill in missing parts of a font spec. This is primarily intended as a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;;; helper function for the functions below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 ;;; mswindows fonts look like:
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
93 ;;; fontname[:[weight][ slant][:pointsize[:effects]]][:charset]
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 ;;; A minimal mswindows font spec looks like:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ;;; Courier New
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 ;;; A maximal mswindows font spec looks like:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ;;; Courier New:Bold Italic:10:underline strikeout:Western
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
98 (defun mswindows-canonicalize-font-name (font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
99 "Given a mswindows font or font name, return its name in canonical form.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
100 This adds missing colons and fills in the style field with \"Regular\".
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
101 This does *NOT* fill in the point size or charset fields, because in those
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
102 cases an empty field is not equivalent to any particular field value, but a
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
103 wildcard allowing for any possible value (charset Western and point size 10
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
104 are chosen first, if they exist)."
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
105 (if (font-instance-p font) (setq font (font-instance-name font)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
106 ;; fill in missing colons
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
107 (setq font
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
108 (cond ((string-match mswindows-font-regexp font) font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
109 ((string-match mswindows-font-regexp-missing-1 font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
110 (concat font ":"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
111 ((string-match mswindows-font-regexp-missing-2 font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
112 (concat font "::"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
113 ((string-match mswindows-font-regexp-missing-3 font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
114 (concat font ":::"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
115 ((string-match mswindows-font-regexp-missing-4 font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
116 (concat font "::::"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
117 (t "::::")))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
118 (or (string-match mswindows-font-regexp font) (error "can't parse %S" font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
119 (if (equal "" (match-string 2 font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
120 (concat (substring font 0 (match-beginning 2)) "Regular"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
121 (substring font (match-beginning 2)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
122 font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
123
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
124 (defun mswindows-parse-font-style (style)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
125 ;; Parse a style into a cons (WEIGHT . SLANT). WEIGHT will never be the
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
126 ;; empty string (it may be "Regular"), but SLANT will be empty for
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
127 ;; non-italic.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
128 (save-match-data
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
129 (let ((case-fold-search t))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
130 (cond ((equalp style "Italic") '("Regular" . "Italic"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
131 ((string-match "^\\([a-zA-Z ]+?\\) +Italic$" style)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
132 (cons (match-string 1 style) "Italic"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
133 (t (cons style ""))))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
134
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
135 (defun mswindows-construct-font-style (weight slant)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
136 ;; Construct the style from WEIGHT and SLANT. Opposite of
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
137 ;; mswindows-parse-font-style.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
138 (cond ((and (equal slant "") (equal weight "")) "Regular")
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
139 ((equal slant "") weight)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
140 ((or (equalp weight "Regular") (equal weight "")) slant)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
141 (t (concat weight " " slant))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
142
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
143 (defun mswindows-frob-font-style (font which)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
144 ;; Given a font name or font instance, return a name with the style field
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
145 ;; (which includes weight and/or slant) changed according to WHICH, a plist.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
146 ;; If no entry found, don't change.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
147 (if (null font) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
148 (setq font (mswindows-canonicalize-font-name font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
149 (or (string-match mswindows-font-regexp font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
150 (error "can't parse %S" font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
151 (let* ((style (match-string 2 font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
152 (style-rep
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
153 (save-match-data
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
154 (or (loop for (x y) on which by #'cddr
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
155 if (string-match (concat "^" x "$") style)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
156 return (replace-match y nil nil style))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
157 style))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
158 (concat (substring font 0 (match-beginning 2))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
159 style-rep
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
160 (substring font (match-end 2))))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
161
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
162 (defun mswindows-frob-font-style-and-sizify (font which &optional device)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
163 (if (null font) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
164 (let* ((oldwidth (if (font-instance-p font) (font-instance-width font)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
165 (let ((fi (make-font-instance font device t)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
166 (and fi (font-instance-width fi)))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
167 (newname (mswindows-frob-font-style font which))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
168 (newfont (make-font-instance newname device t)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
169 ;; Hack! On MS Windows, bold fonts (even monospaced) are often wider
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
170 ;; than the equivalent non-bold font. Making the bold font one point
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
171 ;; smaller usually makes it the same width (maybe at the expense of
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
172 ;; making it one pixel shorter). Do the same trick in both directions.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
173 (when (font-instance-p newfont)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
174 (let ((newerfont newfont))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
175 (block nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
176 (while (and newerfont oldwidth)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
177 (setq newfont newerfont)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
178 (cond ((< (font-instance-width newfont) oldwidth)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
179 (setq newerfont
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
180 (make-font-instance
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
181 (mswindows-find-larger-font newfont device)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
182 device t))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
183 (if (and newerfont
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
184 (> (font-instance-width newerfont) oldwidth))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
185 (return nil)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
186 ((> (font-instance-width newfont) oldwidth)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
187 (setq newerfont
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
188 (make-font-instance
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
189 (mswindows-find-smaller-font newfont device)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
190 device t))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
191 (if (and newerfont
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
192 (< (font-instance-width newerfont) oldwidth))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
193 (return nil)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
194 (t (return nil))))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
195 (if (font-instance-p newfont) (font-instance-name newfont) newfont)))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
196
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
197 (defconst mswindows-nonbold-weight-regexp
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
198 ;; He looked so, so cool with the ultra light dangling from his mouth as
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
199 ;; his fingers spun out demisemiquavers from the keyboard ...
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
200 "\\(Regular\\|Thin\\|Extra Light\\|Ultra Light\\|Light\\|Normal\\|Medium\\|Semi Bold\\|Demi Bold\\)"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
201 )
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
202 (defconst mswindows-bold-weight-regexp
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
203 "\\(Semi Bold\\|Demi Bold\\|Bold\\|Extra Bold\\|Ultra Bold\\|Heavy\\|Black\\)"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
204 )
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
205
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
206 (defconst mswindows-make-font-bold-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
207 `(,mswindows-nonbold-weight-regexp "Bold"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
208 "Italic" "Bold Italic"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
209 ,(concat mswindows-nonbold-weight-regexp " Italic") "Bold Italic"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
210
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
211 (defconst mswindows-make-font-nonbold-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
212 `(,mswindows-bold-weight-regexp "Regular"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
213 ,(concat mswindows-bold-weight-regexp " Italic") "Italic"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
214
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
215 (defconst mswindows-make-font-italic-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
216 '("\\(.*\\)Italic" "\\1Italic"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
217 "\\(.*\\)" "\\1 Italic"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
218
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
219 (defconst mswindows-make-font-unitalic-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
220 '("Italic" "Regular"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
221 "\\(.*\\) Italic" "\\1"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
222
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
223 (defconst mswindows-make-font-bold-italic-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
224 `(,mswindows-nonbold-weight-regexp "Bold Italic"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
225 ,(concat mswindows-nonbold-weight-regexp " Italic") "Bold Italic"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
226 "Italic" "Bold Italic"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
227 ,mswindows-bold-weight-regexp "\\1 Italic"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (defun mswindows-make-font-bold (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 "Given a mswindows font specification, this attempts to make a bold font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 If it fails, it returns nil."
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
232 (mswindows-frob-font-style-and-sizify font mswindows-make-font-bold-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
233 device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (defun mswindows-make-font-unbold (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 "Given a mswindows font specification, this attempts to make a non-bold font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 If it fails, it returns nil."
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
238 (mswindows-frob-font-style-and-sizify font mswindows-make-font-nonbold-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
239 device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (defun mswindows-make-font-italic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 "Given a mswindows font specification, this attempts to make an `italic'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 font. If it fails, it returns nil."
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
244 (try-font-name (mswindows-frob-font-style
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
245 font mswindows-make-font-italic-mapper) device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (defun mswindows-make-font-unitalic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 "Given a mswindows font specification, this attempts to make a non-italic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 font. If it fails, it returns nil."
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
250 (try-font-name (mswindows-frob-font-style
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
251 font mswindows-make-font-unitalic-mapper) device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (defun mswindows-make-font-bold-italic (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 "Given a mswindows font specification, this attempts to make a `bold-italic'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 font. If it fails, it returns nil."
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
256 (mswindows-frob-font-style-and-sizify font
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
257 mswindows-make-font-bold-italic-mapper
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
258 device))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
259
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
260 (defun mswindows-available-font-sizes (font device)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
261 (if (font-instance-p font) (setq font (font-instance-name font)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
262 (setq font (mswindows-canonicalize-font-name font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
263 (or (string-match mswindows-font-regexp font) (error "Can't parse %S" font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
264 ;; turn pointsize into wildcard
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
265 (setq font
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
266 (concat (substring font 0 (match-beginning 3))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
267 (substring font (match-end 3) (match-end 0))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
268 (sort
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
269 (delq nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
270 (mapcar #'(lambda (name)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
271 (and (string-match mswindows-font-regexp name)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
272 (string-to-int (substring name (match-beginning 3)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
273 (match-end 3)))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
274 (list-fonts font device)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
275 #'<))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
276
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
277 (defun mswindows-frob-font-size (font up-p device)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
278 (if (stringp font) (setq font (make-font-instance font device)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
279 (let* ((name (font-instance-name font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
280 (truename (font-instance-truename font))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
281 (available (and truename
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
282 (mswindows-available-font-sizes truename device))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
283 (if (null available) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
284 (or (string-match mswindows-font-regexp truename)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
285 (error "can't parse %S" truename))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
286 (let ((old-size (string-to-int
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
287 (substring truename
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
288 (match-beginning 3) (match-end 3)))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
289 (or (> old-size 0) (error "font truename has 0 pointsize?"))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
290 (or (string-match mswindows-font-regexp name)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
291 (error "can't parse %S" name))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
292 (let ((newsize
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
293 ;; scalable fonts: change size by 1 point.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
294 (if (= 0 (car available))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
295 (if (and (not up-p) (= 1 old-size)) nil
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
296 (if up-p (1+ old-size) (1- old-size)))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
297 ;; non-scalable fonts: take the next available size.
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
298 (if up-p
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
299 (loop for tail on available
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
300 if (eql (car tail) old-size)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
301 return (cadr tail))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
302 (loop for tail on available
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
303 if (eql (cadr tail) old-size)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
304 return (car tail))))))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
305 (and newsize
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
306 (concat (substring name 0 (match-beginning 3))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
307 (int-to-string newsize)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
308 (substring name (match-end 3) (match-end 0)))))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (defun mswindows-find-smaller-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 "Loads a new version of the given font (or font name) 1 point smaller.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 Returns the font if it succeeds, nil otherwise."
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
313 (mswindows-frob-font-size font nil device))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (defun mswindows-find-larger-font (font &optional device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 "Loads a new version of the given font (or font name) 1 point larger.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 Returns the font if it succeeds, nil otherwise."
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 853
diff changeset
318 (mswindows-frob-font-size font t device))