annotate src/objects.c @ 844:047d37eb70d7

[xemacs-hg @ 2002-05-16 13:30:23 by ben] ui fixes for things that were bothering me bytecode.c, editfns.c, lisp.h, lread.c: Fix save-restriction to use markers rather than pseudo-markers (integers representing the amount of text on either side of the region). That way, all inserts are handled correctly, not just those inside old restriction. Add buffer argument to save_restriction_save(). process.c: Clean up very dirty and kludgy code that outputs into a buffer -- use proper unwind protects, etc. font-lock.c: Do save-restriction/widen around the function -- otherwise, incorrect results will ensue when a buffer has been narrowed before a call to e.g. `buffer-syntactic-context' -- something that happens quite often. fileio.c: Look for a handler for make-temp-name. window.c, winslots.h: Try to solve this annoying problem: have two frames displaying the buffer, in different places; in one, temporarily switch away to another buffer and then back -- and you've lost your position; it's reset to the other one in the other frame. My current solution involves window-level caches of buffers and points (also a cache for window-start); when set-window-buffer is called, it looks to see if the buffer was previously visited in the window, and if so, uses the most recent point at that time. (It's a marker, so it handles changes.) #### Note: It could be argued that doing it on the frame level would be better -- e.g. if you visit a buffer temporarily through a grep, and then go back to that buffer, you presumably want the grep's position rather than some previous position provided everything was in the same frame, even though the grep was in another window in the frame. However, doing it on the frame level fails when you have two windows on the same frame. Perhaps we keep both a window and a frame cache, and use the frame cache if there are no other windows on the frame showing the buffer, else the window's cache? This is probably something to be configurable using a specifier. Suggestions please please please? window.c: Clean up a bit code that deals with the annoyance of window-point vs. point. dialog.el: Function to ask a multiple-choice question, automatically choosing a dialog box or minibuffer representation as necessary. Generalized version of yes-or-no-p, y-or-n-p. files.el: Use get-user-response to ask "yes/no/diff" question when recovering. "diff" means that a diff is displayed between the current file and the autosave. (Converts/deconverts escape-quoted as necessary. No more complaints from you, Mr. Turnbull!) One known problem: when a dialog is used, it's modal, so you can't scroll the diff. Will fix soon. lisp-mode.el: If we're filling a string, don't treat semicolon as a comment, which would give very unfriendly results. Uses `buffer-syntactic-context'. simple.el: all changes back to the beginning. (Useful if you've saved the file in the middle of the changes.) simple.el: Add option kill-word-into-kill-ring, which controls whether words deleted with kill-word, backward-kill-word, etc. are "cut" into the kill ring, or "cleared" into nothingness. (My preference is the latter, by far. I'd almost go so far as suggesting we make it the default, as you can always select a word and then cut it if you want it cut.) menubar-items.el: Add option corresponding to kill-word-into-kill-ring.
author ben
date Thu, 16 May 2002 13:30:58 +0000
parents a5954632b187
children 804517e16990
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.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4 Copyright (C) 1995, 1996, 2002 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"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "device.h"
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"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "objects.h"
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 /* Objects that are substituted when an instantiation fails.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 If we leave in the Qunbound value, we will probably get crashes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /* Authors: Ben Wing, Chuck Thompson */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 finalose (void *ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
47 Lisp_Object obj = wrap_pointer_1 (ptr);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
48
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
50 invalid_operation
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ("Can't dump an emacs containing window system objects", obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
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 * Color-Instance Object *
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 Lisp_Object Qcolor_instancep;
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 mark_color_instance (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
64 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 mark_object (c->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 if (!NILP (c->device)) /* Vthe_null_color_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 return c->device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
76 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
78 printing_unreadable_object ("#<color-instance 0x%x>",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 c->header.uid);
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
80 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
81 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 if (!NILP (c->device)) /* Vthe_null_color_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (c, printcharfun, escapeflag));
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
85 write_fmt_string (printcharfun, " 0x%x>", c->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 finalize_color_instance (void *header, int for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
91 Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 if (!NILP (c->device))
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 if (for_disksave) finalose (c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
103 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
104 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 return (c1 == c2) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (EQ (c1->device, c2->device) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 DEVICEP (c1->device) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 static unsigned long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 color_instance_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
116 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 return HASH2 ((unsigned long) d,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 !d ? LISP_HASH (obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 LISP_HASH (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 mark_color_instance, print_color_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 finalize_color_instance, color_instance_equal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 color_instance_hash, 0,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
129 Lisp_Color_Instance);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Return a new `color-instance' object named NAME (a string).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 Optional argument DEVICE specifies the device this object applies to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 and defaults to the selected device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 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
138 however, if optional argument NOERROR is non-nil, nil is simply
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
139 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
140 be issued.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 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
143 `deallocate' the color is the way you deallocate any other lisp object:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 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
145 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
146 is deallocated as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
148 (name, device, noerror))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
150 Lisp_Color_Instance *c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 int retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 CHECK_STRING (name);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
154 device = wrap_device (decode_device (device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
156 c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 c->name = name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 c->device = device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 c->data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (c, name, device,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
163 decode_error_behavior_flag (noerror)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 if (!retval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
167 return wrap_color_instance (c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 Return non-nil if OBJECT is a color instance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 return COLOR_INSTANCEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 }
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 DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 Return the name used to allocate COLOR-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (color_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 CHECK_COLOR_INSTANCE (color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 return XCOLOR_INSTANCE (color_instance)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Return a three element list containing the red, green, and blue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 color components of COLOR-INSTANCE, or nil if unknown.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 Component values range from 0 to 65535.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (color_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
194 Lisp_Color_Instance *c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 CHECK_COLOR_INSTANCE (color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 c = XCOLOR_INSTANCE (color_instance);
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 if (NILP (c->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 return MAYBE_LISP_DEVMETH (XDEVICE (c->device),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 color_instance_rgb_components,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 }
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 DEFUN ("valid-color-name-p", Fvalid_color_name_p, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Return true if COLOR names a valid color for the current device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 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
211 whatever the equivalent is on your system.
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 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
214 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
215 such as `blink'.
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 (color, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 struct device *d = decode_device (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 CHECK_STRING (color);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 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
223 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
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 /***************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 * Font-Instance Object *
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 Lisp_Object Qfont_instancep;
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 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
233 Error_Behavior errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 mark_font_instance (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
238 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
428
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 mark_object (f->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 if (!NILP (f->device)) /* Vthe_null_font_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 return f->device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
250 Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
252 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
253 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
254 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 if (!NILP (f->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (f, printcharfun, escapeflag));
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
258 write_fmt_string (printcharfun, " 0x%x>", f->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 finalize_font_instance (void *header, int for_disksave)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
264 Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 if (!NILP (f->device))
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 if (for_disksave) finalose (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 /* Fonts are equal if they resolve to the same name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 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
275 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
276 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 /* #### 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
281 return internal_equal (font_instance_truename_internal
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
282 (obj1, ERROR_ME_DEBUG_WARN),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
283 font_instance_truename_internal
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
284 (obj2, ERROR_ME_DEBUG_WARN),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 static unsigned long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 font_instance_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
291 return internal_hash (font_instance_truename_internal
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
292 (obj, ERROR_ME_DEBUG_WARN),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 mark_font_instance, print_font_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 finalize_font_instance, font_instance_equal,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
299 font_instance_hash, 0, Lisp_Font_Instance);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 Return a new `font-instance' object named NAME.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 DEVICE specifies the device this object applies to and defaults to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 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
305 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
306 this case.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 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
309 `deallocate' the font is the way you deallocate any other lisp object:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 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
311 these objects are GCed, the underlying X data is deallocated as well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
313 (name, device, noerror))
428
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;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 int retval = 0;
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
317 Error_Behavior errb = decode_error_behavior_flag (noerror);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 if (ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 else if (!STRINGP (name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
324 device = wrap_device (decode_device (device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
326 f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 f->name = name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 f->device = device;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 f->data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 /* Stick some default values here ... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 f->ascent = f->height = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 f->descent = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 f->width = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 f->proportional_p = 0;
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 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (f, name, device, errb));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 if (!retval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
344 return wrap_font_instance (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 Return non-nil if OBJECT is a font instance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (object))
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 return FONT_INSTANCEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 Return the name used to allocate FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (font_instance))
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 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 return XFONT_INSTANCE (font_instance)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 Return the ascent in pixels of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 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
367 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
368 the baseline.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 return make_int (XFONT_INSTANCE (font_instance)->ascent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 }
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 DEFUN ("font-instance-descent", Ffont_instance_descent, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 Return the descent in pixels of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 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
379 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
380 \(Many characters to do not have any descent. Typical characters with a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 descent are lowercase p and lowercase g.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 return make_int (XFONT_INSTANCE (font_instance)->descent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 DEFUN ("font-instance-width", Ffont_instance_width, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 Return the width in pixels of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 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
392 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 return make_int (XFONT_INSTANCE (font_instance)->width);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 Return whether FONT-INSTANCE is proportional.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 This means that different characters in the font have different widths.
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 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 return XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 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
411 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
413 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
414
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 if (NILP (f->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
417 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
418 font_instance, Qfont, errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
421
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 return DEVMETH_OR_GIVEN (XDEVICE (f->device),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 font_instance_truename, (f, errb), f->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 }
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 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 Return the canonical name of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 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
429 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
430 \(but not necessarily its only unambiguous name).
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 font_instance_truename_internal (font_instance, ERROR_ME);
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-properties", Ffont_instance_properties, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 Return the properties (an alist or nil) of FONT-INSTANCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (font_instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
443 Lisp_Font_Instance *f;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 CHECK_FONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 f = XFONT_INSTANCE (font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 if (NILP (f->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 return MAYBE_LISP_DEVMETH (XDEVICE (f->device),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 font_instance_properties, (f));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 DEFUN ("list-fonts", Flist_fonts, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 Return a list of font names matching the given pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 DEVICE specifies which device to search for names, and defaults to the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 currently selected device.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (pattern, device))
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 CHECK_STRING (pattern);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
463 device = wrap_device (decode_device (device));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 return MAYBE_LISP_DEVMETH (XDEVICE (device), list_fonts, (pattern, device));
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
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 /****************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 Color Object
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 DEFINE_SPECIFIER_TYPE (color);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 /* Qcolor defined in general.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 color_create (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
478 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 COLOR_SPECIFIER_FACE (color) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 color_mark (Lisp_Object obj)
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_Specifier *color = XCOLOR_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 mark_object (COLOR_SPECIFIER_FACE (color));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 /* 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
494 of for `equal' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 color_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 Lisp_Object domain, Lisp_Object instantiator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 Lisp_Object depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 /* When called, we're inside of call_with_suspended_errors(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 so we can freely error. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
503 Lisp_Object device = DOMAIN_DEVICE (domain);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 struct device *d = XDEVICE (device);
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 if (COLOR_INSTANCEP (instantiator))
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 /* 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
509 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
510 STRINGP case deal with it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 if (NILP (device) /* Vthe_null_color_instance */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 || EQ (device, XCOLOR_INSTANCE (instantiator)->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 return instantiator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 instantiator = Fcolor_instance_name (instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 if (STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 /* First, look to see if we can retrieve a cached value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 Lisp_Object instance =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 Fgethash (instantiator, d->color_instance_cache, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 /* Otherwise, make a new one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 if (UNBOUNDP (instance))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 /* make sure we cache the failures, too. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 instance = Fmake_color_instance (instantiator, device, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 Fputhash (instantiator, instance, d->color_instance_cache);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 return NILP (instance) ? Qunbound : instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 else if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 switch (XVECTOR_LENGTH (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 case 0:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 if (DEVICE_TTY_P (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 return Vthe_null_color_instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
541 gui_error ("Color instantiator [] only valid on TTY's",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 device);
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 case 1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 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
546 gui_error ("Color specifier not attached to a face",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 return (FACE_PROPERTY_INSTANCE_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (Fget_face (XVECTOR_DATA (instantiator)[0]),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 domain, ERROR_ME, 0, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 case 2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 return (FACE_PROPERTY_INSTANCE_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (Fget_face (XVECTOR_DATA (instantiator)[0]),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, 0, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 }
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 else if (NILP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 if (DEVICE_TTY_P (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 return Vthe_null_color_instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
567 gui_error ("Color instantiator [] only valid on TTY's",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 abort (); /* The spec validation routines are screwed up. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 return Qunbound;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 color_validate (Lisp_Object instantiator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 if (VECTORP (instantiator))
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 if (XVECTOR_LENGTH (instantiator) > 2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
584 sferror ("Inheritance vector must be of size 0 - 2",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 else if (XVECTOR_LENGTH (instantiator) > 0)
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 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
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 Fget_face (face);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 if (XVECTOR_LENGTH (instantiator) == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 if (!EQ (field, Qforeground) && !EQ (field, Qbackground))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
595 invalid_constant
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 ("Inheritance field must be `foreground' or `background'",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 field);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
602 invalid_argument ("Invalid color instantiator", instantiator);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 color_after_change (Lisp_Object specifier, Lisp_Object locale)
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 Lisp_Object face = COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 Lisp_Object property =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 if (!NILP (face))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
612 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
613 face_property_was_changed (face, property, locale);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
614 if (BUFFERP (locale))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
615 XBUFFER (locale)->buffer_local_face_property = 1;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
616 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 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
621 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
622 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 COLOR_SPECIFIER_FACE (color) = face;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 COLOR_SPECIFIER_FACE_PROPERTY (color) = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 Return t if OBJECT is a color specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
631 See `make-color-specifier' for a description of possible color instantiators.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (object))
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 return COLOR_SPECIFIERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638
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 Font Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 ***************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 DEFINE_SPECIFIER_TYPE (font);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 /* Qfont defined in general.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 font_create (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
648 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 FONT_SPECIFIER_FACE (font) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 font_mark (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
657 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 mark_object (FONT_SPECIFIER_FACE (font));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 mark_object (FONT_SPECIFIER_FACE_PROPERTY (font));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 /* 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
664 of for `equal' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 font_spec_matches_charset (struct device *d, Lisp_Object charset,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 578
diff changeset
670 const Intbyte *nonreloc, Lisp_Object reloc,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 Bytecount offset, Bytecount length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 (d, charset, nonreloc, reloc, offset, length),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 font_validate_matchspec (Lisp_Object matchspec)
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 Fget_charset (matchspec);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 #endif /* MULE */
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 font_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 Lisp_Object domain, Lisp_Object instantiator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 Lisp_Object depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 /* When called, we're inside of call_with_suspended_errors(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 so we can freely error. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
694 Lisp_Object device = DOMAIN_DEVICE (domain);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 struct device *d = XDEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 Lisp_Object instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 if (!UNBOUNDP (matchspec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 matchspec = Fget_charset (matchspec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 if (FONT_INSTANCEP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 if (NILP (device)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 || EQ (device, XFONT_INSTANCE (instantiator)->device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 if (font_spec_matches_charset (d, matchspec, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 Ffont_instance_truename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (instantiator),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 0, -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 return instantiator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 return instantiator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 instantiator = Ffont_instance_name (instantiator);
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 if (STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 if (!UNBOUNDP (matchspec))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 /* The instantiator is a font spec that could match many
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 different fonts. We need to find one of those fonts
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 whose registry matches the registry of the charset in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 MATCHSPEC. This is potentially a very slow operation,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 as it involves doing an XListFonts() or equivalent to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 iterate over all possible fonts, and a regexp match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 on each one. So we cache the results. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 Lisp_Object matching_font = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 Lisp_Object hash_table = Fgethash (matchspec, d->charset_font_cache,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 if (UNBOUNDP (hash_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 /* need to make a sub hash table. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 HASH_TABLE_EQUAL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 Fputhash (matchspec, hash_table, d->charset_font_cache);
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 matching_font = Fgethash (instantiator, hash_table, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 if (UNBOUNDP (matching_font))
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 /* make sure we cache the failures, too. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 matching_font =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 DEVMETH_OR_GIVEN (d, find_charset_font,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (device, instantiator, matchspec),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 Fputhash (instantiator, matching_font, hash_table);
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 if (NILP (matching_font))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 instantiator = matching_font;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 /* First, look to see if we can retrieve a cached value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 instance = Fgethash (instantiator, d->font_instance_cache, Qunbound);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 /* Otherwise, make a new one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 if (UNBOUNDP (instance))
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 /* make sure we cache the failures, too. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 instance = Fmake_font_instance (instantiator, device, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 Fputhash (instantiator, instance, d->font_instance_cache);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 }
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 return NILP (instance) ? Qunbound : instance;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 else if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 assert (XVECTOR_LENGTH (instantiator) == 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 return (face_property_matching_instance
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 matchspec, domain, ERROR_ME, 0, depth));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 else if (NILP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 abort (); /* Eh? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 font_validate (Lisp_Object instantiator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 if (XVECTOR_LENGTH (instantiator) != 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
797 sferror
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 ("Vector length must be one for font inheritance", instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 Fget_face (XVECTOR_DATA (instantiator)[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
803 invalid_argument ("Must be string, vector, or font-instance",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 font_after_change (Lisp_Object specifier, Lisp_Object locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 Lisp_Object face = FONT_SPECIFIER_FACE (XFONT_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 Lisp_Object property =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 if (!NILP (face))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
814 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
815 face_property_was_changed (face, property, locale);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
816 if (BUFFERP (locale))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
817 XBUFFER (locale)->buffer_local_face_property = 1;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
818 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 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
823 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
824 Lisp_Specifier *font = XFONT_SPECIFIER (obj);
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 FONT_SPECIFIER_FACE (font) = face;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 FONT_SPECIFIER_FACE_PROPERTY (font) = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 Return non-nil if OBJECT is a font specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
833 See `make-font-specifier' for a description of possible font instantiators.
428
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 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 return FONT_SPECIFIERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 /*****************************************************************************
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 Face Boolean Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 ****************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 DEFINE_SPECIFIER_TYPE (face_boolean);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 Lisp_Object Qface_boolean;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 face_boolean_create (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
850 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 face_boolean_mark (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
859 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
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 mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 /* 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
866 of for `equal' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 face_boolean_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 Lisp_Object domain, Lisp_Object instantiator,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 Lisp_Object depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 /* When called, we're inside of call_with_suspended_errors(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 so we can freely error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 if (NILP (instantiator) || EQ (instantiator, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 return instantiator;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 else if (VECTORP (instantiator))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 Lisp_Object prop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 int instantiator_len = XVECTOR_LENGTH (instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 assert (instantiator_len >= 1 && instantiator_len <= 3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 if (instantiator_len > 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 prop = XVECTOR_DATA (instantiator)[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 if (NILP (FACE_BOOLEAN_SPECIFIER_FACE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 (XFACE_BOOLEAN_SPECIFIER (specifier))))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
890 gui_error
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 ("Face-boolean specifier not attached to a face", instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 (XFACE_BOOLEAN_SPECIFIER (specifier));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 retval = (FACE_PROPERTY_INSTANCE_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (Fget_face (XVECTOR_DATA (instantiator)[0]),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 prop, domain, ERROR_ME, 0, depth));
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 if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 retval = NILP (retval) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 return retval;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 abort (); /* Eh? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 return Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 face_boolean_validate (Lisp_Object instantiator)
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 if (NILP (instantiator) || EQ (instantiator, Qt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 else if (VECTORP (instantiator) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 (XVECTOR_LENGTH (instantiator) >= 1 &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 XVECTOR_LENGTH (instantiator) <= 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 Lisp_Object face = XVECTOR_DATA (instantiator)[0];
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 Fget_face (face);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 if (XVECTOR_LENGTH (instantiator) > 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 Lisp_Object field = XVECTOR_DATA (instantiator)[1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 if (!EQ (field, Qunderline)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 && !EQ (field, Qstrikethru)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 && !EQ (field, Qhighlight)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 && !EQ (field, Qdim)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 && !EQ (field, Qblinking)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 && !EQ (field, Qreverse))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
933 invalid_constant ("Invalid face-boolean inheritance field",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 field);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 else if (VECTORP (instantiator))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
938 sferror ("Wrong length for face-boolean inheritance spec",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 instantiator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
941 invalid_argument ("Face-boolean instantiator must be nil, t, or vector",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 instantiator);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 face_boolean_after_change (Lisp_Object specifier, Lisp_Object locale)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 Lisp_Object face =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 FACE_BOOLEAN_SPECIFIER_FACE (XFACE_BOOLEAN_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 Lisp_Object property =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 if (!NILP (face))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
953 {
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
954 face_property_was_changed (face, property, locale);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
955 if (BUFFERP (locale))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
956 XBUFFER (locale)->buffer_local_face_property = 1;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 444
diff changeset
957 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 Lisp_Object property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
964 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 Return non-nil if OBJECT is a face-boolean specifier.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
973 See `make-face-boolean-specifier' for a description of possible
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
974 face-boolean instantiators.
428
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 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 syms_of_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989 INIT_LRECORD_IMPLEMENTATION (color_instance);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
990 INIT_LRECORD_IMPLEMENTATION (font_instance);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
991
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 DEFSUBR (Fcolor_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 DEFSUBR (Ffont_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 DEFSUBR (Fface_boolean_specifier_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
996 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 DEFSUBR (Fmake_color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 DEFSUBR (Fcolor_instance_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 DEFSUBR (Fcolor_instance_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 DEFSUBR (Fcolor_instance_rgb_components);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 DEFSUBR (Fvalid_color_name_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1003 DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 DEFSUBR (Fmake_font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 DEFSUBR (Ffont_instance_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 DEFSUBR (Ffont_instance_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 DEFSUBR (Ffont_instance_ascent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 DEFSUBR (Ffont_instance_descent);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 DEFSUBR (Ffont_instance_width);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 DEFSUBR (Ffont_instance_proportional_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 DEFSUBR (Ffont_instance_truename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 DEFSUBR (Ffont_instance_properties);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 DEFSUBR (Flist_fonts);
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 /* Qcolor, Qfont defined in general.c */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
1016 DEFSYMBOL (Qface_boolean);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 static const struct lrecord_description color_specifier_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1020 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1021 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face_property) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 };
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 static const struct lrecord_description font_specifier_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1026 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1027 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face_property) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 { XD_END }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 static const struct lrecord_description face_boolean_specifier_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1032 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1033 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face_property) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 };
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 specifier_type_create_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 "face-boolean-specifier-p");
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 SPECIFIER_HAS_METHOD (color, instantiate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 SPECIFIER_HAS_METHOD (font, instantiate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 SPECIFIER_HAS_METHOD (face_boolean, instantiate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 SPECIFIER_HAS_METHOD (color, validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 SPECIFIER_HAS_METHOD (font, validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 SPECIFIER_HAS_METHOD (face_boolean, validate);
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 SPECIFIER_HAS_METHOD (color, create);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 SPECIFIER_HAS_METHOD (font, create);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 SPECIFIER_HAS_METHOD (face_boolean, create);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 SPECIFIER_HAS_METHOD (color, mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 SPECIFIER_HAS_METHOD (font, mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 SPECIFIER_HAS_METHOD (face_boolean, mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 SPECIFIER_HAS_METHOD (color, after_change);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 SPECIFIER_HAS_METHOD (font, after_change);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 SPECIFIER_HAS_METHOD (face_boolean, after_change);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 SPECIFIER_HAS_METHOD (font, validate_matchspec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 reinit_specifier_type_create_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 REINITIALIZE_SPECIFIER_TYPE (color);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 REINITIALIZE_SPECIFIER_TYPE (font);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 REINITIALIZE_SPECIFIER_TYPE (face_boolean);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 reinit_vars_of_objects (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 staticpro_nodump (&Vthe_null_color_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1083 Lisp_Color_Instance *c =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1084 alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 c->name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 c->device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 c->data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1089 Vthe_null_color_instance = wrap_color_instance (c);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 staticpro_nodump (&Vthe_null_font_instance);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1094 Lisp_Font_Instance *f =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1095 alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 f->name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 f->device = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 f->data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 f->ascent = f->height = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 f->descent = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 f->width = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 f->proportional_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1105 Vthe_null_font_instance = wrap_font_instance (f);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 vars_of_objects (void)
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 reinit_vars_of_objects ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 }