Mercurial > hg > xemacs-beta

comparison lisp/w3/font.el @ 114:8619ce7e4c50 r20-1b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b9
author cvs
date Mon, 13 Aug 2007 09:21:54 +0200
parents fe104dbd9147
children 9f59509498e1
comparison
equal deleted inserted replaced
113:2ec2fe4a4c89 114:8619ce7e4c50
1 ;;; font.el --- New font model 1 ;;; font.el --- New font model
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/10 15:18:19 3 ;; Created: 1997/03/19 18:28:10
4 ;; Version: 1.36 4 ;; Version: 1.38
5 ;; Keywords: faces 5 ;; Keywords: faces
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
62 (setq keywords (cdr keywords))))))) 62 (setq keywords (cdr keywords)))))))
63 63
64 (defconst font-window-system-mappings 64 (defconst font-window-system-mappings
65 '((x . (x-font-create-name x-font-create-object)) 65 '((x . (x-font-create-name x-font-create-object))
66 (ns . (ns-font-create-name ns-font-create-object)) 66 (ns . (ns-font-create-name ns-font-create-object))
67 (win32 . (x-font-create-name x-font-create-object)) ; Change? FIXME 67 (win32 . (x-font-create-name x-font-create-object))
68 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME 68 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME
69 (tty . (tty-font-create-plist tty-font-create-object))) 69 (tty . (tty-font-create-plist tty-font-create-object)))
70 "An assoc list mapping device types to the function used to create 70 "An assoc list mapping device types to the function used to create
71 a font name from a font structure.") 71 a font name from a font structure.")
72 72
531 (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0)))) 531 (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0))))
532 (aref menu 0))) 532 (aref menu 0)))
533 (normal (mapcar (function (lambda (x) (if x (aref x 0)))) 533 (normal (mapcar (function (lambda (x) (if x (aref x 0))))
534 (aref menu 1)))) 534 (aref menu 1))))
535 (sort (unique (nconc scaled normal)) 'string-lessp)))) 535 (sort (unique (nconc scaled normal)) 'string-lessp))))
536 (mapcar 'car font-family-mappings))) 536 (cons "monospace" (mapcar 'car font-family-mappings))))
537 537
538 (defvar font-default-cache nil) 538 (defvar font-default-cache nil)
539 539
540 ;;;###autoload 540 ;;;###autoload
541 (defun font-default-font-for-device (&optional device) 541 (defun font-default-font-for-device (&optional device)
570 (or device (setq device (selected-device))) 570 (or device (setq device (selected-device)))
571 ;; face-height isn't the right thing (always 1 pixel too high?) 571 ;; face-height isn't the right thing (always 1 pixel too high?)
572 ;; (if font-running-xemacs 572 ;; (if font-running-xemacs
573 ;; (format "%dpx" (face-height 'default device)) 573 ;; (format "%dpx" (face-height 'default device))
574 (font-size (font-default-object-for-device device))) 574 (font-size (font-default-object-for-device device)))
575 575
576 (defun x-font-create-name (fontobj &optional device) 576 (defun x-font-create-name (fontobj &optional device)
577 (if (and (not (or (font-family fontobj) 577 (if (and (not (or (font-family fontobj)
578 (font-weight fontobj) 578 (font-weight fontobj)
579 (font-size fontobj) 579 (font-size fontobj)
580 (font-registry fontobj) 580 (font-registry fontobj)