comparison src/print.c @ 793:e38acbeb1cae

[xemacs-hg @ 2002-03-29 04:46:17 by ben] lots o' fixes etc/ChangeLog: New file. Separated out all entries for etc/ into their own ChangeLog. Includes entries for the following files: etc/BABYL, etc/BETA, etc/CHARSETS, etc/DISTRIB, etc/Emacs.ad, etc/FTP, etc/GNUS-NEWS, etc/GOATS, etc/HELLO, etc/INSTALL, etc/MACHINES, etc/MAILINGLISTS, etc/MSDOS, etc/MYTHOLOGY, etc/NEWS, etc/OXYMORONS, etc/PACKAGES, etc/README, etc/TUTORIAL, etc/TUTORIAL.de, etc/TUTORIAL.ja, etc/TUTORIAL.ko, etc/TUTORIAL.se, etc/aliases.ksh, etc/altrasoft-logo.xpm, etc/check_cygwin_setup.sh, etc/custom/example-themes/europe-theme.el, etc/custom/example-themes/ex-custom-file, etc/custom/example-themes/example-theme.el, etc/e/eterm.ti, etc/edt-user.doc, etc/enriched.doc, etc/etags.1, etc/gnuserv.1, etc/gnuserv.README, etc/package-index.LATEST.gpg, etc/package-index.LATEST.pgp, etc/photos/jan.png, etc/recycle.xpm, etc/refcard.tex, etc/sample.Xdefaults, etc/sample.emacs, etc/sgml/CATALOG, etc/sgml/HTML32.dtd, etc/skk/SKK.tut.E, etc/smilies/Face_ase.xbm, etc/smilies/Face_ase2.xbm, etc/smilies/Face_ase3.xbm, etc/smilies/Face_smile.xbm, etc/smilies/Face_weep.xbm, etc/sounds, etc/toolbar, etc/toolbar/workshop-cap-up.xpm, etc/xemacs-ja.1, etc/xemacs.1, etc/yow.lines, etc\BETA, etc\NEWS, etc\README, etc\TUTORIAL, etc\TUTORIAL.de, etc\check_cygwin_setup.sh, etc\sample.init.el, etc\unicode\README, etc\unicode\mule-ucs\*, etc\unicode\other\* unicode/unicode-consortium/8859-16.TXT: New file. mule/english.el: Define this charset now, since a bug was fixed that formerly prevented it. mule/ethio-util.el: Fix compile errors involving Unicode `characters', which should be integers. Makefile.in.in: Always include gui.c, to fix compile error when TTY-only. EmacsFrame.c, abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, bytecode.h, callint.c, callproc.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.c, console-msw.h, console-tty.c, console-x.c, console-x.h, console.c, console.h, data.c, database.c, device-gtk.c, device-msw.c, device-x.c, device.c, device.h, dialog-msw.c, doc.c, doprnt.c, dumper.c, dynarr.c, editfns.c, eldap.c, eldap.h, elhash.c, elhash.h, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, events.h, extents.c, extents.h, faces.c, faces.h, file-coding.c, file-coding.h, fileio.c, filelock.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, free-hook.c, general-slots.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gpmevent.c, gtk-xemacs.c, gui-msw.c, gui-x.c, gui-x.h, gui.c, gui.h, gutter.c, gutter.h, indent.c, input-method-xlib.c, insdel.c, keymap.c, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-canna.c, mule-ccl.c, mule-charset.c, mule-wnnfns.c, native-gtk-toolbar.c, objects-msw.c, objects-tty.c, objects-x.c, objects.c, objects.h, opaque.c, opaque.h, postgresql.c, postgresql.h, print.c, process-unix.c, process.c, process.h, rangetab.c, rangetab.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, search.c, select-gtk.c, select-x.c, sound.c, specifier.c, specifier.h, strftime.c, symbols.c, symeval.h, syntax.h, text.c, text.h, toolbar-common.c, toolbar-msw.c, toolbar.c, toolbar.h, tooltalk.c, tooltalk.h, ui-gtk.c, ui-gtk.h, undo.c, vm-limit.c, window.c, window.h: Eliminate XSETFOO. Replace all usages with wrap_foo(). Make symbol->name a Lisp_Object, not Lisp_String *. Eliminate nearly all uses of Lisp_String * in favor of Lisp_Object, and correct macros so most of them favor Lisp_Object. Create new error-behavior ERROR_ME_DEBUG_WARN -- output warnings, but at level `debug' (usually ignored). Use it when instantiating specifiers, so problems can be debugged. Move log-warning-minimum-level into C so that we can optimize ERROR_ME_DEBUG_WARN. Fix warning levels consistent with new definitions. Add default_ and parent fields to char table; not yet implemented. New fun Dynarr_verify(); use for further error checking on Dynarrs. Rearrange code at top of lisp.h in conjunction with dynarr changes. Fix eifree(). Use Eistrings in various places (format_event_object(), where_is_to_char(), and callers thereof) to avoid fixed-size strings buffers. New fun write_eistring(). Reindent and fix GPM code to follow standards. Set default MS Windows font to Lucida Console (same size as Courier New but less interline spacing, so more lines fit). Increase default frame size on Windows to 50 lines. (If that's too big for the workspace, the frame will be shrunk as necessary.) Fix problem with text files with no newlines (). (Change `convert-eol' coding system to use `nil' for autodetect, consistent with make-coding-system.) Correct compile warnings in vm-limit.c. Fix handling of reverse-direction charsets to avoid errors when opening (e.g.) mule-ucs/lisp/reldata/uiso8859-6.el. Recode some object printing methods to use write_fmt_string() instead of a fixed buffer and sprintf. Turn on display of png comments as warnings (level `info'), now that they're unobtrusive. Revamped the sound documentation. Fixed bug in redisplay w.r.t. hscroll/truncation/continuation glyphs causing jumping up and down of the lines, since they're bigger than the line size. (It was seen most obviously when there's a horizontal scroll bar, e.g. do C-h a glyph or something like that.) The problem was that the glyph-contrib-p setting on glyphs was ignored even if it was set properly, which it wasn't until now.
author ben
date Fri, 29 Mar 2002 04:49:13 +0000
parents 943eaba38521
children a5954632b187
comparison
equal deleted inserted replaced
792:4e83fdb13eb9 793:e38acbeb1cae
1 /* Lisp object printing and output streams. 1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc. 2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996, 2000, 2001 Ben Wing. 3 Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
322 322
323 fixup_internal_substring (newnonreloc, reloc, offset, &len); 323 fixup_internal_substring (newnonreloc, reloc, offset, &len);
324 324
325 if (STRINGP (reloc)) 325 if (STRINGP (reloc))
326 { 326 {
327 cclen = XSTRING_OFFSET_BYTE_TO_CHAR_LEN (reloc, offset, len); 327 cclen = string_offset_byte_to_char_len (reloc, offset, len);
328 newnonreloc = XSTRING_DATA (reloc); 328 newnonreloc = XSTRING_DATA (reloc);
329 } 329 }
330 else 330 else
331 cclen = bytecount_to_charcount (newnonreloc + offset, len); 331 cclen = bytecount_to_charcount (newnonreloc + offset, len);
332 332
403 { 403 {
404 Charcount ccoff; 404 Charcount ccoff;
405 Charcount iii; 405 Charcount iii;
406 406
407 if (STRINGP (reloc)) 407 if (STRINGP (reloc))
408 ccoff = XSTRING_INDEX_BYTE_TO_CHAR (reloc, offset); 408 ccoff = string_index_byte_to_char (reloc, offset);
409 else 409 else
410 ccoff = bytecount_to_charcount (newnonreloc, offset); 410 ccoff = bytecount_to_charcount (newnonreloc, offset);
411 411
412 if (STRINGP (reloc)) 412 if (STRINGP (reloc))
413 { 413 {
562 { 562 {
563 /* This function can GC */ 563 /* This function can GC */
564 write_string_1 ((const Intbyte *) str, strlen (str), stream); 564 write_string_1 ((const Intbyte *) str, strlen (str), stream);
565 } 565 }
566 566
567 void
568 write_eistring (const Eistring *ei, Lisp_Object stream)
569 {
570 write_string_1 (eidata (ei), eilen (ei), stream);
571 }
572
567 /* Write a printf-style string to STREAM; see output_string(). */ 573 /* Write a printf-style string to STREAM; see output_string(). */
568 574
569 void 575 void
570 write_fmt_string (Lisp_Object stream, const CIntbyte *fmt, ...) 576 write_fmt_string (Lisp_Object stream, const CIntbyte *fmt, ...)
571 { 577 {
660 Fset_buffer (Fget_buffer_create (bufname)); 666 Fset_buffer (Fget_buffer_create (bufname));
661 667
662 current_buffer->read_only = Qnil; 668 current_buffer->read_only = Qnil;
663 Ferase_buffer (Qnil); 669 Ferase_buffer (Qnil);
664 670
665 XSETBUFFER (buf, current_buffer); 671 buf = wrap_buffer (current_buffer);
666 specbind (Qstandard_output, buf); 672 specbind (Qstandard_output, buf);
667 673
668 set_buffer_internal (old); 674 set_buffer_internal (old);
669 } 675 }
670 676
1276 } 1282 }
1277 1283
1278 void 1284 void
1279 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 1285 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1280 { 1286 {
1281 Lisp_String *s = XSTRING (obj);
1282 /* We distinguish between Bytecounts and Charcounts, to make 1287 /* We distinguish between Bytecounts and Charcounts, to make
1283 Vprint_string_length work correctly under Mule. */ 1288 Vprint_string_length work correctly under Mule. */
1284 Charcount size = string_char_length (s); 1289 Charcount size = XSTRING_CHAR_LENGTH (obj);
1285 Charcount max = size; 1290 Charcount max = size;
1286 Bytecount bcmax = string_length (s); 1291 Bytecount bcmax = XSTRING_LENGTH (obj);
1287 struct gcpro gcpro1, gcpro2; 1292 struct gcpro gcpro1, gcpro2;
1288 GCPRO2 (obj, printcharfun); 1293 GCPRO2 (obj, printcharfun);
1289 1294
1290 if (INTP (Vprint_string_length) && 1295 if (INTP (Vprint_string_length) &&
1291 XINT (Vprint_string_length) < max) 1296 XINT (Vprint_string_length) < max)
1292 { 1297 {
1293 max = XINT (Vprint_string_length); 1298 max = XINT (Vprint_string_length);
1294 bcmax = string_index_char_to_byte (s, max); 1299 bcmax = string_index_char_to_byte (obj, max);
1295 } 1300 }
1296 if (max < 0) 1301 if (max < 0)
1297 { 1302 {
1298 max = 0; 1303 max = 0;
1299 bcmax = 0; 1304 bcmax = 0;
1311 Bytecount i, last = 0; 1316 Bytecount i, last = 0;
1312 1317
1313 write_char_internal ("\"", printcharfun); 1318 write_char_internal ("\"", printcharfun);
1314 for (i = 0; i < bcmax; i++) 1319 for (i = 0; i < bcmax; i++)
1315 { 1320 {
1316 Intbyte ch = string_byte (s, i); 1321 Intbyte ch = XSTRING_BYTE (obj, i);
1317 if (ch == '\"' || ch == '\\' 1322 if (ch == '\"' || ch == '\\'
1318 || (ch == '\n' && print_escape_newlines)) 1323 || (ch == '\n' && print_escape_newlines))
1319 { 1324 {
1320 if (i > last) 1325 if (i > last)
1321 { 1326 {
1329 else 1334 else
1330 { 1335 {
1331 write_char_internal ("\\", printcharfun); 1336 write_char_internal ("\\", printcharfun);
1332 /* This is correct for Mule because the 1337 /* This is correct for Mule because the
1333 character is either \ or " */ 1338 character is either \ or " */
1334 write_char_internal (string_data (s) + i, printcharfun); 1339 write_char_internal (XSTRING_DATA (obj) + i, printcharfun);
1335 } 1340 }
1336 last = i + 1; 1341 last = i + 1;
1337 } 1342 }
1338 } 1343 }
1339 if (bcmax > last) 1344 if (bcmax > last)
1438 1443
1439 if (STRINGP (obj)) 1444 if (STRINGP (obj))
1440 { 1445 {
1441 Lisp_String *l = (Lisp_String *) lheader; 1446 Lisp_String *l = (Lisp_String *) lheader;
1442 if (!debug_can_access_memory 1447 if (!debug_can_access_memory
1443 (l->data, l->size)) 1448 (l->data_, l->size_))
1444 { 1449 {
1445 char buf[128]; 1450 char buf[128];
1446 1451
1447 sprintf (buf, "#<EMACS BUG: %p (BAD STRING DATA %p)>", 1452 sprintf (buf, "#<EMACS BUG: %p (BAD STRING DATA %p)>",
1448 lheader, l->data); 1453 lheader, l->data_);
1449 write_c_string (buf, printcharfun); 1454 write_c_string (buf, printcharfun);
1450 return; 1455 return;
1451 } 1456 }
1452 } 1457 }
1453 } 1458 }
1633 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 1638 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1634 { 1639 {
1635 /* This function can GC */ 1640 /* This function can GC */
1636 /* #### Bug!! (intern "") isn't printed in some distinguished way */ 1641 /* #### Bug!! (intern "") isn't printed in some distinguished way */
1637 /* #### (the reader also loses on it) */ 1642 /* #### (the reader also loses on it) */
1638 Lisp_String *name = symbol_name (XSYMBOL (obj)); 1643 Lisp_Object name = symbol_name (XSYMBOL (obj));
1639 Bytecount size = string_length (name); 1644 Bytecount size = XSTRING_LENGTH (name);
1640 struct gcpro gcpro1, gcpro2; 1645 struct gcpro gcpro1, gcpro2;
1641 1646
1642 if (!escapeflag) 1647 if (!escapeflag)
1643 { 1648 {
1644 /* This deals with GC-relocation */ 1649 /* This deals with GC-relocation */
1645 Lisp_Object nameobj; 1650 output_string (printcharfun, 0, name, 0, size);
1646 XSETSTRING (nameobj, name);
1647 output_string (printcharfun, 0, nameobj, 0, size);
1648 return; 1651 return;
1649 } 1652 }
1650 GCPRO2 (obj, printcharfun); 1653 GCPRO2 (obj, printcharfun);
1651 1654
1652 /* If we print an uninterned symbol as part of a complex object and 1655 /* If we print an uninterned symbol as part of a complex object and
1654 object back with the #n# reader syntax later if needed. */ 1657 object back with the #n# reader syntax later if needed. */
1655 if (!NILP (Vprint_gensym) 1658 if (!NILP (Vprint_gensym)
1656 /* #### Test whether this produces a noticeable slow-down for 1659 /* #### Test whether this produces a noticeable slow-down for
1657 printing when print-gensym is non-nil. */ 1660 printing when print-gensym is non-nil. */
1658 && !EQ (obj, oblookup (Vobarray, 1661 && !EQ (obj, oblookup (Vobarray,
1659 string_data (symbol_name (XSYMBOL (obj))), 1662 XSTRING_DATA (symbol_name (XSYMBOL (obj))),
1660 string_length (symbol_name (XSYMBOL (obj)))))) 1663 XSTRING_LENGTH (symbol_name (XSYMBOL (obj))))))
1661 { 1664 {
1662 if (print_depth > 1) 1665 if (print_depth > 1)
1663 { 1666 {
1664 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist); 1667 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist);
1665 if (CONSP (tem)) 1668 if (CONSP (tem))
1676 { 1679 {
1677 /* Vprint_gensym_alist is exposed to Lisp, so we 1680 /* Vprint_gensym_alist is exposed to Lisp, so we
1678 have to be careful. */ 1681 have to be careful. */
1679 CHECK_CONS (XCAR (Vprint_gensym_alist)); 1682 CHECK_CONS (XCAR (Vprint_gensym_alist));
1680 CHECK_INT (XCDR (XCAR (Vprint_gensym_alist))); 1683 CHECK_INT (XCDR (XCAR (Vprint_gensym_alist)));
1681 XSETINT (tem, XINT (XCDR (XCAR (Vprint_gensym_alist))) + 1); 1684 tem = make_int (XINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
1682 } 1685 }
1683 else 1686 else
1684 XSETINT (tem, 1); 1687 tem = make_int (1);
1685 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist); 1688 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
1686 1689
1687 write_char_internal ("#", printcharfun); 1690 write_char_internal ("#", printcharfun);
1688 print_internal (tem, printcharfun, escapeflag); 1691 print_internal (tem, printcharfun, escapeflag);
1689 write_char_internal ("=", printcharfun); 1692 write_char_internal ("=", printcharfun);
1692 write_c_string ("#:", printcharfun); 1695 write_c_string ("#:", printcharfun);
1693 } 1696 }
1694 1697
1695 /* Does it look like an integer or a float? */ 1698 /* Does it look like an integer or a float? */
1696 { 1699 {
1697 Intbyte *data = string_data (name); 1700 Intbyte *data = XSTRING_DATA (name);
1698 Bytecount confusing = 0; 1701 Bytecount confusing = 0;
1699 1702
1700 if (size == 0) 1703 if (size == 0)
1701 goto not_yet_confused; /* Really confusing */ 1704 goto not_yet_confused; /* Really confusing */
1702 else if (isdigit (data[0])) 1705 else if (isdigit (data[0]))
1728 if (confusing) 1731 if (confusing)
1729 write_char_internal ("\\", printcharfun); 1732 write_char_internal ("\\", printcharfun);
1730 } 1733 }
1731 1734
1732 { 1735 {
1733 Lisp_Object nameobj;
1734 Bytecount i; 1736 Bytecount i;
1735 Bytecount last = 0; 1737 Bytecount last = 0;
1736 1738
1737 XSETSTRING (nameobj, name);
1738 for (i = 0; i < size; i++) 1739 for (i = 0; i < size; i++)
1739 { 1740 {
1740 switch (string_byte (name, i)) 1741 switch (XSTRING_BYTE (name, i))
1741 { 1742 {
1742 case 0: case 1: case 2: case 3: 1743 case 0: case 1: case 2: case 3:
1743 case 4: case 5: case 6: case 7: 1744 case 4: case 5: case 6: case 7:
1744 case 8: case 9: case 10: case 11: 1745 case 8: case 9: case 10: case 11:
1745 case 12: case 13: case 14: case 15: 1746 case 12: case 13: case 14: case 15:
1750 case ' ': case '\"': case '\\': case '\'': 1751 case ' ': case '\"': case '\\': case '\'':
1751 case ';': case '#' : case '(' : case ')': 1752 case ';': case '#' : case '(' : case ')':
1752 case ',': case '.' : case '`' : 1753 case ',': case '.' : case '`' :
1753 case '[': case ']' : case '?' : 1754 case '[': case ']' : case '?' :
1754 if (i > last) 1755 if (i > last)
1755 output_string (printcharfun, 0, nameobj, last, i - last); 1756 output_string (printcharfun, 0, name, last, i - last);
1756 write_char_internal ("\\", printcharfun); 1757 write_char_internal ("\\", printcharfun);
1757 last = i; 1758 last = i;
1758 } 1759 }
1759 } 1760 }
1760 output_string (printcharfun, 0, nameobj, last, size - last); 1761 output_string (printcharfun, 0, name, last, size - last);
1761 } 1762 }
1762 UNGCPRO; 1763 UNGCPRO;
1763 } 1764 }
1764 1765
1765 1766