Mercurial > hg > xemacs-beta

diff src/print.c @ 4846:a98ca4640147

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
clean up object print methods casetab.c, console.c, data.c, database.c, device-msw.c, device.c, eval.c, file-coding.c, frame.c, glyphs.c, gui.c, keymap.c, lisp.h, mule-charset.c, objects.c, print.c, process.c, tooltalk.c, ui-gtk.c, window.c: New function printing_unreadable_lcrecord(). Automatically prints the type name and pointer value of the object. Use it instead of printing_unreadable_object(); make that latter function local to print.c. window.c: During creation, window may have Qt as its buffer. Don't crash if trying to print such a window.
author Ben Wing <ben@xemacs.org>
date Wed, 13 Jan 2010 05:49:13 -0600
parents 80cd90837ac5
children 05c519de7353
line wrap: on
line diff
--- a/src/print.c	Wed Jan 13 04:25:15 2010 -0600
+++ b/src/print.c	Wed Jan 13 05:49:13 2010 -0600
@@ -1485,13 +1485,41 @@
   UNGCPRO;
 }
 
-void
-default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
-			int UNUSED (escapeflag))
+DOESNT_RETURN
+printing_unreadable_object (const CIbyte *fmt, ...)
+{
+  Lisp_Object obj;
+  va_list args;
+
+  va_start (args, fmt);
+  obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
+  va_end (args);
+
+  /* Fsignal GC-protects its args */
+  signal_error (Qprinting_unreadable_object, 0, obj);
+}
+
+DOESNT_RETURN
+printing_unreadable_lcrecord (Lisp_Object obj, const Ibyte *name)
 {
   struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj);
 
-  if (print_readably)
+#ifndef NEW_GC
+  /* This must be a real lcrecord */
+  assert (!LHEADER_IMPLEMENTATION (&header->lheader)->basic_p);
+#endif
+
+  if (name)
+    printing_unreadable_object
+      ("#<%s %s 0x%x>",
+#ifdef NEW_GC
+       LHEADER_IMPLEMENTATION (header)->name,
+#else /* not NEW_GC */
+       LHEADER_IMPLEMENTATION (&header->lheader)->name,
+#endif /* not NEW_GC */
+       name,
+       header->uid);
+  else
     printing_unreadable_object
       ("#<%s 0x%x>",
 #ifdef NEW_GC
@@ -1500,6 +1528,21 @@
        LHEADER_IMPLEMENTATION (&header->lheader)->name,
 #endif /* not NEW_GC */
        header->uid);
+}
+
+void
+default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
+			int UNUSED (escapeflag))
+{
+  struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj);
+
+#ifndef NEW_GC
+  /* This must be a real lcrecord */
+  assert (!LHEADER_IMPLEMENTATION (&header->lheader)->basic_p);
+#endif
+
+  if (print_readably)
+    printing_unreadable_lcrecord (obj, 0);
 
   write_fmt_string (printcharfun, "#<%s 0x%x>",
 #ifdef NEW_GC