annotate src/objects.c @ 2918:a3be0b1ce2f3

[xemacs-hg @ 2005-09-04 21:51:13 by viteno] Update xemacs_extra_name.
author viteno
date Sun, 04 Sep 2005 21:51:13 +0000
parents 6fa9919a9a0b
children 1e7cc382eb16
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Generic Objects and Functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
4 Copyright (C) 1995, 1996, 2002, 2004 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
28 #include "buffer.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
29 #include "device-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "faces.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "frame.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
33 #include "glyphs.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
34 #include "objects-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "specifier.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "window.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
38 #ifdef HAVE_TTY
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
39 #include "console-tty.h"
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
40 #endif
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
41
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /* Objects that are substituted when an instantiation fails.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 If we leave in the Qunbound value, we will probably get crashes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 /* Authors: Ben Wing, Chuck Thompson */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
2268
61855263cb07 [xemacs-hg @ 2004-09-14 14:32:29 by james]
james
parents: 1701
diff changeset
48 DOESNT_RETURN
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 finalose (void *ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
51 Lisp_Object obj = wrap_pointer_1 (ptr);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
52
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
53 invalid_operation
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ("Can't dump an emacs containing window system objects", obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 /****************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 * Color-Instance Object *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ****************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Qcolor_instancep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
64 static const struct memory_description color_instance_data_description_1 []= {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
65 #ifdef HAVE_TTY
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2527
diff changeset
66 { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } },
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
67 #endif
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
68 { XD_END }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
69 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
70
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
71 static const struct sized_memory_description color_instance_data_description = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
72 sizeof (void *), color_instance_data_description_1
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
73 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
74
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
75 static const struct memory_description color_instance_description[] = {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
76 { XD_INT, offsetof (Lisp_Color_Instance, color_instance_type) },
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
77 { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, name)},
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
78 { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, device)},
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
79 { XD_UNION, offsetof (Lisp_Color_Instance, data),
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2527
diff changeset
80 XD_INDIRECT (0, 0), { &color_instance_data_description } },
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
81 {XD_END}
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
82 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
83
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 mark_color_instance (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
87 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 mark_object (c->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 if (!NILP (c->device)) /* Vthe_null_color_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 return c->device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
99 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
101 printing_unreadable_object ("#<color-instance 0x%x>",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 c->header.uid);
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
103 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name);
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
104 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 if (!NILP (c->device)) /* Vthe_null_color_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (c, printcharfun, escapeflag));
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
108 write_fmt_string (printcharfun, " 0x%x>", c->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 finalize_color_instance (void *header, int for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
114 Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 if (!NILP (c->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 if (for_disksave) finalose (c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
126 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
127 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 return (c1 == c2) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (EQ (c1->device, c2->device) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 DEVICEP (c1->device) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
2515
de9952d2ed18 [xemacs-hg @ 2005-01-26 10:22:19 by ben]
ben
parents: 2500
diff changeset
136 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 color_instance_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
139 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
2515
de9952d2ed18 [xemacs-hg @ 2005-01-26 10:22:19 by ben]
ben
parents: 2500
diff changeset
142 return HASH2 ((Hashcode) d,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 !d ? LISP_HASH (obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 LISP_HASH (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
148 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
149 0, /*dumpable-flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
150 mark_color_instance, print_color_instance,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
151 finalize_color_instance, color_instance_equal,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
152 color_instance_hash,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
153 color_instance_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
154 Lisp_Color_Instance);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Return a new `color-instance' object named NAME (a string).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 Optional argument DEVICE specifies the device this object applies to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 and defaults to the selected device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 An error is signaled if the color is unknown or cannot be allocated;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
163 however, if optional argument NOERROR is non-nil, nil is simply
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
164 returned in this case. (And if NOERROR is other than t, a warning may
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 be issued.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 The returned object is a normal, first-class lisp object. The way you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 `deallocate' the color is the way you deallocate any other lisp object:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 you drop all pointers to it and allow it to be garbage collected. When
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 these objects are GCed, the underlying window-system data (e.g. X object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 is deallocated as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
173 (name, device, noerror))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
175 Lisp_Color_Instance *c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 int retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 CHECK_STRING (name);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
179 device = wrap_device (decode_device (device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
181 #ifdef MC_ALLOC
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
182 c = alloc_lrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
183 #else /* not MC_ALLOC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
184 c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
185 #endif /* not MC_ALLOC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 c->name = name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 c->device = device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 c->data = 0;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
189 c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (c, name, device,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
193 decode_error_behavior_flag (noerror)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 if (!retval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
197 return wrap_color_instance (c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 Return non-nil if OBJECT is a color instance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 return COLOR_INSTANCEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 Return the name used to allocate COLOR-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (color_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 CHECK_COLOR_INSTANCE (color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 return XCOLOR_INSTANCE (color_instance)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Return a three element list containing the red, green, and blue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 color components of COLOR-INSTANCE, or nil if unknown.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 Component values range from 0 to 65535.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (color_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
224 Lisp_Color_Instance *c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 CHECK_COLOR_INSTANCE (color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 c = XCOLOR_INSTANCE (color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 if (NILP (c->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 return MAYBE_LISP_DEVMETH (XDEVICE (c->device),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 color_instance_rgb_components,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 DEFUN ("valid-color-name-p", Fvalid_color_name_p, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 Return true if COLOR names a valid color for the current device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 Valid color names for X are listed in the file /usr/lib/X11/rgb.txt, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 whatever the equivalent is on your system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 Valid color names for TTY are those which have an ISO 6429 (ANSI) sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 In addition to being a color this may be one of a number of attributes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 such as `blink'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 (color, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 struct device *d = decode_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 CHECK_STRING (color);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 return MAYBE_INT_DEVMETH (d, valid_color_name_p, (d, color)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
255 DEFUN ("color-list", Fcolor_list, 0, 1, 0, /*
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
256 Return a list of color names.
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
257 DEVICE specifies which device to return names for, and defaults to the
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
258 currently selected device.
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
259 */
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
260 (device))
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
261 {
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
262 device = wrap_device (decode_device (device));
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
263
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
264 return MAYBE_LISP_DEVMETH (XDEVICE (device), color_list, ());
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
265 }
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
266
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 /***************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 * Font-Instance Object *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 ***************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 Lisp_Object Qfont_instancep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 static Lisp_Object font_instance_truename_internal (Lisp_Object xfont,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
275 Error_Behavior errb);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
276
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
277 static const struct memory_description font_instance_data_description_1 []= {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
278 #ifdef HAVE_TTY
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2527
diff changeset
279 { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description} },
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
280 #endif
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
281 { XD_END }
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
282 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
283
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
284 static const struct sized_memory_description font_instance_data_description = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
285 sizeof (void *), font_instance_data_description_1
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
286 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
287
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
288 static const struct memory_description font_instance_description[] = {
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
289 { XD_INT, offsetof (Lisp_Font_Instance, font_instance_type) },
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
290 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, name)},
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
291 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)},
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
292 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)},
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
293 { XD_UNION, offsetof (Lisp_Font_Instance, data),
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2527
diff changeset
294 XD_INDIRECT (0, 0), { &font_instance_data_description } },
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
295 { XD_END }
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
296 };
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
297
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 mark_font_instance (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
302 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 mark_object (f->name);
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
305 mark_object (f->truename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 if (!NILP (f->device)) /* Vthe_null_font_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 return f->device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
315 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
317 printing_unreadable_object ("#<font-instance 0x%x>", f->header.uid);
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
318 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name);
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
319 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 if (!NILP (f->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (f, printcharfun, escapeflag));
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
323 write_fmt_string (printcharfun, " 0x%x>", f->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 finalize_font_instance (void *header, int for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
329 Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 if (!NILP (f->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 if (for_disksave) finalose (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 /* Fonts are equal if they resolve to the same name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 Since we call `font-truename' to do this, and since font-truename is lazy,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 this means the `equal' could cause XListFonts to be run the first time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 /* #### should this be moved into a device method? */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
346 return internal_equal (font_instance_truename_internal
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
347 (obj1, ERROR_ME_DEBUG_WARN),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
348 font_instance_truename_internal
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
349 (obj2, ERROR_ME_DEBUG_WARN),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352
2515
de9952d2ed18 [xemacs-hg @ 2005-01-26 10:22:19 by ben]
ben
parents: 2500
diff changeset
353 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 font_instance_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
356 return internal_hash (font_instance_truename_internal
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
357 (obj, ERROR_ME_DEBUG_WARN),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
361 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
362 0, /*dumpable-flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
363 mark_font_instance, print_font_instance,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
364 finalize_font_instance, font_instance_equal,
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
365 font_instance_hash, font_instance_description,
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
366 Lisp_Font_Instance);
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 874
diff changeset
367
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 Return a new `font-instance' object named NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 DEVICE specifies the device this object applies to and defaults to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 selected device. An error is signalled if the font is unknown or cannot
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 be allocated; however, if NOERROR is non-nil, nil is simply returned in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 this case.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 The returned object is a normal, first-class lisp object. The way you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 `deallocate' the font is the way you deallocate any other lisp object:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 you drop all pointers to it and allow it to be garbage collected. When
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 these objects are GCed, the underlying X data is deallocated as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
381 (name, device, noerror))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
383 Lisp_Font_Instance *f;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 int retval = 0;
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
385 Error_Behavior errb = decode_error_behavior_flag (noerror);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 if (ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 else if (!STRINGP (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
392 device = wrap_device (decode_device (device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
394 #ifdef MC_ALLOC
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
395 f = alloc_lrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
396 #else /* not MC_ALLOC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
397 f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
398 #endif /* not MC_ALLOC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 f->name = name;
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
400 f->truename = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 f->device = device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 f->data = 0;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
404 f->font_instance_type = get_console_variant (XDEVICE_TYPE (f->device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 /* Stick some default values here ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 f->ascent = f->height = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 f->descent = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 f->width = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 f->proportional_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (f, name, device, errb));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 if (!retval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
418 return wrap_font_instance (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 Return non-nil if OBJECT is a font instance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 return FONT_INSTANCEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 Return the name used to allocate FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 return XFONT_INSTANCE (font_instance)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 Return the ascent in pixels of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 The returned value is the maximum ascent for all characters in the font,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 where a character's ascent is the number of pixels above (and including)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 the baseline.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 return make_int (XFONT_INSTANCE (font_instance)->ascent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 DEFUN ("font-instance-descent", Ffont_instance_descent, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 Return the descent in pixels of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 The returned value is the maximum descent for all characters in the font,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 where a character's descent is the number of pixels below the baseline.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 \(Many characters to do not have any descent. Typical characters with a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 descent are lowercase p and lowercase g.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 return make_int (XFONT_INSTANCE (font_instance)->descent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 DEFUN ("font-instance-width", Ffont_instance_width, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 Return the width in pixels of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 The returned value is the average width for all characters in the font.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 return make_int (XFONT_INSTANCE (font_instance)->width);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 Return whether FONT-INSTANCE is proportional.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 This means that different characters in the font have different widths.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 return XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 font_instance_truename_internal (Lisp_Object font_instance,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
485 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
487 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
488
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 if (NILP (f->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
491 maybe_signal_error (Qgui_error, "Couldn't determine font truename",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
492 font_instance, Qfont, errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
495
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 return DEVMETH_OR_GIVEN (XDEVICE (f->device),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 font_instance_truename, (f, errb), f->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 Return the canonical name of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 Font names are patterns which may match any number of fonts, of which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 the first found is used. This returns an unambiguous name for that font
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 \(but not necessarily its only unambiguous name).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 return font_instance_truename_internal (font_instance, ERROR_ME);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 Return the properties (an alist or nil) of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
517 Lisp_Font_Instance *f;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 f = XFONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 if (NILP (f->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 return MAYBE_LISP_DEVMETH (XDEVICE (f->device),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 font_instance_properties, (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
529 DEFUN ("font-list", Ffont_list, 1, 3, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 Return a list of font names matching the given pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 DEVICE specifies which device to search for names, and defaults to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 currently selected device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 */
1701
a1e328407366 [xemacs-hg @ 2003-09-20 01:14:24 by youngs]
youngs
parents: 1204
diff changeset
534 (pattern, device, maxnumber))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 CHECK_STRING (pattern);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
537 device = wrap_device (decode_device (device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
539 return MAYBE_LISP_DEVMETH (XDEVICE (device), font_list, (pattern, device,
1701
a1e328407366 [xemacs-hg @ 2003-09-20 01:14:24 by youngs]
youngs
parents: 1204
diff changeset
540 maxnumber));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 /****************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 Color Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 ***************************************************************************/
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
547
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
548 static const struct memory_description color_specifier_description[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
549 { XD_LISP_OBJECT, offsetof (struct color_specifier, face) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
550 { XD_LISP_OBJECT, offsetof (struct color_specifier, face_property) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
551 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
552 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
553
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
554 DEFINE_SPECIFIER_TYPE_WITH_DATA (color);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 /* Qcolor defined in general.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 color_create (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
560 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 COLOR_SPECIFIER_FACE (color) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 color_mark (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
569 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 mark_object (COLOR_SPECIFIER_FACE (color));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 /* No equal or hash methods; ignore the face the color is based off
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 of for `equal' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2268
diff changeset
579 color_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 Lisp_Object domain, Lisp_Object instantiator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 Lisp_Object depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 /* When called, we're inside of call_with_suspended_errors(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 so we can freely error. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
585 Lisp_Object device = DOMAIN_DEVICE (domain);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 struct device *d = XDEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 if (COLOR_INSTANCEP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 /* If we are on the same device then we're done. Otherwise change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 the instantiator to the name used to generate the pixel and let the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 STRINGP case deal with it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 if (NILP (device) /* Vthe_null_color_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 || EQ (device, XCOLOR_INSTANCE (instantiator)->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 return instantiator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 instantiator = Fcolor_instance_name (instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 if (STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 /* First, look to see if we can retrieve a cached value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 Lisp_Object instance =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 Fgethash (instantiator, d->color_instance_cache, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 /* Otherwise, make a new one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 if (UNBOUNDP (instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 /* make sure we cache the failures, too. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 instance = Fmake_color_instance (instantiator, device, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 Fputhash (instantiator, instance, d->color_instance_cache);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 return NILP (instance) ? Qunbound : instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 else if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 switch (XVECTOR_LENGTH (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 case 0:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 if (DEVICE_TTY_P (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 return Vthe_null_color_instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
623 gui_error ("Color instantiator [] only valid on TTY's",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 case 1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier))))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
628 gui_error ("Color specifier not attached to a face",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 return (FACE_PROPERTY_INSTANCE_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (Fget_face (XVECTOR_DATA (instantiator)[0]),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 domain, ERROR_ME, 0, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 case 2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 return (FACE_PROPERTY_INSTANCE_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (Fget_face (XVECTOR_DATA (instantiator)[0]),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, 0, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 default:
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
641 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 else if (NILP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 if (DEVICE_TTY_P (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 return Vthe_null_color_instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
649 gui_error ("Color instantiator [] only valid on TTY's",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
653 ABORT (); /* The spec validation routines are screwed up. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 color_validate (Lisp_Object instantiator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 if (XVECTOR_LENGTH (instantiator) > 2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
666 sferror ("Inheritance vector must be of size 0 - 2",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 else if (XVECTOR_LENGTH (instantiator) > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 Fget_face (face);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 if (XVECTOR_LENGTH (instantiator) == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 if (!EQ (field, Qforeground) && !EQ (field, Qbackground))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
677 invalid_constant
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 ("Inheritance field must be `foreground' or `background'",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 field);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
684 invalid_argument ("Invalid color instantiator", instantiator);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 color_after_change (Lisp_Object specifier, Lisp_Object locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 Lisp_Object face = COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 Lisp_Object property =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 if (!NILP (face))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
694 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
695 face_property_was_changed (face, property, locale);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
696 if (BUFFERP (locale))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
697 XBUFFER (locale)->buffer_local_face_property = 1;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
698 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
704 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 COLOR_SPECIFIER_FACE (color) = face;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 COLOR_SPECIFIER_FACE_PROPERTY (color) = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 Return t if OBJECT is a color specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
713 See `make-color-specifier' for a description of possible color instantiators.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 return COLOR_SPECIFIERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 /****************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 Font Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 ***************************************************************************/
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
724
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
725 static const struct memory_description font_specifier_description[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
726 { XD_LISP_OBJECT, offsetof (struct font_specifier, face) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
727 { XD_LISP_OBJECT, offsetof (struct font_specifier, face_property) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
728 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
729 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
730
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
731 DEFINE_SPECIFIER_TYPE_WITH_DATA (font);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 /* Qfont defined in general.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 font_create (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
737 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 FONT_SPECIFIER_FACE (font) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 font_mark (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
746 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 mark_object (FONT_SPECIFIER_FACE (font));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 mark_object (FONT_SPECIFIER_FACE_PROPERTY (font));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 /* No equal or hash methods; ignore the face the font is based off
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 of for `equal' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
757 /* Given a truename font spec (i.e. the font spec should have its registry
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
758 field filled in), does it support displaying characters from CHARSET? */
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
759
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
760 static int
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 font_spec_matches_charset (struct device *d, Lisp_Object charset,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 800
diff changeset
762 const Ibyte *nonreloc, Lisp_Object reloc,
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
763 Bytecount offset, Bytecount length,
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
764 int stage)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
767 (d, charset, nonreloc, reloc, offset, length,
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
768 stage),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 font_validate_matchspec (Lisp_Object matchspec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 {
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
775 CHECK_CONS (matchspec);
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
776 Fget_charset (XCAR (matchspec));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
779 void
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
780 initialize_charset_font_caches (struct device *d)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
781 {
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
782 /* Note that the following tables are bi-level. */
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
783 d->charset_font_cache_stage_1 =
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
784 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
785 d->charset_font_cache_stage_2 =
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
786 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
787 }
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
788
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
789 void
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
790 invalidate_charset_font_caches (Lisp_Object charset)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
791 {
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
792 /* Invalidate font cache entries for charset on all devices. */
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
793 Lisp_Object devcons, concons, hash_table;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
794 DEVICE_LOOP_NO_BREAK (devcons, concons)
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
795 {
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
796 struct device *d = XDEVICE (XCAR (devcons));
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
797 hash_table = Fgethash (charset, d->charset_font_cache_stage_1,
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
798 Qunbound);
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
799 if (!UNBOUNDP (hash_table))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
800 Fclrhash (hash_table);
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
801 hash_table = Fgethash (charset, d->charset_font_cache_stage_2,
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
802 Qunbound);
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
803 if (!UNBOUNDP (hash_table))
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
804 Fclrhash (hash_table);
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
805 }
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
806 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807
874
d4ba25667ff4 [xemacs-hg @ 2002-06-22 17:14:43 by michaels]
michaels
parents: 872
diff changeset
808 #endif /* MULE */
d4ba25667ff4 [xemacs-hg @ 2002-06-22 17:14:43 by michaels]
michaels
parents: 872
diff changeset
809
d4ba25667ff4 [xemacs-hg @ 2002-06-22 17:14:43 by michaels]
michaels
parents: 872
diff changeset
810
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 static Lisp_Object
2333
ba4677f54a05 [xemacs-hg @ 2004-10-14 17:26:18 by james]
james
parents: 2286
diff changeset
812 font_instantiate (Lisp_Object UNUSED (specifier),
ba4677f54a05 [xemacs-hg @ 2004-10-14 17:26:18 by james]
james
parents: 2286
diff changeset
813 Lisp_Object USED_IF_MULE (matchspec),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 Lisp_Object domain, Lisp_Object instantiator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 Lisp_Object depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 /* When called, we're inside of call_with_suspended_errors(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 so we can freely error. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
819 Lisp_Object device = DOMAIN_DEVICE (domain);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 struct device *d = XDEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 Lisp_Object instance;
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
822 Lisp_Object charset = Qnil;
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
823 #ifdef MULE
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
824 int stage = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 if (!UNBOUNDP (matchspec))
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
827 {
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
828 charset = Fget_charset (XCAR (matchspec));
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
829 stage = NILP (XCDR (matchspec)) ? 0 : 1;
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
830 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 if (FONT_INSTANCEP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 if (NILP (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 || EQ (device, XFONT_INSTANCE (instantiator)->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 #ifdef MULE
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
839 if (font_spec_matches_charset (d, charset, 0,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 Ffont_instance_truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (instantiator),
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
842 0, -1, stage))
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
843 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 return instantiator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 instantiator = Ffont_instance_name (instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 if (STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 {
874
d4ba25667ff4 [xemacs-hg @ 2002-06-22 17:14:43 by michaels]
michaels
parents: 872
diff changeset
851 #ifdef MULE
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
852 Lisp_Object cache = stage ? d->charset_font_cache_stage_2 :
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
853 d->charset_font_cache_stage_1;
874
d4ba25667ff4 [xemacs-hg @ 2002-06-22 17:14:43 by michaels]
michaels
parents: 872
diff changeset
854 #else
d4ba25667ff4 [xemacs-hg @ 2002-06-22 17:14:43 by michaels]
michaels
parents: 872
diff changeset
855 Lisp_Object cache = d->font_instance_cache;
d4ba25667ff4 [xemacs-hg @ 2002-06-22 17:14:43 by michaels]
michaels
parents: 872
diff changeset
856 #endif
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
857
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 #ifdef MULE
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
859 if (!NILP (charset))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 /* The instantiator is a font spec that could match many
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 different fonts. We need to find one of those fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 whose registry matches the registry of the charset in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 MATCHSPEC. This is potentially a very slow operation,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 as it involves doing an XListFonts() or equivalent to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 iterate over all possible fonts, and a regexp match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 on each one. So we cache the results. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 Lisp_Object matching_font = Qunbound;
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
869 Lisp_Object hash_table = Fgethash (charset, cache, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 if (UNBOUNDP (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 /* need to make a sub hash table. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 HASH_TABLE_EQUAL);
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
875 Fputhash (charset, hash_table, cache);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 matching_font = Fgethash (instantiator, hash_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 if (UNBOUNDP (matching_font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 /* make sure we cache the failures, too. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 matching_font =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 DEVMETH_OR_GIVEN (d, find_charset_font,
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
885 (device, instantiator, charset, stage),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 Fputhash (instantiator, matching_font, hash_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 if (NILP (matching_font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 instantiator = matching_font;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 /* First, look to see if we can retrieve a cached value. */
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
896 instance = Fgethash (instantiator, cache, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 /* Otherwise, make a new one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 if (UNBOUNDP (instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 /* make sure we cache the failures, too. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 instance = Fmake_font_instance (instantiator, device, Qt);
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
902 Fputhash (instantiator, instance, cache);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 return NILP (instance) ? Qunbound : instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 else if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 assert (XVECTOR_LENGTH (instantiator) == 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 return (face_property_matching_instance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
912 charset, domain, ERROR_ME, 0, depth));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 else if (NILP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
917 ABORT (); /* Eh? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 font_validate (Lisp_Object instantiator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 if (XVECTOR_LENGTH (instantiator) != 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
931 sferror
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 ("Vector length must be one for font inheritance", instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 Fget_face (XVECTOR_DATA (instantiator)[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
937 invalid_argument ("Must be string, vector, or font-instance",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 font_after_change (Lisp_Object specifier, Lisp_Object locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 Lisp_Object face = FONT_SPECIFIER_FACE (XFONT_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 Lisp_Object property =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 if (!NILP (face))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
948 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
949 face_property_was_changed (face, property, locale);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
950 if (BUFFERP (locale))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
951 XBUFFER (locale)->buffer_local_face_property = 1;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
952 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
958 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 FONT_SPECIFIER_FACE (font) = face;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 FONT_SPECIFIER_FACE_PROPERTY (font) = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 Return non-nil if OBJECT is a font specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
967 See `make-font-specifier' for a description of possible font instantiators.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 return FONT_SPECIFIERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 /*****************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 Face Boolean Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 ****************************************************************************/
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
978
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
979 static const struct memory_description face_boolean_specifier_description[] = {
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
980 { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
981 { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face_property) },
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
982 { XD_END }
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
983 };
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
984
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 934
diff changeset
985 DEFINE_SPECIFIER_TYPE_WITH_DATA (face_boolean);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 Lisp_Object Qface_boolean;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 face_boolean_create (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
991 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 face_boolean_mark (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1000 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 /* No equal or hash methods; ignore the face the face-boolean is based off
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 of for `equal' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 static Lisp_Object
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2268
diff changeset
1010 face_boolean_instantiate (Lisp_Object specifier,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2268
diff changeset
1011 Lisp_Object UNUSED (matchspec),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 Lisp_Object domain, Lisp_Object instantiator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 Lisp_Object depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 /* When called, we're inside of call_with_suspended_errors(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 so we can freely error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 if (NILP (instantiator) || EQ (instantiator, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 return instantiator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 else if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 Lisp_Object prop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 int instantiator_len = XVECTOR_LENGTH (instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 assert (instantiator_len >= 1 && instantiator_len <= 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 if (instantiator_len > 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 prop = XVECTOR_DATA (instantiator)[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 if (NILP (FACE_BOOLEAN_SPECIFIER_FACE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 (XFACE_BOOLEAN_SPECIFIER (specifier))))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1032 gui_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 ("Face-boolean specifier not attached to a face", instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 (XFACE_BOOLEAN_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 retval = (FACE_PROPERTY_INSTANCE_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (Fget_face (XVECTOR_DATA (instantiator)[0]),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 prop, domain, ERROR_ME, 0, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 retval = NILP (retval) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
1048 ABORT (); /* Eh? */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 face_boolean_validate (Lisp_Object instantiator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 if (NILP (instantiator) || EQ (instantiator, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 else if (VECTORP (instantiator) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 (XVECTOR_LENGTH (instantiator) >= 1 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 XVECTOR_LENGTH (instantiator) <= 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 Fget_face (face);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 if (XVECTOR_LENGTH (instantiator) > 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 if (!EQ (field, Qunderline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 && !EQ (field, Qstrikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 && !EQ (field, Qhighlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 && !EQ (field, Qdim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 && !EQ (field, Qblinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 && !EQ (field, Qreverse))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1075 invalid_constant ("Invalid face-boolean inheritance field",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 field);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 else if (VECTORP (instantiator))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1080 sferror ("Wrong length for face-boolean inheritance spec",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1083 invalid_argument ("Face-boolean instantiator must be nil, t, or vector",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 face_boolean_after_change (Lisp_Object specifier, Lisp_Object locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 Lisp_Object face =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 FACE_BOOLEAN_SPECIFIER_FACE (XFACE_BOOLEAN_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 Lisp_Object property =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 if (!NILP (face))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
1095 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
1096 face_property_was_changed (face, property, locale);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
1097 if (BUFFERP (locale))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
1098 XBUFFER (locale)->buffer_local_face_property = 1;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
1099 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1106 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 Return non-nil if OBJECT is a face-boolean specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1115 See `make-face-boolean-specifier' for a description of possible
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1116 face-boolean instantiators.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 syms_of_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1131 INIT_LRECORD_IMPLEMENTATION (color_instance);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1132 INIT_LRECORD_IMPLEMENTATION (font_instance);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1133
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 DEFSUBR (Fcolor_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 DEFSUBR (Ffont_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 DEFSUBR (Fface_boolean_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1138 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 DEFSUBR (Fmake_color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 DEFSUBR (Fcolor_instance_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 DEFSUBR (Fcolor_instance_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 DEFSUBR (Fcolor_instance_rgb_components);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 DEFSUBR (Fvalid_color_name_p);
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
1144 DEFSUBR (Fcolor_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1146 DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 DEFSUBR (Fmake_font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 DEFSUBR (Ffont_instance_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 DEFSUBR (Ffont_instance_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 DEFSUBR (Ffont_instance_ascent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 DEFSUBR (Ffont_instance_descent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 DEFSUBR (Ffont_instance_width);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 DEFSUBR (Ffont_instance_proportional_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 DEFSUBR (Ffont_instance_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 DEFSUBR (Ffont_instance_properties);
2527
491f8cf78a9c [xemacs-hg @ 2005-01-28 02:58:38 by ben]
ben
parents: 2515
diff changeset
1156 DEFSUBR (Ffont_list);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 /* Qcolor, Qfont defined in general.c */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1159 DEFSYMBOL (Qface_boolean);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 specifier_type_create_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 "face-boolean-specifier-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 SPECIFIER_HAS_METHOD (color, instantiate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 SPECIFIER_HAS_METHOD (font, instantiate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 SPECIFIER_HAS_METHOD (face_boolean, instantiate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 SPECIFIER_HAS_METHOD (color, validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 SPECIFIER_HAS_METHOD (font, validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 SPECIFIER_HAS_METHOD (face_boolean, validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 SPECIFIER_HAS_METHOD (color, create);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 SPECIFIER_HAS_METHOD (font, create);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 SPECIFIER_HAS_METHOD (face_boolean, create);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 SPECIFIER_HAS_METHOD (color, mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 SPECIFIER_HAS_METHOD (font, mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 SPECIFIER_HAS_METHOD (face_boolean, mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 SPECIFIER_HAS_METHOD (color, after_change);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 SPECIFIER_HAS_METHOD (font, after_change);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 SPECIFIER_HAS_METHOD (face_boolean, after_change);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 SPECIFIER_HAS_METHOD (font, validate_matchspec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 reinit_specifier_type_create_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 REINITIALIZE_SPECIFIER_TYPE (color);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 REINITIALIZE_SPECIFIER_TYPE (font);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 REINITIALIZE_SPECIFIER_TYPE (face_boolean);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 reinit_vars_of_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 staticpro_nodump (&Vthe_null_color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1208 Lisp_Color_Instance *c =
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1209 #ifdef MC_ALLOC
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1210 alloc_lrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1211 #else /* not MC_ALLOC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1212 alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1213 #endif /* not MC_ALLOC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 c->name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 c->device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 c->data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1218 Vthe_null_color_instance = wrap_color_instance (c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 staticpro_nodump (&Vthe_null_font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1223 Lisp_Font_Instance *f =
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1224 #ifdef MC_ALLOC
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1225 alloc_lrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1226 #else /* not MC_ALLOC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1227 alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 2551
diff changeset
1228 #endif /* not MC_ALLOC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 f->name = Qnil;
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
1230 f->truename = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 f->device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 f->data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 f->ascent = f->height = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 f->descent = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 f->width = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 f->proportional_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1239 Vthe_null_font_instance = wrap_font_instance (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 vars_of_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 }