diff lisp/x-faces.el @ 2527:491f8cf78a9c

[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 79c6ff3eef26
children 2f2d12f4f93a
line wrap: on
line diff
--- 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