Mercurial > hg > xemacs-beta

changeset 2527:491f8cf78a9c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-01-28 02:58:38 by ben] Abstract font-list/color-list font-menu.el, font.el, frame.el, gtk-font-menu.el, minibuf.el, msw-faces.el, msw-font-menu.el, obsolete.el, x-faces.el, x-font-menu.el: list-fonts->font-list. Create color-list. Abstract out x/msw-specific versions and obsolete the x/msw-specific Lisp functions. console-impl.h, objects-gtk.c, objects-msw.c, objects-tty.c, objects-x.c, objects.c: list-fonts->font-list. Create color-list. Abstract out x/msw-specific versions and obsolete the x/msw-specific Lisp functions.
author ben
date Fri, 28 Jan 2005 02:58:52 +0000
parents 902d5bd9b75c
children 4a661d2ac568
files lisp/ChangeLog lisp/font-menu.el lisp/font.el lisp/frame.el lisp/gtk-font-menu.el lisp/minibuf.el lisp/msw-faces.el lisp/msw-font-menu.el lisp/obsolete.el lisp/x-faces.el lisp/x-font-menu.el src/ChangeLog src/console-impl.h src/objects-gtk.c src/objects-msw.c src/objects-tty.c src/objects-x.c src/objects.c
diffstat 18 files changed, 197 insertions(+), 121 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/ChangeLog	Fri Jan 28 02:58:52 2005 +0000
@@ -1,3 +1,28 @@
+2005-01-27  Ben Wing  <ben@xemacs.org>
+
+	* font-menu.el:
+	* font.el:
+	* font.el (internal-facep):
+	* font.el (x-font-build-cache):
+	* font.el (font-lookup-rgb-components):
+	* frame.el (set-frame-font):
+	* gtk-font-menu.el (gtk-reset-device-font-menus):
+	* minibuf.el (read-color-completion-table):
+	* minibuf.el (x-library-search-path): Removed.
+	* minibuf.el (x-read-color-completion-table)): Removed.
+	* msw-faces.el (mswindows-available-font-sizes):
+	* msw-font-menu.el (mswindows-reset-device-font-menus):
+	* obsolete.el:
+	* x-faces.el:
+	* x-faces.el (x-available-font-sizes):
+	* x-faces.el (x-library-search-path): New.
+	* x-faces.el (x-color-list-internal-cache)): New.
+	* x-faces.el (x-color-list-internal): New.
+	* x-font-menu.el (x-reset-device-font-menus):
+	list-fonts->font-list.  Create color-list.  Abstract out
+	x/msw-specific versions and obsolete the x/msw-specific Lisp
+	functions.
+
 2005-01-27  Ben Wing  <ben@xemacs.org>
 
 	* subr.el:
--- a/lisp/font-menu.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/font-menu.el	Fri Jan 28 02:58:52 2005 +0000
@@ -113,7 +113,7 @@
 ;;; ==>
 ;;; "-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*-*-*-*-*-*-*-*-*")
+;;; (font-list "-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"
--- a/lisp/font.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/font.el	Fri Jan 28 02:58:52 2005 +0000
@@ -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 Ben Wing.
+;; Copyright (C) 2002, 2004 Ben Wing.
 
 ;; Author: wmperry
 ;; Maintainer: XEmacs Development Team
@@ -32,8 +32,7 @@
 ;;; Code:
 
 (globally-declare-fboundp
- '(x-list-fonts
-   mswindows-list-fonts ns-list-fonts internal-facep fontsetp get-font-info
+ '(internal-facep fontsetp get-font-info
    get-fontset-info mswindows-define-rgb-color cancel-function-timers
    mswindows-font-regexp mswindows-canonicalize-font-name
    mswindows-parse-font-style mswindows-construct-font-style
@@ -60,13 +59,7 @@
     (defmacro defcustom (var value doc &rest args)
       `(defvar ,var ,value ,doc))))
 
-(if (not (fboundp 'try-font-name))
-    (defun try-font-name (fontname &rest args)
-      (case window-system
-	((x pm) (car-safe (x-list-fonts fontname)))
-	(mswindows (car-safe (mswindows-list-fonts fontname)))
-	(ns (car-safe (ns-list-fonts fontname)))
-	(otherwise nil))))
+; delete alternate defn of try-font-name
 
 (if (not (fboundp 'facep))
     (defun facep (face)
@@ -932,7 +925,7 @@
 (defun x-font-build-cache (&optional device)
   (let ((hash-table (make-hash-table :test 'equal :size 15))
 	(fonts (mapcar 'x-font-create-object
-		       (x-list-fonts "-*-*-*-*-*-*-*-*-*-*-*-*-*-*")))
+		       (font-list "-*-*-*-*-*-*-*-*-*-*-*-*-*-*")))
 	(plist nil)
 	(cur nil))
     (while fonts
@@ -1064,7 +1057,7 @@
 (defun font-lookup-rgb-components (color)
   "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values.
 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)
+  (let ((lib-list (if-boundp 'x-library-search-path
 		      x-library-search-path
 		    ;; This default is from XEmacs 19.13 - hope it covers
 		    ;; everyone.
--- a/lisp/frame.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/frame.el	Fri Jan 28 02:58:52 2005 +0000
@@ -994,7 +994,7 @@
 	  (completion-ignore-case t)
 	  (font (completing-read "Font name: "
 			 (mapcar #'list
-				 (list-fonts "*" frame))
+				 (font-list "*" frame))
 			 nil nil nil nil
 			 (face-font-name 'default frame))))
      (list font current-prefix-arg)))
--- a/lisp/gtk-font-menu.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/gtk-font-menu.el	Fri Jan 28 02:58:52 2005 +0000
@@ -90,7 +90,7 @@
 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.
+  ;; recalculate the menus from the cache w/o having to do font-list again.
   (unless gtk-font-regexp-ascii
     (setq gtk-font-regexp-ascii (if (featurep 'mule)
 				    (declare-fboundp
@@ -102,7 +102,7 @@
 	family size weight entry monospaced-p
 	dev-cache cache families sizes weights)
     (dolist (name (cond ((null debug)	; debugging kludge
-			 (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
+			 (font-list "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
 			((stringp debug) (split-string debug "\n"))
 			(t debug)))
       (when (and (string-match gtk-font-regexp-ascii name)
--- a/lisp/minibuf.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/minibuf.el	Fri Jan 28 02:58:52 2005 +0000
@@ -2181,75 +2181,8 @@
   "Read the name of a face from the minibuffer and return it as a symbol."
   (intern (completing-read prompt obarray 'find-face must-match)))
 
-;; #### - wrong place for this variable?  Exactly.  We probably want
-;; `color-list' to be a console method, so `tty-color-list' becomes
-;; obsolete, and `read-color-completion-table' conses (mapcar #'list
-;; (color-list)), optionally caching the results.
-
-;; Ben wanted all of the possibilities from the `configure' script used
-;; here, but I think this is way too many.  I already trimmed the R4 variants
-;; and a few obvious losers from the list.  --Stig
-(defvar x-library-search-path '("/usr/X11R6/lib/X11/"
-				"/usr/X11R5/lib/X11/"
-				"/usr/lib/X11R6/X11/"
-				"/usr/lib/X11R5/X11/"
-				"/usr/local/X11R6/lib/X11/"
-				"/usr/local/X11R5/lib/X11/"
-				"/usr/local/lib/X11R6/X11/"
-				"/usr/local/lib/X11R5/X11/"
-				"/usr/X11/lib/X11/"
-				"/usr/lib/X11/"
-				"/usr/local/lib/X11/"
-				"/usr/X386/lib/X11/"
-				"/usr/x386/lib/X11/"
-				"/usr/XFree86/lib/X11/"
-				"/usr/unsupported/lib/X11/"
-				"/usr/athena/lib/X11/"
-				"/usr/local/x11r5/lib/X11/"
-				"/usr/lpp/Xamples/lib/X11/"
-				"/usr/openwin/lib/X11/"
-				"/usr/openwin/share/lib/X11/")
-  "Search path used by `read-color' to find rgb.txt.")
-
-(defvar x-read-color-completion-table)
-
 (defun read-color-completion-table ()
-  (case (device-type)
-    ;; #### Evil device-type dependency
-    ((x gtk)
-     (if (boundp 'x-read-color-completion-table)
-	 x-read-color-completion-table
-       (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
-	     clist color p)
-	 (if (not rgb-file)
-	     ;; prevents multiple searches for rgb.txt if we can't find it
-	     (setq x-read-color-completion-table nil)
-	   (with-current-buffer (get-buffer-create " *colors*")
-	     (reset-buffer (current-buffer))
-	     (insert-file-contents rgb-file)
-	     (while (not (eobp))
-	       ;; skip over comments
-	       (while (looking-at "^!")
-		 (end-of-line)
-		 (forward-char 1))
-	       (skip-chars-forward "0-9 \t")
-	       (setq p (point))
-	       (end-of-line)
-	       (setq color (buffer-substring p (point))
-		     clist (cons (list color) clist))
-	       ;; Ugh.  If we want to be able to complete the lowercase form
-	       ;; of the color name, we need to add it twice!  Yuck.
-	       (let ((dcase (downcase color)))
-		 (or (string= dcase color)
-		     (push (list dcase) clist)))
-	       (forward-char 1))
-	     (kill-buffer (current-buffer))))
-	 (setq x-read-color-completion-table clist)
-	 x-read-color-completion-table)))
-    (mswindows
-     (mapcar #'list (declare-fboundp (mswindows-color-list))))
-    (tty
-     (mapcar #'list (declare-fboundp (tty-color-list))))))
+  (mapcar #'list (color-list)))
 
 (defun read-color (prompt &optional must-match initial-contents)
   "Read the name of a color from the minibuffer.
--- a/lisp/msw-faces.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/msw-faces.el	Fri Jan 28 02:58:52 2005 +0000
@@ -271,7 +271,7 @@
 		     (and (string-match mswindows-font-regexp name)
 			  (string-to-int (substring name (match-beginning 3)
 						    (match-end 3)))))
-		 (list-fonts font device)))
+		 (font-list font device)))
    #'<))
 
 (defun mswindows-frob-font-size (font up-p device)
--- a/lisp/msw-font-menu.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/msw-font-menu.el	Fri Jan 28 02:58:52 2005 +0000
@@ -74,7 +74,7 @@
 	family size weight entry
 	dev-cache cache families sizes weights)
     (dolist (name (cond ((null debug)	; debugging kludge
-			 (list-fonts "::::" device))
+			 (font-list "::::" device))
 			((stringp debug) (split-string debug "\n"))
 			(t debug)))
       (when (and (string-match mswindows-font-regexp-ascii name)
--- a/lisp/obsolete.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/obsolete.el	Fri Jan 28 02:58:52 2005 +0000
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1985-1994, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1994, 1995 Amdahl Corporation.
 ;; Copyright (C) 1995 Sun Microsystems.
-;; Copyright (C) 2002 Ben Wing.
+;; Copyright (C) 2002, 2004 Ben Wing.
 
 ;; Maintainer: XEmacs Development Team
 ;; Keywords: internal, dumped
@@ -372,6 +372,10 @@
   (color-instance-rgb-components (make-color-instance color)))
 (make-compatible 'x-color-values 'color-instance-rgb-components)
 
+(make-obsolete 'mswindows-color-list 'color-list)
+(make-obsolete 'tty-color-list 'color-list)
+(make-compatible 'list-fonts 'font-list)
+
 ;; Two loser functions which shouldn't be used.
 (make-obsolete 'following-char 'char-after)
 (make-obsolete 'preceding-char 'char-before)
--- a/lisp/x-faces.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/x-faces.el	Fri Jan 28 02:58:52 2005 +0000
@@ -1,7 +1,7 @@
 ;;; x-faces.el --- X-specific face frobnication, aka black magic.
 
 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995, 1996, 2002 Ben Wing.
+;; Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
 
 ;; Author: Jamie Zawinski <jwz@jwz.org>
 ;; Maintainer: XEmacs Development Team
@@ -284,7 +284,7 @@
 			  (string-to-int (substring name (match-beginning 6)
 						    (match-end 6)))
 			  name))))
-		 (list-fonts font device)))
+		 (font-list font device)))
    (function (lambda (x y) (if (= (nth 1 x) (nth 1 y))
 			       (< (nth 0 x) (nth 0 y))
 			       (< (nth 1 x) (nth 1 y)))))))
@@ -376,6 +376,71 @@
 (make-obsolete 'x-make-face-unitalic 'make-face-unitalic)
 
 
+
+;; #### - wrong place for this variable?  Exactly.  We probably want
+;; `color-list' to be a console method, so `tty-color-list' becomes
+;; obsolete, and `read-color-completion-table' conses (mapcar #'list
+;; (color-list)), optionally caching the results.
+
+;; Ben wanted all of the possibilities from the `configure' script used
+;; here, but I think this is way too many.  I already trimmed the R4 variants
+;; and a few obvious losers from the list.  --Stig
+(defvar x-library-search-path '("/usr/X11R6/lib/X11/"
+				"/usr/X11R5/lib/X11/"
+				"/usr/lib/X11R6/X11/"
+				"/usr/lib/X11R5/X11/"
+				"/usr/local/X11R6/lib/X11/"
+				"/usr/local/X11R5/lib/X11/"
+				"/usr/local/lib/X11R6/X11/"
+				"/usr/local/lib/X11R5/X11/"
+				"/usr/X11/lib/X11/"
+				"/usr/lib/X11/"
+				"/usr/local/lib/X11/"
+				"/usr/X386/lib/X11/"
+				"/usr/x386/lib/X11/"
+				"/usr/XFree86/lib/X11/"
+				"/usr/unsupported/lib/X11/"
+				"/usr/athena/lib/X11/"
+				"/usr/local/x11r5/lib/X11/"
+				"/usr/lpp/Xamples/lib/X11/"
+				"/usr/openwin/lib/X11/"
+				"/usr/openwin/share/lib/X11/")
+  "Search path used by `x-color-list-internal' to find rgb.txt.")
+
+(defvar x-color-list-internal-cache)
+
+(defun x-color-list-internal ()
+  (if (boundp 'x-color-list-internal-cache)
+      x-color-list-internal-cache
+    (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
+	  clist color p)
+      (if (not rgb-file)
+	  ;; prevents multiple searches for rgb.txt if we can't find it
+	  (setq x-color-list-internal-cache nil)
+	(with-current-buffer (get-buffer-create " *colors*")
+	  (reset-buffer (current-buffer))
+	  (insert-file-contents rgb-file)
+	  (while (not (eobp))
+	    ;; skip over comments
+	    (while (looking-at "^!")
+	      (end-of-line)
+	      (forward-char 1))
+	    (skip-chars-forward "0-9 \t")
+	    (setq p (point))
+	    (end-of-line)
+	    (setq color (buffer-substring p (point))
+		  clist (cons (list color) clist))
+	    ;; Ugh.  If we want to be able to complete the lowercase form
+	    ;; of the color name, we need to add it twice!  Yuck.
+	    (let ((dcase (downcase color)))
+	      (or (string= dcase color)
+		  (push (list dcase) clist)))
+	    (forward-char 1))
+	  (kill-buffer (current-buffer))))
+      (setq x-color-list-internal-cache clist)
+      x-color-list-internal-cache)))
+
+
 ;;; internal routines
 
 ;;; x-init-face-from-resources is responsible for initializing a
--- a/lisp/x-font-menu.el	Fri Jan 28 02:36:28 2005 +0000
+++ b/lisp/x-font-menu.el	Fri Jan 28 02:58:52 2005 +0000
@@ -90,7 +90,7 @@
 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.
+  ;; recalculate the menus from the cache w/o having to do font-list again.
   (unless x-font-regexp-ascii
     (setq x-font-regexp-ascii (if (featurep 'mule)
 				  (charset-registry 'ascii)
@@ -101,7 +101,7 @@
 	family size weight entry monospaced-p
 	dev-cache cache families sizes weights)
     (dolist (name (cond ((null debug)	; debugging kludge
-			 (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device
+			 (font-list "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device
 				     font-menu-max-number))
 			((stringp debug) (split-string debug "\n"))
 			(t debug)))
--- a/src/ChangeLog	Fri Jan 28 02:36:28 2005 +0000
+++ b/src/ChangeLog	Fri Jan 28 02:58:52 2005 +0000
@@ -1,3 +1,33 @@
+2005-01-27  Ben Wing  <ben@xemacs.org>
+
+	* console-impl.h (struct console_methods):
+	* objects-gtk.c:
+	* objects-gtk.c (gtk_color_list):
+	* objects-gtk.c (gtk_font_list):
+	* objects-gtk.c (console_type_create_objects_gtk):
+	* objects-gtk.c (__gtk_font_list_internal):
+	* objects-msw.c:
+	* objects-msw.c (mswindows_font_list):
+	* objects-msw.c (mswindows_find_charset_font):
+	* objects-msw.c (mswindows_color_list):
+	* objects-msw.c (syms_of_objects_mswindows):
+	* objects-msw.c (console_type_create_objects_mswindows):
+	* objects-tty.c (tty_color_list):
+	* objects-tty.c (tty_font_list):
+	* objects-tty.c (syms_of_objects_tty):
+	* objects-tty.c (console_type_create_objects_tty):
+	* objects-x.c:
+	* objects-x.c (x_color_list):
+	* objects-x.c (x_font_list):
+	* objects-x.c (console_type_create_objects_x):
+	* objects.c:
+	* objects.c (Fcolor_list):
+	* objects.c (Ffont_list):
+	* objects.c (syms_of_objects):
+	list-fonts->font-list.  Create color-list.  Abstract out
+	x/msw-specific versions and obsolete the x/msw-specific Lisp
+	functions.
+
 2005-01-27  Ben Wing  <ben@xemacs.org>
 
 	* nt.c:
--- a/src/console-impl.h	Fri Jan 28 02:36:28 2005 +0000
+++ b/src/console-impl.h	Fri Jan 28 02:58:52 2005 +0000
@@ -192,6 +192,7 @@
 					   int depth);
   Lisp_Object (*color_instance_rgb_components_method) (Lisp_Color_Instance *);
   int (*valid_color_name_p_method) (struct device *, Lisp_Object color);
+  Lisp_Object (*color_list_method) (void);
 
   /* font methods */
   int (*initialize_font_instance_method) (Lisp_Font_Instance *,
@@ -206,7 +207,7 @@
   Lisp_Object (*font_instance_truename_method) (Lisp_Font_Instance *,
 						Error_Behavior errb);
   Lisp_Object (*font_instance_properties_method) (Lisp_Font_Instance *);
-  Lisp_Object (*list_fonts_method) (Lisp_Object pattern,
+  Lisp_Object (*font_list_method) (Lisp_Object pattern,
 				    Lisp_Object device,
 				    Lisp_Object maxnumber);
   Lisp_Object (*find_charset_font_method) (Lisp_Object device,
--- a/src/objects-gtk.c	Fri Jan 28 02:36:28 2005 +0000
+++ b/src/objects-gtk.c	Fri Jan 28 02:58:52 2005 +0000
@@ -206,6 +206,14 @@
   return (1);
 }
 
+static Lisp_Object
+gtk_color_list (void)
+{
+  /* #### BILL!!!
+     Is this correct? */
+  return call0 (intern ("x-color-list-internal"));
+}
+
 
 /************************************************************************/
 /*                           font instances                             */
@@ -330,7 +338,7 @@
 
 /* Forward declarations for X specific functions at the end of the file */
 Lisp_Object __get_gtk_font_truename (GdkFont *gdk_font, int expandp);
-static Lisp_Object __gtk_list_fonts_internal (const char *pattern);
+static Lisp_Object __gtk_font_list_internal (const char *pattern);
 
 static Lisp_Object
 gtk_font_instance_truename (struct Lisp_Font_Instance *f,
@@ -361,14 +369,14 @@
 }
 
 static Lisp_Object
-gtk_list_fonts (Lisp_Object pattern, Lisp_Object UNUSED (device),
+gtk_font_list (Lisp_Object pattern, Lisp_Object UNUSED (device),
 		Lisp_Object UNUSED (maxnumber))
 {
   const char *patternext;
 
   TO_EXTERNAL_FORMAT (LISP_STRING, pattern, C_STRING_ALLOCA, patternext, Qbinary);
 
-  return (__gtk_list_fonts_internal (patternext));
+  return (__gtk_font_list_internal (patternext));
 }
 
 #ifdef MULE
@@ -454,13 +462,14 @@
   CONSOLE_HAS_METHOD (gtk, color_instance_hash);
   CONSOLE_HAS_METHOD (gtk, color_instance_rgb_components);
   CONSOLE_HAS_METHOD (gtk, valid_color_name_p);
+  CONSOLE_HAS_METHOD (gtk, color_list);
 
   CONSOLE_HAS_METHOD (gtk, initialize_font_instance);
   CONSOLE_HAS_METHOD (gtk, print_font_instance);
   CONSOLE_HAS_METHOD (gtk, finalize_font_instance);
   CONSOLE_HAS_METHOD (gtk, font_instance_truename);
   CONSOLE_HAS_METHOD (gtk, font_instance_properties);
-  CONSOLE_HAS_METHOD (gtk, list_fonts);
+  CONSOLE_HAS_METHOD (gtk, font_list);
 #ifdef MULE
   CONSOLE_HAS_METHOD (gtk, find_charset_font);
   CONSOLE_HAS_METHOD (gtk, font_spec_matches_charset);
@@ -587,7 +596,7 @@
   return (font_name);
 }
 
-static Lisp_Object __gtk_list_fonts_internal (const char *pattern)
+static Lisp_Object __gtk_font_list_internal (const char *pattern)
 {
   char **names;
   int count = 0;
--- a/src/objects-msw.c	Fri Jan 28 02:36:28 2005 +0000
+++ b/src/objects-msw.c	Fri Jan 28 02:58:52 2005 +0000
@@ -2,7 +2,7 @@
    Copyright (C) 1993, 1994 Free Software Foundation, Inc.
    Copyright (C) 1995 Board of Trustees, University of Illinois.
    Copyright (C) 1995 Tinker Systems.
-   Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
+   Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing.
    Copyright (C) 1995 Sun Microsystems, Inc.
    Copyright (C) 1997 Jonathan Harris.
 
@@ -1926,7 +1926,7 @@
 }
 
 static Lisp_Object
-mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device,
+mswindows_font_list (Lisp_Object pattern, Lisp_Object device,
 		      Lisp_Object UNUSED (maxnumber))
 {
   struct device *d = XDEVICE (device);
@@ -2188,7 +2188,7 @@
 
   /* If FONT specifies a particular charset, this will only list fonts with
      that charset; otherwise, it will list fonts with all charsets. */
-  fontlist = mswindows_list_fonts (font, device, Qnil);
+  fontlist = mswindows_font_list (font, device, Qnil);
 
   if (!stage)
     {
@@ -2219,10 +2219,8 @@
 /*                             non-methods                              */
 /************************************************************************/
 
-DEFUN ("mswindows-color-list", Fmswindows_color_list, 0, 0, 0, /*
-Return a list of the colors available on mswindows devices.
-*/
-       ())
+static Lisp_Object
+mswindows_color_list (void)
 {
   Lisp_Object result = Qnil;
   int i;
@@ -2233,7 +2231,6 @@
   return Fnreverse (result);
 }
 
-
 
 /************************************************************************/
 /*                            initialization                            */
@@ -2242,7 +2239,6 @@
 void
 syms_of_objects_mswindows (void)
 {
-  DEFSUBR (Fmswindows_color_list);
 }
 
 void
@@ -2257,13 +2253,14 @@
   CONSOLE_HAS_METHOD (mswindows, color_instance_hash);
   CONSOLE_HAS_METHOD (mswindows, color_instance_rgb_components);
   CONSOLE_HAS_METHOD (mswindows, valid_color_name_p);
+  CONSOLE_HAS_METHOD (mswindows, color_list);
 
   CONSOLE_HAS_METHOD (mswindows, initialize_font_instance);
 /*  CONSOLE_HAS_METHOD (mswindows, mark_font_instance); */
   CONSOLE_HAS_METHOD (mswindows, print_font_instance);
   CONSOLE_HAS_METHOD (mswindows, finalize_font_instance);
   CONSOLE_HAS_METHOD (mswindows, font_instance_truename);
-  CONSOLE_HAS_METHOD (mswindows, list_fonts);
+  CONSOLE_HAS_METHOD (mswindows, font_list);
 #ifdef MULE
   CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset);
   CONSOLE_HAS_METHOD (mswindows, find_charset_font);
@@ -2280,13 +2277,14 @@
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_hash);
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_rgb_components);
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, valid_color_name_p);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_list);
 
   CONSOLE_HAS_METHOD (msprinter, initialize_font_instance);
 /*  CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_font_instance); */
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_font_instance);
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_font_instance);
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_instance_truename);
-  CONSOLE_INHERITS_METHOD (msprinter, mswindows, list_fonts);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_list);
 #ifdef MULE
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_spec_matches_charset);
   CONSOLE_INHERITS_METHOD (msprinter, mswindows, find_charset_font);
--- a/src/objects-tty.c	Fri Jan 28 02:36:28 2005 +0000
+++ b/src/objects-tty.c	Fri Jan 28 02:58:52 2005 +0000
@@ -106,10 +106,8 @@
     return Qnil;
 }
 
-DEFUN ("tty-color-list", Ftty_color_list, 0, 0, 0, /*
-Return a list of the registered TTY colors.
-*/
-       ())
+static Lisp_Object
+tty_color_list (void)
 {
   Lisp_Object result = Qnil;
   Lisp_Object rest;
@@ -293,7 +291,7 @@
 }
 
 static Lisp_Object
-tty_list_fonts (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device),
+tty_font_list (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device),
 		Lisp_Object UNUSED (maxnumber))
 {
   return list1 (build_string ("normal"));
@@ -368,7 +366,6 @@
   DEFSUBR (Fregister_tty_color);
   DEFSUBR (Funregister_tty_color);
   DEFSUBR (Ffind_tty_color);
-  DEFSUBR (Ftty_color_list);
 #if 0
   DEFSUBR (Fset_tty_dynamic_color_specs);
   DEFSUBR (Ftty_dynamic_color_specs);
@@ -386,12 +383,13 @@
   CONSOLE_HAS_METHOD (tty, color_instance_equal);
   CONSOLE_HAS_METHOD (tty, color_instance_hash);
   CONSOLE_HAS_METHOD (tty, valid_color_name_p);
+  CONSOLE_HAS_METHOD (tty, color_list);
 
   CONSOLE_HAS_METHOD (tty, initialize_font_instance);
   CONSOLE_HAS_METHOD (tty, mark_font_instance);
   CONSOLE_HAS_METHOD (tty, print_font_instance);
   CONSOLE_HAS_METHOD (tty, finalize_font_instance);
-  CONSOLE_HAS_METHOD (tty, list_fonts);
+  CONSOLE_HAS_METHOD (tty, font_list);
 #ifdef MULE
   CONSOLE_HAS_METHOD (tty, font_spec_matches_charset);
   CONSOLE_HAS_METHOD (tty, find_charset_font);
--- a/src/objects-x.c	Fri Jan 28 02:36:28 2005 +0000
+++ b/src/objects-x.c	Fri Jan 28 02:58:52 2005 +0000
@@ -355,6 +355,12 @@
   return XParseColor (dpy, cmap, extname, &c);
 }
 
+static Lisp_Object
+x_color_list (void)
+{
+  return call0 (intern ("x-color-list-internal"));
+}
+
 
 /************************************************************************/
 /*                           font instances                             */
@@ -853,7 +859,7 @@
 }
 
 static Lisp_Object
-x_list_fonts (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber)
+x_font_list (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber)
 {
   Extbyte **names;
   int count = 0;
@@ -1005,13 +1011,14 @@
   CONSOLE_HAS_METHOD (x, color_instance_hash);
   CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
   CONSOLE_HAS_METHOD (x, valid_color_name_p);
+  CONSOLE_HAS_METHOD (x, color_list);
 
   CONSOLE_HAS_METHOD (x, initialize_font_instance);
   CONSOLE_HAS_METHOD (x, print_font_instance);
   CONSOLE_HAS_METHOD (x, finalize_font_instance);
   CONSOLE_HAS_METHOD (x, font_instance_truename);
   CONSOLE_HAS_METHOD (x, font_instance_properties);
-  CONSOLE_HAS_METHOD (x, list_fonts);
+  CONSOLE_HAS_METHOD (x, font_list);
 #ifdef MULE
   CONSOLE_HAS_METHOD (x, find_charset_font);
   CONSOLE_HAS_METHOD (x, font_spec_matches_charset);
--- a/src/objects.c	Fri Jan 28 02:36:28 2005 +0000
+++ b/src/objects.c	Fri Jan 28 02:58:52 2005 +0000
@@ -1,7 +1,7 @@
 /* Generic Objects and Functions.
    Copyright (C) 1995 Free Software Foundation, Inc.
    Copyright (C) 1995 Board of Trustees, University of Illinois.
-   Copyright (C) 1995, 1996, 2002 Ben Wing.
+   Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -248,6 +248,18 @@
   return MAYBE_INT_DEVMETH (d, valid_color_name_p, (d, color)) ? Qt : Qnil;
 }
 
+DEFUN ("color-list", Fcolor_list, 0, 1, 0, /*
+Return a list of color names.
+DEVICE specifies which device to return names for, and defaults to the
+currently selected device.
+*/
+       (device))
+{
+  device = wrap_device (decode_device (device));
+
+  return MAYBE_LISP_DEVMETH (XDEVICE (device), color_list, ());
+}
+
 
 /***************************************************************************
  *                       Font-Instance Object                              *
@@ -506,7 +518,7 @@
 			     font_instance_properties, (f));
 }
 
-DEFUN ("list-fonts", Flist_fonts, 1, 3, 0, /*
+DEFUN ("font-list", Ffont_list, 1, 3, 0, /*
 Return a list of font names matching the given pattern.
 DEVICE specifies which device to search for names, and defaults to the
 currently selected device.
@@ -516,7 +528,7 @@
   CHECK_STRING (pattern);
   device = wrap_device (decode_device (device));
 
-  return MAYBE_LISP_DEVMETH (XDEVICE (device), list_fonts, (pattern, device,
+  return MAYBE_LISP_DEVMETH (XDEVICE (device), font_list, (pattern, device,
 							    maxnumber));
 }
 
@@ -1121,6 +1133,7 @@
   DEFSUBR (Fcolor_instance_name);
   DEFSUBR (Fcolor_instance_rgb_components);
   DEFSUBR (Fvalid_color_name_p);
+  DEFSUBR (Fcolor_list);
 
   DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep);
   DEFSUBR (Fmake_font_instance);
@@ -1132,7 +1145,7 @@
   DEFSUBR (Ffont_instance_proportional_p);
   DEFSUBR (Ffont_instance_truename);
   DEFSUBR (Ffont_instance_properties);
-  DEFSUBR (Flist_fonts);
+  DEFSUBR (Ffont_list);
 
   /* Qcolor, Qfont defined in general.c */
   DEFSYMBOL (Qface_boolean);