Mercurial > hg > xemacs-beta

comparison lisp/font.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 01c57eb70ae9
children 64752935473d
comparison
equal deleted inserted replaced
2526:902d5bd9b75c 2527:491f8cf78a9c
1 ;;; font.el --- New font model 1 ;;; font.el --- New font model
2 2
3 ;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) 3 ;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
4 ;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 4 ;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
5 ;; Copyright (C) 2002 Ben Wing. 5 ;; Copyright (C) 2002, 2004 Ben Wing.
6 6
7 ;; Author: wmperry 7 ;; Author: wmperry
8 ;; Maintainer: XEmacs Development Team 8 ;; Maintainer: XEmacs Development Team
9 ;; Created: 1997/09/05 15:44:37 9 ;; Created: 1997/09/05 15:44:37
10 ;; Keywords: faces 10 ;; Keywords: faces
30 ;;; Commentary: 30 ;;; Commentary:
31 31
32 ;;; Code: 32 ;;; Code:
33 33
34 (globally-declare-fboundp 34 (globally-declare-fboundp
35 '(x-list-fonts 35 '(internal-facep fontsetp get-font-info
36 mswindows-list-fonts ns-list-fonts internal-facep fontsetp get-font-info
37 get-fontset-info mswindows-define-rgb-color cancel-function-timers 36 get-fontset-info mswindows-define-rgb-color cancel-function-timers
38 mswindows-font-regexp mswindows-canonicalize-font-name 37 mswindows-font-regexp mswindows-canonicalize-font-name
39 mswindows-parse-font-style mswindows-construct-font-style 38 mswindows-parse-font-style mswindows-construct-font-style
40 ;; #### perhaps we should rewrite font-warn to avoid the warning 39 ;; #### perhaps we should rewrite font-warn to avoid the warning
41 font-warn)) 40 font-warn))
58 (defmacro defgroup (&rest args) 57 (defmacro defgroup (&rest args)
59 nil) 58 nil)
60 (defmacro defcustom (var value doc &rest args) 59 (defmacro defcustom (var value doc &rest args)
61 `(defvar ,var ,value ,doc)))) 60 `(defvar ,var ,value ,doc))))
62 61
63 (if (not (fboundp 'try-font-name)) 62 ; delete alternate defn of try-font-name
64 (defun try-font-name (fontname &rest args)
65 (case window-system
66 ((x pm) (car-safe (x-list-fonts fontname)))
67 (mswindows (car-safe (mswindows-list-fonts fontname)))
68 (ns (car-safe (ns-list-fonts fontname)))
69 (otherwise nil))))
70 63
71 (if (not (fboundp 'facep)) 64 (if (not (fboundp 'facep))
72 (defun facep (face) 65 (defun facep (face)
73 "Return t if X is a face name or an internal face vector." 66 "Return t if X is a face name or an internal face vector."
74 (if (not window-system) 67 (if (not window-system)
930 ;;; Cache building code 923 ;;; Cache building code
931 ;;;###autoload 924 ;;;###autoload
932 (defun x-font-build-cache (&optional device) 925 (defun x-font-build-cache (&optional device)
933 (let ((hash-table (make-hash-table :test 'equal :size 15)) 926 (let ((hash-table (make-hash-table :test 'equal :size 15))
934 (fonts (mapcar 'x-font-create-object 927 (fonts (mapcar 'x-font-create-object
935 (x-list-fonts "-*-*-*-*-*-*-*-*-*-*-*-*-*-*"))) 928 (font-list "-*-*-*-*-*-*-*-*-*-*-*-*-*-*")))
936 (plist nil) 929 (plist nil)
937 (cur nil)) 930 (cur nil))
938 (while fonts 931 (while fonts
939 (setq cur (car fonts) 932 (setq cur (car fonts)
940 fonts (cdr fonts) 933 fonts (cdr fonts)
1062 (display-buffer (current-buffer)))))) 1055 (display-buffer (current-buffer))))))
1063 1056
1064 (defun font-lookup-rgb-components (color) 1057 (defun font-lookup-rgb-components (color)
1065 "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values. 1058 "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values.
1066 The list (R G B) is returned, or an error is signaled if the lookup fails." 1059 The list (R G B) is returned, or an error is signaled if the lookup fails."
1067 (let ((lib-list (if (boundp 'x-library-search-path) 1060 (let ((lib-list (if-boundp 'x-library-search-path
1068 x-library-search-path 1061 x-library-search-path
1069 ;; This default is from XEmacs 19.13 - hope it covers 1062 ;; This default is from XEmacs 19.13 - hope it covers
1070 ;; everyone. 1063 ;; everyone.
1071 (list "/usr/X11R6/lib/X11/" 1064 (list "/usr/X11R6/lib/X11/"
1072 "/usr/X11R5/lib/X11/" 1065 "/usr/X11R5/lib/X11/"