Mercurial > hg > xemacs-beta

comparison lisp/font.el @ 4099:a5e2d0f90f97

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2007-08-06 07:00:26 by aidan] Handle XFT fonts in x-font-create-object.
author aidan
date Mon, 06 Aug 2007 07:00:27 +0000
parents 316fddbf58e2
children b4f4e0cc90f1
comparison
equal deleted inserted replaced
4098:7f58c7282a52 4099:a5e2d0f90f97
585 (defun x-font-create-object (fontname &optional device) 585 (defun x-font-create-object (fontname &optional device)
586 "Return a font descriptor object for FONTNAME, appropriate for X devices." 586 "Return a font descriptor object for FONTNAME, appropriate for X devices."
587 (let ((case-fold-search t)) 587 (let ((case-fold-search t))
588 (if (or (not (stringp fontname)) 588 (if (or (not (stringp fontname))
589 (not (string-match font-x-font-regexp fontname))) 589 (not (string-match font-x-font-regexp fontname)))
590 (make-font) 590 (if (and (stringp fontname)
591 (string-match font-xft-font-regexp fontname))
592 ;; Return an XFT font.
593 (xft-font-create-object fontname)
594 ;; It's unclear how to parse the font; return an unspecified
595 ;; one.
596 (make-font))
591 (let ((family nil) 597 (let ((family nil)
592 (size nil) 598 (size nil)
593 (weight (match-string 1 fontname)) 599 (weight (match-string 1 fontname))
594 (slant (match-string 2 fontname)) 600 (slant (match-string 2 fontname))
595 (swidth (match-string 3 fontname)) 601 (swidth (match-string 3 fontname))
749 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 755 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
750 756
751 ;;; #### FIXME actually, this section should be fc-*, right? 757 ;;; #### FIXME actually, this section should be fc-*, right?
752 758
753 (defvar font-xft-font-regexp 759 (defvar font-xft-font-regexp
754 ;; #### FIXME what the fuck?!? 760 (concat "\\`"
755 (when (and (boundp 'xft-font-regexp) xft-font-regexp) 761 #r"\(\\-\|\\:\|\\,\|[^:-]\)*" ; optional foundry and family
756 (concat "\\`" 762 ; (allows for escaped colons,
757 "[^:-]*" ; optional foundry and family 763 ; dashes, commas)
758 ; incorrect, escaping exists 764 "\\(-[0-9]*\\(\\.[0-9]*\\)?\\)?" ; optional size (points)
759 "\\(-[0-9]*\\(\\.[0-9]*\\)?\\)?" ; optional size (points) 765 "\\(:[^:]*\\)*" ; optional properties
760 "\\(:[^:]*\\)*" ; optional properties
761 ; not necessarily key=value!! 766 ; not necessarily key=value!!
762 "\\'" 767 "\\'"
763 ))) 768 ))
764 769
765 (defvar font-xft-family-mappings 770 (defvar font-xft-family-mappings
766 ;; #### FIXME this shouldn't be needed or used for Xft 771 ;; #### FIXME this shouldn't be needed or used for Xft
767 '(("serif" . ("new century schoolbook" 772 '(("serif" . ("new century schoolbook"
768 "utopia" 773 "utopia"