--- a/lisp/w3/font.el	Mon Aug 13 08:48:43 2007 +0200
+++ b/lisp/w3/font.el	Mon Aug 13 08:49:20 2007 +0200
@@ -1,12 +1,12 @@
 ;;; font.el --- New font model
 ;; Author: wmperry
-;; Created: 1997/01/03 16:43:49
-;; Version: 1.22
+;; Created: 1997/01/30 00:58:33
+;; Version: 1.29
 ;; Keywords: faces
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
-;;; Copyright (c) 1996 Free Software Foundation, Inc.
+;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
 ;;;
 ;;; This file is part of GNU Emacs.
 ;;;
@@ -48,13 +48,20 @@
 (defconst font-running-xemacs (string-match "XEmacs" (emacs-version))
   "Whether we are running in XEmacs or not.")
 
-(defmacro defkeyword (keyword &optional docstring)
-  (list 'defconst keyword (list 'quote keyword)
-	(or docstring "A keyword")))
+(defmacro define-font-keywords (&rest keys)
+  (`
+   (eval-and-compile
+     (let ((keywords (quote (, keys))))
+       (while keywords
+	 (or (boundp (car keywords))
+	     (set (car keywords) (car keywords)))
+	 (setq keywords (cdr keywords)))))))  
 
 (defconst font-window-system-mappings
   '((x        . (x-font-create-name x-font-create-object))
     (ns       . (ns-font-create-name ns-font-create-object))
+    (win32    . (x-font-create-name x-font-create-object)) ; Change? FIXME
+    (pm       . (x-font-create-name x-font-create-object)) ; Change? FIXME
     (tty      . (tty-font-create-plist tty-font-create-object)))
   "An assoc list mapping device types to the function used to create
 a font name from a font structure.")
@@ -127,22 +134,11 @@
     )
   "A list of font family mappings.")
 
-(defkeyword :family "Keyword specifying the font family of a FONTOBJ.")
+(define-font-keywords :family :style :size :registry :encoding)
 
-(defkeyword :weight "Keyword specifying the font weight of a FONTOBJ.")
- (defkeyword :extra-light)
- (defkeyword :light)
- (defkeyword :demi-light)
- (defkeyword :medium)
- (defkeyword :normal)
- (defkeyword :demi-bold)
- (defkeyword :bold)
- (defkeyword :extra-bold)
-
-(defkeyword :style "Keyword specifying the font style of a FONTOBJ.")
-(defkeyword :size "Keyword specifying the font size of a FONTOBJ.")
-(defkeyword :registry "Keyword specifying the registry of a FONTOBJ.")
-(defkeyword :encoding "Keyword specifying the encoding of a FONTOBJ.")
+(define-font-keywords
+  :weight :extra-light :light :demi-light :medium :normal :demi-bold
+  :bold :extra-bold)
 
 (defvar font-style-keywords nil)
 
@@ -255,9 +251,12 @@
 (defsubst set-font-style-by-keywords (fontobj styles)
   (make-local-variable 'font-func)
   (declare (special font-func))
-  (while styles
-    (setq font-func (car-safe (cdr-safe (assq (car styles) font-style-keywords)))
-	  styles (cdr styles))
+  (if (listp styles)
+      (while styles
+	(setq font-func (car-safe (cdr-safe (assq (car styles) font-style-keywords)))
+	      styles (cdr styles))
+	(and (fboundp font-func) (funcall font-func fontobj t)))
+    (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords))))
     (and (fboundp font-func) (funcall font-func fontobj t))))
 
 (defsubst font-properties-from-style (fontobj)
@@ -576,7 +575,9 @@
 		      (x-font-families-for-device device)))
 	  (weight (or (font-weight fontobj) :medium))
 	  (style (font-style fontobj))
-	  (size (or (font-size fontobj) (font-default-size-for-device device)))
+	  (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) "*")))
       (if (stringp family)
@@ -1058,16 +1059,16 @@
 (defun font-normalize-color (color &optional device)
   "Return an RGB tuple, given any form of input.  If an error occurs, black
 is returned."
-  (cond
-   ((eq (device-type device) 'x)
+  (case (device-type device)
+   ((x pm win32)
     (apply 'format "#%02x%02x%02x" (font-color-rgb-components color)))
-   ((eq (device-type device) 'tty)
+   (tty
     (apply 'font-tty-find-closest-color (font-color-rgb-components color)))
-   ((eq (device-type device) 'ns)
+   (ns
     (let ((vals (mapcar (function (lambda (x) (>> x 8)))
 			(font-color-rgb-components color))))
       (apply 'format "RGB%02x%02x%02xff" vals)))
-   (t "black")))
+   (otherwise "black")))
 
 (defun font-set-face-background (&optional face color &rest args)
   (interactive)