Mercurial > hg > xemacs-beta
comparison src/glyphs.c @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | 9ee227acff29 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:376386a54a3c |
---|---|
1 /* Generic glyph/image implementation + display tables | |
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. | |
3 Copyright (C) 1995 Tinker Systems | |
4 Copyright (C) 1995, 1996 Ben Wing | |
5 Copyright (C) 1995 Sun Microsystems | |
6 | |
7 This file is part of XEmacs. | |
8 | |
9 XEmacs is free software; you can redistribute it and/or modify it | |
10 under the terms of the GNU General Public License as published by the | |
11 Free Software Foundation; either version 2, or (at your option) any | |
12 later version. | |
13 | |
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
17 for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
20 along with XEmacs; see the file COPYING. If not, write to | |
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 Boston, MA 02111-1307, USA. */ | |
23 | |
24 /* Synched up with: Not in FSF. */ | |
25 | |
26 /* Written by Ben Wing and Chuck Thompson */ | |
27 | |
28 #include <config.h> | |
29 #include "lisp.h" | |
30 | |
31 #include "buffer.h" | |
32 #include "device.h" | |
33 #include "elhash.h" | |
34 #include "faces.h" | |
35 #include "frame.h" | |
36 #include "glyphs.h" | |
37 #include "objects.h" | |
38 #include "redisplay.h" | |
39 #include "window.h" | |
40 | |
41 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline; | |
42 | |
43 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p; | |
44 | |
45 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p; | |
46 Lisp_Object Qmono_pixmap_image_instance_p; | |
47 Lisp_Object Qcolor_pixmap_image_instance_p; | |
48 Lisp_Object Qpointer_image_instance_p; | |
49 Lisp_Object Qsubwindow_image_instance_p; | |
50 | |
51 Lisp_Object Qconst_glyph_variable; | |
52 | |
53 /* Qtext, Qpointer defined in general.c */ | |
54 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; | |
55 | |
56 Lisp_Object Vcurrent_display_table; | |
57 | |
58 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph; | |
59 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph; | |
60 Lisp_Object Vxemacs_logo; | |
61 | |
62 Lisp_Object Vthe_nothing_vector; | |
63 | |
64 Lisp_Object Q_file, Q_data, Q_face; | |
65 | |
66 Lisp_Object Qicon; | |
67 | |
68 /* Qnothing, Qstring, Qinherit in general.c */ | |
69 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); | |
70 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); | |
71 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string); | |
72 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); | |
73 Lisp_Object Qformatted_string; | |
74 | |
75 MAC_DEFINE (struct image_instantiator_methods *, MTiiformat_meth_or_given) | |
76 | |
77 struct image_instantiator_format_entry | |
78 { | |
79 Lisp_Object symbol; | |
80 struct image_instantiator_methods *meths; | |
81 }; | |
82 | |
83 typedef struct image_instantiator_format_entry_dynarr_type | |
84 { | |
85 Dynarr_declare (struct image_instantiator_format_entry); | |
86 } image_instantiator_format_entry_dynarr; | |
87 | |
88 image_instantiator_format_entry_dynarr * | |
89 the_image_instantiator_format_entry_dynarr; | |
90 | |
91 Lisp_Object Vimage_instantiator_format_list; | |
92 | |
93 Lisp_Object Vimage_instance_type_list; | |
94 | |
95 Lisp_Object Vglyph_type_list; | |
96 | |
97 static Lisp_Object allocate_image_instance (Lisp_Object device); | |
98 static void image_validate (Lisp_Object instantiator); | |
99 static void glyph_property_was_changed (Lisp_Object glyph, | |
100 Lisp_Object property, | |
101 Lisp_Object locale); | |
102 | |
103 | |
104 /**************************************************************************** | |
105 * Image Instantiators * | |
106 ****************************************************************************/ | |
107 | |
108 static struct image_instantiator_methods * | |
109 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb) | |
110 { | |
111 int i; | |
112 | |
113 if (!SYMBOLP (format)) | |
114 { | |
115 if (ERRB_EQ (errb, ERROR_ME)) | |
116 CHECK_SYMBOL (format); | |
117 return 0; | |
118 } | |
119 | |
120 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr); | |
121 i++) | |
122 { | |
123 if (EQ (format, | |
124 Dynarr_at (the_image_instantiator_format_entry_dynarr, i). | |
125 symbol)) | |
126 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths; | |
127 } | |
128 | |
129 maybe_signal_simple_error ("Invalid image-instantiator format", format, | |
130 Qimage, errb); | |
131 | |
132 return 0; | |
133 } | |
134 | |
135 static int | |
136 valid_image_instantiator_format_p (Lisp_Object format) | |
137 { | |
138 if (decode_image_instantiator_format (format, ERROR_ME_NOT)) | |
139 return 1; | |
140 return 0; | |
141 } | |
142 | |
143 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p, | |
144 Svalid_image_instantiator_format_p, 1, 1, 0 /* | |
145 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid. | |
146 Valid formats are some subset of 'nothing, 'string, 'formatted-string, 'xpm, | |
147 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font, 'autodetect, | |
148 and 'subwindow, depending on how XEmacs was compiled. | |
149 */ ) | |
150 (image_instantiator_format) | |
151 Lisp_Object image_instantiator_format; | |
152 { | |
153 if (valid_image_instantiator_format_p (image_instantiator_format)) | |
154 return Qt; | |
155 else | |
156 return Qnil; | |
157 } | |
158 | |
159 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list, | |
160 Simage_instantiator_format_list, | |
161 0, 0, 0 /* | |
162 Return a list of valid image-instantiator formats. | |
163 */ ) | |
164 () | |
165 { | |
166 return Fcopy_sequence (Vimage_instantiator_format_list); | |
167 } | |
168 | |
169 void | |
170 add_entry_to_image_instantiator_format_list (Lisp_Object symbol, | |
171 struct | |
172 image_instantiator_methods *meths) | |
173 { | |
174 struct image_instantiator_format_entry entry; | |
175 | |
176 entry.symbol = symbol; | |
177 entry.meths = meths; | |
178 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry); | |
179 Vimage_instantiator_format_list = | |
180 Fcons (symbol, Vimage_instantiator_format_list); | |
181 } | |
182 | |
183 static Lisp_Object * | |
184 get_image_conversion_list (Lisp_Object console_type) | |
185 { | |
186 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list; | |
187 } | |
188 | |
189 DEFUN ("set-console-type-image-conversion-list", | |
190 Fset_console_type_image_conversion_list, | |
191 Sset_console_type_image_conversion_list, 2, 2, 0 /* | |
192 Set the image-conversion-list for consoles of the given TYPE. | |
193 The image-conversion-list specifies how image instantiators that | |
194 are strings should be interpreted. Each element of the list should be | |
195 a list of two elements (a regular expression string and a vector) or | |
196 a list of three elements (the preceding two plus an integer index into | |
197 the vector). The string is converted to the vector associated with the | |
198 first matching regular expression. If a vector index is specified, the | |
199 string itself is substituted into that position in the vector. | |
200 | |
201 Note: The conversion above is applied when the image instantiator is | |
202 added to an image specifier, not when the specifier is actually | |
203 instantiated. Therefore, changing the image-conversion-list only affects | |
204 newly-added instantiators. Existing instantiators in glyphs and image | |
205 specifiers will not be affected. | |
206 */ ) | |
207 (console_type, list) | |
208 Lisp_Object console_type, list; | |
209 { | |
210 Lisp_Object tail; | |
211 Lisp_Object *imlist = get_image_conversion_list (console_type); | |
212 | |
213 /* Check the list to make sure that it only has valid entries. */ | |
214 | |
215 EXTERNAL_LIST_LOOP (tail, list) | |
216 { | |
217 Lisp_Object mapping = XCAR (tail); | |
218 | |
219 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */ | |
220 if (!CONSP (mapping) || | |
221 !CONSP (XCDR (mapping)) || | |
222 (!NILP (XCDR (XCDR (mapping))) && | |
223 (!CONSP (XCDR (XCDR (mapping))) || | |
224 !NILP (XCDR (XCDR (XCDR (mapping))))))) | |
225 signal_simple_error ("Invalid mapping form", mapping); | |
226 else | |
227 { | |
228 Lisp_Object exp = XCAR (mapping); | |
229 Lisp_Object typevec = XCAR (XCDR (mapping)); | |
230 Lisp_Object pos = Qnil; | |
231 Lisp_Object newvec; | |
232 struct gcpro gcpro1; | |
233 | |
234 CHECK_STRING (exp); | |
235 CHECK_VECTOR (typevec); | |
236 if (!NILP (XCDR (XCDR (mapping)))) | |
237 { | |
238 pos = XCAR (XCDR (XCDR (mapping))); | |
239 CHECK_INT (pos); | |
240 if (XINT (pos) < 0 || | |
241 XINT (pos) >= vector_length (XVECTOR (typevec))) | |
242 args_out_of_range_3 | |
243 (pos, Qzero, make_int | |
244 (vector_length (XVECTOR (typevec)) - 1)); | |
245 } | |
246 | |
247 newvec = Fcopy_sequence (typevec); | |
248 if (INTP (pos)) | |
249 vector_data (XVECTOR (newvec))[XINT (pos)] = exp; | |
250 GCPRO1 (newvec); | |
251 image_validate (newvec); | |
252 UNGCPRO; | |
253 } | |
254 } | |
255 | |
256 *imlist = Fcopy_tree (list, Qt); | |
257 return list; | |
258 } | |
259 | |
260 DEFUN ("console-type-image-conversion-list", | |
261 Fconsole_type_image_conversion_list, | |
262 Sconsole_type_image_conversion_list, 1, 1, 0 /* | |
263 Return the image-conversion-list for devices of the given TYPE. | |
264 The image-conversion-list specifies how to interpret image string | |
265 instantiators for the specified console type. See | |
266 `set-console-type-image-conversion-list' for a description of its syntax. | |
267 */ ) | |
268 (console_type) | |
269 Lisp_Object console_type; | |
270 { | |
271 return Fcopy_tree (*get_image_conversion_list (console_type), Qt); | |
272 } | |
273 | |
274 /* Process an string instantiator according to the image-conversion-list for | |
275 CONSOLE_TYPE. Returns a vector. */ | |
276 | |
277 static Lisp_Object | |
278 process_image_string_instantiator (Lisp_Object data, | |
279 Lisp_Object console_type, | |
280 int dest_mask) | |
281 { | |
282 Lisp_Object tail; | |
283 | |
284 LIST_LOOP (tail, *get_image_conversion_list (console_type)) | |
285 { | |
286 Lisp_Object mapping = XCAR (tail); | |
287 Lisp_Object exp = XCAR (mapping); | |
288 Lisp_Object typevec = XCAR (XCDR (mapping)); | |
289 | |
290 /* if the result is of a type that can't be instantiated | |
291 (e.g. a string when we're dealing with a pointer glyph), | |
292 skip it. */ | |
293 if (!(dest_mask & | |
294 IIFORMAT_METH (decode_image_instantiator_format | |
295 (vector_data (XVECTOR (typevec))[0], ERROR_ME), | |
296 possible_dest_types, ()))) | |
297 continue; | |
298 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0) | |
299 { | |
300 if (!NILP (XCDR (XCDR (mapping)))) | |
301 { | |
302 int pos = XINT (XCAR (XCDR (XCDR (mapping)))); | |
303 Lisp_Object newvec = Fcopy_sequence (typevec); | |
304 vector_data (XVECTOR (newvec))[pos] = data; | |
305 return newvec; | |
306 } | |
307 else | |
308 return typevec; | |
309 } | |
310 } | |
311 | |
312 /* Oh well. */ | |
313 signal_simple_error ("Unable to interpret glyph instantiator", | |
314 data); | |
315 | |
316 return Qnil; | |
317 } | |
318 | |
319 Lisp_Object | |
320 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword, | |
321 Lisp_Object defalt) | |
322 { | |
323 Lisp_Object *elt; | |
324 int instantiator_len; | |
325 | |
326 elt = vector_data (XVECTOR (vector)); | |
327 instantiator_len = vector_length (XVECTOR (vector)); | |
328 | |
329 elt++; | |
330 instantiator_len--; | |
331 | |
332 while (instantiator_len > 0) | |
333 { | |
334 if (EQ (elt[0], keyword)) | |
335 return elt[1]; | |
336 elt += 2; | |
337 instantiator_len -= 2; | |
338 } | |
339 | |
340 return defalt; | |
341 } | |
342 | |
343 Lisp_Object | |
344 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword) | |
345 { | |
346 return find_keyword_in_vector_or_given (vector, keyword, Qnil); | |
347 } | |
348 | |
349 void | |
350 check_valid_string (Lisp_Object data) | |
351 { | |
352 CHECK_STRING (data); | |
353 } | |
354 | |
355 static void | |
356 check_valid_face (Lisp_Object data) | |
357 { | |
358 Fget_face (data); | |
359 } | |
360 | |
361 void | |
362 check_valid_int (Lisp_Object data) | |
363 { | |
364 CHECK_INT (data); | |
365 } | |
366 | |
367 void | |
368 file_or_data_must_be_present (Lisp_Object instantiator) | |
369 { | |
370 if (NILP (find_keyword_in_vector (instantiator, Q_file)) && | |
371 NILP (find_keyword_in_vector (instantiator, Q_data))) | |
372 signal_simple_error ("Must supply either :file or :data", | |
373 instantiator); | |
374 } | |
375 | |
376 void | |
377 data_must_be_present (Lisp_Object instantiator) | |
378 { | |
379 if (NILP (find_keyword_in_vector (instantiator, Q_data))) | |
380 signal_simple_error ("Must supply :data", instantiator); | |
381 } | |
382 | |
383 static void | |
384 face_must_be_present (Lisp_Object instantiator) | |
385 { | |
386 if (NILP (find_keyword_in_vector (instantiator, Q_face))) | |
387 signal_simple_error ("Must supply :face", instantiator); | |
388 } | |
389 | |
390 /* utility function useful in retrieving data from a file. */ | |
391 | |
392 Lisp_Object | |
393 make_string_from_file (Lisp_Object file) | |
394 { | |
395 int count = specpdl_depth (); | |
396 Lisp_Object temp_buffer; | |
397 struct gcpro gcpro1; | |
398 Lisp_Object data; | |
399 | |
400 specbind (Qinhibit_quit, Qt); | |
401 record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); | |
402 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*")); | |
403 GCPRO1 (temp_buffer); | |
404 set_buffer_internal (XBUFFER (temp_buffer)); | |
405 Ferase_buffer (Fcurrent_buffer ()); | |
406 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil); | |
407 data = Fbuffer_substring (Qnil, Qnil, Fcurrent_buffer ()); | |
408 unbind_to (count, Qnil); | |
409 UNGCPRO; | |
410 return data; | |
411 } | |
412 | |
413 /* The following two functions are provided to make it easier for | |
414 the normalize methods to work with keyword-value vectors. | |
415 Hash tables are kind of heavyweight for this purpose. | |
416 (If vectors were resizable, we could avoid this problem; | |
417 but they're not.) An alternative approach that might be | |
418 more efficient but require more work is to use a type of | |
419 assoc-Dynarr and provide primitives for deleting elements out | |
420 of it. (However, you'd also have to add an unwind-protect | |
421 to make sure the Dynarr got freed in case of an error in | |
422 the normalization process.) */ | |
423 | |
424 Lisp_Object | |
425 tagged_vector_to_alist (Lisp_Object vector) | |
426 { | |
427 Lisp_Object *elt = vector_data (XVECTOR (vector)); | |
428 int len = vector_length (XVECTOR (vector)); | |
429 Lisp_Object result = Qnil; | |
430 | |
431 assert (len & 1); | |
432 for (len -= 2; len >= 1; len -= 2) | |
433 result = Fcons (Fcons (elt[len], elt[len+1]), result); | |
434 | |
435 return result; | |
436 } | |
437 | |
438 Lisp_Object | |
439 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist) | |
440 { | |
441 int len = 1 + 2 * XINT (Flength (alist)); | |
442 Lisp_Object *elt = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); | |
443 int i; | |
444 Lisp_Object rest; | |
445 | |
446 i = 0; | |
447 elt[i++] = tag; | |
448 LIST_LOOP (rest, alist) | |
449 { | |
450 Lisp_Object pair = XCAR (rest); | |
451 elt[i] = XCAR (pair); | |
452 elt[i+1] = XCDR (pair); | |
453 i += 2; | |
454 } | |
455 | |
456 return Fvector (len, elt); | |
457 } | |
458 | |
459 static Lisp_Object | |
460 normalize_image_instantiator (Lisp_Object instantiator, | |
461 Lisp_Object contype, | |
462 Lisp_Object dest_mask) | |
463 { | |
464 if (IMAGE_INSTANCEP (instantiator)) | |
465 return instantiator; | |
466 | |
467 if (STRINGP (instantiator)) | |
468 instantiator = process_image_string_instantiator (instantiator, contype, | |
469 XINT (dest_mask)); | |
470 | |
471 assert (VECTORP (instantiator)); | |
472 /* We have to always store the actual pixmap data and not the | |
473 filename even though this is a potential memory pig. We have to | |
474 do this because it is quite possible that we will need to | |
475 instantiate a new instance of the pixmap and the file will no | |
476 longer exist (e.g. w3 pixmaps are almost always from temporary | |
477 files). */ | |
478 instantiator = IIFORMAT_METH_OR_GIVEN | |
479 (decode_image_instantiator_format | |
480 (vector_data (XVECTOR (instantiator))[0], ERROR_ME), | |
481 normalize, (instantiator, contype), instantiator); | |
482 | |
483 return instantiator; | |
484 } | |
485 | |
486 static Lisp_Object | |
487 instantiate_image_instantiator (Lisp_Object device, Lisp_Object instantiator, | |
488 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
489 int dest_mask) | |
490 { | |
491 Lisp_Object ii; | |
492 struct gcpro gcpro1; | |
493 | |
494 ii = allocate_image_instance (device); | |
495 | |
496 GCPRO1 (ii); | |
497 { | |
498 struct image_instantiator_methods *meths = | |
499 decode_image_instantiator_format | |
500 (vector_data (XVECTOR (instantiator))[0], ERROR_ME); | |
501 | |
502 if (!HAS_IIFORMAT_METH_P (meths, instantiate)) | |
503 signal_simple_error | |
504 ("Don't know how to instantiate this image instantiator?", | |
505 instantiator); | |
506 IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, | |
507 pointer_bg, dest_mask)); | |
508 } | |
509 UNGCPRO; | |
510 | |
511 return ii; | |
512 } | |
513 | |
514 | |
515 /**************************************************************************** | |
516 * Image-Instance Object * | |
517 ****************************************************************************/ | |
518 | |
519 Lisp_Object Qimage_instancep; | |
520 static Lisp_Object mark_image_instance (Lisp_Object, void (*) (Lisp_Object)); | |
521 static void print_image_instance (Lisp_Object, Lisp_Object, int); | |
522 static void finalize_image_instance (void *, int); | |
523 static int image_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth); | |
524 static unsigned long image_instance_hash (Lisp_Object obj, int depth); | |
525 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, | |
526 mark_image_instance, print_image_instance, | |
527 finalize_image_instance, image_instance_equal, | |
528 image_instance_hash, | |
529 struct Lisp_Image_Instance); | |
530 static Lisp_Object | |
531 mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) | |
532 { | |
533 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); | |
534 | |
535 (markobj) (i->name); | |
536 switch (IMAGE_INSTANCE_TYPE (i)) | |
537 { | |
538 case IMAGE_TEXT: | |
539 (markobj) (IMAGE_INSTANCE_TEXT_STRING (i)); | |
540 break; | |
541 case IMAGE_MONO_PIXMAP: | |
542 case IMAGE_COLOR_PIXMAP: | |
543 (markobj) (IMAGE_INSTANCE_PIXMAP_FILENAME (i)); | |
544 (markobj) (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i)); | |
545 (markobj) (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i)); | |
546 (markobj) (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i)); | |
547 (markobj) (IMAGE_INSTANCE_PIXMAP_FG (i)); | |
548 (markobj) (IMAGE_INSTANCE_PIXMAP_BG (i)); | |
549 break; | |
550 case IMAGE_SUBWINDOW: | |
551 /* #### implement me */ | |
552 break; | |
553 default: | |
554 break; | |
555 } | |
556 | |
557 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj)); | |
558 | |
559 return (i->device); | |
560 } | |
561 | |
562 static void | |
563 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun, | |
564 int escapeflag) | |
565 { | |
566 char buf[100]; | |
567 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj); | |
568 | |
569 if (print_readably) | |
570 error ("printing unreadable object #<image-instance 0x%x>", | |
571 ii->header.uid); | |
572 write_c_string ("#<image-instance (", printcharfun); | |
573 print_internal (Fimage_instance_type (obj), printcharfun, 0); | |
574 write_c_string (") ", printcharfun); | |
575 if (!NILP (ii->name)) | |
576 { | |
577 print_internal (ii->name, printcharfun, 1); | |
578 write_c_string (" ", printcharfun); | |
579 } | |
580 write_c_string ("on ", printcharfun); | |
581 print_internal (ii->device, printcharfun, 0); | |
582 write_c_string (" ", printcharfun); | |
583 switch (IMAGE_INSTANCE_TYPE (ii)) | |
584 { | |
585 case IMAGE_NOTHING: | |
586 break; | |
587 | |
588 case IMAGE_TEXT: | |
589 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1); | |
590 break; | |
591 | |
592 case IMAGE_MONO_PIXMAP: | |
593 case IMAGE_COLOR_PIXMAP: | |
594 case IMAGE_POINTER: | |
595 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii))) | |
596 { | |
597 char *s; | |
598 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii); | |
599 s = strrchr ((char *) string_data (XSTRING (filename)), '/'); | |
600 if (s) | |
601 print_internal (build_string (s + 1), printcharfun, 1); | |
602 else | |
603 print_internal (filename, printcharfun, 1); | |
604 } | |
605 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1) | |
606 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii), | |
607 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), | |
608 IMAGE_INSTANCE_PIXMAP_DEPTH (ii)); | |
609 else | |
610 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii), | |
611 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii)); | |
612 write_c_string (buf, printcharfun); | |
613 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) || | |
614 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) | |
615 { | |
616 write_c_string (" @", printcharfun); | |
617 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))) | |
618 { | |
619 sprintf (buf, "%d", XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))); | |
620 write_c_string (buf, printcharfun); | |
621 } | |
622 else | |
623 write_c_string ("??", printcharfun); | |
624 write_c_string (",", printcharfun); | |
625 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) | |
626 { | |
627 sprintf (buf, "%d", XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))); | |
628 write_c_string (buf, printcharfun); | |
629 } | |
630 else | |
631 write_c_string ("??", printcharfun); | |
632 } | |
633 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) || | |
634 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) | |
635 { | |
636 write_c_string (" (", printcharfun); | |
637 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii))) | |
638 { | |
639 print_internal | |
640 (XCOLOR_INSTANCE | |
641 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0); | |
642 } | |
643 write_c_string ("/", printcharfun); | |
644 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) | |
645 { | |
646 print_internal | |
647 (XCOLOR_INSTANCE | |
648 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0); | |
649 } | |
650 write_c_string (")", printcharfun); | |
651 } | |
652 break; | |
653 | |
654 case IMAGE_SUBWINDOW: | |
655 /* #### implement me */ | |
656 break; | |
657 | |
658 default: | |
659 abort (); | |
660 } | |
661 | |
662 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance, | |
663 (ii, printcharfun, escapeflag)); | |
664 sprintf (buf, " 0x%x>", ii->header.uid); | |
665 write_c_string (buf, printcharfun); | |
666 } | |
667 | |
668 static void | |
669 finalize_image_instance (void *header, int for_disksave) | |
670 { | |
671 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header; | |
672 | |
673 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING) | |
674 /* objects like this exist at dump time, so don't bomb out. */ | |
675 return; | |
676 if (for_disksave) finalose (i); | |
677 | |
678 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i)); | |
679 } | |
680 | |
681 static int | |
682 image_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth) | |
683 { | |
684 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (o1); | |
685 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (o2); | |
686 struct device *d1 = XDEVICE (i1->device); | |
687 struct device *d2 = XDEVICE (i2->device); | |
688 | |
689 if (d1 != d2) | |
690 return 0; | |
691 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)) | |
692 return 0; | |
693 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2), | |
694 depth + 1)) | |
695 return 0; | |
696 | |
697 switch (IMAGE_INSTANCE_TYPE (i1)) | |
698 { | |
699 case IMAGE_NOTHING: | |
700 break; | |
701 | |
702 case IMAGE_TEXT: | |
703 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1), | |
704 IMAGE_INSTANCE_TEXT_STRING (i2), | |
705 depth + 1)) | |
706 return 0; | |
707 break; | |
708 | |
709 case IMAGE_MONO_PIXMAP: | |
710 case IMAGE_COLOR_PIXMAP: | |
711 case IMAGE_POINTER: | |
712 if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) == | |
713 IMAGE_INSTANCE_PIXMAP_WIDTH (i2) && | |
714 IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) == | |
715 IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) && | |
716 IMAGE_INSTANCE_PIXMAP_DEPTH (i1) == | |
717 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) && | |
718 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1), | |
719 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) && | |
720 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1), | |
721 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) && | |
722 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1), | |
723 IMAGE_INSTANCE_PIXMAP_FILENAME (i2), | |
724 depth + 1) && | |
725 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1), | |
726 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2), | |
727 depth + 1))) | |
728 return 0; | |
729 break; | |
730 | |
731 case IMAGE_SUBWINDOW: | |
732 /* #### implement me */ | |
733 break; | |
734 | |
735 default: | |
736 abort (); | |
737 } | |
738 | |
739 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1); | |
740 } | |
741 | |
742 static unsigned long | |
743 image_instance_hash (Lisp_Object obj, int depth) | |
744 { | |
745 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); | |
746 struct device *d = XDEVICE (i->device); | |
747 unsigned long hash = (unsigned long) d; | |
748 | |
749 switch (IMAGE_INSTANCE_TYPE (i)) | |
750 { | |
751 case IMAGE_NOTHING: | |
752 break; | |
753 | |
754 case IMAGE_TEXT: | |
755 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i), | |
756 depth + 1)); | |
757 break; | |
758 | |
759 case IMAGE_MONO_PIXMAP: | |
760 case IMAGE_COLOR_PIXMAP: | |
761 case IMAGE_POINTER: | |
762 hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i), | |
763 IMAGE_INSTANCE_PIXMAP_HEIGHT (i), | |
764 IMAGE_INSTANCE_PIXMAP_DEPTH (i), | |
765 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), | |
766 depth + 1)); | |
767 break; | |
768 | |
769 case IMAGE_SUBWINDOW: | |
770 /* #### implement me */ | |
771 break; | |
772 | |
773 default: | |
774 abort (); | |
775 } | |
776 | |
777 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth), | |
778 0)); | |
779 } | |
780 | |
781 static Lisp_Object | |
782 allocate_image_instance (Lisp_Object device) | |
783 { | |
784 struct Lisp_Image_Instance *lp = | |
785 alloc_lcrecord (sizeof (struct Lisp_Image_Instance), | |
786 lrecord_image_instance); | |
787 Lisp_Object val = Qnil; | |
788 | |
789 zero_lcrecord (lp); | |
790 lp->device = device; | |
791 lp->type = IMAGE_NOTHING; | |
792 lp->name = Qnil; | |
793 XSETIMAGE_INSTANCE (val, lp); | |
794 return val; | |
795 } | |
796 | |
797 static enum image_instance_type | |
798 decode_image_instance_type (Lisp_Object type, Error_behavior errb) | |
799 { | |
800 if (ERRB_EQ (errb, ERROR_ME)) | |
801 CHECK_SYMBOL (type); | |
802 | |
803 if (EQ (type, Qnothing)) | |
804 return IMAGE_NOTHING; | |
805 if (EQ (type, Qtext)) | |
806 return IMAGE_TEXT; | |
807 if (EQ (type, Qmono_pixmap)) | |
808 return IMAGE_MONO_PIXMAP; | |
809 if (EQ (type, Qcolor_pixmap)) | |
810 return IMAGE_COLOR_PIXMAP; | |
811 if (EQ (type, Qpointer)) | |
812 return IMAGE_POINTER; | |
813 if (EQ (type, Qsubwindow)) | |
814 return IMAGE_SUBWINDOW; | |
815 | |
816 maybe_signal_simple_error ("Invalid image-instance type", type, | |
817 Qimage, errb); | |
818 return IMAGE_UNKNOWN; | |
819 } | |
820 | |
821 static Lisp_Object | |
822 encode_image_instance_type (enum image_instance_type type) | |
823 { | |
824 switch (type) | |
825 { | |
826 case IMAGE_NOTHING: | |
827 return Qnothing; | |
828 case IMAGE_TEXT: | |
829 return Qtext; | |
830 case IMAGE_MONO_PIXMAP: | |
831 return Qmono_pixmap; | |
832 case IMAGE_COLOR_PIXMAP: | |
833 return Qcolor_pixmap; | |
834 case IMAGE_POINTER: | |
835 return Qpointer; | |
836 case IMAGE_SUBWINDOW: | |
837 return Qsubwindow; | |
838 default: | |
839 abort (); | |
840 } | |
841 | |
842 return Qnil; /* not reached */ | |
843 } | |
844 | |
845 static int | |
846 image_instance_type_to_mask (enum image_instance_type type) | |
847 { | |
848 /* This depends on the fact that enums are assigned consecutive | |
849 integers starting at 0. (Remember that IMAGE_UNKNOWN is the | |
850 first enum.) I'm fairly sure this behavior in ANSI-mandated, | |
851 so there should be no portability problems here. */ | |
852 return (1 << ((int) (type) - 1)); | |
853 } | |
854 | |
855 static int | |
856 decode_image_instance_type_list (Lisp_Object list) | |
857 { | |
858 Lisp_Object rest; | |
859 int mask = 0; | |
860 | |
861 if (NILP (list)) | |
862 return ~0; | |
863 | |
864 if (!CONSP (list)) | |
865 { | |
866 enum image_instance_type type = | |
867 decode_image_instance_type (list, ERROR_ME); | |
868 return image_instance_type_to_mask (type); | |
869 } | |
870 | |
871 EXTERNAL_LIST_LOOP (rest, list) | |
872 { | |
873 enum image_instance_type type = | |
874 decode_image_instance_type (XCAR (rest), ERROR_ME); | |
875 mask |= image_instance_type_to_mask (type); | |
876 } | |
877 | |
878 return mask; | |
879 } | |
880 | |
881 static Lisp_Object | |
882 encode_image_instance_type_list (int mask) | |
883 { | |
884 int count = 0; | |
885 Lisp_Object result = Qnil; | |
886 | |
887 while (mask) | |
888 { | |
889 count++; | |
890 if (mask & 1) | |
891 result = Fcons (encode_image_instance_type | |
892 ((enum image_instance_type) count), result); | |
893 mask >>= 1; | |
894 } | |
895 | |
896 return Fnreverse (result); | |
897 } | |
898 | |
899 DOESNT_RETURN | |
900 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask, | |
901 int desired_dest_mask) | |
902 { | |
903 signal_error | |
904 (Qerror, | |
905 list2 | |
906 (emacs_doprnt_string_lisp_2 | |
907 ((CONST Bufbyte *) | |
908 "No compatible image-instance types given: wanted one of %s, got %s", | |
909 Qnil, -1, 2, | |
910 encode_image_instance_type_list (desired_dest_mask), | |
911 encode_image_instance_type_list (given_dest_mask)), | |
912 instantiator)); | |
913 } | |
914 | |
915 static int | |
916 valid_image_instance_type_p (Lisp_Object type) | |
917 { | |
918 if (!NILP (memq_no_quit (type, Vimage_instance_type_list))) | |
919 return 1; | |
920 return 0; | |
921 } | |
922 | |
923 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, | |
924 Svalid_image_instance_type_p, 1, 1, 0 /* | |
925 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid. | |
926 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap, | |
927 'pointer, and 'subwindow, depending on how XEmacs was compiled. | |
928 */ ) | |
929 (image_instance_type) | |
930 Lisp_Object image_instance_type; | |
931 { | |
932 if (valid_image_instance_type_p (image_instance_type)) | |
933 return Qt; | |
934 else | |
935 return Qnil; | |
936 } | |
937 | |
938 DEFUN ("image-instance-type-list", Fimage_instance_type_list, | |
939 Simage_instance_type_list, | |
940 0, 0, 0 /* | |
941 Return a list of valid image-instance types. | |
942 */ ) | |
943 () | |
944 { | |
945 return Fcopy_sequence (Vimage_instance_type_list); | |
946 } | |
947 | |
948 Error_behavior | |
949 decode_error_behavior_flag (Lisp_Object no_error) | |
950 { | |
951 if (NILP (no_error)) | |
952 return ERROR_ME; | |
953 else if (EQ (no_error, Qt)) | |
954 return ERROR_ME_NOT; | |
955 else | |
956 return ERROR_ME_WARN; | |
957 } | |
958 | |
959 Lisp_Object | |
960 encode_error_behavior_flag (Error_behavior errb) | |
961 { | |
962 if (ERRB_EQ (errb, ERROR_ME)) | |
963 return Qnil; | |
964 else if (ERRB_EQ (errb, ERROR_ME_NOT)) | |
965 return Qt; | |
966 else | |
967 { | |
968 assert (ERRB_EQ (errb, ERROR_ME_WARN)); | |
969 return Qwarning; | |
970 } | |
971 } | |
972 | |
973 static Lisp_Object | |
974 make_image_instance_1 (Lisp_Object data, Lisp_Object device, | |
975 Lisp_Object dest_types) | |
976 { | |
977 Lisp_Object ii; | |
978 struct gcpro gcpro1; | |
979 int dest_mask; | |
980 | |
981 XSETDEVICE (device, decode_device (device)); | |
982 /* instantiate_image_instantiator() will abort if given an | |
983 image instance ... */ | |
984 if (IMAGE_INSTANCEP (data)) | |
985 signal_simple_error ("image instances not allowed here", data); | |
986 image_validate (data); | |
987 dest_mask = decode_image_instance_type_list (dest_types); | |
988 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)), | |
989 make_int (dest_mask)); | |
990 GCPRO1 (data); | |
991 if (VECTORP (data) | |
992 && EQ (vector_data (XVECTOR (data))[0], Qinherit)) | |
993 signal_simple_error ("inheritance not allowed here", data); | |
994 ii = instantiate_image_instantiator (device, data, Qnil, Qnil, dest_mask); | |
995 RETURN_UNGCPRO (ii); | |
996 } | |
997 | |
998 DEFUN ("make-image-instance", Fmake_image_instance, Smake_image_instance, | |
999 1, 4, 0 /* | |
1000 Create a new `image-instance' object. | |
1001 | |
1002 Image-instance objects encapsulate the way a particular image (pixmap, | |
1003 etc.) is displayed on a particular device. In most circumstances, you | |
1004 do not need to directly create image instances; use a glyph instead. | |
1005 However, it may occasionally be useful to explicitly create image | |
1006 instances, if you want more control over the instantiation process. | |
1007 | |
1008 DATA is an image instantiator, which describes the image; see | |
1009 `image-specifier-p' for a description of the allowed values. | |
1010 | |
1011 DEST-TYPES should be a list of allowed image instance types that can | |
1012 be generated. The recognized image instance types are | |
1013 | |
1014 'nothing | |
1015 Nothing is displayed. | |
1016 'text | |
1017 Displayed as text. The foreground and background colors and the | |
1018 font of the text are specified independent of the pixmap. Typically | |
1019 these attributes will come from the face of the surrounding text, | |
1020 unless a face is specified for the glyph in which the image appears. | |
1021 'mono-pixmap | |
1022 Displayed as a mono pixmap (a pixmap with only two colors where the | |
1023 foreground and background can be specified independent of the pixmap; | |
1024 typically the pixmap assumes the foreground and background colors of | |
1025 the text around it, unless a face is specified for the glyph in which | |
1026 the image appears). | |
1027 'color-pixmap | |
1028 Displayed as a color pixmap. | |
1029 'pointer | |
1030 Used as the mouse pointer for a window. | |
1031 'subwindow | |
1032 A child window that is treated as an image. This allows (e.g.) | |
1033 another program to be responsible for drawing into the window. | |
1034 Not currently implemented. | |
1035 | |
1036 The DEST-TYPES list is unordered. If multiple destination types | |
1037 are possible for a given instantiator, the \"most natural\" type | |
1038 for the instantiator's format is chosen. (For XBM, the most natural | |
1039 types are `mono-pixmap', followed by `color-pixmap', followed by | |
1040 `pointer'. For the other normal image formats, the most natural | |
1041 types are `color-pixmap', followed by `mono-pixmap', followed by | |
1042 `pointer'. For the string and formatted-string formats, the most | |
1043 natural types are `text', followed by `mono-pixmap' (not currently | |
1044 implemented), followed by `color-pixmap' (not currently implemented). | |
1045 The other formats can only be instantiated as one type. (If you | |
1046 want to control more specifically the order of the types into which | |
1047 an image is instantiated, just call `make-image-instance' repeatedly | |
1048 until it succeeds, passing less and less preferred destination types | |
1049 each time. | |
1050 | |
1051 If DEST-TYPES is omitted, all possible types are allowed. | |
1052 | |
1053 NO-ERROR controls what happens when the image cannot be generated. | |
1054 If nil, an error message is generated. If t, no messages are | |
1055 generated and this function returns nil. If anything else, a warning | |
1056 message is generated and this function returns nil. | |
1057 */ ) | |
1058 (data, device, dest_types, no_error) | |
1059 Lisp_Object data, device, dest_types, no_error; | |
1060 { | |
1061 Error_behavior errb = decode_error_behavior_flag (no_error); | |
1062 | |
1063 return call_with_suspended_errors (make_image_instance_1, | |
1064 Qnil, Qimage, errb, | |
1065 3, data, device, dest_types); | |
1066 } | |
1067 | |
1068 DEFUN ("image-instance-p", Fimage_instance_p, Simage_instance_p, 1, 1, 0 /* | |
1069 Return non-nil if OBJECT is an image instance. | |
1070 */ ) | |
1071 (object) | |
1072 Lisp_Object object; | |
1073 { | |
1074 return (IMAGE_INSTANCEP (object) ? Qt : Qnil); | |
1075 } | |
1076 | |
1077 DEFUN ("image-instance-type", Fimage_instance_type, Simage_instance_type, | |
1078 1, 1, 0 /* | |
1079 Return the type of the given image instance. | |
1080 The return value will be one of 'nothing, 'text, 'mono-pixmap, | |
1081 'color-pixmap, 'pointer, or 'subwindow. | |
1082 */ ) | |
1083 (image_instance) | |
1084 Lisp_Object image_instance; | |
1085 { | |
1086 CHECK_IMAGE_INSTANCE (image_instance); | |
1087 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance)); | |
1088 } | |
1089 | |
1090 DEFUN ("image-instance-name", Fimage_instance_name, | |
1091 Simage_instance_name, 1, 1, 0 /* | |
1092 Return the name of the given image instance. | |
1093 */ ) | |
1094 (image_instance) | |
1095 Lisp_Object image_instance; | |
1096 { | |
1097 CHECK_IMAGE_INSTANCE (image_instance); | |
1098 return (XIMAGE_INSTANCE_NAME (image_instance)); | |
1099 } | |
1100 | |
1101 DEFUN ("image-instance-string", Fimage_instance_string, | |
1102 Simage_instance_string, 1, 1, 0 /* | |
1103 Return the string of the given image instance. | |
1104 This will only be non-nil for text image instances. | |
1105 */ ) | |
1106 (image_instance) | |
1107 Lisp_Object image_instance; | |
1108 { | |
1109 CHECK_IMAGE_INSTANCE (image_instance); | |
1110 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) | |
1111 return (XIMAGE_INSTANCE_TEXT_STRING (image_instance)); | |
1112 else | |
1113 return Qnil; | |
1114 } | |
1115 | |
1116 DEFUN ("image-instance-file-name", Fimage_instance_file_name, | |
1117 Simage_instance_file_name, 1, 1, 0 /* | |
1118 Return the file name from which IMAGE-INSTANCE was read, if known. | |
1119 */ ) | |
1120 (image_instance) | |
1121 Lisp_Object image_instance; | |
1122 { | |
1123 CHECK_IMAGE_INSTANCE (image_instance); | |
1124 | |
1125 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1126 { | |
1127 case IMAGE_MONO_PIXMAP: | |
1128 case IMAGE_COLOR_PIXMAP: | |
1129 case IMAGE_POINTER: | |
1130 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance); | |
1131 | |
1132 default: | |
1133 return Qnil; | |
1134 } | |
1135 } | |
1136 | |
1137 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, | |
1138 Simage_instance_mask_file_name, 1, 1, 0 /* | |
1139 Return the file name from which IMAGE-INSTANCE's mask was read, if known. | |
1140 */ ) | |
1141 (image_instance) | |
1142 Lisp_Object image_instance; | |
1143 { | |
1144 CHECK_IMAGE_INSTANCE (image_instance); | |
1145 | |
1146 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1147 { | |
1148 case IMAGE_MONO_PIXMAP: | |
1149 case IMAGE_COLOR_PIXMAP: | |
1150 case IMAGE_POINTER: | |
1151 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance); | |
1152 | |
1153 default: | |
1154 return Qnil; | |
1155 } | |
1156 } | |
1157 | |
1158 DEFUN ("image-instance-depth", Fimage_instance_depth, | |
1159 Simage_instance_depth, 1, 1, 0 /* | |
1160 Return the depth of the image instance. | |
1161 This is 0 for a bitmap, or a positive integer for a pixmap. | |
1162 */ ) | |
1163 (image_instance) | |
1164 Lisp_Object image_instance; | |
1165 { | |
1166 CHECK_IMAGE_INSTANCE (image_instance); | |
1167 | |
1168 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1169 { | |
1170 case IMAGE_MONO_PIXMAP: | |
1171 case IMAGE_COLOR_PIXMAP: | |
1172 case IMAGE_POINTER: | |
1173 return (make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance))); | |
1174 | |
1175 default: | |
1176 return Qnil; | |
1177 } | |
1178 } | |
1179 | |
1180 DEFUN ("image-instance-height", Fimage_instance_height, | |
1181 Simage_instance_height, 1, 1, 0 /* | |
1182 Return the height of the image instance, in pixels. | |
1183 */ ) | |
1184 (image_instance) | |
1185 Lisp_Object image_instance; | |
1186 { | |
1187 CHECK_IMAGE_INSTANCE (image_instance); | |
1188 | |
1189 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1190 { | |
1191 case IMAGE_MONO_PIXMAP: | |
1192 case IMAGE_COLOR_PIXMAP: | |
1193 case IMAGE_POINTER: | |
1194 return (make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance))); | |
1195 | |
1196 default: | |
1197 return Qnil; | |
1198 } | |
1199 } | |
1200 | |
1201 DEFUN ("image-instance-width", Fimage_instance_width, | |
1202 Simage_instance_width, 1, 1, 0 /* | |
1203 Return the width of the image instance, in pixels. | |
1204 */ ) | |
1205 (image_instance) | |
1206 Lisp_Object image_instance; | |
1207 { | |
1208 CHECK_IMAGE_INSTANCE (image_instance); | |
1209 | |
1210 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1211 { | |
1212 case IMAGE_MONO_PIXMAP: | |
1213 case IMAGE_COLOR_PIXMAP: | |
1214 case IMAGE_POINTER: | |
1215 return (make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance))); | |
1216 | |
1217 default: | |
1218 return Qnil; | |
1219 } | |
1220 } | |
1221 | |
1222 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, | |
1223 Simage_instance_hotspot_x, 1, 1, 0 /* | |
1224 Return the X coordinate of the image instance's hotspot, if known. | |
1225 This is a point relative to the origin of the pixmap. When an image is | |
1226 used as a mouse pointer, the hotspot is the point on the image that sits | |
1227 over the location that the pointer points to. This is, for example, the | |
1228 tip of the arrow or the center of the crosshairs. | |
1229 This will always be nil for a non-pointer image instance. | |
1230 */ ) | |
1231 (image_instance) | |
1232 Lisp_Object image_instance; | |
1233 { | |
1234 CHECK_IMAGE_INSTANCE (image_instance); | |
1235 | |
1236 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1237 { | |
1238 case IMAGE_MONO_PIXMAP: | |
1239 case IMAGE_COLOR_PIXMAP: | |
1240 case IMAGE_POINTER: | |
1241 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance); | |
1242 | |
1243 default: | |
1244 return Qnil; | |
1245 } | |
1246 } | |
1247 | |
1248 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, | |
1249 Simage_instance_hotspot_y, 1, 1, 0 /* | |
1250 Return the Y coordinate of the image instance's hotspot, if known. | |
1251 This is a point relative to the origin of the pixmap. When an image is | |
1252 used as a mouse pointer, the hotspot is the point on the image that sits | |
1253 over the location that the pointer points to. This is, for example, the | |
1254 tip of the arrow or the center of the crosshairs. | |
1255 This will always be nil for a non-pointer image instance. | |
1256 */ ) | |
1257 (image_instance) | |
1258 Lisp_Object image_instance; | |
1259 { | |
1260 CHECK_IMAGE_INSTANCE (image_instance); | |
1261 | |
1262 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1263 { | |
1264 case IMAGE_MONO_PIXMAP: | |
1265 case IMAGE_COLOR_PIXMAP: | |
1266 case IMAGE_POINTER: | |
1267 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance); | |
1268 | |
1269 default: | |
1270 return Qnil; | |
1271 } | |
1272 } | |
1273 | |
1274 DEFUN ("image-instance-foreground", Fimage_instance_foreground, | |
1275 Simage_instance_foreground, 1, 1, 0 /* | |
1276 Return the foreground color of IMAGE-INSTANCE, if applicable. | |
1277 This will be a color instance or nil. (It will only be non-nil for | |
1278 colorized mono pixmaps and for pointers.) | |
1279 */ ) | |
1280 (image_instance) | |
1281 Lisp_Object image_instance; | |
1282 { | |
1283 CHECK_IMAGE_INSTANCE (image_instance); | |
1284 | |
1285 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1286 { | |
1287 case IMAGE_MONO_PIXMAP: | |
1288 case IMAGE_COLOR_PIXMAP: | |
1289 case IMAGE_POINTER: | |
1290 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance); | |
1291 | |
1292 default: | |
1293 return Qnil; | |
1294 } | |
1295 } | |
1296 | |
1297 DEFUN ("image-instance-background", Fimage_instance_background, | |
1298 Simage_instance_background, 1, 1, 0 /* | |
1299 Return the background color of IMAGE-INSTANCE, if applicable. | |
1300 This will be a color instance or nil. (It will only be non-nil for | |
1301 colorized mono pixmaps and for pointers.) | |
1302 */ ) | |
1303 (image_instance) | |
1304 Lisp_Object image_instance; | |
1305 { | |
1306 CHECK_IMAGE_INSTANCE (image_instance); | |
1307 | |
1308 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1309 { | |
1310 case IMAGE_MONO_PIXMAP: | |
1311 case IMAGE_COLOR_PIXMAP: | |
1312 case IMAGE_POINTER: | |
1313 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance); | |
1314 | |
1315 default: | |
1316 return Qnil; | |
1317 } | |
1318 } | |
1319 | |
1320 | |
1321 DEFUN ("colorize-image-instance", Fcolorize_image_instance, | |
1322 Scolorize_image_instance, 3, 3, 0 /* | |
1323 Make the image instance be displayed in the given colors. | |
1324 This function returns a new image instance that is exactly like the | |
1325 specified one except that (if possible) the foreground and background | |
1326 colors and as specified. Currently, this only does anything if the image | |
1327 instance is a mono pixmap; otherwise, the same image instance is returned. | |
1328 */ ) | |
1329 (image_instance, foreground, background) | |
1330 Lisp_Object image_instance, foreground, background; | |
1331 { | |
1332 Lisp_Object new; | |
1333 Lisp_Object device; | |
1334 | |
1335 CHECK_IMAGE_INSTANCE (image_instance); | |
1336 CHECK_COLOR_INSTANCE (foreground); | |
1337 CHECK_COLOR_INSTANCE (background); | |
1338 | |
1339 device = XIMAGE_INSTANCE_DEVICE (image_instance); | |
1340 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance)) | |
1341 return image_instance; | |
1342 | |
1343 new = allocate_image_instance (device); | |
1344 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance)); | |
1345 /* note that if this method returns non-zero, this method MUST | |
1346 copy any window-system resources, so that when one image instance is | |
1347 freed, the other one is not hosed. */ | |
1348 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground, | |
1349 background))) | |
1350 return image_instance; | |
1351 return new; | |
1352 } | |
1353 | |
1354 | |
1355 /**************************************************************************** | |
1356 * nothing * | |
1357 ****************************************************************************/ | |
1358 | |
1359 static int | |
1360 nothing_possible_dest_types () | |
1361 { | |
1362 return IMAGE_NOTHING_MASK; | |
1363 } | |
1364 | |
1365 static void | |
1366 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
1367 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
1368 int dest_mask) | |
1369 { | |
1370 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); | |
1371 | |
1372 if (dest_mask & IMAGE_NOTHING_MASK) | |
1373 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING; | |
1374 else | |
1375 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK); | |
1376 } | |
1377 | |
1378 | |
1379 /**************************************************************************** | |
1380 * inherit * | |
1381 ****************************************************************************/ | |
1382 | |
1383 static void | |
1384 inherit_validate (Lisp_Object instantiator) | |
1385 { | |
1386 face_must_be_present (instantiator); | |
1387 } | |
1388 | |
1389 static Lisp_Object | |
1390 inherit_normalize (Lisp_Object inst, Lisp_Object console_type) | |
1391 { | |
1392 Lisp_Object face; | |
1393 | |
1394 assert (XVECTOR (inst)->size == 3); | |
1395 face = vector_data (XVECTOR (inst))[2]; | |
1396 if (!FACEP (face)) | |
1397 inst = vector3 (Qinherit, Q_face, Fget_face (face)); | |
1398 return inst; | |
1399 } | |
1400 | |
1401 static int | |
1402 inherit_possible_dest_types () | |
1403 { | |
1404 return IMAGE_MONO_PIXMAP_MASK; | |
1405 } | |
1406 | |
1407 static void | |
1408 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
1409 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
1410 int dest_mask) | |
1411 { | |
1412 /* handled specially in image_instantiate */ | |
1413 abort (); | |
1414 } | |
1415 | |
1416 | |
1417 /**************************************************************************** | |
1418 * string * | |
1419 ****************************************************************************/ | |
1420 | |
1421 static void | |
1422 string_validate (Lisp_Object instantiator) | |
1423 { | |
1424 data_must_be_present (instantiator); | |
1425 } | |
1426 | |
1427 static int | |
1428 string_possible_dest_types () | |
1429 { | |
1430 return IMAGE_TEXT_MASK; | |
1431 } | |
1432 | |
1433 /* called from autodetect_instantiate() */ | |
1434 void | |
1435 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
1436 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
1437 int dest_mask) | |
1438 { | |
1439 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); | |
1440 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); | |
1441 | |
1442 assert (!NILP (data)); | |
1443 if (dest_mask & IMAGE_TEXT_MASK) | |
1444 { | |
1445 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; | |
1446 IMAGE_INSTANCE_TEXT_STRING (ii) = data; | |
1447 } | |
1448 else | |
1449 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); | |
1450 } | |
1451 | |
1452 | |
1453 /**************************************************************************** | |
1454 * formatted-string * | |
1455 ****************************************************************************/ | |
1456 | |
1457 static void | |
1458 formatted_string_validate (Lisp_Object instantiator) | |
1459 { | |
1460 data_must_be_present (instantiator); | |
1461 } | |
1462 | |
1463 static int | |
1464 formatted_string_possible_dest_types () | |
1465 { | |
1466 return IMAGE_TEXT_MASK; | |
1467 } | |
1468 | |
1469 static void | |
1470 formatted_string_instantiate (Lisp_Object image_instance, | |
1471 Lisp_Object instantiator, | |
1472 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
1473 int dest_mask) | |
1474 { | |
1475 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); | |
1476 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); | |
1477 | |
1478 assert (!NILP (data)); | |
1479 /* #### implement this */ | |
1480 warn_when_safe (Qunimplemented, Qnotice, | |
1481 "`formatted-string' not yet implemented; assuming `string'"); | |
1482 if (dest_mask & IMAGE_TEXT_MASK) | |
1483 { | |
1484 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; | |
1485 IMAGE_INSTANCE_TEXT_STRING (ii) = data; | |
1486 } | |
1487 else | |
1488 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); | |
1489 } | |
1490 | |
1491 | |
1492 /**************************************************************************** | |
1493 * Image Specifier Object * | |
1494 ****************************************************************************/ | |
1495 | |
1496 DEFINE_SPECIFIER_TYPE (image); | |
1497 | |
1498 static void | |
1499 image_create (Lisp_Object obj) | |
1500 { | |
1501 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); | |
1502 | |
1503 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */ | |
1504 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil; | |
1505 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil; | |
1506 } | |
1507 | |
1508 static void | |
1509 image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) | |
1510 { | |
1511 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); | |
1512 | |
1513 ((markobj) (IMAGE_SPECIFIER_ATTACHEE (image))); | |
1514 ((markobj) (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image))); | |
1515 } | |
1516 | |
1517 static Lisp_Object | |
1518 image_instantiate_cache_result (Lisp_Object locative) | |
1519 { | |
1520 Lisp_Object instance = Fcar (locative); | |
1521 Lisp_Object instantiator = Fcar (Fcdr (locative)); | |
1522 Lisp_Object subtable = Fcdr (Fcdr (locative)); | |
1523 Fputhash (instantiator, instance, subtable); | |
1524 free_cons (XCONS (XCDR (locative))); | |
1525 free_cons (XCONS (locative)); | |
1526 return Qnil; | |
1527 } | |
1528 | |
1529 /* Given a specification for an image, return an instance of | |
1530 the image which matches the given instantiator and which can be | |
1531 displayed in the given domain. */ | |
1532 | |
1533 static Lisp_Object | |
1534 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec, | |
1535 Lisp_Object domain, Lisp_Object instantiator, | |
1536 Lisp_Object depth) | |
1537 { | |
1538 Lisp_Object device = DFW_DEVICE (domain); | |
1539 struct device *d = XDEVICE (device); | |
1540 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); | |
1541 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); | |
1542 | |
1543 if (IMAGE_INSTANCEP (instantiator)) | |
1544 { | |
1545 /* make sure that the image instance's device and type are | |
1546 matching. */ | |
1547 | |
1548 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator))) | |
1549 { | |
1550 int mask = | |
1551 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator)); | |
1552 if (mask & dest_mask) | |
1553 return instantiator; | |
1554 else | |
1555 signal_simple_error ("Type of image instance not allowed here", | |
1556 instantiator); | |
1557 } | |
1558 else | |
1559 signal_simple_error_2 ("Wrong device for image instance", | |
1560 instantiator, device); | |
1561 } | |
1562 else if (VECTORP (instantiator) | |
1563 && EQ (vector_data (XVECTOR (instantiator))[0], Qinherit)) | |
1564 { | |
1565 assert (XVECTOR (instantiator)->size == 3); | |
1566 return (FACE_PROPERTY_INSTANCE | |
1567 (Fget_face (vector_data (XVECTOR (instantiator))[2]), | |
1568 Qbackground_pixmap, domain, 0, depth)); | |
1569 } | |
1570 else | |
1571 { | |
1572 Lisp_Object instance; | |
1573 Lisp_Object subtable; | |
1574 Lisp_Object ls3 = Qnil; | |
1575 Lisp_Object pointer_fg = Qnil; | |
1576 Lisp_Object pointer_bg = Qnil; | |
1577 | |
1578 if (pointerp) | |
1579 { | |
1580 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain); | |
1581 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain); | |
1582 ls3 = list3 (instantiator, pointer_fg, pointer_bg); | |
1583 } | |
1584 | |
1585 /* First look in the hash table. */ | |
1586 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache, | |
1587 Qunbound); | |
1588 if (UNBOUNDP (subtable)) | |
1589 { | |
1590 /* For the image instance cache, we do comparisons with EQ rather | |
1591 than with EQUAL, as we do for color and font names. | |
1592 The reasons are: | |
1593 | |
1594 1) pixmap data can be very long, and thus the hashing and | |
1595 comparing will take awhile. | |
1596 2) It's not so likely that we'll run into things that are EQUAL | |
1597 but not EQ (that can happen a lot with faces, because their | |
1598 specifiers are copied around); but pixmaps tend not to be | |
1599 in faces. | |
1600 | |
1601 However, if the image-instance could be a pointer, we have to | |
1602 use EQUAL because we massaged the instantiator into a cons3 | |
1603 also containing the foreground and background of the | |
1604 pointer face. | |
1605 */ | |
1606 | |
1607 subtable = make_lisp_hashtable (20, | |
1608 pointerp ? HASHTABLE_KEY_CAR_WEAK | |
1609 : HASHTABLE_KEY_WEAK, | |
1610 pointerp ? HASHTABLE_EQUAL | |
1611 : HASHTABLE_EQ); | |
1612 Fputhash (make_int (dest_mask), subtable, | |
1613 d->image_instance_cache); | |
1614 instance = Qunbound; | |
1615 } | |
1616 else | |
1617 instance = Fgethash (pointerp ? ls3 : instantiator, | |
1618 subtable, Qunbound); | |
1619 | |
1620 if (UNBOUNDP (instance)) | |
1621 { | |
1622 Lisp_Object locative = | |
1623 noseeum_cons (Qnil, | |
1624 noseeum_cons (pointerp ? ls3 : instantiator, | |
1625 subtable)); | |
1626 int speccount = specpdl_depth (); | |
1627 | |
1628 /* make sure we cache the failures, too. | |
1629 Use an unwind-protect to catch such errors. | |
1630 If we fail, the unwind-protect records nil in | |
1631 the hash table. If we succeed, we change the | |
1632 car of the locative to the resulting instance, | |
1633 which gets recorded instead. */ | |
1634 record_unwind_protect (image_instantiate_cache_result, | |
1635 locative); | |
1636 instance = instantiate_image_instantiator (device, | |
1637 instantiator, | |
1638 pointer_fg, pointer_bg, | |
1639 dest_mask); | |
1640 Fsetcar (locative, instance); | |
1641 unbind_to (speccount, Qnil); | |
1642 } | |
1643 else | |
1644 free_list (ls3); | |
1645 | |
1646 if (NILP (instance)) | |
1647 signal_simple_error ("Can't instantiate image (probably cached)", | |
1648 instantiator); | |
1649 return instance; | |
1650 } | |
1651 | |
1652 abort (); | |
1653 return Qnil; /* not reached */ | |
1654 } | |
1655 | |
1656 /* Validate an image instantiator. */ | |
1657 | |
1658 static void | |
1659 image_validate (Lisp_Object instantiator) | |
1660 { | |
1661 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator)) | |
1662 return; | |
1663 else if (VECTORP (instantiator)) | |
1664 { | |
1665 Lisp_Object *elt = vector_data (XVECTOR (instantiator)); | |
1666 int instantiator_len = XVECTOR (instantiator)->size; | |
1667 struct image_instantiator_methods *meths; | |
1668 Lisp_Object already_seen = Qnil; | |
1669 struct gcpro gcpro1; | |
1670 int i; | |
1671 | |
1672 if (instantiator_len < 1) | |
1673 signal_simple_error ("Vector length must be at least 1", | |
1674 instantiator); | |
1675 | |
1676 meths = decode_image_instantiator_format (elt[0], ERROR_ME); | |
1677 if (!(instantiator_len & 1)) | |
1678 signal_simple_error | |
1679 ("Must have alternating keyword/value pairs", instantiator); | |
1680 | |
1681 GCPRO1 (already_seen); | |
1682 | |
1683 for (i = 1; i < instantiator_len; i += 2) | |
1684 { | |
1685 Lisp_Object keyword = elt[i]; | |
1686 Lisp_Object value = elt[i+1]; | |
1687 int j; | |
1688 | |
1689 CHECK_SYMBOL (keyword); | |
1690 if (!SYMBOL_IS_KEYWORD (keyword)) | |
1691 signal_simple_error ("Symbol must begin with a colon", keyword); | |
1692 | |
1693 for (j = 0; j < Dynarr_length (meths->keywords); j++) | |
1694 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) | |
1695 break; | |
1696 | |
1697 if (j == Dynarr_length (meths->keywords)) | |
1698 signal_simple_error ("Unrecognized keyword", keyword); | |
1699 | |
1700 if (!Dynarr_at (meths->keywords, j).multiple_p) | |
1701 { | |
1702 if (!NILP (memq_no_quit (keyword, already_seen))) | |
1703 signal_simple_error | |
1704 ("Keyword may not appear more than once", keyword); | |
1705 already_seen = Fcons (keyword, already_seen); | |
1706 } | |
1707 | |
1708 (Dynarr_at (meths->keywords, j).validate) (value); | |
1709 } | |
1710 | |
1711 UNGCPRO; | |
1712 | |
1713 MAYBE_IIFORMAT_METH (meths, validate, (instantiator)); | |
1714 } | |
1715 else | |
1716 signal_simple_error ("Must be string or vector", instantiator); | |
1717 } | |
1718 | |
1719 static void | |
1720 image_after_change (Lisp_Object specifier, Lisp_Object locale) | |
1721 { | |
1722 Lisp_Object attachee = | |
1723 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); | |
1724 Lisp_Object property = | |
1725 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier)); | |
1726 if (FACEP (attachee)) | |
1727 face_property_was_changed (attachee, property, locale); | |
1728 else if (GLYPHP (attachee)) | |
1729 glyph_property_was_changed (attachee, property, locale); | |
1730 } | |
1731 | |
1732 void | |
1733 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph, | |
1734 Lisp_Object property) | |
1735 { | |
1736 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); | |
1737 | |
1738 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph; | |
1739 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property; | |
1740 } | |
1741 | |
1742 static Lisp_Object | |
1743 image_going_to_add (Lisp_Object specifier, Lisp_Object locale, | |
1744 Lisp_Object tag_set, Lisp_Object instantiator) | |
1745 { | |
1746 Lisp_Object possible_console_types = Qnil; | |
1747 Lisp_Object rest; | |
1748 Lisp_Object retlist = Qnil; | |
1749 struct gcpro gcpro1, gcpro2; | |
1750 | |
1751 LIST_LOOP (rest, Vconsole_type_list) | |
1752 { | |
1753 Lisp_Object contype = XCAR (rest); | |
1754 if (!NILP (memq_no_quit (contype, tag_set))) | |
1755 possible_console_types = Fcons (contype, possible_console_types); | |
1756 } | |
1757 | |
1758 if (XINT (Flength (possible_console_types)) > 1) | |
1759 /* two conflicting console types specified */ | |
1760 return Qnil; | |
1761 | |
1762 if (NILP (possible_console_types)) | |
1763 possible_console_types = Vconsole_type_list; | |
1764 | |
1765 GCPRO2 (retlist, possible_console_types); | |
1766 | |
1767 LIST_LOOP (rest, possible_console_types) | |
1768 { | |
1769 Lisp_Object newinst; | |
1770 Lisp_Object contype = XCAR (rest); | |
1771 | |
1772 newinst = call_with_suspended_errors (normalize_image_instantiator, | |
1773 Qnil, Qimage, ERROR_ME_NOT, | |
1774 3, instantiator, contype, | |
1775 make_int | |
1776 (XIMAGE_SPECIFIER_ALLOWED | |
1777 (specifier))); | |
1778 if (!NILP (newinst)) | |
1779 { | |
1780 Lisp_Object newtag; | |
1781 if (NILP (memq_no_quit (contype, tag_set))) | |
1782 newtag = Fcons (contype, tag_set); | |
1783 else | |
1784 newtag = tag_set; | |
1785 retlist = Fcons (Fcons (newtag, newinst), retlist); | |
1786 } | |
1787 } | |
1788 | |
1789 UNGCPRO; | |
1790 | |
1791 return retlist; | |
1792 } | |
1793 | |
1794 DEFUN ("image-specifier-p", Fimage_specifier_p, Simage_specifier_p, 1, 1, 0 /* | |
1795 Return non-nil if OBJECT is an image specifier. | |
1796 | |
1797 An image specifier is used for images (pixmaps and the like). It is used | |
1798 to describe the actual image in a glyph. It is instanced as an image- | |
1799 instance. | |
1800 | |
1801 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg', | |
1802 etc. This describes the format of the data describing the image. The | |
1803 resulting image instances also come in many types -- `mono-pixmap', | |
1804 `color-pixmap', `text', `pointer', etc. This refers to the behavior of | |
1805 the image and the sorts of places it can appear. (For example, a | |
1806 color-pixmap image has fixed colors specified for it, while a | |
1807 mono-pixmap image comes in two unspecified shades \"foreground\" and | |
1808 \"background\" that are determined from the face of the glyph or | |
1809 surrounding text; a text image appears as a string of text and has an | |
1810 unspecified foreground, background, and font; a pointer image behaves | |
1811 like a mono-pixmap image but can only be used as a mouse pointer | |
1812 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is | |
1813 important to keep the distinction between image instantiator format and | |
1814 image instance type in mind. Typically, a given image instantiator | |
1815 format can result in many different image instance types (for example, | |
1816 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer'; | |
1817 whereas `cursor-font' can be instanced only as `pointer'), and a | |
1818 particular image instance type can be generated by many different | |
1819 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm', | |
1820 `gif', `jpeg', etc.). | |
1821 | |
1822 See `make-image-instance' for a more detailed discussion of image | |
1823 instance types. | |
1824 | |
1825 An image instantiator should be a string or a vector of the form | |
1826 | |
1827 [FORMAT :KEYWORD VALUE ...] | |
1828 | |
1829 i.e. a format symbol followed by zero or more alternating keyword-value | |
1830 pairs. FORMAT should be one of | |
1831 | |
1832 'nothing | |
1833 (Don't display anything; no keywords are valid for this. | |
1834 Can only be instanced as `nothing'.) | |
1835 'string | |
1836 (Display this image as a text string. Can only be instanced | |
1837 as `text', although support for instancing as `mono-pixmap' | |
1838 should be added.) | |
1839 'formatted-string | |
1840 (Display this image as a text string, with replaceable fields; | |
1841 not currently implemented.) | |
1842 'xbm | |
1843 (An X bitmap; only if X support was compiled into this XEmacs. | |
1844 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.) | |
1845 'xpm | |
1846 (An XPM pixmap; only if XPM support was compiled into this XEmacs. | |
1847 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.) | |
1848 'xface | |
1849 (An X-Face bitmap, used to encode people's faces in e-mail messages; | |
1850 only if X-Face support was compiled into this XEmacs. Can be | |
1851 instanced as `mono-pixmap', `color-pixmap', or `pointer'.) | |
1852 'gif | |
1853 (A GIF87 or GIF89 image; only if GIF support was compiled into this | |
1854 XEmacs. Can be instanced as `color-pixmap'.) | |
1855 'jpeg | |
1856 (A JPEG image; only if JPEG support was compiled into this XEmacs. | |
1857 Can be instanced as `color-pixmap'.) | |
1858 'png | |
1859 (A PNG/GIF24 image; only if PNG support was compiled into this XEmacs. | |
1860 Can be instanced as `color-pixmap'.) | |
1861 'tiff | |
1862 (A TIFF image; not currently implemented.) | |
1863 'cursor-font | |
1864 (One of the standard cursor-font names, such as \"watch\" or | |
1865 \"right_ptr\" under X. Under X, this is, more specifically, any | |
1866 of the standard cursor names from appendix B of the Xlib manual | |
1867 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix. | |
1868 On other window systems, the valid names will be specific to the | |
1869 type of window system. Can only be instanced as `pointer'.) | |
1870 'font | |
1871 (A glyph from a font; i.e. the name of a font, and glyph index into it | |
1872 of the form \"FONT fontname index [[mask-font] mask-index]\". | |
1873 Currently can only be instanced as `pointer', although this should | |
1874 probably be fixed.) | |
1875 'subwindow | |
1876 (An embedded X window; not currently implemented.) | |
1877 'autodetect | |
1878 (XEmacs tries to guess what format the data is in. If X support | |
1879 exists, the data string will be checked to see if it names a filename. | |
1880 If so, and this filename contains XBM or XPM data, the appropriate | |
1881 sort of pixmap or pointer will be created. [This includes picking up | |
1882 any specified hotspot or associated mask file.] Otherwise, if `pointer' | |
1883 is one of the allowable image-instance types and the string names a | |
1884 valid cursor-font name, the image will be created as a pointer. | |
1885 Otherwise, the image will be displayed as text. If no X support | |
1886 exists, the image will always be displayed as text.) | |
1887 'inherit | |
1888 Inherit from the background-pixmap property of a face. | |
1889 | |
1890 The valid keywords are: | |
1891 | |
1892 :data | |
1893 (Inline data. For most formats above, this should be a string. For | |
1894 XBM images, this should be a list of three elements: width, height, and | |
1895 a string of bit data. This keyword is not valid for instantiator | |
1896 formats `nothing' and `inherit'.) | |
1897 :file | |
1898 (Data is contained in a file. The value is the name of this file. | |
1899 If both :data and :file are specified, the image is created from | |
1900 what is specified in :data and the string in :file becomes the | |
1901 value of the `image-instance-file-name' function when applied to | |
1902 the resulting image-instance. This keyword is not valid for | |
1903 instantiator formats `nothing', `string', `formatted-string', | |
1904 `cursor-font', `font', `autodetect', and `inherit'.) | |
1905 :foreground | |
1906 :background | |
1907 (For `xbm', `xface', `cursor-font', and `font'. These keywords | |
1908 allow you to explicitly specify foreground and background colors. | |
1909 The argument should be anything acceptable to `make-color-instance'. | |
1910 This will cause what would be a `mono-pixmap' to instead be colorized | |
1911 as a two-color color-pixmap, and specifies the foreground and/or | |
1912 background colors for a pointer instead of black and white.) | |
1913 :mask-data | |
1914 (For `xbm' and `xface'. This specifies a mask to be used with the | |
1915 bitmap. The format is a list of width, height, and bits, like for | |
1916 :data.) | |
1917 :mask-file | |
1918 (For `xbm' and `xface'. This specifies a file containing the mask data. | |
1919 If neither a mask file nor inline mask data is given for an XBM image, | |
1920 and the XBM image comes from a file, XEmacs will look for a mask file | |
1921 with the same name as the image file but with \"Mask\" or \"msk\" | |
1922 appended. For example, if you specify the XBM file \"left_ptr\" | |
1923 [usually located in \"/usr/include/X11/bitmaps\"], the associated | |
1924 mask file \"left_ptrmsk\" will automatically be picked up.) | |
1925 :hotspot-x | |
1926 :hotspot-y | |
1927 (For `xbm' and `xface'. These keywords specify a hotspot if the image | |
1928 is instantiated as a `pointer'. Note that if the XBM image file | |
1929 specifies a hotspot, it will automatically be picked up if no | |
1930 explicit hotspot is given.) | |
1931 :color-symbols | |
1932 (Only for `xpm'. This specifies an alist that maps strings | |
1933 that specify symbolic color names to the actual color to be used | |
1934 for that symbolic color (in the form of a string or a color-specifier | |
1935 object). If this is not specified, the contents of `xpm-color-symbols' | |
1936 are used to generate the alist.) | |
1937 :face | |
1938 (Only for `inherit'. This specifies the face to inherit from.) | |
1939 | |
1940 If instead of a vector, the instantiator is a string, it will be | |
1941 converted into a vector by looking it up according to the specs in the | |
1942 `console-type-image-conversion-list' (q.v.) for the console type of | |
1943 the domain (usually a window; sometimes a frame or device) over which | |
1944 the image is being instantiated. | |
1945 | |
1946 If the instantiator specifies data from a file, the data will be read | |
1947 in at the time that the instantiator is added to the image (which may | |
1948 be well before when the image is actually displayed), and the | |
1949 instantiator will be converted into one of the inline-data forms, with | |
1950 the filename retained using a :file keyword. This implies that the | |
1951 file must exist when the instantiator is added to the image, but does | |
1952 not need to exist at any other time (e.g. it may safely be a temporary | |
1953 file). | |
1954 */ ) | |
1955 (object) | |
1956 Lisp_Object object; | |
1957 { | |
1958 return (IMAGE_SPECIFIERP (object) ? Qt : Qnil); | |
1959 } | |
1960 | |
1961 | |
1962 /**************************************************************************** | |
1963 * Glyph Object * | |
1964 ****************************************************************************/ | |
1965 | |
1966 static Lisp_Object mark_glyph (Lisp_Object, void (*) (Lisp_Object)); | |
1967 static void print_glyph (Lisp_Object, Lisp_Object, int); | |
1968 static int glyph_equal (Lisp_Object, Lisp_Object, int depth); | |
1969 static unsigned long glyph_hash (Lisp_Object obj, int depth); | |
1970 static Lisp_Object glyph_getprop (Lisp_Object obj, Lisp_Object prop); | |
1971 static int glyph_putprop (Lisp_Object obj, Lisp_Object prop, | |
1972 Lisp_Object value); | |
1973 static int glyph_remprop (Lisp_Object obj, Lisp_Object prop); | |
1974 static Lisp_Object glyph_plist (Lisp_Object obj); | |
1975 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, | |
1976 mark_glyph, print_glyph, 0, | |
1977 glyph_equal, glyph_hash, | |
1978 glyph_getprop, glyph_putprop, | |
1979 glyph_remprop, glyph_plist, | |
1980 struct Lisp_Glyph); | |
1981 | |
1982 static Lisp_Object | |
1983 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object)) | |
1984 { | |
1985 struct Lisp_Glyph *glyph = XGLYPH (obj); | |
1986 | |
1987 ((markobj) (glyph->image)); | |
1988 ((markobj) (glyph->contrib_p)); | |
1989 ((markobj) (glyph->baseline)); | |
1990 ((markobj) (glyph->face)); | |
1991 | |
1992 return (glyph->plist); | |
1993 } | |
1994 | |
1995 static void | |
1996 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
1997 { | |
1998 struct Lisp_Glyph *glyph = XGLYPH (obj); | |
1999 char buf[20]; | |
2000 | |
2001 if (print_readably) | |
2002 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid); | |
2003 | |
2004 write_c_string ("#<glyph (", printcharfun); | |
2005 print_internal (Fglyph_type (obj), printcharfun, 0); | |
2006 write_c_string (") ", printcharfun); | |
2007 print_internal (glyph->image, printcharfun, 1); | |
2008 sprintf (buf, "0x%x>", glyph->header.uid); | |
2009 write_c_string (buf, printcharfun); | |
2010 } | |
2011 | |
2012 /* Glyphs are equal if all of their display attributes are equal. We | |
2013 don't compare names or doc-strings, because that would make equal | |
2014 be eq. | |
2015 | |
2016 This isn't concerned with "unspecified" attributes, that's what | |
2017 #'glyph-differs-from-default-p is for. */ | |
2018 static int | |
2019 glyph_equal (Lisp_Object o1, Lisp_Object o2, int depth) | |
2020 { | |
2021 struct Lisp_Glyph *g1 = XGLYPH (o1); | |
2022 struct Lisp_Glyph *g2 = XGLYPH (o2); | |
2023 | |
2024 depth++; | |
2025 | |
2026 if (!internal_equal (g1->image, g2->image, depth) || | |
2027 !internal_equal (g1->contrib_p, g2->contrib_p, depth) || | |
2028 !internal_equal (g1->baseline, g2->baseline, depth) || | |
2029 !internal_equal (g1->face, g2->face, depth) || | |
2030 plists_differ (g1->plist, g2->plist, 0, 0, depth + 1)) | |
2031 return 0; | |
2032 | |
2033 return 1; | |
2034 } | |
2035 | |
2036 static unsigned long | |
2037 glyph_hash (Lisp_Object obj, int depth) | |
2038 { | |
2039 struct Lisp_Glyph *g = XGLYPH (obj); | |
2040 | |
2041 depth++; | |
2042 | |
2043 /* No need to hash all of the elements; that would take too long. | |
2044 Just hash the most common ones. */ | |
2045 return HASH2 (internal_hash (g->image, depth), | |
2046 internal_hash (g->face, depth)); | |
2047 } | |
2048 | |
2049 static Lisp_Object | |
2050 glyph_getprop (Lisp_Object obj, Lisp_Object prop) | |
2051 { | |
2052 struct Lisp_Glyph *g = XGLYPH (obj); | |
2053 | |
2054 #define FROB(propprop) \ | |
2055 do { \ | |
2056 if (EQ (prop, Q##propprop)) \ | |
2057 { \ | |
2058 return g->propprop; \ | |
2059 } \ | |
2060 } while (0) | |
2061 | |
2062 FROB (image); | |
2063 FROB (contrib_p); | |
2064 FROB (baseline); | |
2065 FROB (face); | |
2066 | |
2067 #undef FROB | |
2068 | |
2069 return external_plist_get (&g->plist, prop, 0, ERROR_ME); | |
2070 } | |
2071 | |
2072 static int | |
2073 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
2074 { | |
2075 struct Lisp_Glyph *g = XGLYPH (obj); | |
2076 | |
2077 #define FROB(propprop) \ | |
2078 do { \ | |
2079 if (EQ (prop, Q##propprop)) \ | |
2080 return 0; \ | |
2081 } while (0) | |
2082 | |
2083 FROB (image); | |
2084 FROB (contrib_p); | |
2085 FROB (baseline); | |
2086 | |
2087 #undef FROB | |
2088 | |
2089 if (EQ (prop, Qface)) | |
2090 { | |
2091 value = Fget_face (value); | |
2092 g->face = value; | |
2093 return 1; | |
2094 } | |
2095 | |
2096 external_plist_put (&g->plist, prop, value, 0, ERROR_ME); | |
2097 return 1; | |
2098 } | |
2099 | |
2100 static int | |
2101 glyph_remprop (Lisp_Object obj, Lisp_Object prop) | |
2102 { | |
2103 struct Lisp_Glyph *g = XGLYPH (obj); | |
2104 | |
2105 #define FROB(propprop) \ | |
2106 do { \ | |
2107 if (EQ (prop, Q##propprop)) \ | |
2108 return -1; \ | |
2109 } while (0) | |
2110 | |
2111 FROB (image); | |
2112 FROB (contrib_p); | |
2113 FROB (baseline); | |
2114 | |
2115 if (EQ (prop, Qface)) | |
2116 { | |
2117 g->face = Qnil; | |
2118 return 1; | |
2119 } | |
2120 | |
2121 #undef FROB | |
2122 return external_remprop (&g->plist, prop, 0, ERROR_ME); | |
2123 } | |
2124 | |
2125 static Lisp_Object | |
2126 glyph_plist (Lisp_Object obj) | |
2127 { | |
2128 struct Lisp_Glyph *g = XGLYPH (obj); | |
2129 Lisp_Object result = Qnil; | |
2130 | |
2131 #define FROB(propprop) \ | |
2132 do { \ | |
2133 /* backwards order; we reverse it below */ \ | |
2134 result = Fcons (g->propprop, Fcons (Q##propprop, result)); \ | |
2135 } while (0) | |
2136 | |
2137 FROB (image); | |
2138 FROB (contrib_p); | |
2139 FROB (baseline); | |
2140 FROB (face); | |
2141 | |
2142 #undef FROB | |
2143 return nconc2 (Fnreverse (result), g->plist); | |
2144 } | |
2145 | |
2146 Lisp_Object | |
2147 allocate_glyph (enum glyph_type type, | |
2148 void (*after_change) (Lisp_Object glyph, Lisp_Object property, | |
2149 Lisp_Object locale)) | |
2150 { | |
2151 Lisp_Object obj = Qnil; | |
2152 struct Lisp_Glyph *g = | |
2153 alloc_lcrecord (sizeof (struct Lisp_Glyph), lrecord_glyph); | |
2154 | |
2155 g->type = type; | |
2156 g->image = Fmake_specifier (Qimage); | |
2157 switch (g->type) | |
2158 { | |
2159 case GLYPH_BUFFER: | |
2160 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
2161 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK | IMAGE_MONO_PIXMAP_MASK | | |
2162 IMAGE_COLOR_PIXMAP_MASK | IMAGE_SUBWINDOW_MASK; | |
2163 break; | |
2164 case GLYPH_POINTER: | |
2165 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
2166 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK; | |
2167 break; | |
2168 case GLYPH_ICON: | |
2169 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
2170 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK; | |
2171 break; | |
2172 default: | |
2173 abort (); | |
2174 } | |
2175 | |
2176 set_specifier_fallback (g->image, list1 (Fcons (Qnil, Vthe_nothing_vector))); | |
2177 g->contrib_p = Fmake_specifier (Qboolean); | |
2178 set_specifier_fallback (g->contrib_p, list1 (Fcons (Qnil, Qt))); | |
2179 /* #### should have a specifier for the following */ | |
2180 g->baseline = Fmake_specifier (Qgeneric); | |
2181 set_specifier_fallback (g->baseline, list1 (Fcons (Qnil, Qnil))); | |
2182 g->face = Qnil; | |
2183 g->plist = Qnil; | |
2184 g->after_change = after_change; | |
2185 XSETGLYPH (obj, g); | |
2186 | |
2187 set_image_attached_to (g->image, obj, Qimage); | |
2188 | |
2189 return obj; | |
2190 } | |
2191 | |
2192 static enum glyph_type | |
2193 decode_glyph_type (Lisp_Object type, Error_behavior errb) | |
2194 { | |
2195 if (NILP (type)) | |
2196 return GLYPH_BUFFER; | |
2197 | |
2198 if (ERRB_EQ (errb, ERROR_ME)) | |
2199 CHECK_SYMBOL (type); | |
2200 | |
2201 if (EQ (type, Qbuffer)) | |
2202 return GLYPH_BUFFER; | |
2203 if (EQ (type, Qpointer)) | |
2204 return GLYPH_POINTER; | |
2205 if (EQ (type, Qicon)) | |
2206 return GLYPH_ICON; | |
2207 | |
2208 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb); | |
2209 return GLYPH_UNKNOWN; | |
2210 } | |
2211 | |
2212 static int | |
2213 valid_glyph_type_p (Lisp_Object type) | |
2214 { | |
2215 if (!NILP (memq_no_quit (type, Vglyph_type_list))) | |
2216 return 1; | |
2217 return 0; | |
2218 } | |
2219 | |
2220 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, | |
2221 Svalid_glyph_type_p, 1, 1, 0 /* | |
2222 Given a GLYPH-TYPE, return non-nil if it is valid. | |
2223 Valid types are `buffer', `pointer', and `icon'. | |
2224 */ ) | |
2225 (glyph_type) | |
2226 Lisp_Object glyph_type; | |
2227 { | |
2228 if (valid_glyph_type_p (glyph_type)) | |
2229 return Qt; | |
2230 else | |
2231 return Qnil; | |
2232 } | |
2233 | |
2234 DEFUN ("glyph-type-list", Fglyph_type_list, | |
2235 Sglyph_type_list, | |
2236 0, 0, 0 /* | |
2237 Return a list of valid glyph types. | |
2238 */ ) | |
2239 () | |
2240 { | |
2241 return Fcopy_sequence (Vglyph_type_list); | |
2242 } | |
2243 | |
2244 DEFUN ("make-glyph-internal", Fmake_glyph_internal, Smake_glyph_internal, | |
2245 0, 1, 0 /* | |
2246 Create a new, uninitialized glyph. | |
2247 | |
2248 TYPE specifies the type of the glyph; this should be one of `buffer', | |
2249 `pointer', or `icon', and defaults to `buffer'. The type of the glyph | |
2250 specifies in which contexts the glyph can be used, and controls the | |
2251 allowable image types into which the glyph's image can be | |
2252 instantiated. | |
2253 | |
2254 `buffer' glyphs can be used as the begin-glyph or end-glyph of an | |
2255 extent, in the modeline, and in the toolbar. Their image can be | |
2256 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text', | |
2257 and `subwindow'. | |
2258 | |
2259 `pointer' glyphs can be used to specify the mouse pointer. Their | |
2260 image can be instantiated as `pointer'. | |
2261 | |
2262 `icon' glyphs can be used to specify the icon used when a frame is | |
2263 iconified. Their image can be instantiated as `mono-pixmap' and | |
2264 `color-pixmap'. | |
2265 */ ) | |
2266 (type) | |
2267 Lisp_Object type; | |
2268 { | |
2269 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME); | |
2270 return allocate_glyph (typeval, 0); | |
2271 } | |
2272 | |
2273 DEFUN ("glyphp", Fglyphp, Sglyphp, 1, 1, 0 /* | |
2274 Return non-nil if OBJECT is a glyph. | |
2275 | |
2276 A glyph is an object used for pixmaps and the like. It is used | |
2277 in begin-glyphs and end-glyphs attached to extents, in marginal and textual | |
2278 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar | |
2279 buttons, and the like. Its image is described using an image specifier -- | |
2280 see `image-specifier-p'. | |
2281 */ ) | |
2282 (object) | |
2283 Lisp_Object object; | |
2284 { | |
2285 return GLYPHP (object) ? Qt : Qnil; | |
2286 } | |
2287 | |
2288 DEFUN ("glyph-type", Fglyph_type, Sglyph_type, | |
2289 1, 1, 0 /* | |
2290 Return the type of the given glyph. | |
2291 The return value will be one of 'buffer, 'pointer, or 'icon. | |
2292 */ ) | |
2293 (glyph) | |
2294 Lisp_Object glyph; | |
2295 { | |
2296 CHECK_GLYPH (glyph); | |
2297 switch (XGLYPH_TYPE (glyph)) | |
2298 { | |
2299 case GLYPH_BUFFER: | |
2300 return Qbuffer; | |
2301 case GLYPH_POINTER: | |
2302 return Qpointer; | |
2303 case GLYPH_ICON: | |
2304 return Qicon; | |
2305 default: | |
2306 abort (); | |
2307 } | |
2308 | |
2309 return Qnil; /* not reached */ | |
2310 } | |
2311 | |
2312 /***************************************************************************** | |
2313 glyph_width | |
2314 | |
2315 Return the width of the given GLYPH on the given WINDOW. If the | |
2316 instance is a string then the width is calculated using the font of | |
2317 the given FACE, unless a face is defined by the glyph itself. | |
2318 ****************************************************************************/ | |
2319 unsigned short | |
2320 glyph_width (Lisp_Object glyph, Lisp_Object frame_face, | |
2321 face_index window_findex, Lisp_Object window) | |
2322 { | |
2323 Lisp_Object instance; | |
2324 Lisp_Object frame = XWINDOW (window)->frame; | |
2325 | |
2326 /* #### We somehow need to distinguish between the user causing this | |
2327 error condition and a bug causing it. */ | |
2328 if (!GLYPHP (glyph)) | |
2329 return 0; | |
2330 else | |
2331 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1); | |
2332 | |
2333 if (!IMAGE_INSTANCEP (instance)) | |
2334 return 0; | |
2335 | |
2336 switch (XIMAGE_INSTANCE_TYPE (instance)) | |
2337 { | |
2338 case IMAGE_TEXT: | |
2339 { | |
2340 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance); | |
2341 Lisp_Object private_face = XGLYPH_FACE(glyph); | |
2342 | |
2343 if (!NILP (private_face)) | |
2344 return (redisplay_frame_text_width_string (XFRAME (frame), | |
2345 private_face, | |
2346 0, str, 0, -1)); | |
2347 else | |
2348 if (!NILP (frame_face)) | |
2349 return (redisplay_frame_text_width_string (XFRAME (frame), | |
2350 frame_face, | |
2351 0, str, 0, -1)); | |
2352 else | |
2353 return (redisplay_text_width_string (XWINDOW (window), | |
2354 window_findex, | |
2355 0, str, 0, -1)); | |
2356 } | |
2357 | |
2358 case IMAGE_MONO_PIXMAP: | |
2359 case IMAGE_COLOR_PIXMAP: | |
2360 case IMAGE_POINTER: | |
2361 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance); | |
2362 | |
2363 case IMAGE_NOTHING: | |
2364 return 0; | |
2365 | |
2366 case IMAGE_SUBWINDOW: | |
2367 /* #### implement me */ | |
2368 return 0; | |
2369 | |
2370 default: | |
2371 abort (); | |
2372 return 0; | |
2373 } | |
2374 } | |
2375 | |
2376 DEFUN ("glyph-width", Fglyph_width, Sglyph_width, 1, 2, 0 /* | |
2377 Return the width of GLYPH on WINDOW. | |
2378 This may not be exact as it does not take into account all of the context | |
2379 that redisplay will. | |
2380 */ ) | |
2381 (glyph, window) | |
2382 Lisp_Object glyph, window; | |
2383 { | |
2384 XSETWINDOW (window, decode_window (window)); | |
2385 CHECK_GLYPH (glyph); | |
2386 | |
2387 return (make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window))); | |
2388 } | |
2389 | |
2390 #define RETURN_ASCENT 0 | |
2391 #define RETURN_DESCENT 1 | |
2392 #define RETURN_HEIGHT 2 | |
2393 | |
2394 Lisp_Object | |
2395 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, | |
2396 Error_behavior errb, int no_quit) | |
2397 { | |
2398 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); | |
2399 | |
2400 /* This can never return Qunbound. All glyphs have 'nothing as | |
2401 a fallback. */ | |
2402 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0, | |
2403 Qzero); | |
2404 } | |
2405 | |
2406 static unsigned short | |
2407 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face, | |
2408 face_index window_findex, Lisp_Object window, | |
2409 int function) | |
2410 { | |
2411 Lisp_Object instance; | |
2412 Lisp_Object frame = XWINDOW (window)->frame; | |
2413 | |
2414 if (!GLYPHP (glyph)) | |
2415 return 0; | |
2416 else | |
2417 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1); | |
2418 | |
2419 if (!IMAGE_INSTANCEP (instance)) | |
2420 return 0; | |
2421 | |
2422 switch (XIMAGE_INSTANCE_TYPE (instance)) | |
2423 { | |
2424 case IMAGE_TEXT: | |
2425 { | |
2426 struct font_metric_info fm; | |
2427 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance); | |
2428 unsigned char charsets[NUM_LEADING_BYTES]; | |
2429 struct face_cachel frame_cachel; | |
2430 struct face_cachel *cachel; | |
2431 | |
2432 find_charsets_in_bufbyte_string (charsets, | |
2433 string_data (XSTRING (string)), | |
2434 string_length (XSTRING (string))); | |
2435 | |
2436 if (!NILP (frame_face)) | |
2437 { | |
2438 reset_face_cachel (&frame_cachel); | |
2439 update_face_cachel_data (&frame_cachel, frame, frame_face); | |
2440 cachel = &frame_cachel; | |
2441 } | |
2442 else | |
2443 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex); | |
2444 ensure_face_cachel_complete (cachel, window, charsets); | |
2445 | |
2446 face_cachel_charset_font_metric_info (cachel, charsets, &fm); | |
2447 | |
2448 if (function == RETURN_ASCENT) | |
2449 return fm.ascent; | |
2450 else if (function == RETURN_DESCENT) | |
2451 return fm.descent; | |
2452 else if (function == RETURN_HEIGHT) | |
2453 return fm.ascent + fm.descent; | |
2454 else | |
2455 abort (); | |
2456 return 0; | |
2457 } | |
2458 | |
2459 case IMAGE_MONO_PIXMAP: | |
2460 case IMAGE_COLOR_PIXMAP: | |
2461 case IMAGE_POINTER: | |
2462 /* #### Ugh ugh ugh -- temporary crap */ | |
2463 if (function == RETURN_ASCENT || function == RETURN_HEIGHT) | |
2464 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance); | |
2465 else | |
2466 return 0; | |
2467 | |
2468 case IMAGE_NOTHING: | |
2469 return 0; | |
2470 | |
2471 case IMAGE_SUBWINDOW: | |
2472 /* #### implement me */ | |
2473 return 0; | |
2474 | |
2475 default: | |
2476 abort (); | |
2477 return 0; | |
2478 } | |
2479 } | |
2480 | |
2481 unsigned short | |
2482 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face, | |
2483 face_index window_findex, Lisp_Object window) | |
2484 { | |
2485 return glyph_height_internal (glyph, frame_face, window_findex, window, | |
2486 RETURN_ASCENT); | |
2487 } | |
2488 | |
2489 unsigned short | |
2490 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face, | |
2491 face_index window_findex, Lisp_Object window) | |
2492 { | |
2493 return glyph_height_internal (glyph, frame_face, window_findex, window, | |
2494 RETURN_DESCENT); | |
2495 } | |
2496 | |
2497 /* strictly a convenience function. */ | |
2498 unsigned short | |
2499 glyph_height (Lisp_Object glyph, Lisp_Object frame_face, | |
2500 face_index window_findex, Lisp_Object window) | |
2501 { | |
2502 return glyph_height_internal (glyph, frame_face, window_findex, window, | |
2503 RETURN_HEIGHT); | |
2504 } | |
2505 | |
2506 DEFUN ("glyph-ascent", Fglyph_ascent, Sglyph_ascent, 1, 2, 0 /* | |
2507 Return the ascent value of GLYPH on WINDOW. | |
2508 This may not be exact as it does not take into account all of the context | |
2509 that redisplay will. | |
2510 */ ) | |
2511 (glyph, window) | |
2512 Lisp_Object glyph, window; | |
2513 { | |
2514 XSETWINDOW (window, decode_window (window)); | |
2515 CHECK_GLYPH (glyph); | |
2516 | |
2517 return (make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window))); | |
2518 } | |
2519 | |
2520 DEFUN ("glyph-descent", Fglyph_descent, Sglyph_descent, 1, 2, 0 /* | |
2521 Return the descent value of GLYPH on WINDOW. | |
2522 This may not be exact as it does not take into account all of the context | |
2523 that redisplay will. | |
2524 */ ) | |
2525 (glyph, window) | |
2526 Lisp_Object glyph, window; | |
2527 { | |
2528 XSETWINDOW (window, decode_window (window)); | |
2529 CHECK_GLYPH (glyph); | |
2530 | |
2531 return (make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window))); | |
2532 } | |
2533 | |
2534 /* This is redundant but I bet a lot of people expect it to exist. */ | |
2535 DEFUN ("glyph-height", Fglyph_height, Sglyph_height, 1, 2, 0 /* | |
2536 Return the height of GLYPH on WINDOW. | |
2537 This may not be exact as it does not take into account all of the context | |
2538 that redisplay will. | |
2539 */ ) | |
2540 (glyph, window) | |
2541 Lisp_Object glyph, window; | |
2542 { | |
2543 XSETWINDOW (window, decode_window (window)); | |
2544 CHECK_GLYPH (glyph); | |
2545 | |
2546 return (make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window))); | |
2547 } | |
2548 | |
2549 #undef RETURN_ASCENT | |
2550 #undef RETURN_DESCENT | |
2551 #undef RETURN_HEIGHT | |
2552 | |
2553 /* #### do we need to cache this info to speed things up? */ | |
2554 | |
2555 Lisp_Object | |
2556 glyph_baseline (Lisp_Object glyph, Lisp_Object domain) | |
2557 { | |
2558 if (!GLYPHP (glyph)) | |
2559 return Qnil; | |
2560 else | |
2561 { | |
2562 Lisp_Object retval = | |
2563 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)), | |
2564 /* #### look into ERROR_ME_NOT */ | |
2565 Qunbound, domain, ERROR_ME_NOT, | |
2566 0, Qzero); | |
2567 if (!NILP (retval) && !INTP (retval)) | |
2568 retval = Qnil; | |
2569 else if (INTP (retval)) | |
2570 { | |
2571 if (XINT (retval) < 0) | |
2572 retval = Qzero; | |
2573 if (XINT (retval) > 100) | |
2574 retval = make_int (100); | |
2575 } | |
2576 return retval; | |
2577 } | |
2578 } | |
2579 | |
2580 Lisp_Object | |
2581 glyph_face (Lisp_Object glyph, Lisp_Object domain) | |
2582 { | |
2583 /* #### Domain parameter not currently used but it will be */ | |
2584 if (!GLYPHP (glyph)) | |
2585 return Qnil; | |
2586 else | |
2587 return GLYPH_FACE (XGLYPH (glyph)); | |
2588 } | |
2589 | |
2590 int | |
2591 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain) | |
2592 { | |
2593 if (!GLYPHP (glyph)) | |
2594 return 0; | |
2595 else | |
2596 return (!NILP (specifier_instance_no_quit | |
2597 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain, | |
2598 /* #### look into ERROR_ME_NOT */ | |
2599 ERROR_ME_NOT, 0, Qzero))); | |
2600 } | |
2601 | |
2602 static void | |
2603 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property, | |
2604 Lisp_Object locale) | |
2605 { | |
2606 if (XGLYPH (glyph)->after_change) | |
2607 (XGLYPH (glyph)->after_change) (glyph, property, locale); | |
2608 } | |
2609 | |
2610 | |
2611 /***************************************************************************** | |
2612 * glyph cachel functions * | |
2613 *****************************************************************************/ | |
2614 | |
2615 /* | |
2616 #### All of this is 95% copied from face cachels. | |
2617 Consider consolidating. | |
2618 #### We need to add a dirty flag to the glyphs. | |
2619 */ | |
2620 | |
2621 void | |
2622 mark_glyph_cachels (glyph_cachel_dynarr *elements, | |
2623 void (*markobj) (Lisp_Object)) | |
2624 { | |
2625 int elt; | |
2626 | |
2627 if (!elements) | |
2628 return; | |
2629 | |
2630 for (elt = 0; elt < Dynarr_length (elements); elt++) | |
2631 { | |
2632 struct glyph_cachel *cachel = Dynarr_atp (elements, elt); | |
2633 ((markobj) (cachel->glyph)); | |
2634 } | |
2635 } | |
2636 | |
2637 static void | |
2638 update_glyph_cachel_data (struct window *w, Lisp_Object glyph, | |
2639 struct glyph_cachel *cachel) | |
2640 { | |
2641 /* #### This should be || !cachel->updated */ | |
2642 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)) | |
2643 { | |
2644 Lisp_Object window = Qnil; | |
2645 | |
2646 XSETWINDOW (window, w); | |
2647 cachel->glyph = glyph; | |
2648 | |
2649 #define FROB(field) \ | |
2650 do { \ | |
2651 unsigned short new_val = glyph_##field (glyph, Qnil, DEFAULT_INDEX, \ | |
2652 window); \ | |
2653 if (cachel->field != new_val) \ | |
2654 cachel->field = new_val; \ | |
2655 } while (0) | |
2656 | |
2657 /* #### This could be sped up if we redid things to grab the glyph | |
2658 instantiation and passed it to the size functions. */ | |
2659 FROB (width); | |
2660 FROB (ascent); | |
2661 FROB (descent); | |
2662 #undef FROB | |
2663 | |
2664 } | |
2665 | |
2666 cachel->updated = 1; | |
2667 } | |
2668 | |
2669 static void | |
2670 add_glyph_cachel (struct window *w, Lisp_Object glyph) | |
2671 { | |
2672 struct glyph_cachel new_cachel; | |
2673 | |
2674 memset (&new_cachel, 0, sizeof (struct glyph_cachel)); | |
2675 new_cachel.glyph = Qnil; | |
2676 | |
2677 update_glyph_cachel_data (w, glyph, &new_cachel); | |
2678 Dynarr_add (w->glyph_cachels, new_cachel); | |
2679 } | |
2680 | |
2681 static glyph_index | |
2682 get_glyph_cachel_index (struct window *w, Lisp_Object glyph) | |
2683 { | |
2684 int elt; | |
2685 | |
2686 if (noninteractive) | |
2687 return 0; | |
2688 | |
2689 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
2690 { | |
2691 struct glyph_cachel *cachel = | |
2692 Dynarr_atp (w->glyph_cachels, elt); | |
2693 | |
2694 if (EQ (cachel->glyph, glyph) && !NILP (glyph)) | |
2695 { | |
2696 if (!cachel->updated) | |
2697 update_glyph_cachel_data (w, glyph, cachel); | |
2698 return elt; | |
2699 } | |
2700 } | |
2701 | |
2702 /* If we didn't find the glyph, add it and then return its index. */ | |
2703 add_glyph_cachel (w, glyph); | |
2704 return elt; | |
2705 } | |
2706 | |
2707 void | |
2708 reset_glyph_cachels (struct window *w) | |
2709 { | |
2710 Dynarr_reset (w->glyph_cachels); | |
2711 get_glyph_cachel_index (w, Vcontinuation_glyph); | |
2712 get_glyph_cachel_index (w, Vtruncation_glyph); | |
2713 get_glyph_cachel_index (w, Vhscroll_glyph); | |
2714 get_glyph_cachel_index (w, Vcontrol_arrow_glyph); | |
2715 get_glyph_cachel_index (w, Voctal_escape_glyph); | |
2716 get_glyph_cachel_index (w, Vinvisible_text_glyph); | |
2717 } | |
2718 | |
2719 void | |
2720 mark_glyph_cachels_as_not_updated (struct window *w) | |
2721 { | |
2722 int elt; | |
2723 | |
2724 /* We need to have a dirty flag to tell if the glyph has changed. | |
2725 We can check to see if each glyph variable is actually a | |
2726 completely different glyph, though. */ | |
2727 #define FROB(glyph_obj, gindex) \ | |
2728 update_glyph_cachel_data (w, glyph_obj, \ | |
2729 Dynarr_atp (w->glyph_cachels, gindex)) | |
2730 | |
2731 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX); | |
2732 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX); | |
2733 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX); | |
2734 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX); | |
2735 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX); | |
2736 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX); | |
2737 #undef FROB | |
2738 | |
2739 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
2740 Dynarr_atp (w->glyph_cachels, elt)->updated = 0; | |
2741 } | |
2742 | |
2743 #ifdef MEMORY_USAGE_STATS | |
2744 | |
2745 int | |
2746 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, | |
2747 struct overhead_stats *ovstats) | |
2748 { | |
2749 int total = 0; | |
2750 | |
2751 if (glyph_cachels) | |
2752 total += Dynarr_memory_usage (glyph_cachels, ovstats); | |
2753 | |
2754 return total; | |
2755 } | |
2756 | |
2757 #endif /* MEMORY_USAGE_STATS */ | |
2758 | |
2759 | |
2760 /***************************************************************************** | |
2761 * display tables * | |
2762 *****************************************************************************/ | |
2763 | |
2764 /* Get the display table for use currently on window W with face FACE. | |
2765 Precedence: | |
2766 | |
2767 -- FACE's display table | |
2768 -- W's display table (comes from specifier `current-display-table') | |
2769 | |
2770 Ignore the specified tables if they are not valid; | |
2771 if no valid table is specified, return 0. */ | |
2772 | |
2773 struct Lisp_Vector * | |
2774 get_display_table (struct window *w, face_index findex) | |
2775 { | |
2776 Lisp_Object tem = Qnil; | |
2777 | |
2778 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); | |
2779 if (VECTORP (tem) && XVECTOR (tem)->size == DISP_TABLE_SIZE) | |
2780 return XVECTOR (tem); | |
2781 | |
2782 tem = w->display_table; | |
2783 if (VECTORP (tem) && XVECTOR (tem)->size == DISP_TABLE_SIZE) | |
2784 return XVECTOR (tem); | |
2785 | |
2786 return 0; | |
2787 } | |
2788 | |
2789 | |
2790 /***************************************************************************** | |
2791 * initialization * | |
2792 *****************************************************************************/ | |
2793 | |
2794 void | |
2795 syms_of_glyphs (void) | |
2796 { | |
2797 /* image instantiators */ | |
2798 | |
2799 defsubr (&Simage_instantiator_format_list); | |
2800 defsubr (&Svalid_image_instantiator_format_p); | |
2801 defsubr (&Sset_console_type_image_conversion_list); | |
2802 defsubr (&Sconsole_type_image_conversion_list); | |
2803 | |
2804 defkeyword (&Q_file, ":file"); | |
2805 defkeyword (&Q_data, ":data"); | |
2806 defkeyword (&Q_face, ":face"); | |
2807 | |
2808 /* image specifiers */ | |
2809 | |
2810 defsubr (&Simage_specifier_p); | |
2811 /* Qimage in general.c */ | |
2812 | |
2813 /* image instances */ | |
2814 | |
2815 defsymbol (&Qimage_instancep, "image-instance-p"); | |
2816 | |
2817 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p"); | |
2818 defsymbol (&Qtext_image_instance_p, "text-image-instance-p"); | |
2819 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p"); | |
2820 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p"); | |
2821 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p"); | |
2822 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p"); | |
2823 | |
2824 defsubr (&Smake_image_instance); | |
2825 defsubr (&Simage_instance_p); | |
2826 defsubr (&Simage_instance_type); | |
2827 defsubr (&Svalid_image_instance_type_p); | |
2828 defsubr (&Simage_instance_type_list); | |
2829 defsubr (&Simage_instance_name); | |
2830 defsubr (&Simage_instance_string); | |
2831 defsubr (&Simage_instance_file_name); | |
2832 defsubr (&Simage_instance_mask_file_name); | |
2833 defsubr (&Simage_instance_depth); | |
2834 defsubr (&Simage_instance_height); | |
2835 defsubr (&Simage_instance_width); | |
2836 defsubr (&Simage_instance_hotspot_x); | |
2837 defsubr (&Simage_instance_hotspot_y); | |
2838 defsubr (&Simage_instance_foreground); | |
2839 defsubr (&Simage_instance_background); | |
2840 defsubr (&Scolorize_image_instance); | |
2841 | |
2842 /* Qnothing defined as part of the "nothing" image-instantiator | |
2843 type. */ | |
2844 /* Qtext defined in general.c */ | |
2845 defsymbol (&Qmono_pixmap, "mono-pixmap"); | |
2846 defsymbol (&Qcolor_pixmap, "color-pixmap"); | |
2847 /* Qpointer defined in general.c */ | |
2848 defsymbol (&Qsubwindow, "subwindow"); | |
2849 | |
2850 /* glyphs */ | |
2851 | |
2852 defsymbol (&Qglyphp, "glyphp"); | |
2853 defsymbol (&Qcontrib_p, "contrib-p"); | |
2854 defsymbol (&Qbaseline, "baseline"); | |
2855 | |
2856 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p"); | |
2857 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p"); | |
2858 defsymbol (&Qicon_glyph_p, "icon-glyph-p"); | |
2859 | |
2860 defsymbol (&Qconst_glyph_variable, "const-glyph-variable"); | |
2861 | |
2862 defsubr (&Sglyph_type); | |
2863 defsubr (&Svalid_glyph_type_p); | |
2864 defsubr (&Sglyph_type_list); | |
2865 defsubr (&Sglyphp); | |
2866 defsubr (&Smake_glyph_internal); | |
2867 defsubr (&Sglyph_width); | |
2868 defsubr (&Sglyph_ascent); | |
2869 defsubr (&Sglyph_descent); | |
2870 defsubr (&Sglyph_height); | |
2871 | |
2872 /* Qbuffer defined in general.c. */ | |
2873 /* Qpointer defined above */ | |
2874 defsymbol (&Qicon, "icon"); | |
2875 } | |
2876 | |
2877 void | |
2878 specifier_type_create_image (void) | |
2879 { | |
2880 /* image specifiers */ | |
2881 | |
2882 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep"); | |
2883 | |
2884 SPECIFIER_HAS_METHOD (image, create); | |
2885 SPECIFIER_HAS_METHOD (image, mark); | |
2886 SPECIFIER_HAS_METHOD (image, instantiate); | |
2887 SPECIFIER_HAS_METHOD (image, validate); | |
2888 SPECIFIER_HAS_METHOD (image, after_change); | |
2889 SPECIFIER_HAS_METHOD (image, going_to_add); | |
2890 } | |
2891 | |
2892 void | |
2893 image_instantiator_format_create (void) | |
2894 { | |
2895 /* image instantiators */ | |
2896 | |
2897 the_image_instantiator_format_entry_dynarr = | |
2898 Dynarr_new (struct image_instantiator_format_entry); | |
2899 | |
2900 Vimage_instantiator_format_list = Qnil; | |
2901 staticpro (&Vimage_instantiator_format_list); | |
2902 | |
2903 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing"); | |
2904 | |
2905 IIFORMAT_HAS_METHOD (nothing, possible_dest_types); | |
2906 IIFORMAT_HAS_METHOD (nothing, instantiate); | |
2907 | |
2908 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit"); | |
2909 | |
2910 IIFORMAT_HAS_METHOD (inherit, validate); | |
2911 IIFORMAT_HAS_METHOD (inherit, normalize); | |
2912 IIFORMAT_HAS_METHOD (inherit, possible_dest_types); | |
2913 IIFORMAT_HAS_METHOD (inherit, instantiate); | |
2914 | |
2915 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face); | |
2916 | |
2917 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string"); | |
2918 | |
2919 IIFORMAT_HAS_METHOD (string, validate); | |
2920 IIFORMAT_HAS_METHOD (string, possible_dest_types); | |
2921 IIFORMAT_HAS_METHOD (string, instantiate); | |
2922 | |
2923 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string); | |
2924 | |
2925 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); | |
2926 | |
2927 IIFORMAT_HAS_METHOD (formatted_string, validate); | |
2928 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types); | |
2929 IIFORMAT_HAS_METHOD (formatted_string, instantiate); | |
2930 | |
2931 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); | |
2932 } | |
2933 | |
2934 void | |
2935 vars_of_glyphs (void) | |
2936 { | |
2937 Vthe_nothing_vector = vector1 (Qnothing); | |
2938 staticpro (&Vthe_nothing_vector); | |
2939 | |
2940 /* image instances */ | |
2941 | |
2942 Vimage_instance_type_list = list6 (Qnothing, Qtext, Qmono_pixmap, | |
2943 Qcolor_pixmap, Qpointer, Qsubwindow); | |
2944 staticpro (&Vimage_instance_type_list); | |
2945 | |
2946 /* glyphs */ | |
2947 | |
2948 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); | |
2949 staticpro (&Vglyph_type_list); | |
2950 | |
2951 /* The octal-escape glyph, control-arrow-glyph and | |
2952 invisible-text-glyph are completely initialized in glyphs.el */ | |
2953 | |
2954 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /* | |
2955 What to prefix character codes displayed in octal with. | |
2956 */); | |
2957 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
2958 | |
2959 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /* | |
2960 What to use as an arrow for control characters. | |
2961 */); | |
2962 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER, | |
2963 redisplay_glyph_changed); | |
2964 | |
2965 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /* | |
2966 What to use to indicate the presence of invisible text. | |
2967 This is the glyph that is displayed when an ellipsis is called for | |
2968 \(see `selective-display-ellipses' and `buffer-invisibility-spec'). | |
2969 Normally this is three dots (\"...\"). | |
2970 */); | |
2971 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, | |
2972 redisplay_glyph_changed); | |
2973 | |
2974 /* Partially initialized in glyphs.el */ | |
2975 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /* | |
2976 What to display at the beginning of horizontally scrolled lines. | |
2977 */); | |
2978 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
2979 } | |
2980 | |
2981 void | |
2982 specifier_vars_of_glyphs (void) | |
2983 { | |
2984 /* display tables */ | |
2985 | |
2986 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /* | |
2987 *The display table currently in use. | |
2988 This is a specifier; use `set-specifier' to change it. | |
2989 The display table is a vector created with `make-display-table'. | |
2990 The 256 elements control how to display each possible text character. | |
2991 Each value should be a string, a glyph, a vector or nil. | |
2992 If a value is a vector it must be composed only of strings and glyphs. | |
2993 nil means display the character in the default fashion. | |
2994 Faces can have their own, overriding display table. | |
2995 */ ); | |
2996 Vcurrent_display_table = Fmake_specifier (Qgeneric); | |
2997 set_specifier_fallback (Vcurrent_display_table, | |
2998 list1 (Fcons (Qnil, Qnil))); | |
2999 set_specifier_caching (Vcurrent_display_table, | |
3000 slot_offset (struct window, | |
3001 display_table), | |
3002 some_window_value_changed, | |
3003 0, 0); | |
3004 } | |
3005 | |
3006 void | |
3007 complex_vars_of_glyphs (void) | |
3008 { | |
3009 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
3010 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /* | |
3011 What to display at the end of truncated lines. | |
3012 */ ); | |
3013 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
3014 | |
3015 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
3016 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /* | |
3017 What to display at the end of wrapped lines. | |
3018 */ ); | |
3019 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
3020 | |
3021 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
3022 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /* | |
3023 The glyph used to display the XEmacs logo at startup. | |
3024 */ ); | |
3025 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0); | |
3026 } |