Mercurial > hg > xemacs-beta
diff lisp/w3/font.el @ 20:859a2309aef8 r19-15b93
Import from CVS: tag r19-15b93
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:50:05 +0200 |
parents | 0293115a14e9 |
children | ec9a17fef872 |
line wrap: on
line diff
--- a/lisp/w3/font.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 08:50:05 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/01/30 00:58:33 -;; Version: 1.29 +;; Created: 1997/02/08 00:56:14 +;; Version: 1.33 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,7 +30,8 @@ ;;; The emacsen compatibility package - load it up before anything else ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-and-compile - (require 'w3-sysdp) + (unless (string-match "XEmacs" emacs-version) + (require 'w3-sysdp)) (require 'cl)) (require 'disp-table) @@ -295,8 +296,12 @@ (defun font-spatial-to-canonical (spec &optional device) "Convert SPEC (in inches, millimeters, points, or picas) into points" ;; 1 in = 6 pa = 25.4 mm = 72 pt - (if (numberp spec) - spec + (cond + ((numberp spec) + spec) + ((null spec) + nil) + (t (let ((num nil) (type nil) ;; If for any reason we get null for any of this, default @@ -339,7 +344,7 @@ (t (setq retval num)) ) - retval))) + retval)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -466,46 +471,47 @@ )))) (defun x-font-create-object (fontname &optional device) - (if (or (not (stringp fontname)) - (not (string-match font-x-font-regexp fontname))) - (make-font) - (let ((family nil) - (style nil) - (size nil) - (weight (match-string 1 fontname)) - (slant (match-string 2 fontname)) - (swidth (match-string 3 fontname)) - (adstyle (match-string 4 fontname)) - (pxsize (match-string 5 fontname)) - (ptsize (match-string 6 fontname)) - (retval nil) - (case-fold-search t) - ) - (if (not (string-match x-font-regexp-foundry-and-family fontname)) - nil - (setq family (list (downcase (match-string 1 fontname))))) - (if (string= "*" weight) (setq weight nil)) - (if (string= "*" slant) (setq slant nil)) - (if (string= "*" swidth) (setq swidth nil)) - (if (string= "*" adstyle) (setq adstyle nil)) - (if (string= "*" pxsize) (setq pxsize nil)) - (if (string= "*" ptsize) (setq ptsize nil)) - (if ptsize (setq size (/ (string-to-int ptsize) 10))) - (if (and (not size) pxsize) (setq size (concat pxsize "px"))) - (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) - (if (and adstyle (not (equal adstyle ""))) - (setq family (append family (list (downcase adstyle))))) - (setq retval (make-font :family family - :weight weight - :size size)) - (set-font-bold-p retval (eq :bold weight)) - (cond - ((null slant) nil) - ((member slant '("i" "I")) - (set-font-italic-p retval t)) - ((member slant '("o" "O")) - (set-font-oblique-p retval t))) - retval))) + (let ((case-fold-search t)) + (if (or (not (stringp fontname)) + (not (string-match font-x-font-regexp fontname))) + (make-font) + (let ((family nil) + (style nil) + (size nil) + (weight (match-string 1 fontname)) + (slant (match-string 2 fontname)) + (swidth (match-string 3 fontname)) + (adstyle (match-string 4 fontname)) + (pxsize (match-string 5 fontname)) + (ptsize (match-string 6 fontname)) + (retval nil) + (case-fold-search t) + ) + (if (not (string-match x-font-regexp-foundry-and-family fontname)) + nil + (setq family (list (downcase (match-string 1 fontname))))) + (if (string= "*" weight) (setq weight nil)) + (if (string= "*" slant) (setq slant nil)) + (if (string= "*" swidth) (setq swidth nil)) + (if (string= "*" adstyle) (setq adstyle nil)) + (if (string= "*" pxsize) (setq pxsize nil)) + (if (string= "*" ptsize) (setq ptsize nil)) + (if ptsize (setq size (/ (string-to-int ptsize) 10))) + (if (and (not size) pxsize) (setq size (concat pxsize "px"))) + (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) + (if (and adstyle (not (equal adstyle ""))) + (setq family (append family (list (downcase adstyle))))) + (setq retval (make-font :family family + :weight weight + :size size)) + (set-font-bold-p retval (eq :bold weight)) + (cond + ((null slant) nil) + ((member slant '("i" "I")) + (set-font-italic-p retval t)) + ((member slant '("o" "O")) + (set-font-oblique-p retval t))) + retval)))) (defun x-font-families-for-device (&optional device no-resetp) (condition-case () @@ -565,9 +571,7 @@ (font-size fontobj) (font-registry fontobj) (font-encoding fontobj))) - (not (font-bold-p fontobj)) - (not (font-italic-p fontobj)) - (not (font-oblique-p fontobj))) + (= (font-style fontobj) 0)) (face-font 'default) (or device (setq device (selected-device))) (let ((family (or (font-family fontobj)