annotate lisp/gtk-faces.el @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 5be46355cc42
children 79940b592197
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1 ;;; gtk-faces.el --- GTK-specific face frobnication, aka black magic.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995, 1996 Ben Wing.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
5 ;; Copyright (c) 2000 William Perry
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
6
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
7 ;; Author: William M. Perry <wmperry@gnu.org>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
8 ;; Maintainer: XEmacs Development Team
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
9 ;; Keywords: extensions, internal, dumped
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
10
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
11 ;; This file is part of XEmacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
12
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
13 ;; XEmacs is free software; you can redistribute it and/or modify it
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
16 ;; any later version.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
17
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 ;; XEmacs is distributed in the hope that it will be useful, but
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 ;; General Public License for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 ;; Boston, MA 02111-1307, USA.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28 ;;; Synched up with: Not synched.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30 ;;; Commentary:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 ;; This file is dumped with XEmacs (when GTK support is compiled in).
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
34 (globally-declare-fboundp
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
35 '(gtk-init-pointers
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
36 gtk-font-selection-dialog-new
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
37 gtk-widget-set-sensitive gtk-font-selection-dialog-apply-button
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
38 gtk-signal-connect gtk-main-quit
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
39 gtk-font-selection-dialog-ok-button
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
40 gtk-font-selection-dialog-get-font-name gtk-widget-destroy
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
41 font-menu-set-font font-family font-size
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 462
diff changeset
42 gtk-font-selection-dialog-cancel-button gtk-widget-show-all
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 711
diff changeset
43 gtk-main gtk-style-info))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
45 (eval-when-compile
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
46 (defmacro gtk-style-munge-face (face attribute value)
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
47 (let ((func (intern (format "face-%s" (eval attribute)))))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
48 `(add-spec-to-specifier (,func ,face) ,value nil '(gtk default) 'prepend))))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 ;;; gtk-init-device-faces is responsible for initializing default
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 ;;; values for faces on a newly created device.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 ;;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 (defun gtk-init-device-faces (device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 ;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 ;; If the "default" face didn't have a font specified, try to pick one.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 ;;
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
57 (when (eq (device-type device) 'gtk)
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 706
diff changeset
58 (let* ((style (gtk-style-info device))
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
59 (normal 0) ; GTK_STATE_NORMAL
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 ;;(active 1) ; GTK_STATE_ACTIVE
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 (prelight 2) ; GTK_STATE_PRELIGHT
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 (selected 3) ; GTK_STATE_SELECTED
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 ;;(insensitive 4) ; GTK_STATE_INSENSITIVE
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 )
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
65 (gtk-style-munge-face 'highlight 'foreground
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
66 (nth prelight (plist-get style 'text)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
67 (gtk-style-munge-face 'highlight 'background
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
68 (nth prelight (plist-get style 'background)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
69 (gtk-style-munge-face 'zmacs-region 'foreground
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
70 (nth selected (plist-get style 'text)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
71 (gtk-style-munge-face 'zmacs-region 'background
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
72 (nth selected (plist-get style 'background)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
73 (gtk-style-munge-face 'toolbar 'background
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
74 (nth normal (plist-get style 'base)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
75 (gtk-style-munge-face 'toolbar 'foreground
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
76 (nth normal (plist-get style 'text)))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
77 (set-face-background 'modeline [toolbar background] '(gtk default))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
78 (set-face-foreground 'modeline [toolbar foreground] '(gtk default))
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
79 )
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
80 (gtk-init-pointers)))
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 ;;; This is called from `init-frame-faces', which is called from
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 ;;; init_frame_faces() which is called from Fmake_frame(), to perform
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84 ;;; any device-specific initialization.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 ;;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 (defun gtk-init-frame-faces (frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 )
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 ;;; gtk-init-global-faces is responsible for ensuring that the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 ;;; default face has some reasonable fallbacks if nothing else is
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91 ;;; specified.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92 ;;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
93 (defun gtk-init-global-faces ()
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
94 (let* ((dev nil)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 (default-font (or (face-font 'default 'global)
711
5be46355cc42 [xemacs-hg @ 2001-12-23 01:01:45 by wmperry]
wmperry
parents: 707
diff changeset
96 ;;(plist-get (gtk-style-info dev) 'font)
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 (italic-font (or (gtk-make-font-italic default-font dev) default-font))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 (bold-font (or (gtk-make-font-bold default-font dev) default-font))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 (bi-font (or (gtk-make-font-bold-italic default-font dev) default-font)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102 (or (face-font 'default 'global)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 (set-face-font 'default default-font 'global '(gtk default)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105 (or (face-font 'bold 'global)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 (set-face-font 'bold bold-font 'global '(gtk default)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 (or (face-font 'bold-italic 'global)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109 (set-face-font 'bold-italic bi-font 'global '(gtk default)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 (or (face-font 'italic 'global)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 (set-face-font 'italic italic-font 'global '(gtk default)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 ;;; Lots of this stolen from x-faces.el - I'm not sure if this will
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 ;;; require a rewrite for win32 or not?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 (defconst gtk-font-regexp nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118 (defconst gtk-font-regexp-head nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 (defconst gtk-font-regexp-head-2 nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120 (defconst gtk-font-regexp-weight nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121 (defconst gtk-font-regexp-slant nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122 (defconst gtk-font-regexp-pixel nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 (defconst gtk-font-regexp-point nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 (defconst gtk-font-regexp-foundry-and-family nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125 (defconst gtk-font-regexp-registry-and-encoding nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126 (defconst gtk-font-regexp-spacing nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 ;;; Regexps matching font names in "Host Portable Character Representation."
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 ;;;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130 (let ((- "[-?]")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 (foundry "[^-]*")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132 (family "[^-]*")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 (weight "\\(bold\\|demibold\\|medium\\|black\\)") ; 1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134 ; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 (weight\? "\\([^-]*\\)") ; 1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 (slant "\\([ior]\\)") ; 2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137 ; (slant\? "\\([ior?*]?\\)") ; 2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 (slant\? "\\([^-]?\\)") ; 2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 ; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140 (swidth "\\([^-]*\\)") ; 3
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141 ; (adstyle "\\(\\*\\|sans\\|\\)") ; 4
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142 (adstyle "\\([^-]*\\)") ; 4
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 (pixelsize "\\(\\*\\|[0-9]+\\)") ; 5
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") ; 6
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 ; (resx "\\(\\*\\|[0-9][0-9]+\\)") ; 7
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 ; (resy "\\(\\*\\|[0-9][0-9]+\\)") ; 8
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 (resx "\\([*0]\\|[0-9][0-9]+\\)") ; 7
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148 (resy "\\([*0]\\|[0-9][0-9]+\\)") ; 8
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 (spacing "[cmp?*]")
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 (avgwidth "\\(\\*\\|[0-9]+\\)") ; 9
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151 (registry "[^-]*") ; some fonts have omitted registries
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 ; (encoding ".+") ; note that encoding may contain "-"...
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 (encoding "[^-]+") ; false!
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154 )
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155 (setq gtk-font-regexp
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 (purecopy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
157 (concat "\\`\\*?[-?*]"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 foundry - family - weight\? - slant\? - swidth - adstyle -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159 pixelsize - pointsize - resx - resy - spacing - avgwidth -
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 registry - encoding "\\'"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 )))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162 (setq gtk-font-regexp-head
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 (purecopy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165 "\\([-*?]\\|\\'\\)")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 (setq gtk-font-regexp-head-2
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167 (purecopy
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168 (concat "\\`[-?*]" foundry - family - weight\? - slant\?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 - swidth - adstyle - pixelsize - pointsize
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 "\\([-*?]\\|\\'\\)")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171 (setq gtk-font-regexp-slant (purecopy (concat - slant -)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 (setq gtk-font-regexp-weight (purecopy (concat - weight -)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 ;; if we can't match any of the more specific regexps (unfortunate) then
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 ;; is pixels. Bogus as hell.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176 (setq gtk-font-regexp-pixel (purecopy "[-?*]\\([0-9][0-9]?\\)[-?*]"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 (setq gtk-font-regexp-point (purecopy "[-?*]\\([0-9][0-9]+\\)[-?*]"))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 ;; the following two are used by x-font-menu.el.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179 (setq gtk-font-regexp-foundry-and-family
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 (purecopy (concat "\\`[-?*]" foundry - "\\(" family "\\)" -)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 (setq gtk-font-regexp-registry-and-encoding
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 (purecopy (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 (setq gtk-font-regexp-spacing
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 (purecopy (concat - "\\(" spacing "\\)" - avgwidth
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 - registry - encoding "\\'")))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186 )
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188 (defvaralias 'x-font-regexp 'gtk-font-regexp)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189 (defvaralias 'x-font-regexp-head 'gtk-font-regexp-head)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190 (defvaralias 'x-font-regexp-head-2 'gtk-font-regexp-head-2)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191 (defvaralias 'x-font-regexp-weight 'gtk-font-regexp-weight)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192 (defvaralias 'x-font-regexp-slant 'gtk-font-regexp-slant)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193 (defvaralias 'x-font-regexp-pixel 'gtk-font-regexp-pixel)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194 (defvaralias 'x-font-regexp-point 'gtk-font-regexp-point)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195 (defvaralias 'x-font-regexp-foundry-and-family 'gtk-font-regexp-foundry-and-family)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
196 (defvaralias 'x-font-regexp-registry-and-encoding 'gtk-font-regexp-registry-and-encoding)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
197 (defvaralias 'x-font-regexp-spacing 'gtk-font-regexp-spacing)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
199 (defun gtk-frob-font-weight (font which)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 (if (font-instance-p font) (setq font (font-instance-name font)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 (cond ((null font) nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202 ((or (string-match gtk-font-regexp font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
203 (string-match gtk-font-regexp-head font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
204 (string-match gtk-font-regexp-weight font))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 (concat (substring font 0 (match-beginning 1)) which
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206 (substring font (match-end 1))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
207 (t nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209 (defun gtk-frob-font-slant (font which)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210 (if (font-instance-p font) (setq font (font-instance-name font)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211 (cond ((null font) nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 ((or (string-match gtk-font-regexp font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 (string-match gtk-font-regexp-head font))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
214 (concat (substring font 0 (match-beginning 2)) which
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
215 (substring font (match-end 2))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
216 ((string-match gtk-font-regexp-slant font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
217 (concat (substring font 0 (match-beginning 1)) which
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
218 (substring font (match-end 1))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
219 (t nil)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
220
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
221 (defun gtk-make-font-bold (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
222 (or (try-font-name (gtk-frob-font-weight font "bold") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
223 (try-font-name (gtk-frob-font-weight font "black") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
224 (try-font-name (gtk-frob-font-weight font "demibold") device)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
225
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226 (defun gtk-make-font-unbold (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
227 (try-font-name (gtk-frob-font-weight font "medium") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
228
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 (defcustom *try-oblique-before-italic-fonts* t
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230 "*If nil, italic fonts are searched before oblique fonts.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
231 If non-nil, oblique fonts are tried before italic fonts. This is mostly
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 applicable to adobe-courier fonts"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233 :type 'boolean
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234 :tag "Try Oblique Before Italic Fonts"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235 :group 'x)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237 (defun gtk-make-font-italic (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238 (if *try-oblique-before-italic-fonts*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
239 (or (try-font-name (gtk-frob-font-slant font "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
240 (try-font-name (gtk-frob-font-slant font "i") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
241 (or (try-font-name (gtk-frob-font-slant font "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
242 (try-font-name (gtk-frob-font-slant font "o") device))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
243
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244 (defun gtk-make-font-unitalic (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
245 (try-font-name (gtk-frob-font-slant font "r") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
246
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247 (defun gtk-make-font-bold-italic (font &optional device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
248 (if *try-oblique-before-italic-fonts*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249 (or (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
255 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
256 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
257 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
258 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "i") device))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261 (or (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
264 (gtk-frob-font-slant (gtk-frob-font-weight font "bold") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
265 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268 (gtk-frob-font-slant (gtk-frob-font-weight font "black") "o") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "i") device)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
271 (try-font-name
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
272 (gtk-frob-font-slant (gtk-frob-font-weight font "demibold") "o") device))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
273
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274 (defun gtk-choose-font ()
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275 (interactive)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276 (require 'x-font-menu)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 (require 'font)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 (let ((locale (if font-menu-this-frame-only-p
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 (selected-frame)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280 nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281 (dialog nil))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282 (setq dialog (gtk-font-selection-dialog-new "Choose default font..."))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
283 (put dialog 'modal t)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
284 (put dialog 'type 'dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
285
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
286 (gtk-widget-set-sensitive (gtk-font-selection-dialog-apply-button dialog) nil)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
287 (gtk-signal-connect dialog 'destroy (lambda (&rest ignored) (gtk-main-quit)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
288 (gtk-signal-connect (gtk-font-selection-dialog-ok-button dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
289 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
290 (lambda (button data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
291 (let* ((dialog (car data))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
292 (font (font-create-object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
293 (gtk-font-selection-dialog-get-font-name dialog))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
294 (gtk-widget-destroy dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
295 (font-menu-set-font (car (font-family font)) nil (* 10 (font-size font)))))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
296 (cons dialog locale))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
297 (gtk-signal-connect (gtk-font-selection-dialog-cancel-button dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
298 'clicked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
299 (lambda (button dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
300 (gtk-widget-destroy dialog)) dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
301
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
302 (gtk-widget-show-all dialog)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
303 (gtk-main)))