Mercurial > hg > xemacs-beta

comparison lisp/msw-faces.el @ 318:afd57c14dfc8 r21-0b57

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b57
author cvs
date Mon, 13 Aug 2007 10:45:36 +0200
parents 70ad99077275
children 19dcec799385
comparison
equal deleted inserted replaced
317:a2fc9afbef65 318:afd57c14dfc8
24 ;; You should have received a copy of the GNU General Public License 24 ;; You should have received a copy of the GNU General Public License
25 ;; along with XEmacs; see the file COPYING. If not, write to the 25 ;; along with XEmacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA. 27 ;; Boston, MA 02111-1307, USA.
28 28
29 ;; This file does the magic to parse mswindows font names, and make sure that the 29 ;; This file does the magic to parse mswindows font names, and make sure that
30 ;; default and modeline attributes of new frames are specified enough. 30 ;; the default and modeline attributes of new frames are specified enough.
31 31
32 ;;; ensure that the default face has some reasonable fallbacks if nothing 32 ;;; Force creation of the default face font so that if it fails we get an
33 ;;; else is specified. 33 ;;; error now instead of a crash at frame creation.
34 (defun mswindows-init-device-faces (device) 34 (defun mswindows-init-device-faces (device)
35 (set-face-font 'default 35 (unless (face-font-instance 'default device)
36 '((mswindows default) . "Courier New:Regular:10") 'global) 36 (error "Can't find a suitable default font")))
37 )
38 37
39 38
40 (defun mswindows-init-frame-faces (frame) 39 (defun mswindows-init-frame-faces (frame)
41 ) 40 )
42 41
46 ;;; mswindows fonts look like: 45 ;;; mswindows fonts look like:
47 ;;; fontname[:[weight][ style][:pointsize[:effects]]][:charset] 46 ;;; fontname[:[weight][ style][:pointsize[:effects]]][:charset]
48 ;;; A minimal mswindows font spec looks like: 47 ;;; A minimal mswindows font spec looks like:
49 ;;; Courier New 48 ;;; Courier New
50 ;;; A maximal mswindows font spec looks like: 49 ;;; A maximal mswindows font spec looks like:
51 ;;; Courier New:Bold Italic:10:underline strikeout:western 50 ;;; Courier New:Bold Italic:10:underline strikeout:Western
52 ;;; Missing parts of the font spec should be filled in with these values: 51 ;;; Missing parts of the font spec should be filled in with these values:
53 ;;; Courier New:Normal:10::western 52 ;;; Courier New:Regular:10::Western
54 (defun mswindows-font-canonicalize-name (font) 53 (defun mswindows-font-canonicalize-name (font)
55 "Given a mswindows font or font specification, this returns its 54 "Given a mswindows font or font name, this returns its name in
56 specification in canonical form." 55 canonical form."
57 (if (or (font-instance-p font) 56 (if (or (font-instance-p font)
58 (stringp font)) 57 (stringp font))
59 (let ((name (if (font-instance-p font) 58 (let ((name (if (font-instance-p font)
60 (font-instance-name font) 59 (font-instance-name font)
61 font))) 60 font)))
62 (cond ((string-match 61 (cond ((string-match
63 "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$" 62 "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$"
64 name) name) 63 name) name)
65 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$" 64 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$"
66 name) (concat name ":western")) 65 name) (concat name ":Western"))
67 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name) 66 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name)
68 (concat name "::western")) 67 (concat name "::Western"))
69 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name) 68 ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name)
70 (concat name ":10::western")) 69 (concat name ":10::Western"))
71 ((string-match "^[a-zA-Z ]+$" name) 70 ((string-match "^[a-zA-Z ]+$" name)
72 (concat name ":Normal:10::western")) 71 (concat name ":Regular:10::Western"))
73 (t "Courier New:Normal:10::western"))))) 72 (t "Courier New:Regular:10::Western")))))
74 73
75 (defun mswindows-make-font-bold (font &optional device) 74 (defun mswindows-make-font-bold (font &optional device)
76 "Given a mswindows font specification, this attempts to make a bold font. 75 "Given a mswindows font specification, this attempts to make a bold font.
77 If it fails, it returns nil." 76 If it fails, it returns nil."
78 (if (font-instance-p font) 77 (if (font-instance-p font)
86 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the 85 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
87 ; equivalent non-bold font. Making the bold font one point smaller usually 86 ; equivalent non-bold font. Making the bold font one point smaller usually
88 ; makes it the same width (maybe at the expense of making it one pixel shorter) 87 ; makes it the same width (maybe at the expense of making it one pixel shorter)
89 (if (font-instance-p newfont) 88 (if (font-instance-p newfont)
90 (if (> (font-instance-width newfont) oldwidth) 89 (if (> (font-instance-width newfont) oldwidth)
91 (mswindows-find-smaller-font newfont) 90 (mswindows-find-smaller-font newfont device)
92 newfont)))))) 91 newfont))))))
93 92
94 (defun mswindows-make-font-unbold (font &optional device) 93 (defun mswindows-make-font-unbold (font &optional device)
95 "Given a mswindows font specification, this attempts to make a non-bold font. 94 "Given a mswindows font specification, this attempts to make a non-bold font.
96 If it fails, it returns nil." 95 If it fails, it returns nil."
97 (if (font-instance-p font) 96 (if (font-instance-p font)
98 (let ((name (mswindows-font-canonicalize-name font))) 97 (let ((name (mswindows-font-canonicalize-name font)))
99 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 98 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
100 (make-font-instance (concat 99 (make-font-instance (concat
101 (substring name 0 (match-beginning 1)) 100 (substring name 0 (match-beginning 1))
102 "Normal" (substring name (match-end 1))) 101 "Regular" (substring name (match-end 1)))
103 device t)))) 102 device t))))
104 103
105 (defun mswindows-make-font-italic (font &optional device) 104 (defun mswindows-make-font-italic (font &optional device)
106 "Given a mswindows font specification, this attempts to make an `italic' 105 "Given a mswindows font specification, this attempts to make an `italic'
107 font. If it fails, it returns nil." 106 font. If it fails, it returns nil."
119 (if (font-instance-p font) 118 (if (font-instance-p font)
120 (let ((name (mswindows-font-canonicalize-name font))) 119 (let ((name (mswindows-font-canonicalize-name font)))
121 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 120 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
122 (make-font-instance (concat 121 (make-font-instance (concat
123 (substring name 0 (match-beginning 1)) 122 (substring name 0 (match-beginning 1))
124 "Normal" (substring name (match-end 1))) 123 "Regular" (substring name (match-end 1)))
125 device t)))) 124 device t))))
126 125
127 (defun mswindows-make-font-bold-italic (font &optional device) 126 (defun mswindows-make-font-bold-italic (font &optional device)
128 "Given a mswindows font specification, this attempts to make a `bold-italic' 127 "Given a mswindows font specification, this attempts to make a `bold-italic'
129 font. If it fails, it returns nil." 128 font. If it fails, it returns nil."
138 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the 137 ; Hack! on mswindows, bold fonts (even monospaced) are often wider than the
139 ; equivalent non-bold font. Making the bold font one point smaller usually 138 ; equivalent non-bold font. Making the bold font one point smaller usually
140 ; makes it the same width (maybe at the expense of making it one pixel shorter) 139 ; makes it the same width (maybe at the expense of making it one pixel shorter)
141 (if (font-instance-p newfont) 140 (if (font-instance-p newfont)
142 (if (> (font-instance-width newfont) oldwidth) 141 (if (> (font-instance-width newfont) oldwidth)
143 (mswindows-find-smaller-font newfont) 142 (mswindows-find-smaller-font newfont device)
144 newfont)))))) 143 newfont))))))
145 144
146 (defun mswindows-find-smaller-font (font &optional device) 145 (defun mswindows-find-smaller-font (font &optional device)
147 "Loads a new version of the given font (or font name) 1 point smaller. 146 "Loads a new version of the given font (or font name) 1 point smaller.
148 Returns the font if it succeeds, nil otherwise." 147 Returns the font if it succeeds, nil otherwise."