Mercurial > hg > xemacs-beta

comparison lisp/msw-faces.el @ 282:c42ec1d1cded r21-0b39

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b39
author cvs
date Mon, 13 Aug 2007 10:33:18 +0200
parents 7df0dd720c89
children e11d67e05968
comparison
equal deleted inserted replaced
281:090b52736db2 282:c42ec1d1cded
56 ;;; Courier New 56 ;;; Courier New
57 ;;; A maximal mswindows font spec looks like: 57 ;;; A maximal mswindows font spec looks like:
58 ;;; Courier New:Bold Italic:10:underline strikeout:ansi 58 ;;; Courier New:Bold Italic:10:underline strikeout:ansi
59 ;;; Missing parts of the font spec should be filled in with these values: 59 ;;; Missing parts of the font spec should be filled in with these values:
60 ;;; Courier New:Normal:10::ansi 60 ;;; Courier New:Normal:10::ansi
61 (defun mswindows-font-canicolize-name (font) 61 (defun mswindows-font-canonicalize-name (font)
62 "Given a mswindows font specification, this returns its name in canonical 62 "Given a mswindows font or font specification, this returns its
63 form." 63 specification in canonical form."
64 (if (or (font-instance-p font) 64 (if (or (font-instance-p font)
65 (stringp font)) 65 (stringp font))
66 (let ((name (if (font-instance-p font) 66 (let ((name (if (font-instance-p font)
67 (font-instance-name font) 67 (font-instance-name font)
68 font))) 68 font)))
81 81
82 (defun mswindows-make-font-bold (font &optional device) 82 (defun mswindows-make-font-bold (font &optional device)
83 "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.
84 If it fails, it returns nil." 84 If it fails, it returns nil."
85 (if (font-instance-p font) 85 (if (font-instance-p font)
86 (let ((name (mswindows-font-canicolize-name font)) 86 (let ((name (mswindows-font-canonicalize-name font))
87 (oldwidth (font-instance-width 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 (let ((newfont (make-font-instance 89 (let ((newfont (make-font-instance
90 (concat (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)))
100 100
101 (defun mswindows-make-font-unbold (font &optional device) 101 (defun mswindows-make-font-unbold (font &optional device)
102 "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.
103 If it fails, it returns nil." 103 If it fails, it returns nil."
104 (if (font-instance-p font) 104 (if (font-instance-p font)
105 (let ((name (mswindows-font-canicolize-name font))) 105 (let ((name (mswindows-font-canonicalize-name font)))
106 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 106 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
107 (make-font-instance (concat 107 (make-font-instance (concat
108 (substring name 0 (match-beginning 1)) 108 (substring name 0 (match-beginning 1))
109 "Normal" (substring name (match-end 1))) 109 "Normal" (substring name (match-end 1)))
110 device t)))) 110 device t))))
111 111
112 (defun mswindows-make-font-italic (font &optional device) 112 (defun mswindows-make-font-italic (font &optional device)
113 "Given a mswindows font specification, this attempts to make an `italic' 113 "Given a mswindows font specification, this attempts to make an `italic'
114 font. If it fails, it returns nil." 114 font. If it fails, it returns nil."
115 (if (font-instance-p font) 115 (if (font-instance-p font)
116 (let ((name (mswindows-font-canicolize-name font))) 116 (let ((name (mswindows-font-canonicalize-name font)))
117 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 117 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
118 (make-font-instance (concat 118 (make-font-instance (concat
119 (substring name 0 (match-beginning 1)) 119 (substring name 0 (match-beginning 1))
120 "Italic" (substring name (match-end 1))) 120 "Italic" (substring name (match-end 1)))
121 device t)))) 121 device t))))
122 122
123 (defun mswindows-make-font-unitalic (font &optional device) 123 (defun mswindows-make-font-unitalic (font &optional device)
124 "Given a mswindows font specification, this attempts to make a non-italic 124 "Given a mswindows font specification, this attempts to make a non-italic
125 font. If it fails, it returns nil." 125 font. If it fails, it returns nil."
126 (if (font-instance-p font) 126 (if (font-instance-p font)
127 (let ((name (mswindows-font-canicolize-name font))) 127 (let ((name (mswindows-font-canonicalize-name font)))
128 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 128 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
129 (make-font-instance (concat 129 (make-font-instance (concat
130 (substring name 0 (match-beginning 1)) 130 (substring name 0 (match-beginning 1))
131 "Normal" (substring name (match-end 1))) 131 "Normal" (substring name (match-end 1)))
132 device t)))) 132 device t))))
133 133
134 (defun mswindows-make-font-bold-italic (font &optional device) 134 (defun mswindows-make-font-bold-italic (font &optional device)
135 "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'
136 font. If it fails, it returns nil." 136 font. If it fails, it returns nil."
137 (if (font-instance-p font) 137 (if (font-instance-p font)
138 (let ((name (mswindows-font-canicolize-name font)) 138 (let ((name (mswindows-font-canonicalize-name font))
139 (oldwidth (font-instance-width font))) 139 (oldwidth (font-instance-width font)))
140 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) 140 (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name)
141 (let ((newfont (make-font-instance 141 (let ((newfont (make-font-instance
142 (concat (substring name 0 (match-beginning 1)) 142 (concat (substring name 0 (match-beginning 1))
143 "Bold Italic" (substring name (match-end 1))) 143 "Bold Italic" (substring name (match-end 1)))
152 152
153 (defun mswindows-find-smaller-font (font &optional device) 153 (defun mswindows-find-smaller-font (font &optional device)
154 "Loads a new version of the given font (or font name) 1 point smaller. 154 "Loads a new version of the given font (or font name) 1 point smaller.
155 Returns the font if it succeeds, nil otherwise." 155 Returns the font if it succeeds, nil otherwise."
156 (if (font-instance-p font) 156 (if (font-instance-p font)
157 (let (old-size (name (mswindows-font-canicolize-name font))) 157 (let (old-size (name (mswindows-font-canonicalize-name font)))
158 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) 158 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
159 (setq old-size (string-to-int 159 (setq old-size (string-to-int
160 (substring name (match-beginning 1) (match-end 1)))) 160 (substring name (match-beginning 1) (match-end 1))))
161 (if (> old-size 0) 161 (if (> old-size 0)
162 (make-font-instance (concat 162 (make-font-instance (concat
167 167
168 (defun mswindows-find-larger-font (font &optional device) 168 (defun mswindows-find-larger-font (font &optional device)
169 "Loads a new version of the given font (or font name) 1 point larger. 169 "Loads a new version of the given font (or font name) 1 point larger.
170 Returns the font if it succeeds, nil otherwise." 170 Returns the font if it succeeds, nil otherwise."
171 (if (font-instance-p font) 171 (if (font-instance-p font)
172 (let (old-size (name (mswindows-font-canicolize-name font))) 172 (let (old-size (name (mswindows-font-canonicalize-name font)))
173 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) 173 (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name)
174 (setq old-size (string-to-int 174 (setq old-size (string-to-int
175 (substring name (match-beginning 1) (match-end 1)))) 175 (substring name (match-beginning 1) (match-end 1))))
176 (make-font-instance (concat 176 (make-font-instance (concat
177 (substring name 0 (match-beginning 1)) 177 (substring name 0 (match-beginning 1))