User: ben Date: 05/01/28 03:58:56 Modified: xemacs/src ChangeLog console-impl.h objects-gtk.c objects-msw.c objects-tty.c objects-x.c objects.c Log: 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. Revision Changes Path 1.619 +25 -0 XEmacs/xemacs/lisp/ChangeLog (In the diff below, changes in quantity of whitespace are not shown.) Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v retrieving revision 1.618 retrieving revision 1.619 diff -u -b -r1.618 -r1.619 --- ChangeLog 2005/01/28 02:05:03 1.618 +++ ChangeLog 2005/01/28 02:58:38 1.619 ＠＠ -1,5 +1,30 ＠＠ 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. + +2005-01-27 Ben Wing <ben(a)xemacs.org&gt; + * subr.el: * subr.el (macro-declaration-function): New. Some synching with FSF 21.2. 1.8 +1 -1 XEmacs/xemacs/lisp/font-menu.el (In the diff below, changes in quantity of whitespace are not shown.) Index: font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font-menu.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -b -r1.7 -r1.8 --- font-menu.el 2004/09/22 02:05:50 1.7 +++ font-menu.el 2005/01/28 02:58:39 1.8 ＠＠ -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" 1.16 +5 -12 XEmacs/xemacs/lisp/font.el (In the diff below, changes in quantity of whitespace are not shown.) Index: font.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/font.el,v retrieving revision 1.15 retrieving revision 1.16 diff -u -b -r1.15 -r1.16 --- font.el 2003/03/09 02:27:33 1.15 +++ font.el 2005/01/28 02:58:40 1.16 ＠＠ -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 ＠＠ (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. 1.24 +1 -1 XEmacs/xemacs/lisp/frame.el (In the diff below, changes in quantity of whitespace are not shown.) Index: frame.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/frame.el,v retrieving revision 1.23 retrieving revision 1.24 diff -u -b -r1.23 -r1.24 --- frame.el 2005/01/26 09:53:32 1.23 +++ frame.el 2005/01/28 02:58:40 1.24 ＠＠ -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))) 1.6 +2 -2 XEmacs/xemacs/lisp/gtk-font-menu.el (In the diff below, changes in quantity of whitespace are not shown.) Index: gtk-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gtk-font-menu.el,v retrieving revision 1.5 retrieving revision 1.6 diff -u -b -r1.5 -r1.6 --- gtk-font-menu.el 2004/09/22 02:05:50 1.5 +++ gtk-font-menu.el 2005/01/28 02:58:40 1.6 ＠＠ -90,7 +90,7 ＠＠ 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 ＠＠ 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) 1.27 +1 -68 XEmacs/xemacs/lisp/minibuf.el (In the diff below, changes in quantity of whitespace are not shown.) Index: minibuf.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/minibuf.el,v retrieving revision 1.26 retrieving revision 1.27 diff -u -b -r1.26 -r1.27 --- minibuf.el 2004/04/17 09:59:24 1.26 +++ minibuf.el 2005/01/28 02:58:40 1.27 ＠＠ -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. 1.18 +1 -1 XEmacs/xemacs/lisp/msw-faces.el (In the diff below, changes in quantity of whitespace are not shown.) Index: msw-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/msw-faces.el,v retrieving revision 1.17 retrieving revision 1.18 diff -u -b -r1.17 -r1.18 --- msw-faces.el 2003/03/09 02:27:33 1.17 +++ msw-faces.el 2005/01/28 02:58:40 1.18 ＠＠ -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) 1.8 +1 -1 XEmacs/xemacs/lisp/msw-font-menu.el (In the diff below, changes in quantity of whitespace are not shown.) Index: msw-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/msw-font-menu.el,v retrieving revision 1.7 retrieving revision 1.8 diff -u -b -r1.7 -r1.8 --- msw-font-menu.el 2002/06/20 21:18:04 1.7 +++ msw-font-menu.el 2005/01/28 02:58:40 1.8 ＠＠ -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) 1.18 +5 -1 XEmacs/xemacs/lisp/obsolete.el (In the diff below, changes in quantity of whitespace are not shown.) Index: obsolete.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/obsolete.el,v retrieving revision 1.17 retrieving revision 1.18 diff -u -b -r1.17 -r1.18 --- obsolete.el 2003/03/20 13:19:59 1.17 +++ obsolete.el 2005/01/28 02:58:41 1.18 ＠＠ -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 ＠＠ 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) 1.20 +67 -2 XEmacs/xemacs/lisp/x-faces.el (In the diff below, changes in quantity of whitespace are not shown.) Index: x-faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-faces.el,v retrieving revision 1.19 retrieving revision 1.20 diff -u -b -r1.19 -r1.20 --- x-faces.el 2002/06/20 21:18:04 1.19 +++ x-faces.el 2005/01/28 02:58:41 1.20 ＠＠ -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 ＠＠ (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 ＠＠ (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 1.13 +2 -2 XEmacs/xemacs/lisp/x-font-menu.el (In the diff below, changes in quantity of whitespace are not shown.) Index: x-font-menu.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/x-font-menu.el,v retrieving revision 1.12 retrieving revision 1.13 diff -u -b -r1.12 -r1.13 --- x-font-menu.el 2004/09/22 02:05:51 1.12 +++ x-font-menu.el 2005/01/28 02:58:41 1.13 ＠＠ -90,7 +90,7 ＠＠ 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 ＠＠ 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))) 1.779 +30 -0 XEmacs/xemacs/src/ChangeLog (In the diff below, changes in quantity of whitespace are not shown.) Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v retrieving revision 1.778 retrieving revision 1.779 diff -u -b -r1.778 -r1.779 --- ChangeLog 2005/01/28 02:36:22 1.778 +++ ChangeLog 2005/01/28 02:58:49 1.779 ＠＠ -1,5 +1,35 ＠＠ 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. + +2005-01-27 Ben Wing <ben(a)xemacs.org&gt; + * nt.c: * fileio.c: Fix sync comments. 1.8 +2 -1 XEmacs/xemacs/src/console-impl.h (In the diff below, changes in quantity of whitespace are not shown.) Index: console-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v retrieving revision 1.7 retrieving revision 1.8 diff -u -b -r1.7 -r1.8 --- console-impl.h 2004/11/04 23:06:18 1.7 +++ console-impl.h 2005/01/28 02:58:51 1.8 ＠＠ -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, 1.16 +14 -5 XEmacs/xemacs/src/objects-gtk.c (In the diff below, changes in quantity of whitespace are not shown.) Index: objects-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v retrieving revision 1.15 retrieving revision 1.16 diff -u -b -r1.15 -r1.16 --- objects-gtk.c 2005/01/26 10:22:27 1.15 +++ objects-gtk.c 2005/01/28 02:58:51 1.16 ＠＠ -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; 1.47 +9 -11 XEmacs/xemacs/src/objects-msw.c (In the diff below, changes in quantity of whitespace are not shown.) Index: objects-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v retrieving revision 1.46 retrieving revision 1.47 diff -u -b -r1.46 -r1.47 --- objects-msw.c 2005/01/26 10:22:27 1.46 +++ objects-msw.c 2005/01/28 02:58:51 1.47 ＠＠ -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; ＠＠ -2234,7 +2232,6 ＠＠ } - /************************************************************************/ /* 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); 1.16 +5 -7 XEmacs/xemacs/src/objects-tty.c (In the diff below, changes in quantity of whitespace are not shown.) Index: objects-tty.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-tty.c,v retrieving revision 1.15 retrieving revision 1.16 diff -u -b -r1.15 -r1.16 --- objects-tty.c 2005/01/26 10:22:27 1.15 +++ objects-tty.c 2005/01/28 02:58:51 1.16 ＠＠ -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); 1.28 +9 -2 XEmacs/xemacs/src/objects-x.c (In the diff below, changes in quantity of whitespace are not shown.) Index: objects-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-x.c,v retrieving revision 1.27 retrieving revision 1.28 diff -u -b -r1.27 -r1.28 --- objects-x.c 2005/01/26 10:22:27 1.27 +++ objects-x.c 2005/01/28 02:58:52 1.28 ＠＠ -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); 1.26 +17 -4 XEmacs/xemacs/src/objects.c (In the diff below, changes in quantity of whitespace are not shown.) Index: objects.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v retrieving revision 1.25 retrieving revision 1.26 diff -u -b -r1.25 -r1.26 --- objects.c 2005/01/26 10:22:27 1.25 +++ objects.c 2005/01/28 02:58:52 1.26 ＠＠ -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);