[COMMIT] Abstract font-list/color-list

NOTE: This patch has been committed. NOTE: I don't know if the GTK version of color-list is correct. Please verify! lisp/ChangeLog addition: 2005-01-27 Ben Wing <ben(a)xemacs.org&gt; * 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. src/ChangeLog addition: 2005-01-27 Ben Wing <ben(a)xemacs.org&gt; * 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. smallfix source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: src/objects.c src/objects-x.c src/objects-tty.c src/objects-msw.c src/objects-gtk.c src/console-impl.h lisp/x-font-menu.el lisp/x-faces.el lisp/obsolete.el lisp/msw-font-menu.el lisp/msw-faces.el lisp/minibuf.el lisp/gtk-font-menu.el lisp/frame.el lisp/font.el lisp/font-menu.el cvs server: Diffing . cvs server: Diffing dynodump cvs server: Diffing dynodump/i386 cvs server: Diffing dynodump/ppc cvs server: Diffing dynodump/sparc cvs server: Diffing etc cvs server: Diffing etc/custom cvs server: Diffing etc/custom/example-themes cvs server: Diffing etc/eos cvs server: Diffing etc/idd cvs server: Diffing etc/photos cvs server: Diffing etc/sparcworks cvs server: Diffing etc/tests cvs server: Diffing etc/tests/external-widget cvs server: Diffing etc/toolbar cvs server: Diffing etc/unicode cvs server: Diffing etc/unicode/ibm cvs server: Diffing etc/unicode/mule-ucs cvs server: Diffing etc/unicode/other cvs server: Diffing etc/unicode/unicode-consortium cvs server: Diffing info cvs server: Diffing lib-src cvs server: Diffing lisp Index: lisp/font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-menu.el,v retrieving revision 1.7 diff -u -p -r1.7 font-menu.el --- lisp/font-menu.el 2004/09/22 02:05:50 1.7 +++ lisp/font-menu.el 2005/01/28 02:54:15 ＠＠ -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" Index: lisp/font.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font.el,v retrieving revision 1.15 diff -u -p -r1.15 font.el --- lisp/font.el 2003/03/09 02:27:33 1.15 +++ lisp/font.el 2005/01/28 02:54:15 ＠＠ -2,7 +2,7 ＠＠ ;; Copyright (c) 1995, 1996 by William M. Perry (wmperry(a)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 ＠＠ for use in the 'weight' field of an mswi (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 ＠＠ for use in the 'weight' field of an mswi (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. Index: lisp/frame.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/frame.el,v retrieving revision 1.23 diff -u -p -r1.23 frame.el --- lisp/frame.el 2005/01/26 09:53:32 1.23 +++ lisp/frame.el 2005/01/28 02:54:16 ＠＠ -994,7 +994,7 ＠＠ pixels) is kept by adjusting the numbers (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))) Index: lisp/gtk-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gtk-font-menu.el,v retrieving revision 1.5 diff -u -p -r1.5 gtk-font-menu.el --- lisp/gtk-font-menu.el 2004/09/22 02:05:50 1.5 +++ lisp/gtk-font-menu.el 2005/01/28 02:54:16 ＠＠ -90,7 +90,7 ＠＠ when they are selected for the first tim or if you change your font path, you can call this to re-initialize the menus." ;; by Stig(a)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 ＠＠ or if you change your font path, you can 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) Index: lisp/minibuf.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/minibuf.el,v retrieving revision 1.26 diff -u -p -r1.26 minibuf.el --- lisp/minibuf.el 2004/04/17 09:59:24 1.26 +++ lisp/minibuf.el 2005/01/28 02:54:17 ＠＠ -2181,75 +2181,8 ＠＠ whether it is a file(/result) or a direc "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. Index: lisp/msw-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/msw-faces.el,v retrieving revision 1.17 diff -u -p -r1.17 msw-faces.el --- lisp/msw-faces.el 2003/03/09 02:27:33 1.17 +++ lisp/msw-faces.el 2005/01/28 02:54:17 ＠＠ -271,7 +271,7 ＠＠ font. If it fails, it returns nil." (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) Index: lisp/msw-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/msw-font-menu.el,v retrieving revision 1.7 diff -u -p -r1.7 msw-font-menu.el --- lisp/msw-font-menu.el 2002/06/20 21:18:04 1.7 +++ lisp/msw-font-menu.el 2005/01/28 02:54:17 ＠＠ -74,7 +74,7 ＠＠ or if you change your font path, you can 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) Index: lisp/obsolete.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/obsolete.el,v retrieving revision 1.17 diff -u -p -r1.17 obsolete.el --- lisp/obsolete.el 2003/03/20 13:19:59 1.17 +++ lisp/obsolete.el 2005/01/28 02:54:17 ＠＠ -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 ＠＠ -371,6 +371,10 ＠＠ on the system; white is (65280 65280 652 If FRAME is omitted or nil, use the selected frame." (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) Index: lisp/x-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v retrieving revision 1.19 diff -u -p -r1.19 x-faces.el --- lisp/x-faces.el 2002/06/20 21:18:04 1.19 +++ lisp/x-faces.el 2005/01/28 02:54:18 ＠＠ -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(a)jwz.org&gt; ;; Maintainer: XEmacs Development Team ＠＠ -284,7 +284,7 ＠＠ X fonts can be specified (by the user) i (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))))))) ＠＠ -374,6 +374,71 ＠＠ Otherwise, it returns the next larger ve (make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic) (make-obsolete 'x-make-face-unbold 'make-face-unbold) (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 Index: lisp/x-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v retrieving revision 1.12 diff -u -p -r1.12 x-font-menu.el --- lisp/x-font-menu.el 2004/09/22 02:05:51 1.12 +++ lisp/x-font-menu.el 2005/01/28 02:54:18 ＠＠ -90,7 +90,7 ＠＠ when they are selected for the first tim or if you change your font path, you can call this to re-initialize the menus." ;; by Stig(a)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 ＠＠ or if you change your font path, you can 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))) cvs server: Diffing lisp/mule cvs server: Diffing lisp/term cvs server: Diffing lock cvs server: Diffing lwlib cvs server: Diffing man cvs server: Diffing man/internals cvs server: Diffing man/lispref cvs server: Diffing man/new-users-guide cvs server: Diffing man/xemacs cvs server: Diffing modules cvs server: Diffing modules/base64 cvs server: Diffing modules/common cvs server: Diffing modules/ldap cvs server: Diffing modules/postgresql cvs server: Diffing modules/sample cvs server: Diffing modules/sample/external cvs server: Diffing modules/sample/internal cvs server: Diffing modules/zlib cvs server: Diffing netinstall cvs server: Diffing nt cvs server: Diffing nt/installer cvs server: Diffing nt/installer/Wise cvs server: Diffing src Index: src/console-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v retrieving revision 1.7 diff -u -p -r1.7 console-impl.h --- src/console-impl.h 2004/11/04 23:06:18 1.7 +++ src/console-impl.h 2005/01/28 02:54:18 ＠＠ -192,6 +192,7 ＠＠ struct console_methods 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 ＠＠ struct console_methods 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, Index: src/objects-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v retrieving revision 1.15 diff -u -p -r1.15 objects-gtk.c --- src/objects-gtk.c 2005/01/26 10:22:27 1.15 +++ src/objects-gtk.c 2005/01/28 02:54:19 ＠＠ -206,6 +206,14 ＠＠ gtk_valid_color_name_p (struct device *U 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 ＠＠ gtk_finalize_font_instance (struct Lisp_ /* 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 ＠＠ gtk_font_instance_properties (struct Lis } 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_type_create_objects_gtk (void) 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 ＠＠ __get_gtk_font_truename (GdkFont *gdk_fo 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; Index: src/objects-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v retrieving revision 1.46 diff -u -p -r1.46 objects-msw.c --- src/objects-msw.c 2005/01/26 10:22:27 1.46 +++ src/objects-msw.c 2005/01/28 02:54:19 ＠＠ -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 ＠＠ mswindows_print_font_instance (Lisp_Font } 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 ＠＠ mswindows_find_charset_font (Lisp_Object /* 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 ＠＠ mswindows_find_charset_font (Lisp_Object /* 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 a list of the colors available on return Fnreverse (result); } -  /************************************************************************/ /* initialization */ ＠＠ -2242,7 +2239,6 ＠＠ Return a list of the colors available on void syms_of_objects_mswindows (void) { - DEFSUBR (Fmswindows_color_list); } void ＠＠ -2257,13 +2253,14 ＠＠ console_type_create_objects_mswindows (v 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_type_create_objects_mswindows (v 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); Index: src/objects-tty.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v retrieving revision 1.15 diff -u -p -r1.15 objects-tty.c --- src/objects-tty.c 2005/01/26 10:22:27 1.15 +++ src/objects-tty.c 2005/01/28 02:54:19 ＠＠ -106,10 +106,8 ＠＠ If it is not found, return nil. 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 ＠＠ tty_finalize_font_instance (Lisp_Font_In } 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 ＠＠ syms_of_objects_tty (void) 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_type_create_objects_tty (void) 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); Index: src/objects-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v retrieving revision 1.27 diff -u -p -r1.27 objects-x.c --- src/objects-x.c 2005/01/26 10:22:27 1.27 +++ src/objects-x.c 2005/01/28 02:54:20 ＠＠ -355,6 +355,12 ＠＠ x_valid_color_name_p (struct device *d, 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 ＠＠ x_font_instance_properties (Lisp_Font_In } 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_type_create_objects_x (void) 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); Index: src/objects.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v retrieving revision 1.25 diff -u -p -r1.25 objects.c --- src/objects.c 2005/01/26 10:22:27 1.25 +++ src/objects.c 2005/01/28 02:54:20 ＠＠ -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 ＠＠ such as `blink'. 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 ＠＠ Return the properties (an alist or nil) 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 ＠＠ currently selected device. 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 ＠＠ syms_of_objects (void) 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 ＠＠ syms_of_objects (void) 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); cvs server: Diffing src/m cvs server: Diffing src/s cvs server: Diffing tests cvs server: Diffing tests/DLL cvs server: Diffing tests/Dnd cvs server: Diffing tests/automated cvs server: Diffing tests/gtk cvs server: Diffing tests/mule cvs server: Diffing tests/tooltalk