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

Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 9f59509498e1
children cca96a509cfe
line wrap: on
line diff
--- a/lisp/w3/font.el	Mon Aug 13 09:23:08 2007 +0200
+++ b/lisp/w3/font.el	Mon Aug 13 09:24:17 2007 +0200
@@ -1,7 +1,7 @@
 ;;; font.el --- New font model
 ;; Author: wmperry
-;; Created: 1997/03/26 20:08:55
-;; Version: 1.40
+;; Created: 1997/03/28 20:23:52
+;; Version: 1.43
 ;; Keywords: faces
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -75,7 +75,7 @@
     (:light       . "light")
     (:demi-light  . "demilight")
     (:medium      . "medium")
-    (:normal      . "normal")
+    (:normal      . "medium")
     (:demi-bold   . "demibold")
     (:bold        . "bold")
     (:extra-bold  . "extrabold"))
@@ -89,7 +89,7 @@
     (:demi        . "demi")
     (:book        . "book")
     (:medium      . "medium")
-    (:normal      . "normal")
+    (:normal      . "medium")
     (:demi-bold   . "demibold")
     (:bold        . "bold")
     (:extra-bold  . "extrabold"))
@@ -474,6 +474,15 @@
 	   registry - encoding "\\'"
 	   ))))
 
+(defvar font-x-registry-and-encoding-regexp
+  (or (and font-running-xemacs
+	   (boundp 'x-font-regexp-registry-and-encoding)
+	   (symbol-value 'x-font-regexp-registry-and-encoding))
+      (let ((- "[-?]")
+	    (registry "[^-]*")
+	    (encoding "[^-]+"))
+	(concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))))
+
 (defun x-font-create-object (fontname &optional device)
   (let ((case-fold-search t))
     (if (or (not (stringp fontname))
@@ -515,6 +524,10 @@
 	  (set-font-italic-p retval t))
 	 ((member slant '("o" "O"))
 	  (set-font-oblique-p retval t)))
+	(if (string-match font-x-registry-and-encoding-regexp fontname)
+	    (progn
+	      (set-font-registry retval (match-string 1 fontname))
+	      (set-font-encoding retval (match-string 2 fontname))))
 	retval))))
 
 (defun x-font-families-for-device (&optional device no-resetp)
@@ -566,6 +579,16 @@
   (font-family (font-default-object-for-device device)))
 
 ;;;###autoload
+(defun font-default-registry-for-device (&optional device)
+  (or device (setq device (selected-device)))
+  (font-registry (font-default-object-for-device device)))
+
+;;;###autoload
+(defun font-default-encoding-for-device (&optional device)
+  (or device (setq device (selected-device)))
+  (font-encoding (font-default-object-for-device device)))
+
+;;;###autoload
 (defun font-default-size-for-device (&optional device)
   (or device (setq device (selected-device)))
   ;; face-height isn't the right thing (always 1 pixel too high?)
@@ -582,16 +605,21 @@
 	   (= (font-style fontobj) 0))
       (face-font 'default)
     (or device (setq device (selected-device)))
-    (let ((family (or (font-family fontobj)
-		      (font-default-family-for-device device)
-		      (x-font-families-for-device device)))
-	  (weight (or (font-weight fontobj) :medium))
-	  (style (font-style fontobj))
-	  (size (or (if font-running-xemacs
-			(font-size fontobj))
-		    (font-default-size-for-device device)))
-	  (registry (or (font-registry fontobj) "*"))
-	  (encoding (or (font-encoding fontobj) "*")))
+    (let* ((default (font-default-object-for-device device))
+	   (family (or (font-family fontobj)
+		       (font-family default)
+		       (x-font-families-for-device device)))
+	   (weight (or (font-weight fontobj) :medium))
+	   (style (font-style fontobj))
+	   (size (or (if font-running-xemacs
+			 (font-size fontobj))
+		     (font-size default)))
+	   (registry (or (font-registry fontobj)
+			 (font-registry default)
+			 "*"))
+	   (encoding (or (font-encoding fontobj)
+			 (font-encoding default)
+			 "*")))
       (if (stringp family)
 	  (setq family (list family)))
       (setq weight (font-higher-weight weight