Mercurial > hg > xemacs-beta

comparison lisp/gtk-font-menu.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 13a418960a88
children b4f4e0cc90f1
comparison
equal deleted inserted replaced
2526:902d5bd9b75c 2527:491f8cf78a9c
88 `create-device-hook' and that will make the font menus respond more quickly 88 `create-device-hook' and that will make the font menus respond more quickly
89 when they are selected for the first time. If you add fonts to your system, 89 when they are selected for the first time. If you add fonts to your system,
90 or if you change your font path, you can call this to re-initialize the menus." 90 or if you change your font path, you can call this to re-initialize the menus."
91 ;; by Stig@hackvan.com 91 ;; by Stig@hackvan.com
92 ;; #### - this should implement a `menus-only' option, which would 92 ;; #### - this should implement a `menus-only' option, which would
93 ;; recalculate the menus from the cache w/o having to do list-fonts again. 93 ;; recalculate the menus from the cache w/o having to do font-list again.
94 (unless gtk-font-regexp-ascii 94 (unless gtk-font-regexp-ascii
95 (setq gtk-font-regexp-ascii (if (featurep 'mule) 95 (setq gtk-font-regexp-ascii (if (featurep 'mule)
96 (declare-fboundp 96 (declare-fboundp
97 (charset-registry 'ascii)) 97 (charset-registry 'ascii))
98 "iso8859-1"))) 98 "iso8859-1")))
100 (if (featurep 'mule) "*-*" "iso8859-1")) 100 (if (featurep 'mule) "*-*" "iso8859-1"))
101 (let ((case-fold-search t) 101 (let ((case-fold-search t)
102 family size weight entry monospaced-p 102 family size weight entry monospaced-p
103 dev-cache cache families sizes weights) 103 dev-cache cache families sizes weights)
104 (dolist (name (cond ((null debug) ; debugging kludge 104 (dolist (name (cond ((null debug) ; debugging kludge
105 (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device)) 105 (font-list "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device))
106 ((stringp debug) (split-string debug "\n")) 106 ((stringp debug) (split-string debug "\n"))
107 (t debug))) 107 (t debug)))
108 (when (and (string-match gtk-font-regexp-ascii name) 108 (when (and (string-match gtk-font-regexp-ascii name)
109 (string-match gtk-font-regexp name)) 109 (string-match gtk-font-regexp name))
110 (setq weight (capitalize (match-string 1 name)) 110 (setq weight (capitalize (match-string 1 name))