Mercurial > hg > xemacs-beta
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