Mercurial > hg > xemacs-beta
diff src/glyphs.c @ 5178:97eb4942aec8
merge
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 29 Mar 2010 21:28:13 -0500 |
parents | 8b2f75cecb89 1fae11d56ad2 |
children | 71ee43b8a74d |
line wrap: on
line diff
--- a/src/glyphs.c Tue Feb 23 07:28:35 2010 -0600 +++ b/src/glyphs.c Mon Mar 29 21:28:13 2010 -0500 @@ -4,7 +4,7 @@ Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing Copyright (C) 1995 Sun Microsystems Copyright (C) 1998, 1999, 2000 Andy Piper - Copyright (C) 2007 Didier Verna + Copyright (C) 2007, 2010 Didier Verna This file is part of XEmacs. @@ -992,7 +992,7 @@ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#<image-instance (%s) ", 1, Fimage_instance_type (obj)); if (!NILP (ii->name)) @@ -1108,20 +1108,19 @@ MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), print_image_instance, (ii, printcharfun, escapeflag)); - write_fmt_string (printcharfun, " 0x%x>", ii->header.uid); + write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); } static void -finalize_image_instance (void *header, int for_disksave) -{ - Lisp_Image_Instance *i = (Lisp_Image_Instance *) header; +finalize_image_instance (Lisp_Object obj) +{ + Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); /* objects like this exist at dump time, so don't bomb out. */ if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING || NILP (IMAGE_INSTANCE_DEVICE (i))) return; - if (for_disksave) finalose (i); /* We can't use the domain here, because it might have disappeared. */ @@ -1314,21 +1313,19 @@ 0)); } -DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, - 0, /*dumpable-flag*/ - mark_image_instance, print_image_instance, - finalize_image_instance, image_instance_equal, - image_instance_hash, - image_instance_description, - Lisp_Image_Instance); +DEFINE_NODUMP_LISP_OBJECT ("image-instance", image_instance, + mark_image_instance, print_image_instance, + finalize_image_instance, image_instance_equal, + image_instance_hash, + image_instance_description, + Lisp_Image_Instance); static Lisp_Object allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, Lisp_Object instantiator) { - Lisp_Image_Instance *lp = - ALLOC_LCRECORD_TYPE (Lisp_Image_Instance, &lrecord_image_instance); - Lisp_Object val; + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (image_instance); + Lisp_Image_Instance *lp = XIMAGE_INSTANCE (obj); /* It's not possible to simply keep a record of the domain in which the instance was instantiated. This is because caching may mean @@ -1351,10 +1348,9 @@ /* So that layouts get done. */ lp->layout_changed = 1; - val = wrap_image_instance (lp); MARK_GLYPHS_CHANGED; - return val; + return obj; } static enum image_instance_type @@ -1994,7 +1990,7 @@ device-specific method to copy the window-system subobject. */ new_ = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance), Qnil, Qnil); - COPY_LCRECORD (XIMAGE_INSTANCE (new_), XIMAGE_INSTANCE (image_instance)); + copy_lisp_object (new_, image_instance); /* note that if this method returns non-zero, this method MUST copy any window-system resources, so that when one image instance is freed, the other one is not hosed. */ @@ -2521,15 +2517,16 @@ /* pixmap file functions */ /************************************************************************/ -/* If INSTANTIATOR refers to inline data, return Qt. - If INSTANTIATOR refers to data in a file, return the full filename - if it exists, Qnil if there's no console method for locating the file, or - (filename) if there was an error locating the file. +/* - If INSTANTIATOR refers to inline data, or there is no file keyword, we + have nothing to do, so return Qt. + - If INSTANTIATOR refers to data in a file, return the full filename + if it exists; otherwise, return '(filename), meaning "file not found". + - If there is no locate_pixmap_file method for this console, return Qnil. FILE_KEYWORD and DATA_KEYWORD are symbols specifying the keywords used to look up the file and inline data, - respectively, in the instantiator. Normally these would - be Q_file and Q_data, but might be different for mask data. */ + respectively, in the instantiator. These would be Q_file and Q_data, + Q_mask_file or Q_mask_data. */ Lisp_Object potential_pixmap_file_instantiator (Lisp_Object instantiator, @@ -2736,18 +2733,20 @@ return Qnil; /* not reached */ } +/* This function attempts to find implicit mask files by appending "Mask" or + "msk" to the original bitmap file name. This is more or less standard: a + number of bitmaps in /usr/include/X11/bitmaps use it. */ Lisp_Object xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, Lisp_Object mask_file, Lisp_Object console_type) { - /* This is unclean but it's fairly standard -- a number of the - bitmaps in /usr/include/X11/bitmaps use it -- so we support - it. */ - if (EQ (mask_file, Qt) - /* don't override explicitly specified mask data. */ - && NILP (assq_no_quit (Q_mask_data, alist)) - && !EQ (file, Qt)) + /* Let's try to find an implicit mask file if we have neither an explicit + mask file name, nor inline mask data. Note that no errors are reported in + case of failure because the mask file we're looking for might not + exist. */ + if (EQ (mask_file, Qt) && NILP (assq_no_quit (Q_mask_data, alist))) { + assert (!EQ (file, Qt) && !EQ (file, Qnil)); mask_file = MAYBE_LISP_CONTYPE_METH (decode_console_type(console_type, ERROR_ME), locate_pixmap_file, (concat2 (file, build_ascstring ("Mask")))); @@ -2757,10 +2756,14 @@ locate_pixmap_file, (concat2 (file, build_ascstring ("msk")))); } + /* We got a mask file, either explicitely or from the search above. */ if (!NILP (mask_file)) { - Lisp_Object mask_data = - bitmap_to_lisp_data (mask_file, 0, 0, 0); + Lisp_Object mask_data; + + assert (!EQ (mask_file, Qt)); + + mask_data = bitmap_to_lisp_data (mask_file, 0, 0, 0); alist = remassq_no_quit (Q_mask_file, alist); /* there can't be a :mask-data at this point. */ alist = Fcons (Fcons (Q_mask_file, mask_file), @@ -2776,9 +2779,8 @@ xbm_normalize (Lisp_Object inst, Lisp_Object console_type, Lisp_Object UNUSED (dest_mask)) { - Lisp_Object file = Qnil, mask_file = Qnil; + Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; GCPRO3 (file, mask_file, alist); @@ -2796,7 +2798,9 @@ mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, Q_mask_data, console_type); - if (NILP (file)) /* normalization impossible for the console type */ + /* No locate_pixmap_file method for this console type, so we can't get a + file (neither a mask file BTW). */ + if (NILP (file)) RETURN_UNGCPRO (Qnil); if (CONSP (file)) /* failure locating filename */ @@ -2804,6 +2808,11 @@ "no such file or directory", Fcar (file)); + if (CONSP (mask_file)) /* failure locating filename */ + signal_double_image_error ("Opening bitmap mask file", + "no such file or directory", + Fcar (mask_file)); + if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ RETURN_UNGCPRO (inst); @@ -2863,10 +2872,8 @@ xface_normalize (Lisp_Object inst, Lisp_Object console_type, Lisp_Object UNUSED (dest_mask)) { - /* This function can call lisp */ - Lisp_Object file = Qnil, mask_file = Qnil; + Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; GCPRO3 (file, mask_file, alist); @@ -2884,28 +2891,34 @@ mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, Q_mask_data, console_type); - if (NILP (file)) /* normalization impossible for the console type */ + /* No locate_pixmap_file method for this console type, so we can't get a + file (neither a mask file BTW). */ + if (NILP (file)) RETURN_UNGCPRO (Qnil); if (CONSP (file)) /* failure locating filename */ - signal_double_image_error ("Opening bitmap file", + signal_double_image_error ("Opening face file", "no such file or directory", Fcar (file)); + if (CONSP (mask_file)) /* failure locating filename */ + signal_double_image_error ("Opening face mask file", + "no such file or directory", + Fcar (mask_file)); + if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ RETURN_UNGCPRO (inst); alist = tagged_vector_to_alist (inst); - { - /* #### FIXME: what if EQ (file, Qt) && !EQ (mask, Qt) ? Is that possible? - If so, we have a problem... -- dvl */ - Lisp_Object data = make_string_from_file (file); - alist = remassq_no_quit (Q_file, alist); - /* there can't be a :data at this point. */ - alist = Fcons (Fcons (Q_file, file), - Fcons (Fcons (Q_data, data), alist)); - } + if (!EQ (file, Qt)) + { + Lisp_Object data = make_string_from_file (file); + alist = remassq_no_quit (Q_file, alist); + /* there can't be a :data at this point. */ + alist = Fcons (Fcons (Q_file, file), + Fcons (Fcons (Q_data, data), alist)); + } alist = xbm_mask_file_munging (alist, file, mask_file, console_type); @@ -3694,11 +3707,11 @@ Lisp_Glyph *glyph = XGLYPH (obj); if (print_readably) - printing_unreadable_lcrecord (obj, 0); + printing_unreadable_lisp_object (obj, 0); write_fmt_string_lisp (printcharfun, "#<glyph (%s", 1, Fglyph_type (obj)); write_fmt_string_lisp (printcharfun, ") %S", 1, glyph->image); - write_fmt_string (printcharfun, "0x%x>", glyph->header.uid); + write_fmt_string (printcharfun, "0x%x>", LISP_OBJECT_UID (obj)); } /* Glyphs are equal if all of their display attributes are equal. We @@ -3805,14 +3818,11 @@ { XD_END } }; -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, - 1, /*dumpable-flag*/ - mark_glyph, print_glyph, 0, - glyph_equal, glyph_hash, - glyph_description, - glyph_getprop, glyph_putprop, - glyph_remprop, glyph_plist, - Lisp_Glyph); +DEFINE_DUMPABLE_LISP_OBJECT ("glyph", glyph, + mark_glyph, print_glyph, 0, + glyph_equal, glyph_hash, + glyph_description, + Lisp_Glyph); Lisp_Object allocate_glyph (enum glyph_type type, @@ -3820,8 +3830,8 @@ Lisp_Object locale)) { /* This function can GC */ - Lisp_Object obj = Qnil; - Lisp_Glyph *g = ALLOC_LCRECORD_TYPE (Lisp_Glyph, &lrecord_glyph); + Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (glyph); + Lisp_Glyph *g = XGLYPH (obj); g->type = type; g->image = Fmake_specifier (Qimage); /* This function can GC */ @@ -3867,7 +3877,6 @@ g->face = Qnil; g->plist = Qnil; g->after_change = after_change; - obj = wrap_glyph (g); set_image_attached_to (g->image, obj, Qimage); UNGCPRO; @@ -4465,12 +4474,12 @@ int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, - struct overhead_stats *ovstats) + struct usage_stats *ustats) { int total = 0; if (glyph_cachels) - total += Dynarr_memory_usage (glyph_cachels, ovstats); + total += Dynarr_memory_usage (glyph_cachels, ustats); return total; } @@ -4537,7 +4546,7 @@ XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) = delq_no_quit (value, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); - finalize_image_instance (XIMAGE_INSTANCE (value), 0); + finalize_image_instance (value); } } return 0; @@ -4640,7 +4649,7 @@ struct expose_ignore *ei; #ifdef NEW_GC - ei = alloc_lrecord_type (struct expose_ignore, &lrecord_expose_ignore); + ei = XEXPOSE_IGNORE (ALLOC_NORMAL_LISP_OBJECT (expose_ignore)); #else /* not NEW_GC */ ei = Blocktype_alloc (the_expose_ignore_blocktype); #endif /* not NEW_GC */ @@ -5175,10 +5184,19 @@ *****************************************************************************/ void +glyph_objects_create (void) +{ + OBJECT_HAS_METHOD (glyph, getprop); + OBJECT_HAS_METHOD (glyph, putprop); + OBJECT_HAS_METHOD (glyph, remprop); + OBJECT_HAS_METHOD (glyph, plist); +} + +void syms_of_glyphs (void) { - INIT_LRECORD_IMPLEMENTATION (glyph); - INIT_LRECORD_IMPLEMENTATION (image_instance); + INIT_LISP_OBJECT (glyph); + INIT_LISP_OBJECT (image_instance); /* image instantiators */