--- a/lisp/font.el	Sat Dec 26 00:20:27 2009 -0600
+++ b/lisp/font.el	Sat Dec 26 21:18:49 2009 -0600
@@ -2,7 +2,7 @@
 
 ;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
 ;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 2002, 2004, 2005 Ben Wing.
+;; Copyright (C) 2002, 2004 Ben Wing.
 
 ;; Author: wmperry
 ;; Maintainer: XEmacs Development Team
@@ -29,6 +29,18 @@
 
 ;;; Commentary:
 
+;; This file is totally bogus in the context of Emacs.  Much of what it does
+;; is really in the provice of faces (for example all the style parameters),
+;; and that's the way it is in GNU Emacs.
+;;
+;; What is needed for fonts at the Lisp level is a consistent way to access
+;; face properties that are actually associated with fonts for some rendering
+;; engine, in other words, the kinds of facilities provided by fontconfig
+;; patterns.  We just need to provide an interface to looking up, storing,
+;; and manipulating font specifications with certain properties.  There will
+;; be some engine-specific stuff, like the bogosity of X11's character set
+;; registries.
+
 ;;; Code:
 
 (globally-declare-fboundp
@@ -37,11 +49,16 @@
    mswindows-font-regexp mswindows-canonicalize-font-name
    mswindows-parse-font-style mswindows-construct-font-style
    ;; #### perhaps we should rewrite font-warn to avoid the warning
-   font-warn))
+   ;;   Eh, now I look at the code, we definitely should. 
+   font-warn
+   fc-pattern-get-family fc-pattern-get-size fc-pattern-get-weight
+   fc-font-weight-translate-from-constant make-fc-pattern
+   fc-pattern-add-family fc-pattern-add-size))
 
 (globally-declare-boundp
  '(global-face-data
    x-font-regexp x-font-regexp-foundry-and-family
+   fc-font-regexp
    mswindows-font-regexp))
 
 (require 'cl)
@@ -89,41 +106,21 @@
 ;;; Lots of variables / keywords for use later in the program
 ;;; Not much should need to be modified
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst font-running-xemacs (string-match "XEmacs" (emacs-version))
-  "Whether we are running in XEmacs or not.")
-
-(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))))))
-
+;; #### These aren't window system mappings
 (defconst font-window-system-mappings
   '((x         . (x-font-create-name x-font-create-object))
     (gtk       . (x-font-create-name x-font-create-object))
-    (ns        . (ns-font-create-name ns-font-create-object))
+    ;; #### FIXME should this handle fontconfig font objects?
+    (fc        . (fc-font-create-name fc-font-create-object))
     (mswindows . (mswindows-font-create-name mswindows-font-create-object))
     (pm        . (x-font-create-name x-font-create-object)) ; Change? FIXME
+    ;; #### what is this bogosity?
     (tty       . (tty-font-create-plist tty-font-create-object)))
   "An assoc list mapping device types to a list of translations.
 
 The first function creates a font name from a font descriptor object.
 The second performs the reverse translation.")
 
-(defconst ns-font-weight-mappings
-  '((:extra-light . "extralight")
-    (:light       . "light")
-    (:demi-light  . "demilight")
-    (:medium      . "medium")
-    (:normal      . "medium")
-    (:demi-bold   . "demibold")
-    (:bold        . "bold")
-    (:extra-bold  . "extrabold"))
-  "An assoc list mapping keywords to actual NeXTstep specific
-information to use")
-
 (defconst x-font-weight-mappings
   '((:extra-light . "extralight")
     (:light       . "light")
@@ -148,12 +145,11 @@
   "How much a font is allowed to vary from the desired size.")
 
 ;; Canonical (internal) sizes are in points.
-;; Registry
-(define-font-keywords :family :style :size :registry :encoding)
 
-(define-font-keywords
-  :weight :extra-light :light :demi-light :medium :normal :demi-bold
-  :bold :extra-bold)
+;; Property keywords: :family :style :size :registry :encoding :weight
+;; Weight keywords:   :extra-light :light :demi-light :medium
+;;                    :normal :demi-bold :bold :extra-bold
+;; See GNU Emacs 21.4 for more properties and keywords we should support
 
 (defvar font-style-keywords nil)
 
@@ -207,13 +203,13 @@
 	   "Bitmask for whether a font is to be rendered in %s or not."
 	   attr))
        (defun ,(intern (format "font-%s-p" attr)) (fontobj)
-	 ,(format "Whether FONTOBJ will be renderd in `%s' or not." attr)
+	 ,(format "Whether FONTOBJ will be rendered in `%s' or not." attr)
 	 (if (/= 0 (logand (font-style fontobj)
 		      ,(intern (format "font-%s-mask" attr))))
 	     t
 	   nil))
        (defun ,(intern (format "set-font-%s-p" attr)) (fontobj val)
-	 ,(format "Set whether FONTOBJ will be renderd in `%s' or not."
+	 ,(format "Set whether FONTOBJ will be rendered in `%s' or not."
 		  attr)
 	 (cond
 	  (val
@@ -248,6 +244,7 @@
       (put-display-table (+ i ?a) (+ i ?A) table)
       (setq i (1+ i)))
     ;; Now ISO translations
+    ;; #### FIXME what's this for??
     (setq i 224)
     (while (< i 247)			;; Agrave - Ouml
       (put-display-table i (- i 32) table)
@@ -261,37 +258,29 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Utility functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun set-font-style-by-keywords (fontobj styles)
-  (make-local-variable 'font-func)
-  (declare (special font-func))
-  (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))))
+;; #### unused?
+; (defun set-font-style-by-keywords (fontobj styles)
+;   (make-local-variable 'font-func)
+;   (declare (special font-func))
+;   (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))))
 
-(defun font-properties-from-style (fontobj)
-  (let ((todo font-style-keywords)
-	type func retval)
-    (while todo
-      (setq func (cdr (cdr (car todo)))
-	    type (car (pop todo)))
-      (if (funcall func fontobj)
-	  (setq retval (cons type retval))))
-    retval))
-
-(defun font-unique (list)
-  (let ((retval)
-	(cur))
-    (while list
-      (setq cur (car list)
-	    list (cdr list))
-      (if (member cur retval)
-	  nil
-	(setq retval (cons cur retval))))
-    (nreverse retval)))
+;; #### unused?
+; (defun font-properties-from-style (fontobj)
+;   (let ((todo font-style-keywords)
+; 	type func retval)
+;     (while todo
+;       (setq func (cdr (cdr (car todo)))
+; 	    type (car (pop todo)))
+;       (if (funcall func fontobj)
+; 	  (setq retval (cons type retval))))
+;     retval))
 
 (defun font-higher-weight (w1 w2)
   (let ((index1 (length (memq w1 font-possible-weights)))
@@ -329,8 +318,8 @@
 	  (mm-width (float (or (device-mm-width device) 293)))
 	  (retval nil))
       (cond
-       ;; the following string-match is broken, there will never be a
-       ;; left operand detected
+       ;; #### this is pretty bogus and should probably be made gone
+       ;; or supported at a higher level
        ((string-match "^ *\\([-+*/]\\) *" spec) ; math!  whee!
 	(let ((math-func (intern (match-string 1 spec)))
 	      (other (font-spatial-to-canonical
@@ -361,7 +350,7 @@
        ((string= type "mm")
 	(setq retval (* num (/ 72.0 25.4))))
        ((string= type "cm")
-	(setq retval (* num 10 (/ 72.0 25.4))))
+	(setq retval (* num (/ 72.0 2.54))))
        (t
 	(setq retval num))
        )
@@ -410,8 +399,10 @@
 		     (font-spatial-to-canonical (font-size fontobj-2)))))
     (set-font-weight retval (font-higher-weight (font-weight fontobj-1)
 						(font-weight fontobj-2)))
-    (set-font-family retval (font-unique (append (font-family fontobj-1)
-						 (font-family fontobj-2))))
+    (set-font-family retval
+                     (delete-duplicates (append (font-family fontobj-1)
+                                                (font-family fontobj-2))
+					:test #'equal))
     (set-font-style retval (logior (font-style fontobj-1)
 				   (font-style fontobj-2)))
     (set-font-registry retval (or (font-registry fontobj-1)
@@ -445,6 +436,42 @@
 	      args (cdr args)))
       retval))))
 
+(defvar font-default-cache nil)
+
+;;;###autoload
+(defun font-default-font-for-device (&optional device)
+  (or device (setq device (selected-device)))
+  (font-truename
+   (make-font-specifier
+    (face-font-name 'default device))))
+
+;;;###autoload
+(defun font-default-object-for-device (&optional device)
+  (let ((font (font-default-font-for-device device)))
+    (or (cdr-safe (assoc font font-default-cache))
+	(let ((object (font-create-object font)))
+	  (push (cons font object) font-default-cache)
+	  object))))
+
+;;;###autoload
+(defun font-default-family-for-device (&optional device)
+  (font-family (font-default-object-for-device (or device (selected-device)))))
+
+;;;###autoload
+(defun font-default-registry-for-device (&optional device)
+  (font-registry (font-default-object-for-device (or device (selected-device)))))
+
+;;;###autoload
+(defun font-default-encoding-for-device (&optional device)
+  (font-encoding (font-default-object-for-device (or device (selected-device)))))
+
+;;;###autoload
+(defun font-default-size-for-device (&optional device)
+  ;; face-height isn't the right thing (always 1 pixel too high?)
+  ;; (if font-running-xemacs
+  ;;    (format "%dpx" (face-height 'default device))
+  (font-size (font-default-object-for-device (or device (selected-device)))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; The window-system dependent code (TTY-style)
@@ -468,9 +495,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; The window-system dependent code (X-style)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar font-x-font-regexp (or (and font-running-xemacs
-				    (boundp 'x-font-regexp)
-				    x-font-regexp)
+(defvar font-x-font-regexp (when (and (boundp 'x-font-regexp)
+				      x-font-regexp)
  (let
      ((- 		"[-?]")
       (foundry		"[^-]*")
@@ -497,13 +523,12 @@
 	   ))))
 
 (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 "\\)\\'"))))
+  (when (and (boundp 'x-font-regexp-registry-and-encoding)
+	     (symbol-value 'x-font-regexp-registry-and-encoding))
+    (let ((- "[-?]")
+	  (registry "[^-]*")
+	  (encoding "[^-]+"))
+      (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))))
 
 (defvar font-x-family-mappings
   '(
@@ -543,7 +568,14 @@
   (let ((case-fold-search t))
     (if (or (not (stringp fontname))
 	    (not (string-match font-x-font-regexp fontname)))
-	(make-font)
+	(if (and (stringp fontname)
+		 (featurep 'xft-fonts)
+		 (string-match font-xft-font-regexp fontname))
+	    ;; Return an XFT font. 
+	    (xft-font-create-object fontname)
+	  ;; It's unclear how to parse the font; return an unspecified
+	  ;; one.
+	  (make-font))
       (let ((family nil)
 	    (size nil)
 	    (weight  (match-string 1 fontname))
@@ -597,50 +629,10 @@
 				(aref menu 0)))
 		(normal (mapcar #'(lambda (x) (if x (aref x 0)))
 				(aref menu 1))))
-	    (sort (font-unique (nconc scaled normal)) 'string-lessp))))
+	    (sort (delete-duplicates (nconc scaled normal) :test 'equal)
+                  'string-lessp))))
     (cons "monospace" (mapcar 'car font-x-family-mappings))))
 
-(defvar font-default-cache nil)
-
-;;;###autoload
-(defun font-default-font-for-device (&optional device)
-  (or device (setq device (selected-device)))
-  (if font-running-xemacs
-      (font-truename
-       (make-font-specifier
-	(face-font-name 'default device)))
-    (let ((font (cdr-safe (assq 'font (frame-parameters device)))))
-      (if (and (fboundp 'fontsetp) (fontsetp font))
-	  (aref (get-font-info (aref (cdr (get-fontset-info font)) 0)) 2)
-	font))))
-
-;;;###autoload
-(defun font-default-object-for-device (&optional device)
-  (let ((font (font-default-font-for-device device)))
-    (or (cdr-safe (assoc font font-default-cache))
-	(let ((object (font-create-object font)))
-	  (push (cons font object) font-default-cache)
-	  object))))
-
-;;;###autoload
-(defun font-default-family-for-device (&optional device)
-  (font-family (font-default-object-for-device (or device (selected-device)))))
-
-;;;###autoload
-(defun font-default-registry-for-device (&optional device)
-  (font-registry (font-default-object-for-device (or device (selected-device)))))
-
-;;;###autoload
-(defun font-default-encoding-for-device (&optional device)
-  (font-encoding (font-default-object-for-device (or device (selected-device)))))
-
-;;;###autoload
-(defun font-default-size-for-device (&optional device)
-  ;; face-height isn't the right thing (always 1 pixel too high?)
-  ;; (if font-running-xemacs
-  ;;    (format "%dpx" (face-height 'default device))
-  (font-size (font-default-object-for-device (or device (selected-device)))))
-
 (defun x-font-create-name (fontobj &optional device)
   "Return a font name constructed from FONTOBJ, appropriate for X devices."
   (if (and (not (or (font-family fontobj)
@@ -656,8 +648,7 @@
 		       (font-family default)
 		       (x-font-families-for-device device)))
 	   (weight (or (font-weight fontobj) :medium))
-	   (size (or (if font-running-xemacs
-			 (font-size fontobj))
+	   (size (or (font-size fontobj)
 		     (font-size default)))
 	   (registry (or (font-registry fontobj)
 			 (font-registry default)
@@ -714,63 +705,134 @@
 	(if done font-name)))))
 
 
+;;; Cache building code
+;;;###autoload
+(defun x-font-build-cache (&optional device)
+  (let ((hash-table (make-hash-table :test 'equal :size 15))
+	(fonts (mapcar 'x-font-create-object
+		       (font-list "-*-*-*-*-*-*-*-*-*-*-*-*-*-*")))
+	(plist nil)
+	(cur nil))
+    (while fonts
+      (setq cur (car fonts)
+	    fonts (cdr fonts)
+	    plist (cl-gethash (car (font-family cur)) hash-table))
+      (if (not (memq (font-weight cur) (plist-get plist 'weights)))
+	  (setq plist (plist-put plist 'weights (cons (font-weight cur)
+						      (plist-get plist 'weights)))))
+      (if (not (member (font-size cur) (plist-get plist 'sizes)))
+	  (setq plist (plist-put plist 'sizes (cons (font-size cur)
+						    (plist-get plist 'sizes)))))
+      (if (and (font-oblique-p cur)
+	       (not (memq 'oblique (plist-get plist 'styles))))
+	  (setq plist (plist-put plist 'styles (cons 'oblique (plist-get plist 'styles)))))
+      (if (and (font-italic-p cur)
+	       (not (memq 'italic (plist-get plist 'styles))))
+	  (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles)))))
+      (cl-puthash (car (font-family cur)) plist hash-table))
+    hash-table))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The window-system dependent code (NS-style)
+;;; The rendering engine-dependent code (Xft-style)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun ns-font-families-for-device (&optional device no-resetp)
-  ;; For right now, assume we are going to have the same storage for
-  ;; device fonts for NS as we do for X.  Is this a valid assumption?
+
+;;; #### FIXME actually, this section should be fc-*, right?
+
+(defvar font-xft-font-regexp
+  (concat "\\`"
+	  #r"\(\\-\|\\:\|\\,\|[^:-]\)*"	        ; optional foundry and family
+						; (allows for escaped colons, 
+						; dashes, commas)
+	  "\\(-[0-9]*\\(\\.[0-9]*\\)?\\)?"	; optional size (points)
+	  "\\(:[^:]*\\)*"			; optional properties
+						; not necessarily key=value!!
+	    "\\'"
+	    ))
+
+(defvar font-xft-family-mappings
+  ;; #### FIXME this shouldn't be needed or used for Xft
+  '(("serif"        . ("new century schoolbook"
+		       "utopia"
+		       "charter"
+		       "times"
+		       "lucidabright"
+		       "garamond"
+		       "palatino"
+		       "times new roman"
+		       "baskerville"
+		       "bookman"
+		       "bodoni"
+		       "computer modern"
+		       "rockwell"
+		       ))
+    ("sans-serif"   . ("lucida"
+		       "helvetica"
+		       "gills-sans"
+		       "avant-garde"
+		       "univers"
+		       "optima"))
+    ("elfin"        . ("tymes"))
+    ("monospace"    . ("courier"
+		       "fixed"
+		       "lucidatypewriter"
+		       "clean"
+		       "terminal"))
+    ("cursive"      . ("sirene"
+		       "zapf chancery"))
+    )
+  "A list of font family mappings on Xft devices.")
+
+(defun xft-font-create-object (fontname &optional device)
+  "Return a font descriptor object for FONTNAME, appropriate for Xft.
+
+Optional DEVICE defaults to `default-x-device'."
+  (let* ((name fontname)
+	 (device (or device (default-x-device)))
+	 (pattern (fc-font-match device (fc-name-parse name)))
+	 (font-obj (make-font))
+	 (family (fc-pattern-get-family pattern 0))
+	 (size (fc-pattern-get-or-compute-size pattern 0))
+	 (weight (fc-pattern-get-weight pattern 0)))
+    (set-font-family font-obj 
+		     (and (not (equal family 'fc-result-no-match)) 
+			  family))
+    (set-font-size font-obj 
+		   (and (not (equal size 'fc-result-no-match))
+			size))
+    (set-font-weight font-obj 
+		     (and (not (equal weight 'fc-result-no-match))
+			  (fc-font-weight-translate-from-constant weight)))
+    font-obj))
+
+;; #### FIXME Xft fonts are not defined by the device.
+;; ... Does that mean the whole model here is bogus?
+(defun xft-font-families-for-device (&optional device no-resetp)
+  (ignore-errors (require 'x-font-menu))  ; #### FIXME xft-font-menu?
   (or device (setq device (selected-device)))
-  (if (boundp 'device-fonts-cache)
+  (if (boundp 'device-fonts-cache)	; #### FIXME does this make sense?
       (let ((menu (or (cdr-safe (assq device device-fonts-cache)))))
 	(if (and (not menu) (not no-resetp))
 	    (progn
 	      (reset-device-font-menus device)
-	      (ns-font-families-for-device device t))
+	      (xft-font-families-for-device device t))
+	  ;; #### FIXME clearly bogus for Xft
 	  (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0)))
 				(aref menu 0)))
 		(normal (mapcar #'(lambda (x) (if x (aref x 0)))
 				(aref menu 1))))
-	    (sort (font-unique (nconc scaled normal)) 'string-lessp))))))
+	    (sort (delete-duplicates (nconc scaled normal) :test #'equal)
+                  'string-lessp))))
+	  ;; #### FIXME clearly bogus for Xft
+    (cons "monospace" (mapcar 'car font-xft-family-mappings))))
 
-(defun ns-font-create-name (fontobj &optional device)
-  "Return a font name constructed from FONTOBJ, appropriate for NextSTEP devices."
-  (let ((family (or (font-family fontobj)
-		    (ns-font-families-for-device device)))
-	(weight (or (font-weight fontobj) :medium))
-	(style (or (font-style fontobj) (list :normal)))
-	(size (font-size fontobj)))
-    ;; Create a font, wow!
-    (if (stringp family)
-	(setq family (list family)))
-    (if (or (symbolp style) (numberp style))
-	(setq style (list style)))
-    (setq weight (font-higher-weight weight (car-safe (memq :bold style))))
-    (if (stringp size)
-	(setq size (font-spatial-to-canonical size device)))
-    (setq weight (or (cdr-safe (assq weight ns-font-weight-mappings))
-		     "medium"))
-    (let ((done nil)			; Did we find a good font yet?
-	  (font-name nil)		; font name we are currently checking
-	  (cur-family nil)		; current family we are checking
-	  )
-      (while (and family (not done))
-	(setq cur-family (car family)
-	      family (cdr family))
-	(if (assoc cur-family font-x-family-mappings)
-	    ;; If the family name is an alias as defined by
-	    ;; font-x-family-mappings, then append those families
-	    ;; to the front of 'family' and continue in the loop.
-	    ;; #### jhar: I don't know about ns font names, so using X mappings
-	    (setq family (append
-			  (cdr-safe (assoc cur-family
-					   font-x-family-mappings))
-			  family))
-	  ;; CARL: Need help here - I am not familiar with the NS font
-	  ;; model
-	  (setq font-name "UNKNOWN FORMULA GOES HERE"
-		done (try-font-name font-name device))))
-      (if done font-name))))
+(defun xft-font-create-name (fontobj &optional device)
+  (let* ((pattern (make-fc-pattern)))
+    (if (font-family fontobj)
+	(fc-pattern-add-family pattern (font-family fontobj)))
+    (if (font-size fontobj)
+	(fc-pattern-add-size pattern (font-size fontobj)))
+    (fc-name-unparse pattern)))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -870,8 +932,7 @@
 	   (family (or (font-family fontobj)
 		       (font-family default)))
 	   (weight (or (font-weight fontobj) :regular))
-	   (size (or (if font-running-xemacs
-			 (font-size fontobj))
+	   (size (or (font-size fontobj)
 		     (font-size default)))
 	   (underline-p (font-underline-p fontobj))
 	   (strikeout-p (font-strikethru-p fontobj))
@@ -920,34 +981,6 @@
 	(if done font-name)))))
 
 
-;;; Cache building code
-;;;###autoload
-(defun x-font-build-cache (&optional device)
-  (let ((hash-table (make-hash-table :test 'equal :size 15))
-	(fonts (mapcar 'x-font-create-object
-		       (font-list "-*-*-*-*-*-*-*-*-*-*-*-*-*-*")))
-	(plist nil)
-	(cur nil))
-    (while fonts
-      (setq cur (car fonts)
-	    fonts (cdr fonts)
-	    plist (cl-gethash (car (font-family cur)) hash-table))
-      (if (not (memq (font-weight cur) (plist-get plist 'weights)))
-	  (setq plist (plist-put plist 'weights (cons (font-weight cur)
-						      (plist-get plist 'weights)))))
-      (if (not (member (font-size cur) (plist-get plist 'sizes)))
-	  (setq plist (plist-put plist 'sizes (cons (font-size cur)
-						    (plist-get plist 'sizes)))))
-      (if (and (font-oblique-p cur)
-	       (not (memq 'oblique (plist-get plist 'styles))))
-	  (setq plist (plist-put plist 'styles (cons 'oblique (plist-get plist 'styles)))))
-      (if (and (font-italic-p cur)
-	       (not (memq 'italic (plist-get plist 'styles))))
-	  (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles)))))
-      (cl-puthash (car (font-family cur)) plist hash-table))
-    hash-table))
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Now overwrite the original copy of set-face-font with our own copy that
 ;;; can deal with either syntax.
@@ -967,7 +1000,7 @@
 	    (setq cur (car font-name)
 		  font-name (cdr font-name))
 	    (apply 'set-face-property face (car cur) (cdr cur) args))))
-       (font-running-xemacs
+       (t
 	(apply 'set-face-font face font-name args)
 	(apply 'set-face-underline-p face (font-underline-p font) args)
 	(if (and (or (font-smallcaps-p font) (font-bigcaps-p font))
@@ -978,16 +1011,18 @@
 						    (font-linethrough-p font)
 						    (font-strikethru-p font))
 	       args))
-       (t
-	(condition-case nil
-	    (apply 'set-face-font face font-name args)
-	  (error
-	   (let ((args (car-safe args)))
-	     (and (or (font-bold-p font)
-		      (memq (font-weight font) '(:bold :demi-bold)))
-		  (make-face-bold face args t))
-	     (and (font-italic-p font) (make-face-italic face args t)))))
-	(apply 'set-face-underline-p face (font-underline-p font) args)))))
+;;; this used to be default with preceding conditioned on font-running-xemacs
+;        (t
+; 	(condition-case nil
+; 	    (apply 'set-face-font face font-name args)
+; 	  (error
+; 	   (let ((args (car-safe args)))
+; 	     (and (or (font-bold-p font)
+; 		      (memq (font-weight font) '(:bold :demi-bold)))
+; 		  (make-face-bold face args t))
+; 	     (and (font-italic-p font) (make-face-italic face args t)))))
+; 	(apply 'set-face-underline-p face (font-underline-p font) args))
+       )))
    (t
     ;; Let the original set-face-font signal any errors
     (set-face-property face 'font-specification nil)
@@ -1059,8 +1094,6 @@
 The list (R G B) is returned, or an error is signaled if the lookup fails."
   (let ((lib-list (if-boundp 'x-library-search-path
 		      x-library-search-path
-		    ;; This default is from XEmacs 19.13 - hope it covers
-		    ;; everyone.
 		    (list "/usr/X11R6/lib/X11/"
 			  "/usr/X11R5/lib/X11/"
 			  "/usr/lib/X11R6/X11/"
@@ -1071,7 +1104,9 @@
 			  "/usr/local/lib/X11R5/X11/"
 			  "/usr/X11/lib/X11/"
 			  "/usr/lib/X11/"
+			  "/usr/share/X11/"
 			  "/usr/local/lib/X11/"
+			  "/usr/local/share/X11/"
 			  "/usr/X386/lib/X11/"
 			  "/usr/x386/lib/X11/"
 			  "/usr/XFree86/lib/X11/"
@@ -1362,13 +1397,14 @@
 (defun font-blink-callback ()
   ;; Optimized to never invert the face unless one of the visible windows
   ;; is showing it.
-  (let ((faces (if font-running-xemacs (face-list t) (face-list)))
+  (let ((faces (face-list t))
 	(obj nil))
     (while faces
       (if (and (setq obj (face-property (car faces) 'font-specification))
 	       (font-blink-p obj)
 	       (memq t
-		     (font-map-windows 'font-face-visible-in-window-p (car faces))))
+		     (font-map-windows 'font-face-visible-in-window-p
+				       (car faces))))
 	  (invert-face (car faces)))
       (pop faces))))