Mercurial > hg > xemacs-beta

comparison lisp/msw-faces.el @ 221:6c0ae1f9357f r20-4b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b9
author cvs
date Mon, 13 Aug 2007 10:10:02 +0200
parents 1f0dabaa0855
children 8efd647ea9ca
comparison
equal deleted inserted replaced
220:04f4bca7b601 221:6c0ae1f9357f
62 ;;; Missing parts of the font spec should be filled in with these values: 62 ;;; Missing parts of the font spec should be filled in with these values:
63 ;;; Courier New:Normal:10::ansi 63 ;;; Courier New:Normal:10::ansi
64 (defun mswindows-font-canicolize-name (font) 64 (defun mswindows-font-canicolize-name (font)
65 "Given a mswindows font specification, this returns its name in canonical 65 "Given a mswindows font specification, this returns its name in canonical
66 form." 66 form."
67 (cond ((font-instance-p font) 67 (if (font-instance-p font)
68 (let ((name (font-instance-name font))) 68 (let ((name (font-instance-name font)))
69 (cond ((string-match 69 (cond ((string-match
70 "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$" 70 "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$"
71 name) name) 71 name) name)
72 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$" 72 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$"
73 name) (concat name ":ansi")) 73 name) (concat name ":ansi"))
74 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name) 74 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name)
75 (concat name "::ansi")) 75 (concat name "::ansi"))
76 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name) 76 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name)
77 (concat name "10::ansi")) 77 (concat name ":10::ansi"))
78 ((string-match "^[a-zA-Z ]+$" name) 78 ((string-match "^[a-zA-Z ]+$" name)
79 (concat name ":Normal:10::ansi")) 79 (concat name ":Normal:10::ansi"))
80 (t "Courier New:Normal:10::ansi")))) 80 (t "Courier New:Normal:10::ansi")))))
81 (t "Courier New:Normal:10::ansi")))
82 81
83 (defun mswindows-make-font-bold (font &optional device) 82 (defun mswindows-make-font-bold (font &optional device)
84 "Given a mswindows font specification, this attempts to make a bold font. 83 "Given a mswindows font specification, this attempts to make a bold font.
85 If it fails, it returns nil." 84 If it fails, it returns nil."
86 (if (font-instance-p font) 85 (if (font-instance-p font)
87 (let ((name (mswindows-font-canicolize-name font))) 86 (let ((name (mswindows-font-canicolize-name font))
87 (oldwidth (font-instance-width font)))
88 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 88 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
89 (make-font-instance (concat 89 (let ((newfont (make-font-instance
90 (substring name 0 (match-beginning 1)) 90 (concat (substring name 0 (match-beginning 1))
91 "Bold" (substring name (match-end 1))) 91 "Bold" (substring name (match-end 1)))
92 device t)))) 92 device t)))
93 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
94 ; equivalent non-bold font. Making the bold font one point smaller usually
95 ; makes it the same width (maybe at the expense of making it one pixel shorter)
96 (if (font-instance-p newfont)
97 (if (> (font-instance-width newfont) oldwidth)
98 (mswindows-find-smaller-font newfont)
99 newfont))))))
93 100
94 (defun mswindows-make-font-unbold (font &optional device) 101 (defun mswindows-make-font-unbold (font &optional device)
95 "Given a mswindows font specification, this attempts to make a non-bold font. 102 "Given a mswindows font specification, this attempts to make a non-bold font.
96 If it fails, it returns nil." 103 If it fails, it returns nil."
97 (if (font-instance-p font) 104 (if (font-instance-p font)
126 133
127 (defun mswindows-make-font-bold-italic (font &optional device) 134 (defun mswindows-make-font-bold-italic (font &optional device)
128 "Given a mswindows font specification, this attempts to make a `bold-italic' 135 "Given a mswindows font specification, this attempts to make a `bold-italic'
129 font. If it fails, it returns nil." 136 font. If it fails, it returns nil."
130 (if (font-instance-p font) 137 (if (font-instance-p font)
131 (let ((name (mswindows-font-canicolize-name font))) 138 (let ((name (mswindows-font-canicolize-name font))
139 (oldwidth (font-instance-width font)))
132 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 140 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
133 (make-font-instance (concat 141 (let ((newfont (make-font-instance
134 (substring name 0 (match-beginning 1)) 142 (concat (substring name 0 (match-beginning 1))
135 "Bold Italic" (substring name (match-end 1))) 143 "Bold Italic" (substring name (match-end 1)))
136 device t)))) 144 device t)))
145 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
146 ; equivalent non-bold font. Making the bold font one point smaller usually
147 ; makes it the same width (maybe at the expense of making it one pixel shorter)
148 (if (font-instance-p newfont)
149 (if (> (font-instance-width newfont) oldwidth)
150 (mswindows-find-smaller-font newfont)
151 newfont))))))
137 152
138 (defun mswindows-find-smaller-font (font &optional device) 153 (defun mswindows-find-smaller-font (font &optional device)
139 "Loads a new, version of the given font (or font name). 154 "Loads a new version of the given font (or font name) 1 point smaller.
140 Returns the font if it succeeds, nil otherwise. 155 Returns the font if it succeeds, nil otherwise."
141 If scalable fonts are available, this returns a font which is 1 point smaller.
142 Otherwise, it returns the next smaller version of this font that is defined."
143 (if (font-instance-p font) 156 (if (font-instance-p font)
144 (let (old-size (name (mswindows-font-canicolize-name font))) 157 (let (old-size (name (mswindows-font-canicolize-name font)))
145 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) 158 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
146 (setq old-size (string-to-int 159 (setq old-size (string-to-int
147 (substring name (match-beginning 1) (match-end 1)))) 160 (substring name (match-beginning 1) (match-end 1))))
151 (int-to-string (- old-size 1)) 164 (int-to-string (- old-size 1))
152 (substring name (match-end 1))) 165 (substring name (match-end 1)))
153 device t))))) 166 device t)))))
154 167
155 (defun mswindows-find-larger-font (font &optional device) 168 (defun mswindows-find-larger-font (font &optional device)
156 "Loads a new, slightly larger version of the given font (or font name). 169 "Loads a new version of the given font (or font name) 1 point larger.
157 Returns the font if it succeeds, nil otherwise. 170 Returns the font if it succeeds, nil otherwise."
158 If scalable fonts are available, this returns a font which is 1 point larger.
159 Otherwise, it returns the next larger version of this font that is defined."
160 (if (font-instance-p font) 171 (if (font-instance-p font)
161 (let (old-size (name (mswindows-font-canicolize-name font))) 172 (let (old-size (name (mswindows-font-canicolize-name font)))
162 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) 173 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
163 (setq old-size (string-to-int 174 (setq old-size (string-to-int
164 (substring name (match-beginning 1) (match-end 1)))) 175 (substring name (match-beginning 1) (match-end 1))))