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)