Mercurial > hg > xemacs-beta

comparison lisp/x-font-menu.el @ 523:cd662ad69f40

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-05-09 13:43:49 by ben] regex.c: fix error compiling regexps with back-references in them. xemacs.mak: do not warn about gtk when we're not trying to compile with it. font.el, gtk-widget-accessors.el, widgets-gtk.el, x-font-menu.el: fix byte-compilation warnings. etags.c: temporary fix to avoid crashes with new regex code. PROBLEMS: i swear i already committed this.
author ben
date Wed, 09 May 2001 13:43:58 +0000
parents 7039e6323819
children 8b464283e891
comparison
equal deleted inserted replaced
522:19559cacc941 523:cd662ad69f40
188 188
189 ;; We use the user-specified one if possible, else use the truename. 189 ;; We use the user-specified one if possible, else use the truename.
190 ;; If the user didn't specify one (with "-dt-*-*", for example) 190 ;; If the user didn't specify one (with "-dt-*-*", for example)
191 ;; get the truename and use the possibly suboptimal data from that. 191 ;; get the truename and use the possibly suboptimal data from that.
192 ;;;###autoload 192 ;;;###autoload
193 (defun* x-font-menu-font-data (face dcache) 193 (defun x-font-menu-font-data (face dcache)
194 (let* ((case-fold-search t) 194 (let* ((case-fold-search t)
195 (domain (if font-menu-this-frame-only-p 195 (domain (if font-menu-this-frame-only-p
196 (selected-frame) 196 (selected-frame)
197 (selected-device))) 197 (selected-device)))
198 (name (font-instance-name (face-font-instance face domain))) 198 (name (font-instance-name (face-font-instance face domain)))
205 (setq entry (vassoc family (aref dcache 0)))) 205 (setq entry (vassoc family (aref dcache 0))))
206 (when (and (null entry) 206 (when (and (null entry)
207 (string-match x-font-regexp-foundry-and-family truename)) 207 (string-match x-font-regexp-foundry-and-family truename))
208 (setq family (capitalize (match-string 1 truename))) 208 (setq family (capitalize (match-string 1 truename)))
209 (setq entry (vassoc family (aref dcache 0)))) 209 (setq entry (vassoc family (aref dcache 0))))
210 (when (null entry) 210
211 (return-from x-font-menu-font-data (make-vector 5 nil))) 211 (if (null entry)
212 212 (make-vector 5 nil)
213 (when (string-match x-font-regexp name) 213
214 (setq weight (capitalize (match-string 1 name))) 214 (when (string-match x-font-regexp name)
215 (setq size (string-to-int (match-string 6 name)))) 215 (setq weight (capitalize (match-string 1 name)))
216 (setq size (string-to-int (match-string 6 name))))
216 217
217 (when (string-match x-font-regexp truename) 218 (when (string-match x-font-regexp truename)
218 (when (not (member weight (aref entry 1))) 219 (when (not (member weight (aref entry 1)))
219 (setq weight (capitalize (match-string 1 truename)))) 220 (setq weight (capitalize (match-string 1 truename))))
220 (when (not (member size (aref entry 2))) 221 (when (not (member size (aref entry 2)))
221 (setq size (string-to-int (match-string 6 truename)))) 222 (setq size (string-to-int (match-string 6 truename))))
222 (setq slant (capitalize (match-string 2 truename)))) 223 (setq slant (capitalize (match-string 2 truename))))
223 224
224 (vector entry family size weight slant))) 225 (vector entry family size weight slant))))
225 226
226 (defun x-font-menu-load-font (family weight size slant resolution) 227 (defun x-font-menu-load-font (family weight size slant resolution)
227 "Try to load a font with the requested properties. 228 "Try to load a font with the requested properties.
228 The weight, slant and resolution are only hints." 229 The weight, slant and resolution are only hints."
229 (when (integerp size) (setq size (int-to-string size))) 230 (when (integerp size) (setq size (int-to-string size)))