Mercurial > hg > xemacs-beta

comparison lisp/w3/font.el @ 38:1a767b41a199 r19-15b102

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b102
author cvs
date Mon, 13 Aug 2007 08:54:01 +0200
parents e04119814345
children 6a22abad6937
comparison
equal deleted inserted replaced
37:ad40ac360d14 38:1a767b41a199
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.
59 (setq keywords (cdr keywords))))))) 59 (setq keywords (cdr keywords)))))))
60 60
61 (defconst font-window-system-mappings 61 (defconst font-window-system-mappings
62 '((x . (x-font-create-name x-font-create-object)) 62 '((x . (x-font-create-name x-font-create-object))
63 (ns . (ns-font-create-name ns-font-create-object)) 63 (ns . (ns-font-create-name ns-font-create-object))
64 (win32 . (x-font-create-name x-font-create-object)) ; Change? FIXME 64 (win32 . (x-font-create-name x-font-create-object))
65 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME 65 (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME
66 (tty . (tty-font-create-plist tty-font-create-object))) 66 (tty . (tty-font-create-plist tty-font-create-object)))
67 "An assoc list mapping device types to the function used to create 67 "An assoc list mapping device types to the function used to create
68 a font name from a font structure.") 68 a font name from a font structure.")
69 69
528 (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0)))) 528 (let ((scaled (mapcar (function (lambda (x) (if x (aref x 0))))
529 (aref menu 0))) 529 (aref menu 0)))
530 (normal (mapcar (function (lambda (x) (if x (aref x 0)))) 530 (normal (mapcar (function (lambda (x) (if x (aref x 0))))
531 (aref menu 1)))) 531 (aref menu 1))))
532 (sort (unique (nconc scaled normal)) 'string-lessp)))) 532 (sort (unique (nconc scaled normal)) 'string-lessp))))
533 (mapcar 'car font-family-mappings))) 533 (cons "monospace" (mapcar 'car font-family-mappings))))
534 534
535 (defvar font-default-cache nil) 535 (defvar font-default-cache nil)
536 536
537 ;;;###autoload 537 ;;;###autoload
538 (defun font-default-font-for-device (&optional device) 538 (defun font-default-font-for-device (&optional device)
567 (or device (setq device (selected-device))) 567 (or device (setq device (selected-device)))
568 ;; face-height isn't the right thing (always 1 pixel too high?) 568 ;; face-height isn't the right thing (always 1 pixel too high?)
569 ;; (if font-running-xemacs 569 ;; (if font-running-xemacs
570 ;; (format "%dpx" (face-height 'default device)) 570 ;; (format "%dpx" (face-height 'default device))
571 (font-size (font-default-object-for-device device))) 571 (font-size (font-default-object-for-device device)))
572 572
573 (defun x-font-create-name (fontobj &optional device) 573 (defun x-font-create-name (fontobj &optional device)
574 (if (and (not (or (font-family fontobj) 574 (if (and (not (or (font-family fontobj)
575 (font-weight fontobj) 575 (font-weight fontobj)
576 (font-size fontobj) 576 (font-size fontobj)
577 (font-registry fontobj) 577 (font-registry fontobj)