Mercurial > hg > xemacs-beta

comparison src/glyphs.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents b2472a1930f2
children 6330739388db
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
39 #include "window.h" 39 #include "window.h"
40 40
41 Lisp_Object Qimage_conversion_error; 41 Lisp_Object Qimage_conversion_error;
42 42
43 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline; 43 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
44
45 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p; 44 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
46
47 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p; 45 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
48 Lisp_Object Qmono_pixmap_image_instance_p; 46 Lisp_Object Qmono_pixmap_image_instance_p;
49 Lisp_Object Qcolor_pixmap_image_instance_p; 47 Lisp_Object Qcolor_pixmap_image_instance_p;
50 Lisp_Object Qpointer_image_instance_p; 48 Lisp_Object Qpointer_image_instance_p;
51 Lisp_Object Qsubwindow_image_instance_p; 49 Lisp_Object Qsubwindow_image_instance_p;
52
53 Lisp_Object Qconst_glyph_variable; 50 Lisp_Object Qconst_glyph_variable;
54
55 /* Qtext, Qpointer defined in general.c */
56 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; 51 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
52 Lisp_Object Q_file, Q_data, Q_face;
53 Lisp_Object Qicon;
54 Lisp_Object Qformatted_string;
57 55
58 Lisp_Object Vcurrent_display_table; 56 Lisp_Object Vcurrent_display_table;
59 /* Declared in faces.c */
60 extern Lisp_Object Qdisplay_table;
61
62 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph; 57 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
63 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph; 58 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
64 Lisp_Object Vxemacs_logo; 59 Lisp_Object Vxemacs_logo;
65
66 Lisp_Object Vthe_nothing_vector; 60 Lisp_Object Vthe_nothing_vector;
67 61 Lisp_Object Vimage_instantiator_format_list;
68 Lisp_Object Q_file, Q_data, Q_face; 62 Lisp_Object Vimage_instance_type_list;
69 63 Lisp_Object Vglyph_type_list;
70 Lisp_Object Qicon; 64
71
72 /* Qnothing, Qstring, Qinherit in general.c */
73 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); 65 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
74 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); 66 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
75 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string); 67 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
76 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); 68 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
77 Lisp_Object Qformatted_string;
78
79 MAC_DEFINE (struct image_instantiator_methods *, MTiiformat_meth_or_given)
80 69
81 typedef struct image_instantiator_format_entry image_instantiator_format_entry; 70 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
82 struct image_instantiator_format_entry 71 struct image_instantiator_format_entry
83 { 72 {
84 Lisp_Object symbol; 73 Lisp_Object symbol;
90 Dynarr_declare (struct image_instantiator_format_entry); 79 Dynarr_declare (struct image_instantiator_format_entry);
91 } image_instantiator_format_entry_dynarr; 80 } image_instantiator_format_entry_dynarr;
92 81
93 image_instantiator_format_entry_dynarr * 82 image_instantiator_format_entry_dynarr *
94 the_image_instantiator_format_entry_dynarr; 83 the_image_instantiator_format_entry_dynarr;
95
96 Lisp_Object Vimage_instantiator_format_list;
97
98 Lisp_Object Vimage_instance_type_list;
99
100 Lisp_Object Vglyph_type_list;
101 84
102 static Lisp_Object allocate_image_instance (Lisp_Object device); 85 static Lisp_Object allocate_image_instance (Lisp_Object device);
103 static void image_validate (Lisp_Object instantiator); 86 static void image_validate (Lisp_Object instantiator);
104 static void glyph_property_was_changed (Lisp_Object glyph, 87 static void glyph_property_was_changed (Lisp_Object glyph,
105 Lisp_Object property, 88 Lisp_Object property,
106 Lisp_Object locale); 89 Lisp_Object locale);
90 EXFUN (Fimage_instance_type, 1);
91 EXFUN (Fglyph_type, 1);
107 92
108 93
109 /**************************************************************************** 94 /****************************************************************************
110 * Image Instantiators * 95 * Image Instantiators *
111 ****************************************************************************/ 96 ****************************************************************************/
138 } 123 }
139 124
140 static int 125 static int
141 valid_image_instantiator_format_p (Lisp_Object format) 126 valid_image_instantiator_format_p (Lisp_Object format)
142 { 127 {
143 if (decode_image_instantiator_format (format, ERROR_ME_NOT)) 128 return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0);
144 return 1;
145 return 0;
146 } 129 }
147 130
148 DEFUN ("valid-image-instantiator-format-p", 131 DEFUN ("valid-image-instantiator-format-p",
149 Fvalid_image_instantiator_format_p, 1, 1, 0, /* 132 Fvalid_image_instantiator_format_p, 1, 1, 0, /*
150 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid. 133 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
151 Valid formats are some subset of 'nothing, 'string, 'formatted-string, 134 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
152 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font, 135 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
153 'autodetect, and 'subwindow, depending on how XEmacs was 136 'autodetect, and 'subwindow, depending on how XEmacs was compiled.
154 compiled.
155 */ 137 */
156 (image_instantiator_format)) 138 (image_instantiator_format))
157 { 139 {
158 if (valid_image_instantiator_format_p (image_instantiator_format)) 140 return valid_image_instantiator_format_p (image_instantiator_format) ?
159 return Qt; 141 Qt : Qnil;
160 else
161 return Qnil;
162 } 142 }
163 143
164 DEFUN ("image-instantiator-format-list", 144 DEFUN ("image-instantiator-format-list",
165 Fimage_instantiator_format_list, 0, 0, 0, /* 145 Fimage_instantiator_format_list, 0, 0, 0, /*
166 Return a list of valid image-instantiator formats. 146 Return a list of valid image-instantiator formats.
474 filename even though this is a potential memory pig. We have to 454 filename even though this is a potential memory pig. We have to
475 do this because it is quite possible that we will need to 455 do this because it is quite possible that we will need to
476 instantiate a new instance of the pixmap and the file will no 456 instantiate a new instance of the pixmap and the file will no
477 longer exist (e.g. w3 pixmaps are almost always from temporary 457 longer exist (e.g. w3 pixmaps are almost always from temporary
478 files). */ 458 files). */
479 instantiator = IIFORMAT_METH_OR_GIVEN 459 {
480 (decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], 460 struct image_instantiator_methods * meths =
481 ERROR_ME), 461 decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
482 normalize, (instantiator, contype), instantiator); 462 ERROR_ME);
483 463 return IIFORMAT_METH_OR_GIVEN (meths, normalize,
484 return instantiator; 464 (instantiator, contype),
465 instantiator);
466 }
485 } 467 }
486 468
487 static Lisp_Object 469 static Lisp_Object
488 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain, 470 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
489 Lisp_Object instantiator, 471 Lisp_Object instantiator,
490 Lisp_Object pointer_fg, Lisp_Object pointer_bg, 472 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
491 int dest_mask) 473 int dest_mask)
492 { 474 {
493 Lisp_Object ii; 475 Lisp_Object ii = allocate_image_instance (device);
476 struct image_instantiator_methods *meths;
494 struct gcpro gcpro1; 477 struct gcpro gcpro1;
495 478
496 ii = allocate_image_instance (device);
497
498 GCPRO1 (ii); 479 GCPRO1 (ii);
499 { 480 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
500 struct image_instantiator_methods *meths = 481 ERROR_ME);
501 decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], 482 if (!HAS_IIFORMAT_METH_P (meths, instantiate))
502 ERROR_ME); 483 signal_simple_error
503 484 ("Don't know how to instantiate this image instantiator?",
504 if (!HAS_IIFORMAT_METH_P (meths, instantiate)) 485 instantiator);
505 signal_simple_error 486 IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
506 ("Don't know how to instantiate this image instantiator?", 487 pointer_bg, dest_mask, domain));
507 instantiator);
508 IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
509 pointer_bg, dest_mask, domain));
510 }
511 UNGCPRO; 488 UNGCPRO;
512 489
513 return ii; 490 return ii;
514 } 491 }
515 492
517 /**************************************************************************** 494 /****************************************************************************
518 * Image-Instance Object * 495 * Image-Instance Object *
519 ****************************************************************************/ 496 ****************************************************************************/
520 497
521 Lisp_Object Qimage_instancep; 498 Lisp_Object Qimage_instancep;
522 static Lisp_Object mark_image_instance (Lisp_Object, void (*) (Lisp_Object)); 499
523 static void print_image_instance (Lisp_Object, Lisp_Object, int);
524 static void finalize_image_instance (void *, int);
525 static int image_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth);
526 static unsigned long image_instance_hash (Lisp_Object obj, int depth);
527 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
528 mark_image_instance, print_image_instance,
529 finalize_image_instance, image_instance_equal,
530 image_instance_hash,
531 struct Lisp_Image_Instance);
532 static Lisp_Object 500 static Lisp_Object
533 mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) 501 mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
534 { 502 {
535 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); 503 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
536 504
780 748
781 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth), 749 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
782 0)); 750 0));
783 } 751 }
784 752
753 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
754 mark_image_instance, print_image_instance,
755 finalize_image_instance, image_instance_equal,
756 image_instance_hash,
757 struct Lisp_Image_Instance);
758
785 static Lisp_Object 759 static Lisp_Object
786 allocate_image_instance (Lisp_Object device) 760 allocate_image_instance (Lisp_Object device)
787 { 761 {
788 struct Lisp_Image_Instance *lp = 762 struct Lisp_Image_Instance *lp =
789 alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance); 763 alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance);
790 Lisp_Object val = Qnil; 764 Lisp_Object val;
791 765
792 zero_lcrecord (lp); 766 zero_lcrecord (lp);
793 lp->device = device; 767 lp->device = device;
794 lp->type = IMAGE_NOTHING; 768 lp->type = IMAGE_NOTHING;
795 lp->name = Qnil; 769 lp->name = Qnil;
974 Qnil, Qnil, dest_mask); 948 Qnil, Qnil, dest_mask);
975 RETURN_UNGCPRO (ii); 949 RETURN_UNGCPRO (ii);
976 } 950 }
977 951
978 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /* 952 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
979 Create a new `image-instance' object. 953 Return a new `image-instance' object.
980 954
981 Image-instance objects encapsulate the way a particular image (pixmap, 955 Image-instance objects encapsulate the way a particular image (pixmap,
982 etc.) is displayed on a particular device. In most circumstances, you 956 etc.) is displayed on a particular device. In most circumstances, you
983 do not need to directly create image instances; use a glyph instead. 957 do not need to directly create image instances; use a glyph instead.
984 However, it may occasionally be useful to explicitly create image 958 However, it may occasionally be useful to explicitly create image
1466 } 1440 }
1467 1441
1468 static Lisp_Object 1442 static Lisp_Object
1469 image_instantiate_cache_result (Lisp_Object locative) 1443 image_instantiate_cache_result (Lisp_Object locative)
1470 { 1444 {
1471 Lisp_Object instance = Fcar (locative); 1445 /* locative = (instance instantiator . subtable) */
1472 Lisp_Object instantiator = Fcar (Fcdr (locative)); 1446 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
1473 Lisp_Object subtable = Fcdr (Fcdr (locative));
1474 Fputhash (instantiator, instance, subtable);
1475 free_cons (XCONS (XCDR (locative))); 1447 free_cons (XCONS (XCDR (locative)));
1476 free_cons (XCONS (locative)); 1448 free_cons (XCONS (locative));
1477 return Qnil; 1449 return Qnil;
1478 } 1450 }
1479 1451
1716 1688
1717 GCPRO2 (retlist, possible_console_types); 1689 GCPRO2 (retlist, possible_console_types);
1718 1690
1719 LIST_LOOP (rest, possible_console_types) 1691 LIST_LOOP (rest, possible_console_types)
1720 { 1692 {
1721 Lisp_Object newinst;
1722 Lisp_Object contype = XCAR (rest); 1693 Lisp_Object contype = XCAR (rest);
1723 1694 Lisp_Object newinst = call_with_suspended_errors
1724 newinst = call_with_suspended_errors
1725 ((lisp_fn_t) normalize_image_instantiator, 1695 ((lisp_fn_t) normalize_image_instantiator,
1726 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype, 1696 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
1727 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier))); 1697 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
1728 1698
1729 if (!NILP (newinst)) 1699 if (!NILP (newinst))
1911 1881
1912 /**************************************************************************** 1882 /****************************************************************************
1913 * Glyph Object * 1883 * Glyph Object *
1914 ****************************************************************************/ 1884 ****************************************************************************/
1915 1885
1916 static Lisp_Object mark_glyph (Lisp_Object, void (*) (Lisp_Object)); 1886 static Lisp_Object
1917 static void print_glyph (Lisp_Object, Lisp_Object, int); 1887 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
1918 static int glyph_equal (Lisp_Object, Lisp_Object, int depth); 1888 {
1919 static unsigned long glyph_hash (Lisp_Object obj, int depth); 1889 struct Lisp_Glyph *glyph = XGLYPH (obj);
1920 static Lisp_Object glyph_getprop (Lisp_Object obj, Lisp_Object prop); 1890
1921 static int glyph_putprop (Lisp_Object obj, Lisp_Object prop, 1891 ((markobj) (glyph->image));
1922 Lisp_Object value); 1892 ((markobj) (glyph->contrib_p));
1923 static int glyph_remprop (Lisp_Object obj, Lisp_Object prop); 1893 ((markobj) (glyph->baseline));
1924 static Lisp_Object glyph_plist (Lisp_Object obj); 1894 ((markobj) (glyph->face));
1895
1896 return glyph->plist;
1897 }
1898
1899 static void
1900 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1901 {
1902 struct Lisp_Glyph *glyph = XGLYPH (obj);
1903 char buf[20];
1904
1905 if (print_readably)
1906 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
1907
1908 write_c_string ("#<glyph (", printcharfun);
1909 print_internal (Fglyph_type (obj), printcharfun, 0);
1910 write_c_string (") ", printcharfun);
1911 print_internal (glyph->image, printcharfun, 1);
1912 sprintf (buf, "0x%x>", glyph->header.uid);
1913 write_c_string (buf, printcharfun);
1914 }
1915
1916 /* Glyphs are equal if all of their display attributes are equal. We
1917 don't compare names or doc-strings, because that would make equal
1918 be eq.
1919
1920 This isn't concerned with "unspecified" attributes, that's what
1921 #'glyph-differs-from-default-p is for. */
1922 static int
1923 glyph_equal (Lisp_Object o1, Lisp_Object o2, int depth)
1924 {
1925 struct Lisp_Glyph *g1 = XGLYPH (o1);
1926 struct Lisp_Glyph *g2 = XGLYPH (o2);
1927
1928 depth++;
1929
1930 return (internal_equal (g1->image, g2->image, depth) &&
1931 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
1932 internal_equal (g1->baseline, g2->baseline, depth) &&
1933 internal_equal (g1->face, g2->face, depth) &&
1934 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
1935 }
1936
1937 static unsigned long
1938 glyph_hash (Lisp_Object obj, int depth)
1939 {
1940 depth++;
1941
1942 /* No need to hash all of the elements; that would take too long.
1943 Just hash the most common ones. */
1944 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
1945 internal_hash (XGLYPH (obj)->face, depth));
1946 }
1947
1948 static Lisp_Object
1949 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
1950 {
1951 struct Lisp_Glyph *g = XGLYPH (obj);
1952
1953 if (EQ (prop, Qimage)) return g->image;
1954 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
1955 if (EQ (prop, Qbaseline)) return g->baseline;
1956 if (EQ (prop, Qface)) return g->face;
1957
1958 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
1959 }
1960
1961 static int
1962 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
1963 {
1964 if ((EQ (prop, Qimage)) ||
1965 (EQ (prop, Qcontrib_p)) ||
1966 (EQ (prop, Qbaseline)))
1967 return 0;
1968
1969 if (EQ (prop, Qface))
1970 {
1971 XGLYPH (obj)->face = Fget_face (value);
1972 return 1;
1973 }
1974
1975 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
1976 return 1;
1977 }
1978
1979 static int
1980 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
1981 {
1982 if ((EQ (prop, Qimage)) ||
1983 (EQ (prop, Qcontrib_p)) ||
1984 (EQ (prop, Qbaseline)))
1985 return -1;
1986
1987 if (EQ (prop, Qface))
1988 {
1989 XGLYPH (obj)->face = Qnil;
1990 return 1;
1991 }
1992
1993 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
1994 }
1995
1996 static Lisp_Object
1997 glyph_plist (Lisp_Object obj)
1998 {
1999 struct Lisp_Glyph *glyph = XGLYPH (obj);
2000 Lisp_Object result = glyph->plist;
2001
2002 result = cons3 (Qface, glyph->face, result);
2003 result = cons3 (Qbaseline, glyph->baseline, result);
2004 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
2005 result = cons3 (Qimage, glyph->image, result);
2006
2007 return result;
2008 }
2009
1925 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, 2010 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
1926 mark_glyph, print_glyph, 0, 2011 mark_glyph, print_glyph, 0,
1927 glyph_equal, glyph_hash, 2012 glyph_equal, glyph_hash,
1928 glyph_getprop, glyph_putprop, 2013 glyph_getprop, glyph_putprop,
1929 glyph_remprop, glyph_plist, 2014 glyph_remprop, glyph_plist,
1930 struct Lisp_Glyph); 2015 struct Lisp_Glyph);
1931 2016
1932 static Lisp_Object
1933 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
1934 {
1935 struct Lisp_Glyph *glyph = XGLYPH (obj);
1936
1937 ((markobj) (glyph->image));
1938 ((markobj) (glyph->contrib_p));
1939 ((markobj) (glyph->baseline));
1940 ((markobj) (glyph->face));
1941
1942 return glyph->plist;
1943 }
1944
1945 static void
1946 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1947 {
1948 struct Lisp_Glyph *glyph = XGLYPH (obj);
1949 char buf[20];
1950
1951 if (print_readably)
1952 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
1953
1954 write_c_string ("#<glyph (", printcharfun);
1955 print_internal (Fglyph_type (obj), printcharfun, 0);
1956 write_c_string (") ", printcharfun);
1957 print_internal (glyph->image, printcharfun, 1);
1958 sprintf (buf, "0x%x>", glyph->header.uid);
1959 write_c_string (buf, printcharfun);
1960 }
1961
1962 /* Glyphs are equal if all of their display attributes are equal. We
1963 don't compare names or doc-strings, because that would make equal
1964 be eq.
1965
1966 This isn't concerned with "unspecified" attributes, that's what
1967 #'glyph-differs-from-default-p is for. */
1968 static int
1969 glyph_equal (Lisp_Object o1, Lisp_Object o2, int depth)
1970 {
1971 struct Lisp_Glyph *g1 = XGLYPH (o1);
1972 struct Lisp_Glyph *g2 = XGLYPH (o2);
1973
1974 depth++;
1975
1976 return (internal_equal (g1->image, g2->image, depth) &&
1977 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
1978 internal_equal (g1->baseline, g2->baseline, depth) &&
1979 internal_equal (g1->face, g2->face, depth) &&
1980 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
1981 }
1982
1983 static unsigned long
1984 glyph_hash (Lisp_Object obj, int depth)
1985 {
1986 depth++;
1987
1988 /* No need to hash all of the elements; that would take too long.
1989 Just hash the most common ones. */
1990 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
1991 internal_hash (XGLYPH (obj)->face, depth));
1992 }
1993
1994 static Lisp_Object
1995 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
1996 {
1997 struct Lisp_Glyph *g = XGLYPH (obj);
1998
1999 if (EQ (prop, Qimage)) return g->image;
2000 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2001 if (EQ (prop, Qbaseline)) return g->baseline;
2002 if (EQ (prop, Qface)) return g->face;
2003
2004 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
2005 }
2006
2007 static int
2008 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
2009 {
2010 if ((EQ (prop, Qimage)) ||
2011 (EQ (prop, Qcontrib_p)) ||
2012 (EQ (prop, Qbaseline)))
2013 return 0;
2014
2015 if (EQ (prop, Qface))
2016 {
2017 XGLYPH (obj)->face = Fget_face (value);
2018 return 1;
2019 }
2020
2021 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
2022 return 1;
2023 }
2024
2025 static int
2026 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
2027 {
2028 if ((EQ (prop, Qimage)) ||
2029 (EQ (prop, Qcontrib_p)) ||
2030 (EQ (prop, Qbaseline)))
2031 return -1;
2032
2033 if (EQ (prop, Qface))
2034 {
2035 XGLYPH (obj)->face = Qnil;
2036 return 1;
2037 }
2038
2039 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
2040 }
2041
2042 static Lisp_Object
2043 glyph_plist (Lisp_Object obj)
2044 {
2045 struct Lisp_Glyph *g = XGLYPH (obj);
2046 Lisp_Object result = Qnil;
2047
2048 /* backwards order; we reverse it below */
2049 result = Fcons (g->image, Fcons (Qimage, result));
2050 result = Fcons (g->contrib_p, Fcons (Qcontrib_p, result));
2051 result = Fcons (g->baseline, Fcons (Qbaseline, result));
2052 result = Fcons (g->face, Fcons (Qface, result));
2053
2054 return nconc2 (Fnreverse (result), g->plist);
2055 }
2056
2057 Lisp_Object 2017 Lisp_Object
2058 allocate_glyph (enum glyph_type type, 2018 allocate_glyph (enum glyph_type type,
2059 void (*after_change) (Lisp_Object glyph, Lisp_Object property, 2019 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2060 Lisp_Object locale)) 2020 Lisp_Object locale))
2061 { 2021 {
2154 { 2114 {
2155 return Fcopy_sequence (Vglyph_type_list); 2115 return Fcopy_sequence (Vglyph_type_list);
2156 } 2116 }
2157 2117
2158 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /* 2118 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
2159 Create a new, uninitialized glyph. 2119 Create and return a new uninitialized glyph or type TYPE.
2160 2120
2161 TYPE specifies the type of the glyph; this should be one of `buffer', 2121 TYPE specifies the type of the glyph; this should be one of `buffer',
2162 `pointer', or `icon', and defaults to `buffer'. The type of the glyph 2122 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
2163 specifies in which contexts the glyph can be used, and controls the 2123 specifies in which contexts the glyph can be used, and controls the
2164 allowable image types into which the glyph's image can be 2124 allowable image types into which the glyph's image can be
2537 struct glyph_cachel *cachel) 2497 struct glyph_cachel *cachel)
2538 { 2498 {
2539 /* #### This should be || !cachel->updated */ 2499 /* #### This should be || !cachel->updated */
2540 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)) 2500 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
2541 { 2501 {
2542 Lisp_Object window = Qnil; 2502 Lisp_Object window;
2543 2503
2544 XSETWINDOW (window, w); 2504 XSETWINDOW (window, w);
2545 2505
2546 /* #### This could be sped up if we redid things to grab the glyph 2506 /* #### This could be sped up if we redid things to grab the glyph
2547 instantiation and passed it to the size functions. */ 2507 instantiation and passed it to the size functions. */
2557 static void 2517 static void
2558 add_glyph_cachel (struct window *w, Lisp_Object glyph) 2518 add_glyph_cachel (struct window *w, Lisp_Object glyph)
2559 { 2519 {
2560 struct glyph_cachel new_cachel; 2520 struct glyph_cachel new_cachel;
2561 2521
2562 memset (&new_cachel, 0, sizeof (struct glyph_cachel)); 2522 xzero (new_cachel);
2563 new_cachel.glyph = Qnil; 2523 new_cachel.glyph = Qnil;
2564 2524
2565 update_glyph_cachel_data (w, glyph, &new_cachel); 2525 update_glyph_cachel_data (w, glyph, &new_cachel);
2566 Dynarr_add (w->glyph_cachels, new_cachel); 2526 Dynarr_add (w->glyph_cachels, new_cachel);
2567 } 2527 }
2659 if no valid table is specified, return 0. */ 2619 if no valid table is specified, return 0. */
2660 2620
2661 struct Lisp_Vector * 2621 struct Lisp_Vector *
2662 get_display_table (struct window *w, face_index findex) 2622 get_display_table (struct window *w, face_index findex)
2663 { 2623 {
2664 Lisp_Object tem = Qnil; 2624 Lisp_Object tem;
2665 2625
2666 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); 2626 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
2667 if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE) 2627 if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE)
2668 return XVECTOR (tem); 2628 return XVECTOR (tem);
2669 2629