Mercurial > hg > xemacs-beta

comparison 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
comparison
equal deleted inserted replaced
4845:a3c673c0720b 4846:a98ca4640147
1483 write_c_string (printcharfun, "\""); 1483 write_c_string (printcharfun, "\"");
1484 } 1484 }
1485 UNGCPRO; 1485 UNGCPRO;
1486 } 1486 }
1487 1487
1488 void 1488 DOESNT_RETURN
1489 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun, 1489 printing_unreadable_object (const CIbyte *fmt, ...)
1490 int UNUSED (escapeflag)) 1490 {
1491 Lisp_Object obj;
1492 va_list args;
1493
1494 va_start (args, fmt);
1495 obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
1496 va_end (args);
1497
1498 /* Fsignal GC-protects its args */
1499 signal_error (Qprinting_unreadable_object, 0, obj);
1500 }
1501
1502 DOESNT_RETURN
1503 printing_unreadable_lcrecord (Lisp_Object obj, const Ibyte *name)
1491 { 1504 {
1492 struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj); 1505 struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj);
1493 1506
1494 if (print_readably) 1507 #ifndef NEW_GC
1508 /* This must be a real lcrecord */
1509 assert (!LHEADER_IMPLEMENTATION (&header->lheader)->basic_p);
1510 #endif
1511
1512 if (name)
1513 printing_unreadable_object
1514 ("#<%s %s 0x%x>",
1515 #ifdef NEW_GC
1516 LHEADER_IMPLEMENTATION (header)->name,
1517 #else /* not NEW_GC */
1518 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1519 #endif /* not NEW_GC */
1520 name,
1521 header->uid);
1522 else
1495 printing_unreadable_object 1523 printing_unreadable_object
1496 ("#<%s 0x%x>", 1524 ("#<%s 0x%x>",
1497 #ifdef NEW_GC 1525 #ifdef NEW_GC
1498 LHEADER_IMPLEMENTATION (header)->name, 1526 LHEADER_IMPLEMENTATION (header)->name,
1499 #else /* not NEW_GC */ 1527 #else /* not NEW_GC */
1500 LHEADER_IMPLEMENTATION (&header->lheader)->name, 1528 LHEADER_IMPLEMENTATION (&header->lheader)->name,
1501 #endif /* not NEW_GC */ 1529 #endif /* not NEW_GC */
1502 header->uid); 1530 header->uid);
1531 }
1532
1533 void
1534 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
1535 int UNUSED (escapeflag))
1536 {
1537 struct LCRECORD_HEADER *header = (struct LCRECORD_HEADER *) XPNTR (obj);
1538
1539 #ifndef NEW_GC
1540 /* This must be a real lcrecord */
1541 assert (!LHEADER_IMPLEMENTATION (&header->lheader)->basic_p);
1542 #endif
1543
1544 if (print_readably)
1545 printing_unreadable_lcrecord (obj, 0);
1503 1546
1504 write_fmt_string (printcharfun, "#<%s 0x%x>", 1547 write_fmt_string (printcharfun, "#<%s 0x%x>",
1505 #ifdef NEW_GC 1548 #ifdef NEW_GC
1506 LHEADER_IMPLEMENTATION (header)->name, 1549 LHEADER_IMPLEMENTATION (header)->name,
1507 #else /* not NEW_GC */ 1550 #else /* not NEW_GC */