Mercurial > hg > xemacs-beta

comparison lisp/x-faces.el @ 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 79c6ff3eef26
children 2f2d12f4f93a
comparison
equal deleted inserted replaced
2526:902d5bd9b75c 2527:491f8cf78a9c
1 ;;; x-faces.el --- X-specific face frobnication, aka black magic. 1 ;;; x-faces.el --- X-specific face frobnication, aka black magic.
2 2
3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996, 2002 Ben Wing. 4 ;; Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
5 5
6 ;; Author: Jamie Zawinski <jwz@jwz.org> 6 ;; Author: Jamie Zawinski <jwz@jwz.org>
7 ;; Maintainer: XEmacs Development Team 7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: extensions, internal, dumped 8 ;; Keywords: extensions, internal, dumped
9 9
282 (string-to-int (substring name (match-beginning 5) 282 (string-to-int (substring name (match-beginning 5)
283 (match-end 5))) 283 (match-end 5)))
284 (string-to-int (substring name (match-beginning 6) 284 (string-to-int (substring name (match-beginning 6)
285 (match-end 6))) 285 (match-end 6)))
286 name)))) 286 name))))
287 (list-fonts font device))) 287 (font-list font device)))
288 (function (lambda (x y) (if (= (nth 1 x) (nth 1 y)) 288 (function (lambda (x y) (if (= (nth 1 x) (nth 1 y))
289 (< (nth 0 x) (nth 0 y)) 289 (< (nth 0 x) (nth 0 y))
290 (< (nth 1 x) (nth 1 y))))))) 290 (< (nth 1 x) (nth 1 y)))))))
291 291
292 ;; Given a font name, this attempts to construct a valid font name for 292 ;; Given a font name, this attempts to construct a valid font name for
372 (make-obsolete 'x-make-face-bold 'make-face-bold) 372 (make-obsolete 'x-make-face-bold 'make-face-bold)
373 (make-obsolete 'x-make-face-italic 'make-face-italic) 373 (make-obsolete 'x-make-face-italic 'make-face-italic)
374 (make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic) 374 (make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic)
375 (make-obsolete 'x-make-face-unbold 'make-face-unbold) 375 (make-obsolete 'x-make-face-unbold 'make-face-unbold)
376 (make-obsolete 'x-make-face-unitalic 'make-face-unitalic) 376 (make-obsolete 'x-make-face-unitalic 'make-face-unitalic)
377
378
379
380 ;; #### - wrong place for this variable? Exactly. We probably want
381 ;; `color-list' to be a console method, so `tty-color-list' becomes
382 ;; obsolete, and `read-color-completion-table' conses (mapcar #'list
383 ;; (color-list)), optionally caching the results.
384
385 ;; Ben wanted all of the possibilities from the `configure' script used
386 ;; here, but I think this is way too many. I already trimmed the R4 variants
387 ;; and a few obvious losers from the list. --Stig
388 (defvar x-library-search-path '("/usr/X11R6/lib/X11/"
389 "/usr/X11R5/lib/X11/"
390 "/usr/lib/X11R6/X11/"
391 "/usr/lib/X11R5/X11/"
392 "/usr/local/X11R6/lib/X11/"
393 "/usr/local/X11R5/lib/X11/"
394 "/usr/local/lib/X11R6/X11/"
395 "/usr/local/lib/X11R5/X11/"
396 "/usr/X11/lib/X11/"
397 "/usr/lib/X11/"
398 "/usr/local/lib/X11/"
399 "/usr/X386/lib/X11/"
400 "/usr/x386/lib/X11/"
401 "/usr/XFree86/lib/X11/"
402 "/usr/unsupported/lib/X11/"
403 "/usr/athena/lib/X11/"
404 "/usr/local/x11r5/lib/X11/"
405 "/usr/lpp/Xamples/lib/X11/"
406 "/usr/openwin/lib/X11/"
407 "/usr/openwin/share/lib/X11/")
408 "Search path used by `x-color-list-internal' to find rgb.txt.")
409
410 (defvar x-color-list-internal-cache)
411
412 (defun x-color-list-internal ()
413 (if (boundp 'x-color-list-internal-cache)
414 x-color-list-internal-cache
415 (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
416 clist color p)
417 (if (not rgb-file)
418 ;; prevents multiple searches for rgb.txt if we can't find it
419 (setq x-color-list-internal-cache nil)
420 (with-current-buffer (get-buffer-create " *colors*")
421 (reset-buffer (current-buffer))
422 (insert-file-contents rgb-file)
423 (while (not (eobp))
424 ;; skip over comments
425 (while (looking-at "^!")
426 (end-of-line)
427 (forward-char 1))
428 (skip-chars-forward "0-9 \t")
429 (setq p (point))
430 (end-of-line)
431 (setq color (buffer-substring p (point))
432 clist (cons (list color) clist))
433 ;; Ugh. If we want to be able to complete the lowercase form
434 ;; of the color name, we need to add it twice! Yuck.
435 (let ((dcase (downcase color)))
436 (or (string= dcase color)
437 (push (list dcase) clist)))
438 (forward-char 1))
439 (kill-buffer (current-buffer))))
440 (setq x-color-list-internal-cache clist)
441 x-color-list-internal-cache)))
377 442
378 443
379 ;;; internal routines 444 ;;; internal routines
380 445
381 ;;; x-init-face-from-resources is responsible for initializing a 446 ;;; x-init-face-from-resources is responsible for initializing a