Mercurial > hg > xemacs-beta

comparison lisp/w3/font.el @ 118:7d55a9ba150c r20-1b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 9f59509498e1
children cca96a509cfe
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
1 ;;; font.el --- New font model 1 ;;; font.el --- New font model
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/26 20:08:55 3 ;; Created: 1997/03/28 20:23:52
4 ;; Version: 1.40 4 ;; Version: 1.43
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.
73 (defconst ns-font-weight-mappings 73 (defconst ns-font-weight-mappings
74 '((:extra-light . "extralight") 74 '((:extra-light . "extralight")
75 (:light . "light") 75 (:light . "light")
76 (:demi-light . "demilight") 76 (:demi-light . "demilight")
77 (:medium . "medium") 77 (:medium . "medium")
78 (:normal . "normal") 78 (:normal . "medium")
79 (:demi-bold . "demibold") 79 (:demi-bold . "demibold")
80 (:bold . "bold") 80 (:bold . "bold")
81 (:extra-bold . "extrabold")) 81 (:extra-bold . "extrabold"))
82 "An assoc list mapping keywords to actual NeXTstep specific 82 "An assoc list mapping keywords to actual NeXTstep specific
83 information to use") 83 information to use")
87 (:light . "light") 87 (:light . "light")
88 (:demi-light . "demilight") 88 (:demi-light . "demilight")
89 (:demi . "demi") 89 (:demi . "demi")
90 (:book . "book") 90 (:book . "book")
91 (:medium . "medium") 91 (:medium . "medium")
92 (:normal . "normal") 92 (:normal . "medium")
93 (:demi-bold . "demibold") 93 (:demi-bold . "demibold")
94 (:bold . "bold") 94 (:bold . "bold")
95 (:extra-bold . "extrabold")) 95 (:extra-bold . "extrabold"))
96 "An assoc list mapping keywords to actual Xwindow specific strings 96 "An assoc list mapping keywords to actual Xwindow specific strings
97 for use in the 'weight' field of an X font string.") 97 for use in the 'weight' field of an X font string.")
472 foundry - family - weight\? - slant\? - swidth - adstyle - 472 foundry - family - weight\? - slant\? - swidth - adstyle -
473 pixelsize - pointsize - resx - resy - spacing - avgwidth - 473 pixelsize - pointsize - resx - resy - spacing - avgwidth -
474 registry - encoding "\\'" 474 registry - encoding "\\'"
475 )))) 475 ))))
476 476
477 (defvar font-x-registry-and-encoding-regexp
478 (or (and font-running-xemacs
479 (boundp 'x-font-regexp-registry-and-encoding)
480 (symbol-value 'x-font-regexp-registry-and-encoding))
481 (let ((- "[-?]")
482 (registry "[^-]*")
483 (encoding "[^-]+"))
484 (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))))
485
477 (defun x-font-create-object (fontname &optional device) 486 (defun x-font-create-object (fontname &optional device)
478 (let ((case-fold-search t)) 487 (let ((case-fold-search t))
479 (if (or (not (stringp fontname)) 488 (if (or (not (stringp fontname))
480 (not (string-match font-x-font-regexp fontname))) 489 (not (string-match font-x-font-regexp fontname)))
481 (make-font) 490 (make-font)
513 ((null slant) nil) 522 ((null slant) nil)
514 ((member slant '("i" "I")) 523 ((member slant '("i" "I"))
515 (set-font-italic-p retval t)) 524 (set-font-italic-p retval t))
516 ((member slant '("o" "O")) 525 ((member slant '("o" "O"))
517 (set-font-oblique-p retval t))) 526 (set-font-oblique-p retval t)))
527 (if (string-match font-x-registry-and-encoding-regexp fontname)
528 (progn
529 (set-font-registry retval (match-string 1 fontname))
530 (set-font-encoding retval (match-string 2 fontname))))
518 retval)))) 531 retval))))
519 532
520 (defun x-font-families-for-device (&optional device no-resetp) 533 (defun x-font-families-for-device (&optional device no-resetp)
521 (condition-case () 534 (condition-case ()
522 (require 'x-font-menu) 535 (require 'x-font-menu)
564 (defun font-default-family-for-device (&optional device) 577 (defun font-default-family-for-device (&optional device)
565 (or device (setq device (selected-device))) 578 (or device (setq device (selected-device)))
566 (font-family (font-default-object-for-device device))) 579 (font-family (font-default-object-for-device device)))
567 580
568 ;;;###autoload 581 ;;;###autoload
582 (defun font-default-registry-for-device (&optional device)
583 (or device (setq device (selected-device)))
584 (font-registry (font-default-object-for-device device)))
585
586 ;;;###autoload
587 (defun font-default-encoding-for-device (&optional device)
588 (or device (setq device (selected-device)))
589 (font-encoding (font-default-object-for-device device)))
590
591 ;;;###autoload
569 (defun font-default-size-for-device (&optional device) 592 (defun font-default-size-for-device (&optional device)
570 (or device (setq device (selected-device))) 593 (or device (setq device (selected-device)))
571 ;; face-height isn't the right thing (always 1 pixel too high?) 594 ;; face-height isn't the right thing (always 1 pixel too high?)
572 ;; (if font-running-xemacs 595 ;; (if font-running-xemacs
573 ;; (format "%dpx" (face-height 'default device)) 596 ;; (format "%dpx" (face-height 'default device))
580 (font-registry fontobj) 603 (font-registry fontobj)
581 (font-encoding fontobj))) 604 (font-encoding fontobj)))
582 (= (font-style fontobj) 0)) 605 (= (font-style fontobj) 0))
583 (face-font 'default) 606 (face-font 'default)
584 (or device (setq device (selected-device))) 607 (or device (setq device (selected-device)))
585 (let ((family (or (font-family fontobj) 608 (let* ((default (font-default-object-for-device device))
586 (font-default-family-for-device device) 609 (family (or (font-family fontobj)
587 (x-font-families-for-device device))) 610 (font-family default)
588 (weight (or (font-weight fontobj) :medium)) 611 (x-font-families-for-device device)))
589 (style (font-style fontobj)) 612 (weight (or (font-weight fontobj) :medium))
590 (size (or (if font-running-xemacs 613 (style (font-style fontobj))
591 (font-size fontobj)) 614 (size (or (if font-running-xemacs
592 (font-default-size-for-device device))) 615 (font-size fontobj))
593 (registry (or (font-registry fontobj) "*")) 616 (font-size default)))
594 (encoding (or (font-encoding fontobj) "*"))) 617 (registry (or (font-registry fontobj)
618 (font-registry default)
619 "*"))
620 (encoding (or (font-encoding fontobj)
621 (font-encoding default)
622 "*")))
595 (if (stringp family) 623 (if (stringp family)
596 (setq family (list family))) 624 (setq family (list family)))
597 (setq weight (font-higher-weight weight 625 (setq weight (font-higher-weight weight
598 (and (font-bold-p fontobj) :bold))) 626 (and (font-bold-p fontobj) :bold)))
599 (if (stringp size) 627 (if (stringp size)