X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fx-font-menu.el;h=8dffa3991bffa2746fe84f581c645b77ef1e6ba3;hp=d96fe11ba83d9b23d1049f3b33d600dafdad7b39;hb=113b194be934327de99a168d809271db252c07c4;hpb=976b002b16336930724ae22476014583ad022e7d

diff --git a/lisp/x-font-menu.el b/lisp/x-font-menu.el
index d96fe11..8dffa39 100644
--- a/lisp/x-font-menu.el
+++ b/lisp/x-font-menu.el
@@ -7,6 +7,7 @@
 ;; Author: Jamie Zawinski <jwz@netscape.com>
 ;; Restructured by: Jonathan Stigelman <Stig@hackvan.com>
 ;; Mule-ized by: Martin Buchholz
+;; More restructuring for MS-Windows by Andy Piper <andy@xemacs.org>
 
 ;; This file is part of XEmacs.
 
@@ -24,105 +25,6 @@
 ;; along with XEmacs; see the file COPYING.  If not, write to the 
 ;; Free Software Foundation, 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;;
-;;; Creates three menus, "Font", "Size", and "Weight", and puts them on the
-;;; "Options" menu.  The contents of these menus are the superset of those
-;;; properties available on any fonts, but only the intersection of the three
-;;; sets is selectable at one time.
-;;;
-;;; Known Problems:
-;;; ===============
-;;; Items on the Font menu are selectable if and only if that font exists in
-;;; the same size and weight as the current font.  This means that some fonts
-;;; are simply not reachable from some other fonts - if only one font comes
-;;; in only one point size (like "Nil", which comes only in 2), you will never
-;;; be able to select it.  It would be better if the items on the Fonts menu
-;;; were always selectable, and selecting them would set the size to be the
-;;; closest size to the current font's size.
-;;;
-;;; This attempts to change all other faces in an analagous way to the change
-;;; that was made to the default face; if it can't, it will skip over the face.
-;;; However, this could leave incongruous font sizes around, which may cause
-;;; some nonreversibility problems if further changes are made.  Perhaps it
-;;; should remember the initial fonts of all faces, and derive all subsequent
-;;; fonts from that initial state.
-;;;
-;;; xfontsel(1) is a lot more flexible (but probably harder to understand).
-;;;
-;;; The code to construct menus from all of the x11 fonts available from the
-;;; server is autoloaded and executed the very first time that one of the Font
-;;; menus is selected on each device.  That is, if XEmacs has frames on two
-;;; different devices, then separate font menu information will be maintained
-;;; for each X display.  If the font path changes after emacs has already
-;;; asked the X server on a particular display for its list of fonts, this
-;;; won't notice.  Also, the first time that a font menu is posted on each
-;;; display will entail a lengthy delay, but that's better than slowing down
-;;; XEmacs startup.  At any time (i.e.: after a font-path change or
-;;; immediately after device creation), you can call
-;;; `reset-device-font-menus' to rebuild the menus from all currently
-;;; available fonts.
-;;;
-;;; There is knowledge here about the regexp match numbers in
-;;; `x-font-regexp' and `x-font-regexp-foundry-and-family' defined in
-;;; x-faces.el.
-;;;
-;;; There are at least three kinds of fonts under X11r5:
-;;;
-;;; - bitmap fonts, which can be assumed to look as good as possible;
-;;; - bitmap fonts which have been (or can be) automatically scaled to
-;;;   a new size, and which almost always look awful;
-;;; - and true outline fonts, which should look ok at any size, but in
-;;;   practice (on at least some systems) look awful at any size, and
-;;;   even in theory are unlikely ever to look as good as non-scaled
-;;;   bitmap fonts.
-;;;
-;;; It would be nice to get this code to look for non-scaled bitmap fonts
-;;; first, then outline fonts, then scaled bitmap fonts as a last resort.
-;;; But it's not clear to me how to tell them apart based on their truenames
-;;; and/or the result of XListFonts().  I welcome any and all explanations
-;;; of the subtleties involved...
-;;;
-;;;
-;;; If You Think You'Re Seeing A Bug:
-;;; =================================
-;;; When reporting problems, send the following information:
-;;;
-;;; - Exactly what behavior you're seeing;
-;;; - The output of the `xlsfonts' program;
-;;; - The value of the variable `device-fonts-cache';
-;;; - The values of the following expressions, both before and after
-;;;   making a selection from any of the fonts-related menus:
-;;;	(face-font 'default)
-;;;	(font-truename   (face-font 'default))
-;;;	(font-properties (face-font 'default))
-;;; - The values of the following variables after making a selection:
-;;;	font-menu-preferred-resolution
-;;;	font-menu-registry-encoding
-;;;
-;;; There is a common misconception that "*-courier-medium-r-*-11-*", also
-;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1",
-;;; is an 11-point font.  It is not -- it is an 11-pixel font at 100dpi,
-;;; which is an 8-point font (the number after -11- is the size in tenths
-;;; of points).  So if you expect to be seeing an "11" entry in the "Size"
-;;; menu and are not, this may be why.
-;;;
-;;; In the real world (aka Solaris), one has to deal with fonts that
-;;; appear to be medium-i but are really light-r, and fonts that
-;;; resolve to different resolutions depending on the charset:
-;;;
-;;; (font-instance-truename
-;;;  (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*"))
-;;; ==>
-;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0"
-;;;
-;;; (list-fonts "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*")
-;;; ==>
-;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1"
-;;;  "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0"
-;;;  "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0")
-
 ;;; Code:
 
 ;; #### - implement these...
@@ -130,57 +32,12 @@
 ;;; (defvar font-menu-ignore-proportional-fonts nil
 ;;;   "*If non-nil, then the font menu will only show fixed-width fonts.")
 
-(defgroup font-menu ()
-  "Settings for the font menu"
-  :group 'x)
-
-;;;###autoload
-(defcustom font-menu-ignore-scaled-fonts t
-  "*If non-nil, then the font menu will try to show only bitmap fonts."
-  :type 'boolean
-  :group 'font-menu)
-
-;;;###autoload
-(defcustom font-menu-this-frame-only-p nil
-  "*If non-nil, then changing the default font from the font menu will only
-affect one frame instead of all frames."
-  :type 'boolean
-  :group 'font-menu)
-
-(defcustom font-menu-max-items 25
-  "*Maximum number of items in the font menu
-If number of entries in a menu is larger than this value, split menu
-into submenus of nearly equal length.  If nil, never split menu into
-submenus."
-  :group 'font-menu
-  :type '(choice (const :tag "no submenus" nil)
-		 (integer)))
-
-(defcustom font-menu-submenu-name-format "%-12.12s ... %.12s"
-  "*Format specification of the submenu name.
-Used by `font-menu-split-long-menu' if the number of entries in a menu is
-larger than `font-menu-menu-max-items'.
-This string should contain one %s for the name of the first entry and
-one %s for the name of the last entry in the submenu.
-If the value is a function, it should return the submenu name.  The
-function is be called with two arguments, the names of the first and
-the last entry in the menu."
-  :group 'font-menu
-  :type '(choice (string :tag "Format string")
-		 (function)))
-
-
-;; only call XListFonts (and parse) once per device.
-;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...)
-(defvar device-fonts-cache nil)
+(require 'font-menu)
 
-(defvar font-menu-registry-encoding nil
+(defvar x-font-menu-registry-encoding nil
   "Registry and encoding to use with font menu fonts.")
 
-(defvar font-menu-preferred-resolution "*-*"
-  "Preferred horizontal and vertical font menu resolution (e.g. \"75-75\").")
-
-(defvar fonts-menu-junk-families
+(defvar x-fonts-menu-junk-families
   (purecopy
    (mapconcat
     #'identity
@@ -194,11 +51,6 @@ the last entry in the menu."
     "\\|"))
   "A regexp matching font families which are uninteresting (e.g. cursor fonts).")
 
-(eval-when-compile
-  (defsubst device-fonts-cache ()
-    (or (cdr (assq (selected-device) device-fonts-cache))
-	(reset-device-font-menus (selected-device)))))
-
 (defun hack-font-truename (fn)
   "Filter the output of `font-instance-truename' to deal with Japanese fontsets."
   (if (string-match "," (font-instance-truename fn))
@@ -213,26 +65,12 @@ the last entry in the menu."
 	ret)
     (font-instance-truename fn)))
 
-;;;###autoload
-(fset 'install-font-menus 'reset-device-font-menus)
-(make-obsolete 'install-font-menus 'reset-device-font-menus)
-
 (defvar x-font-regexp-ascii nil
   "This is used to filter out font families that can't display ASCII text.
 It must be set at run-time.")
 
-(defun vassoc (key valist)
-  "Search VALIST for a vector whose first element is equal to KEY.
-See also `assoc'."
-  ;; by Stig@hackvan.com
-  (let (el)
-    (catch 'done
-      (while (setq el (pop valist))
-	(and (equal key (aref el 0))
-	     (throw 'done el))))))
-
 ;;;###autoload
-(defun reset-device-font-menus (&optional device debug)
+(defun x-reset-device-font-menus (device &optional debug)
   "Generates the `Font', `Size', and `Weight' submenus for the Options menu.
 This is run the first time that a font-menu is needed for each device.
 If you don't like the lazy invocation of this function, you can add it to
@@ -242,107 +80,100 @@ or if you change your font path, you can call this to re-initialize the menus."
   ;; by Stig@hackvan.com
   ;; #### - this should implement a `menus-only' option, which would
   ;; recalculate the menus from the cache w/o having to do list-fonts again.
-  (message "Getting list of fonts from server... ")
-  (if (or noninteractive
-	  (not (or device (setq device (selected-device))))
-	  (not (eq (device-type device) 'x)))
-      nil
-    (unless x-font-regexp-ascii
-      (setq x-font-regexp-ascii (if (featurep 'mule)
-				    (charset-registry 'ascii)
-				  "iso8859-1")))
-    (setq font-menu-registry-encoding
-	  (if (featurep 'mule) "*-*" "iso8859-1"))
-    (let ((case-fold-search t)
-	  family size weight entry monospaced-p
-	  dev-cache cache families sizes weights)
-      (dolist (name (cond ((null debug)	; debugging kludge
-			   (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
-			  ((stringp debug) (split-string debug "\n"))
-			  (t debug)))
-	(when (and (string-match x-font-regexp-ascii name)
-		   (string-match x-font-regexp name))
-	  (setq weight (capitalize (match-string 1 name))
-		size   (string-to-int (match-string 6 name)))
-	  (or (string-match x-font-regexp-foundry-and-family name)
-	      (error "internal error"))
-	  (setq family (capitalize (match-string 1 name)))
-	  (or (string-match x-font-regexp-spacing name)
-	      (error "internal error"))
-	  (setq monospaced-p (string= "m" (match-string 1 name)))
-	  (unless (string-match fonts-menu-junk-families family)
-	    (setq entry (or (vassoc family cache)
-			    (car (setq cache
-				       (cons (vector family nil nil t)
-					     cache)))))
-	    (or (member family families) (push family families))
-	    (or (member weight weights)  (push weight weights))
-	    (or (member size   sizes)    (push size   sizes))
-	    (or (member weight (aref entry 1)) (push weight (aref entry 1)))
-	    (or (member size   (aref entry 2)) (push size   (aref entry 2)))
-	    (aset entry 3 (and (aref entry 3) monospaced-p)))))
-      ;;
-      ;; Hack scalable fonts.
-      ;; Some fonts come only in scalable versions (the only size is 0)
-      ;; and some fonts come in both scalable and non-scalable versions
-      ;; (one size is 0).  If there are any scalable fonts at all, make
-      ;; sure that the union of all point sizes contains at least some
-      ;; common sizes - it's possible that some sensible sizes might end
-      ;; up not getting mentioned explicitly.
-      ;;
-      (if (member 0 sizes)
-	  (let ((common '(60 80 100 120 140 160 180 240)))
-	    (while common
-	      (or;;(member (car common) sizes)   ; not enough slack
-	       (let ((rest sizes)
-		     (done nil))
-		 (while (and (not done) rest)
-		   (if (and (> (car common) (- (car rest) 5))
-			    (< (car common) (+ (car rest) 5)))
-		       (setq done t))
-		   (setq rest (cdr rest)))
-		 done)
-	       (setq sizes (cons (car common) sizes)))
-	      (setq common (cdr common)))
-	    (setq sizes (delq 0 sizes))))
-
-      (setq families (sort families 'string-lessp)
-	    weights  (sort weights 'string-lessp)
-	    sizes    (sort sizes '<))
-
-      (dolist (entry cache)
-	  (aset entry 1 (sort (aref entry 1) 'string-lessp))
-	  (aset entry 2 (sort (aref entry 2) '<)))
-
-      (message "Getting list of fonts from server... done.")
-
-      (setq dev-cache (assq device device-fonts-cache))
-      (or dev-cache
-	  (setq dev-cache (car (push (list device) device-fonts-cache))))
-      (setcdr
-       dev-cache
-       (vector
-	cache
-	(mapcar (lambda (x)
-		  (vector x
-			  (list 'font-menu-set-font x nil nil)
-			  ':style 'radio ':active nil ':selected nil))
-		families)
-	(mapcar (lambda (x)
-		  (vector (if (/= 0 (% x 10))
-			      ;; works with no LISP_FLOAT_TYPE
-			      (concat (int-to-string (/ x 10)) "."
-				      (int-to-string (% x 10)))
-			    (int-to-string (/ x 10)))
-			  (list 'font-menu-set-font nil nil x)
-			  ':style 'radio ':active nil ':selected nil))
-		sizes)
-	(mapcar (lambda (x)
-		  (vector x
-			  (list 'font-menu-set-font nil x nil)
-			  ':style 'radio ':active nil ':selected nil))
-		weights)))
-      (cdr dev-cache))))
+  (unless x-font-regexp-ascii
+    (setq x-font-regexp-ascii (if (featurep 'mule)
+				  (charset-registry 'ascii)
+				"iso8859-1")))
+  (setq x-font-menu-registry-encoding
+	(if (featurep 'mule) "*-*" "iso8859-1"))
+  (let ((case-fold-search t)
+	family size weight entry monospaced-p
+	dev-cache cache families sizes weights)
+    (dolist (name (cond ((null debug)	; debugging kludge
+			 (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
+			((stringp debug) (split-string debug "\n"))
+			(t debug)))
+      (when (and (string-match x-font-regexp-ascii name)
+		 (string-match x-font-regexp name))
+	(setq weight (capitalize (match-string 1 name))
+	      size   (string-to-int (match-string 6 name)))
+	(or (string-match x-font-regexp-foundry-and-family name)
+	    (error "internal error"))
+	(setq family (capitalize (match-string 1 name)))
+	(or (string-match x-font-regexp-spacing name)
+	    (error "internal error"))
+	(setq monospaced-p (string= "m" (match-string 1 name)))
+	(unless (string-match x-fonts-menu-junk-families family)
+	  (setq entry (or (vassoc family cache)
+			  (car (setq cache
+				     (cons (vector family nil nil t)
+					   cache)))))
+	  (or (member family families) (push family families))
+	  (or (member weight weights)  (push weight weights))
+	  (or (member size   sizes)    (push size   sizes))
+	  (or (member weight (aref entry 1)) (push weight (aref entry 1)))
+	  (or (member size   (aref entry 2)) (push size   (aref entry 2)))
+	  (aset entry 3 (and (aref entry 3) monospaced-p)))))
+    ;;
+    ;; Hack scalable fonts.
+    ;; Some fonts come only in scalable versions (the only size is 0)
+    ;; and some fonts come in both scalable and non-scalable versions
+    ;; (one size is 0).  If there are any scalable fonts at all, make
+    ;; sure that the union of all point sizes contains at least some
+    ;; common sizes - it's possible that some sensible sizes might end
+    ;; up not getting mentioned explicitly.
+    ;;
+    (if (member 0 sizes)
+	(let ((common '(60 80 100 120 140 160 180 240)))
+	  (while common
+	    (or;;(member (car common) sizes)   ; not enough slack
+	     (let ((rest sizes)
+		   (done nil))
+	       (while (and (not done) rest)
+		 (if (and (> (car common) (- (car rest) 5))
+			  (< (car common) (+ (car rest) 5)))
+		     (setq done t))
+		 (setq rest (cdr rest)))
+	       done)
+	     (setq sizes (cons (car common) sizes)))
+	    (setq common (cdr common)))
+	  (setq sizes (delq 0 sizes))))
+    
+    (setq families (sort families 'string-lessp)
+	  weights  (sort weights 'string-lessp)
+	  sizes    (sort sizes '<))
+    
+    (dolist (entry cache)
+      (aset entry 1 (sort (aref entry 1) 'string-lessp))
+      (aset entry 2 (sort (aref entry 2) '<)))
+
+    (setq dev-cache (assq device device-fonts-cache))
+    (or dev-cache
+	(setq dev-cache (car (push (list device) device-fonts-cache))))
+    (setcdr
+     dev-cache
+     (vector
+      cache
+      (mapcar (lambda (x)
+		(vector x
+			(list 'font-menu-set-font x nil nil)
+			':style 'radio ':active nil ':selected nil))
+	      families)
+      (mapcar (lambda (x)
+		(vector (if (/= 0 (% x 10))
+			    ;; works with no LISP_FLOAT_TYPE
+			    (concat (int-to-string (/ x 10)) "."
+				    (int-to-string (% x 10)))
+			  (int-to-string (/ x 10)))
+			(list 'font-menu-set-font nil nil x)
+			':style 'radio ':active nil ':selected nil))
+	      sizes)
+      (mapcar (lambda (x)
+		(vector x
+			(list 'font-menu-set-font nil x nil)
+			':style 'radio ':active nil ':selected nil))
+	      weights)))
+    (cdr dev-cache)))
 
 ;; Extract font information from a face.  We examine both the
 ;; user-specified font name and the canonical (`true') font name.
@@ -352,7 +183,8 @@ or if you change your font path, you can call this to re-initialize the menus."
 ;; We use the user-specified one if possible, else use the truename.
 ;; If the user didn't specify one (with "-dt-*-*", for example)
 ;; get the truename and use the possibly suboptimal data from that.
-(defun* font-menu-font-data (face dcache)
+;;;###autoload
+(defun* x-font-menu-font-data (face dcache)
   (let* ((case-fold-search t)
 	 (domain (if font-menu-this-frame-only-p
 				  (selected-frame)
@@ -370,7 +202,7 @@ or if you change your font path, you can call this to re-initialize the menus."
       (setq family (capitalize (match-string 1 truename)))
       (setq entry  (vassoc family (aref dcache 0))))
     (when (null entry)
-      (return-from font-menu-font-data (make-vector 5 nil)))
+      (return-from x-font-menu-font-data (make-vector 5 nil)))
     
     (when (string-match x-font-regexp name)
       (setq weight (capitalize    (match-string 1 name)))
@@ -385,229 +217,7 @@ or if you change your font path, you can call this to re-initialize the menus."
       
     (vector entry family size weight slant)))
 
-(defun font-menu-split-long-menu (menu)
-  "Split MENU according to `font-menu-max-items'."
-  (let ((len (length menu)))
-    (if (or (null font-menu-max-items)
-	    (null (featurep 'lisp-float-type))
-	    (<= len font-menu-max-items))
-	menu
-      ;; Submenu is max 2 entries longer than menu, never shorter, number of
-      ;; entries in submenus differ by at most one (with longer submenus first)
-      (let* ((outer (floor (sqrt len)))
-	     (inner (/ len outer))
-	     (rest (% len outer))
-	     (result nil))
-	(setq menu (reverse menu))
-	(while menu
-	  (let ((in inner)
-		(sub nil)
-		(to (car menu)))
-	    (while (> in 0)
-	      (setq in   (1- in)
-		    sub  (cons (car menu) sub)
-		    menu (cdr menu)))
-	    (setq result
-		  (cons (cons (if (stringp font-menu-submenu-name-format)
-				  (format font-menu-submenu-name-format
-					  (aref (car sub) 0) (aref to 0))
-				(funcall font-menu-submenu-name-format
-					 (aref (car sub) 0) (aref to 0)))
-			      sub)
-			result)
-		  rest  (1+ rest))
-	    (if (= rest outer) (setq inner (1+ inner)))))
-	result))))
-
-;;;###autoload
-(defun font-menu-family-constructor (ignored)
-  (catch 'menu
-    (unless (eq 'x (device-type (selected-device)))
-      (throw 'menu '(["Cannot parse current font" ding nil])))
-    (let* ((dcache (device-fonts-cache))
-	   (font-data (font-menu-font-data 'default dcache))
-	   (entry  (aref font-data 0))
-	   (family (aref font-data 1))
-	   (size   (aref font-data 2))
-	   (weight (aref font-data 3))
-	   f)
-      (unless family
-	(throw 'menu '(["Cannot parse current font" ding nil])))
-      ;; Items on the Font menu are enabled iff that font exists in
-      ;; the same size and weight as the current font (scalable fonts
-      ;; exist in every size).  Only the current font is marked as
-      ;; selected.
-      (font-menu-split-long-menu
-       (mapcar
-	(lambda (item)
-	  (setq f (aref item 0)
-		entry (vassoc f (aref dcache 0)))
-	  ;; The user can no longer easily control the weight using the menu
-	  ;; Note it is silly anyway as it could very well be that the font
-	  ;; has no common size+weight combinations with the default font.
-;;	  (if (and (member weight (aref entry 1))
-;;		   (or (member size (aref entry 2))
-;;		       (and (not font-menu-ignore-scaled-fonts)
-;;			    (member 0 (aref entry 2)))))
-;;	      (enable-menu-item item)
-;;	    (disable-menu-item item))
-	  (if (and font-menu-ignore-scaled-fonts (member 0 (aref entry 2)))
-	      (disable-menu-item item)
-	    (enable-menu-item item))	  
-	  (if (string-equal family f)
-	      (select-toggle-menu-item item)
-	    (deselect-toggle-menu-item item))
-	  item)
-	(aref dcache 1))))))
-
-;;;###autoload
-(defun font-menu-size-constructor (ignored)
-  (catch 'menu
-    (unless (eq 'x (device-type (selected-device)))
-      (throw 'menu '(["Cannot parse current font" ding nil])))
-    (let* ((dcache (device-fonts-cache))
-	   (font-data (font-menu-font-data 'default dcache))
-	   (entry  (aref font-data 0))
-	   (family (aref font-data 1))
-	   (size   (aref font-data 2))
-	   ;;(weight (aref font-data 3))
-	   s)
-      (unless family
-	(throw 'menu '(["Cannot parse current font" ding nil])))
-      ;; Items on the Size menu are enabled iff current font has
-      ;; that size.  Only the size of the current font is selected.
-      ;; (If the current font comes in size 0, it is scalable, and
-      ;; thus has every size.)
-      (mapcar
-       (lambda (item)
-	 (setq s (nth 3 (aref item 1)))
-	 (if (or (member s (aref entry 2))
-		 (and (not font-menu-ignore-scaled-fonts)
-		      (member 0 (aref entry 2))))
-	     (enable-menu-item item)
-	   (disable-menu-item item))
-	 (if (eq size s)
-	     (select-toggle-menu-item item)
-	   (deselect-toggle-menu-item item))
-	 item)
-       (aref dcache 2)))))
-
-;;;###autoload
-(defun font-menu-weight-constructor (ignored)
-  (catch 'menu
-    (unless (eq 'x (device-type (selected-device)))
-      (throw 'menu '(["Cannot parse current font" ding nil])))
-    (let* ((dcache (device-fonts-cache))
-	   (font-data (font-menu-font-data 'default dcache))
-	   (entry  (aref font-data 0))
-	   (family (aref font-data 1))
-	   ;;(size   (aref font-data 2))
-	   (weight (aref font-data 3))
-	   w)
-      (unless family
-	(throw 'menu '(["Cannot parse current font" ding nil])))
-      ;; Items on the Weight menu are enabled iff current font
-      ;; has that weight.  Only the weight of the current font
-      ;; is selected.
-      (mapcar
-       (lambda (item)
-	 (setq w (aref item 0))
-	 (if (member w (aref entry 1))
-	     (enable-menu-item item)
-	   (disable-menu-item item))
-	 (if (string-equal weight w)
-	     (select-toggle-menu-item item)
-	   (deselect-toggle-menu-item item))
-	 item)
-       (aref dcache 3)))))
-
-
-;;; Changing font sizes
-
-(defun font-menu-set-font (family weight size)
-  ;; This is what gets run when an item is selected from any of the three
-  ;; fonts menus.  It needs to be rather clever.
-  ;; (size is measured in 10ths of points.)
-  (let* ((dcache (device-fonts-cache))
-	 (font-data (font-menu-font-data 'default dcache))
-	 (from-family (aref font-data 1))
-	 (from-size   (aref font-data 2))
-	 (from-weight (aref font-data 3))
-	 (from-slant  (aref font-data 4))
-	 new-default-face-font
-	 new-props)
-    (unless from-family
-      (signal 'error '("couldn't parse font name for default face")))
-    (when weight
-      (signal 'error '("Setting weight currently not supported")))
-    (setq new-default-face-font
-	  (font-menu-load-font (or family from-family)
-			       (or weight from-weight)
-			       (or size   from-size)
-			       from-slant
-			       font-menu-preferred-resolution))
-    (dolist (face (delq 'default (face-list)))
-      (when (face-font-instance face)
-	(message "Changing font of `%s'..." face)
-	(condition-case c
-	    (font-menu-change-face face
-				   from-family from-weight from-size
-				   family      weight      size)
-	  (error
-	   (display-error c nil)
-	   (sit-for 1)))))
-    ;; Set the default face's font after hacking the other faces, so that
-    ;; the frame size doesn't change until we are all done.
-
-    ;; If we need to be frame local we do the changes ourselves.
-    (if font-menu-this-frame-only-p
-    ;;; WMP - we need to honor font-menu-this-frame-only-p here!
-	(set-face-font 'default new-default-face-font
-		       (and font-menu-this-frame-only-p (selected-frame)))
-      ;; OK Let Customize do it.
-      (when (and family (not (equal family from-family)))
-	(setq new-props (append (list :family family) new-props)))
-      (when (and size (not (equal size from-size)))
-	(setq new-props (append
-	   (list :size (concat (int-to-string (/ size 10)) "pt")) new-props)))
-      (custom-set-face-update-spec 'default '((type x)) new-props)
-      (message "Font %s" (face-font-name 'default)))))
-
-
-(defun font-menu-change-face (face
-			      from-family from-weight from-size
-			      to-family   to-weight   to-size)
-  (or (symbolp face) (signal 'wrong-type-argument (list 'symbolp face)))
-  (let* ((dcache (device-fonts-cache))
-	 (font-data (font-menu-font-data face dcache))
-	 (face-family (aref font-data 1))
-	 (face-size   (aref font-data 2))
-	 (face-weight (aref font-data 3))
-	 (face-slant  (aref font-data 4)))
-
-    (or face-family
-	(signal 'error (list "couldn't parse font name for face" face)))
-
-    ;; If this face matches the old default face in the attribute we
-    ;; are changing, then change it to the new attribute along that
-    ;; dimension.  Also, the face must have its own global attribute.
-    ;; If its value is inherited, we don't touch it.  If any of this
-    ;; is not true, we leave it alone.
-    (when (and (face-font face 'global)
-	       (cond 
-		(to-family (string-equal face-family from-family))
-		(to-weight (string-equal face-weight from-weight))
-		(to-size   (=            face-size   from-size))))
-      (set-face-font face
-		     (font-menu-load-font (or to-family face-family)
-					  (or to-weight face-weight)
-					  (or to-size   face-size)
-					  face-slant
-					  font-menu-preferred-resolution)
-		     (and font-menu-this-frame-only-p
-			  (selected-frame))))))
-
-(defun font-menu-load-font (family weight size slant resolution)
+(defun x-font-menu-load-font (family weight size slant resolution)
   "Try to load a font with the requested properties.
 The weight, slant and resolution are only hints."
   (when (integerp size) (setq size (int-to-string size)))
@@ -627,18 +237,10 @@ The weight, slant and resolution are only hints."
 			(make-font-instance
 			 (concat  "-*-" family "-" weight "-" slant "-*-*-*-"
 				  size "-" resolution "-*-*-"
-				  font-menu-registry-encoding)
+				  x-font-menu-registry-encoding)
 			 nil t))
 	      (throw 'got-font font))))))))
 
-(defun flush-device-fonts-cache (device)
-  ;; by Stig@hackvan.com
-  (let ((elt (assq device device-fonts-cache)))
-    (and elt
-	 (setq device-fonts-cache (delq elt device-fonts-cache)))))
-
-(add-hook 'delete-device-hook 'flush-device-fonts-cache)
-
 (provide 'x-font-menu)
 
 ;;; x-font-menu.el ends here