Mercurial > hg > xemacs-beta
comparison src/print.c @ 826:6728e641994e
[xemacs-hg @ 2002-05-05 11:30:15 by ben]
syntax cache, 8-bit-format, lots of code cleanup
README.packages: Update info about --package-path.
i.c: Create an inheritable event and pass it on to XEmacs, so that ^C
can be handled properly. Intercept ^C and signal the event.
"Stop Build" in VC++ now works.
bytecomp-runtime.el: Doc string changes.
compat.el: Some attempts to redo this to
make it truly useful and fix the "multiple versions interacting
with each other" problem. Not yet done. Currently doesn't work.
files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code.
xemacs.mak: Split up CFLAGS into a version without flags specifying the C
library. The problem seems to be that minitar depends on zlib,
which depends specifically on libc.lib, not on any of the other C
libraries. Unless you compile with libc.lib, you get errors --
specifically, no _errno in the other libraries, which must make it
something other than an int. (#### But this doesn't seem to obtain
in XEmacs, which also uses zlib, and can be linked with any of the
C libraries. Maybe zlib is used differently and doesn't need
errno, or maybe XEmacs provides an int errno; ... I don't
understand.
Makefile.in.in: Fix so that packages are around when testing.
abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, 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-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch.
-- FUNCTIONALITY CHANGES:
add partial support for 8-bit-fixed, 16-bit-fixed, and
32-bit-fixed formats. not quite done yet. (in particular, needs
functions to actually convert the buffer.) NOTE: lots of changes
to regex.c here. also, many new *_fmt() inline funs that take an
Internal_Format argument.
redo syntax cache code. make the cache per-buffer; keep the cache
valid across calls to functions that use it. also keep it valid
across insertions/deletions and extent changes, as much as is
possible. eliminate the junky regex-reentrancy code by passing in
the relevant lisp info to the regex routines as local vars.
add general mechanism in extents code for signalling extent changes.
fix numerous problems with the case-table implementation; yoshiki
never properly transferred many algorithms from old-style to
new-style case tables.
redo char tables to support a default argument, so that mapping
only occurs over changed args. change many chartab functions to
accept Lisp_Object instead of Lisp_Char_Table *.
comment out the code in font-lock.c by default, because
font-lock.el no longer uses it. we should consider eliminating it
entirely.
Don't output bell as ^G in console-stream when not a TTY.
add -mswindows-termination-handle to interface with i.c, so we can
properly kill a build.
add more error-checking to buffer/string macros.
add some additional buffer_or_string_() funs.
-- INTERFACE CHANGES AFFECTING MORE CODE:
switch the arguments of write_c_string and friends to be
consistent with write_fmt_string, which must have printcharfun
first.
change BI_* macros to BYTE_* for increased clarity; similarly for
bi_* local vars.
change VOID_TO_LISP to be a one-argument function. eliminate
no-longer-needed CVOID_TO_LISP.
-- char/string macro changes:
rename MAKE_CHAR() to make_emchar() for slightly less confusion
with make_char(). (The former generates an Emchar, the latter a
Lisp object. Conceivably we should rename make_char() -> wrap_char()
and similarly for make_int(), make_float().)
Similar changes for other *CHAR* macros -- we now consistently use
names with `emchar' whenever we are working with Emchars. Any
remaining name with just `char' always refers to a Lisp object.
rename macros with XSTRING_* to string_* except for those that
reference actual fields in the Lisp_String object, following
conventions used elsewhere.
rename set_string_{data,length} macros (the only ones to work with
a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_*
to make the difference clear.
try to be consistent about caps vs. lowercase in macro/inline-fun
names for chars and such, which wasn't the case before. we now
reserve caps either for XFOO_ macros that reference object fields
(e.g. XSTRING_DATA) or for things that have non-function semantics,
e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an
arg (any arg) more than once. otherwise, use lowercase.
here is a summary of most of the macros/inline funs changed by all
of the above changes:
BYTE_*_P -> byte_*_p
XSTRING_BYTE -> string_byte
set_string_data/length -> set_lispstringp_data/length
XSTRING_CHAR_LENGTH -> string_char_length
XSTRING_CHAR -> string_emchar
INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p
INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p
charptr_copy_char -> charptr_copy_emchar
LEADING_BYTE_* -> leading_byte_*
CHAR_* -> EMCHAR_*
*_CHAR_* -> *_EMCHAR_*
*_CHAR -> *_EMCHAR
CHARSET_BY_ -> charset_by_*
BYTE_SHIFT_JIS* -> byte_shift_jis*
BYTE_BIG5* -> byte_big5*
REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte
char_to_unicode -> emchar_to_unicode
valid_char_p -> valid_emchar_p
Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality).
-- INTERFACE CHANGES AFFECTING LESS CODE:
use DECLARE_INLINE_HEADER in various places.
remove '#ifdef emacs' from XEmacs-only files.
eliminate CHAR_TABLE_VALUE(), which duplicated the functionality
of get_char_table().
add BUFFER_TEXT_LOOP to simplify iterations over buffer text.
define typedefs for signed and unsigned types of fixed sizes
(INT_32_BIT, UINT_32_BIT, etc.).
create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE;
fix code to use it.
add charptr_emchar_len to return the text length of the character
pointed to by a ptr; use it in place of
charcount_to_bytecount(..., 1). add emchar_len to return the text
length of a given character.
add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount
and Charbpos/Charcount, in code (particularly, the extents code
and redisplay code) that works with either kind of index. rename
redisplay struct params with names such as `charbpos' to
e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos.
eliminate xxDEFUN in place of DEFUN; no longer necessary with
changes awhile back to doc.c.
split up big ugly combined list of EXFUNs in lisp.h on a
file-by-file basis, since other prototypes are similarly split.
rewrite some "*_UNSAFE" macros as inline funs and eliminate the
_UNSAFE suffix.
move most string code from lisp.h to text.h; the string code and
text.h code is now intertwined in such a fashion that they need
to be in the same place and partially interleaved. (you can't
create forward references for inline funs)
automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in
batch mode.
Fix up some problems in lisp-tests/symbol-tests that were
causing spurious failures.
author | ben |
---|---|
date | Sun, 05 May 2002 11:33:57 +0000 |
parents | 19dfb459d51a |
children | 2b6fa2618f76 |
comparison
equal
deleted
inserted
replaced
825:eb3bc15a6e0f | 826:6728e641994e |
---|---|
414 | 414 |
415 if (STRINGP (reloc)) | 415 if (STRINGP (reloc)) |
416 { | 416 { |
417 for (iii = ccoff; iii < cclen + ccoff; iii++) | 417 for (iii = ccoff; iii < cclen + ccoff; iii++) |
418 { | 418 { |
419 call1 (function, make_char (XSTRING_CHAR (reloc, iii))); | 419 call1 (function, make_char (string_emchar (reloc, iii))); |
420 if (STRINGP (reloc)) | 420 if (STRINGP (reloc)) |
421 newnonreloc = XSTRING_DATA (reloc); | 421 newnonreloc = XSTRING_DATA (reloc); |
422 } | 422 } |
423 } | 423 } |
424 else | 424 else |
524 Vprint_message_label); | 524 Vprint_message_label); |
525 Lstream_delete (str); | 525 Lstream_delete (str); |
526 } | 526 } |
527 } | 527 } |
528 | 528 |
529 /* Used for printing a single-byte character (*not* any Emchar). */ | |
530 #define write_char_internal(string_of_length_1, stream) \ | |
531 output_string (stream, (const Intbyte *) (string_of_length_1), \ | |
532 Qnil, 0, 1) | |
533 | 529 |
534 /* Write internal-format data to STREAM. See output_string() for | 530 /* Write internal-format data to STREAM. See output_string() for |
535 interpretation of STREAM. | 531 interpretation of STREAM. |
536 | 532 |
537 NOTE: Do not call this with the data of a Lisp_String, as | 533 NOTE: Do not call this with the data of a Lisp_String, as |
542 | 538 |
543 Also note that STREAM should be the result of | 539 Also note that STREAM should be the result of |
544 canonicalize_printcharfun() (i.e. Qnil means stdout, not | 540 canonicalize_printcharfun() (i.e. Qnil means stdout, not |
545 Vstandard_output, etc.) */ | 541 Vstandard_output, etc.) */ |
546 void | 542 void |
547 write_string_1 (const Intbyte *str, Bytecount size, Lisp_Object stream) | 543 write_string_1 (Lisp_Object stream, const Intbyte *str, Bytecount size) |
548 { | 544 { |
549 /* This function can GC */ | 545 /* This function can GC */ |
550 #ifdef ERROR_CHECK_TEXT | 546 #ifdef ERROR_CHECK_TEXT |
551 assert (size >= 0); | 547 assert (size >= 0); |
552 #endif | 548 #endif |
553 output_string (stream, str, Qnil, 0, size); | 549 output_string (stream, str, Qnil, 0, size); |
554 } | 550 } |
555 | 551 |
556 void | 552 void |
557 write_string (const Intbyte *str, Lisp_Object stream) | 553 write_string (Lisp_Object stream, const Intbyte *str) |
558 { | 554 { |
559 /* This function can GC */ | 555 /* This function can GC */ |
560 write_string_1 (str, qxestrlen (str), stream); | 556 write_string_1 (stream, str, qxestrlen (str)); |
561 } | 557 } |
562 | 558 |
563 void | 559 void |
564 write_c_string (const CIntbyte *str, Lisp_Object stream) | 560 write_c_string (Lisp_Object stream, const CIntbyte *str) |
565 { | 561 { |
566 /* This function can GC */ | 562 /* This function can GC */ |
567 write_string_1 ((const Intbyte *) str, strlen (str), stream); | 563 write_string_1 (stream, (const Intbyte *) str, strlen (str)); |
568 } | 564 } |
569 | 565 |
570 void | 566 void |
571 write_eistring (const Eistring *ei, Lisp_Object stream) | 567 write_eistring (Lisp_Object stream, const Eistring *ei) |
572 { | 568 { |
573 write_string_1 (eidata (ei), eilen (ei), stream); | 569 write_string_1 (stream, eidata (ei), eilen (ei)); |
574 } | 570 } |
575 | 571 |
576 /* Write a printf-style string to STREAM; see output_string(). */ | 572 /* Write a printf-style string to STREAM; see output_string(). */ |
577 | 573 |
578 void | 574 void |
585 | 581 |
586 va_start (va, fmt); | 582 va_start (va, fmt); |
587 str = emacs_vsprintf_malloc (fmt, va, &len); | 583 str = emacs_vsprintf_malloc (fmt, va, &len); |
588 va_end (va); | 584 va_end (va); |
589 count = record_unwind_protect_freeing (str); | 585 count = record_unwind_protect_freeing (str); |
590 write_string_1 (str, len, stream); | 586 write_string_1 (stream, str, len); |
591 unbind_to (count); | 587 unbind_to (count); |
592 } | 588 } |
593 | 589 |
594 /* Write a printf-style string to STREAM, where the arguments are | 590 /* Write a printf-style string to STREAM, where the arguments are |
595 Lisp objects and not C strings or integers; see output_string(). | 591 Lisp objects and not C strings or integers; see output_string(). |
611 for (i = 0; i < nargs; i++) | 607 for (i = 0; i < nargs; i++) |
612 args[i] = va_arg (va, Lisp_Object); | 608 args[i] = va_arg (va, Lisp_Object); |
613 va_end (va); | 609 va_end (va); |
614 str = emacs_vsprintf_malloc_lisp (fmt, Qnil, nargs, args, &len); | 610 str = emacs_vsprintf_malloc_lisp (fmt, Qnil, nargs, args, &len); |
615 count = record_unwind_protect_freeing (str); | 611 count = record_unwind_protect_freeing (str); |
616 write_string_1 (str, len, stream); | 612 write_string_1 (stream, str, len); |
617 unbind_to (count); | 613 unbind_to (count); |
618 } | 614 } |
619 | 615 |
620 void | 616 void |
621 stderr_out_lisp (const CIntbyte *fmt, int nargs, ...) | 617 stderr_out_lisp (const CIntbyte *fmt, int nargs, ...) |
631 for (i = 0; i < nargs; i++) | 627 for (i = 0; i < nargs; i++) |
632 args[i] = va_arg (va, Lisp_Object); | 628 args[i] = va_arg (va, Lisp_Object); |
633 va_end (va); | 629 va_end (va); |
634 str = emacs_vsprintf_malloc_lisp (fmt, Qnil, nargs, args, &len); | 630 str = emacs_vsprintf_malloc_lisp (fmt, Qnil, nargs, args, &len); |
635 count = record_unwind_protect_freeing (str); | 631 count = record_unwind_protect_freeing (str); |
636 write_string_1 (str, len, Qexternal_debugging_output); | 632 write_string_1 (Qexternal_debugging_output, str, len); |
637 unbind_to (count); | 633 unbind_to (count); |
638 } | 634 } |
639 | 635 |
640 | 636 |
641 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /* | 637 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /* |
743 If STREAM is omitted or nil, the value of `standard-output' is used. | 739 If STREAM is omitted or nil, the value of `standard-output' is used. |
744 */ | 740 */ |
745 (stream)) | 741 (stream)) |
746 { | 742 { |
747 /* This function can GC */ | 743 /* This function can GC */ |
748 write_char_internal ("\n", canonicalize_printcharfun (stream)); | 744 write_c_string (canonicalize_printcharfun (stream), "\n"); |
749 return Qt; | 745 return Qt; |
750 } | 746 } |
751 | 747 |
752 DEFUN ("prin1", Fprin1, 1, 2, 0, /* | 748 DEFUN ("prin1", Fprin1, 1, 2, 0, /* |
753 Output the printed representation of OBJECT, any Lisp object. | 749 Output the printed representation of OBJECT, any Lisp object. |
829 Lisp_Object frame = Qnil; | 825 Lisp_Object frame = Qnil; |
830 struct gcpro gcpro1, gcpro2; | 826 struct gcpro gcpro1, gcpro2; |
831 | 827 |
832 GCPRO2 (object, stream); | 828 GCPRO2 (object, stream); |
833 stream = print_prepare (stream, &frame); | 829 stream = print_prepare (stream, &frame); |
834 write_char_internal ("\n", stream); | 830 write_c_string (stream, "\n"); |
835 print_internal (object, stream, 1); | 831 print_internal (object, stream, 1); |
836 write_char_internal ("\n", stream); | 832 write_c_string (stream, "\n"); |
837 print_finish (stream, frame); | 833 print_finish (stream, frame); |
838 UNGCPRO; | 834 UNGCPRO; |
839 return object; | 835 return object; |
840 } | 836 } |
841 | 837 |
907 else | 903 else |
908 print_internal (LISP_GETTEXT (errmsg), stream, 0); | 904 print_internal (LISP_GETTEXT (errmsg), stream, 0); |
909 } | 905 } |
910 while (!NILP (tail)) | 906 while (!NILP (tail)) |
911 { | 907 { |
912 write_c_string (first ? ": " : ", ", stream); | 908 write_c_string (stream, first ? ": " : ", "); |
913 /* Most errors have an explanatory string as their first argument, | 909 /* Most errors have an explanatory string as their first argument, |
914 and it looks better not to put the quotes around it. */ | 910 and it looks better not to put the quotes around it. */ |
915 print_internal (Fcar (tail), stream, | 911 print_internal (Fcar (tail), stream, |
916 !(first && STRINGP (Fcar (tail))) || | 912 !(first && STRINGP (Fcar (tail))) || |
917 !NILP (Fget (type, Qerror_lacks_explanatory_string, | 913 !NILP (Fget (type, Qerror_lacks_explanatory_string, |
927 } | 923 } |
928 | 924 |
929 error_throw: | 925 error_throw: |
930 if (NILP (method)) | 926 if (NILP (method)) |
931 { | 927 { |
932 write_c_string (GETTEXT ("Peculiar error "), stream); | 928 write_c_string (stream, GETTEXT ("Peculiar error ")); |
933 print_internal (error_object, stream, 1); | 929 print_internal (error_object, stream, 1); |
934 return; | 930 return; |
935 } | 931 } |
936 else | 932 else |
937 { | 933 { |
1191 { | 1187 { |
1192 int max = XINT (Vprint_length); | 1188 int max = XINT (Vprint_length); |
1193 if (max < len) last = max; | 1189 if (max < len) last = max; |
1194 } | 1190 } |
1195 | 1191 |
1196 write_c_string (start, printcharfun); | 1192 write_c_string (printcharfun, start); |
1197 for (i = 0; i < last; i++) | 1193 for (i = 0; i < last; i++) |
1198 { | 1194 { |
1199 Lisp_Object elt = XVECTOR_DATA (obj)[i]; | 1195 Lisp_Object elt = XVECTOR_DATA (obj)[i]; |
1200 if (i != 0) write_char_internal (" ", printcharfun); | 1196 if (i != 0) write_c_string (printcharfun, " "); |
1201 print_internal (elt, printcharfun, escapeflag); | 1197 print_internal (elt, printcharfun, escapeflag); |
1202 } | 1198 } |
1203 UNGCPRO; | 1199 UNGCPRO; |
1204 if (last != len) | 1200 if (last != len) |
1205 write_c_string (" ...", printcharfun); | 1201 write_c_string (printcharfun, " ..."); |
1206 write_c_string (end, printcharfun); | 1202 write_c_string (printcharfun, end); |
1207 } | 1203 } |
1208 | 1204 |
1209 void | 1205 void |
1210 print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 1206 print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
1211 { | 1207 { |
1222 CONSP (XCDR (obj)) && | 1218 CONSP (XCDR (obj)) && |
1223 NILP (XCDR (XCDR (obj)))) | 1219 NILP (XCDR (XCDR (obj)))) |
1224 { | 1220 { |
1225 obj = XCAR (XCDR (obj)); | 1221 obj = XCAR (XCDR (obj)); |
1226 GCPRO2 (obj, printcharfun); | 1222 GCPRO2 (obj, printcharfun); |
1227 write_char_internal ("\'", printcharfun); | 1223 write_c_string (printcharfun, "\'"); |
1228 UNGCPRO; | 1224 UNGCPRO; |
1229 print_internal (obj, printcharfun, escapeflag); | 1225 print_internal (obj, printcharfun, escapeflag); |
1230 return; | 1226 return; |
1231 } | 1227 } |
1232 | 1228 |
1233 GCPRO2 (obj, printcharfun); | 1229 GCPRO2 (obj, printcharfun); |
1234 write_char_internal ("(", printcharfun); | 1230 write_c_string (printcharfun, "("); |
1235 | 1231 |
1236 { | 1232 { |
1237 int len; | 1233 int len; |
1238 int max = INTP (Vprint_length) ? XINT (Vprint_length) : INT_MAX; | 1234 int max = INTP (Vprint_length) ? XINT (Vprint_length) : INT_MAX; |
1239 Lisp_Object tortoise; | 1235 Lisp_Object tortoise; |
1242 for (tortoise = obj, len = 0; | 1238 for (tortoise = obj, len = 0; |
1243 CONSP (obj); | 1239 CONSP (obj); |
1244 obj = XCDR (obj), len++) | 1240 obj = XCDR (obj), len++) |
1245 { | 1241 { |
1246 if (len > 0) | 1242 if (len > 0) |
1247 write_char_internal (" ", printcharfun); | 1243 write_c_string (printcharfun, " "); |
1248 if (EQ (obj, tortoise) && len > 0) | 1244 if (EQ (obj, tortoise) && len > 0) |
1249 { | 1245 { |
1250 if (print_readably) | 1246 if (print_readably) |
1251 printing_unreadable_object ("circular list"); | 1247 printing_unreadable_object ("circular list"); |
1252 else | 1248 else |
1253 write_c_string ("... <circular list>", printcharfun); | 1249 write_c_string (printcharfun, "... <circular list>"); |
1254 break; | 1250 break; |
1255 } | 1251 } |
1256 if (len & 1) | 1252 if (len & 1) |
1257 tortoise = XCDR (tortoise); | 1253 tortoise = XCDR (tortoise); |
1258 if (len > max) | 1254 if (len > max) |
1259 { | 1255 { |
1260 write_c_string ("...", printcharfun); | 1256 write_c_string (printcharfun, "..."); |
1261 break; | 1257 break; |
1262 } | 1258 } |
1263 print_internal (XCAR (obj), printcharfun, escapeflag); | 1259 print_internal (XCAR (obj), printcharfun, escapeflag); |
1264 } | 1260 } |
1265 } | 1261 } |
1266 if (!LISTP (obj)) | 1262 if (!LISTP (obj)) |
1267 { | 1263 { |
1268 write_c_string (" . ", printcharfun); | 1264 write_c_string (printcharfun, " . "); |
1269 print_internal (obj, printcharfun, escapeflag); | 1265 print_internal (obj, printcharfun, escapeflag); |
1270 } | 1266 } |
1271 UNGCPRO; | 1267 UNGCPRO; |
1272 | 1268 |
1273 write_char_internal (")", printcharfun); | 1269 write_c_string (printcharfun, ")"); |
1274 return; | 1270 return; |
1275 } | 1271 } |
1276 | 1272 |
1277 void | 1273 void |
1278 print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 1274 print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
1283 void | 1279 void |
1284 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 1280 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
1285 { | 1281 { |
1286 /* We distinguish between Bytecounts and Charcounts, to make | 1282 /* We distinguish between Bytecounts and Charcounts, to make |
1287 Vprint_string_length work correctly under Mule. */ | 1283 Vprint_string_length work correctly under Mule. */ |
1288 Charcount size = XSTRING_CHAR_LENGTH (obj); | 1284 Charcount size = string_char_length (obj); |
1289 Charcount max = size; | 1285 Charcount max = size; |
1290 Bytecount bcmax = XSTRING_LENGTH (obj); | 1286 Bytecount bcmax = XSTRING_LENGTH (obj); |
1291 struct gcpro gcpro1, gcpro2; | 1287 struct gcpro gcpro1, gcpro2; |
1292 GCPRO2 (obj, printcharfun); | 1288 GCPRO2 (obj, printcharfun); |
1293 | 1289 |
1306 if (!escapeflag) | 1302 if (!escapeflag) |
1307 { | 1303 { |
1308 /* This deals with GC-relocation and Mule. */ | 1304 /* This deals with GC-relocation and Mule. */ |
1309 output_string (printcharfun, 0, obj, 0, bcmax); | 1305 output_string (printcharfun, 0, obj, 0, bcmax); |
1310 if (max < size) | 1306 if (max < size) |
1311 write_c_string (" ...", printcharfun); | 1307 write_c_string (printcharfun, " ..."); |
1312 } | 1308 } |
1313 else | 1309 else |
1314 { | 1310 { |
1315 Bytecount i, last = 0; | 1311 Bytecount i, last = 0; |
1316 | 1312 |
1317 write_char_internal ("\"", printcharfun); | 1313 write_c_string (printcharfun, "\""); |
1318 for (i = 0; i < bcmax; i++) | 1314 for (i = 0; i < bcmax; i++) |
1319 { | 1315 { |
1320 Intbyte ch = XSTRING_BYTE (obj, i); | 1316 Intbyte ch = string_byte (obj, i); |
1321 if (ch == '\"' || ch == '\\' | 1317 if (ch == '\"' || ch == '\\' |
1322 || (ch == '\n' && print_escape_newlines)) | 1318 || (ch == '\n' && print_escape_newlines)) |
1323 { | 1319 { |
1324 if (i > last) | 1320 if (i > last) |
1325 { | 1321 { |
1326 output_string (printcharfun, 0, obj, last, | 1322 output_string (printcharfun, 0, obj, last, |
1327 i - last); | 1323 i - last); |
1328 } | 1324 } |
1329 if (ch == '\n') | 1325 if (ch == '\n') |
1330 { | 1326 { |
1331 write_c_string ("\\n", printcharfun); | 1327 write_c_string (printcharfun, "\\n"); |
1332 } | 1328 } |
1333 else | 1329 else |
1334 { | 1330 { |
1335 write_char_internal ("\\", printcharfun); | 1331 Intbyte temp[2]; |
1332 write_c_string (printcharfun, "\\"); | |
1336 /* This is correct for Mule because the | 1333 /* This is correct for Mule because the |
1337 character is either \ or " */ | 1334 character is either \ or " */ |
1338 write_char_internal (XSTRING_DATA (obj) + i, printcharfun); | 1335 temp[0] = string_byte (obj, i); |
1336 temp[1] = '\0'; | |
1337 write_string (printcharfun, temp); | |
1339 } | 1338 } |
1340 last = i + 1; | 1339 last = i + 1; |
1341 } | 1340 } |
1342 } | 1341 } |
1343 if (bcmax > last) | 1342 if (bcmax > last) |
1344 { | 1343 { |
1345 output_string (printcharfun, 0, obj, last, | 1344 output_string (printcharfun, 0, obj, last, |
1346 bcmax - last); | 1345 bcmax - last); |
1347 } | 1346 } |
1348 if (max < size) | 1347 if (max < size) |
1349 write_c_string (" ...", printcharfun); | 1348 write_c_string (printcharfun, " ..."); |
1350 write_char_internal ("\"", printcharfun); | 1349 write_c_string (printcharfun, "\""); |
1351 } | 1350 } |
1352 UNGCPRO; | 1351 UNGCPRO; |
1353 } | 1352 } |
1354 | 1353 |
1355 static void | 1354 static void |
1470 if (EQ (obj, being_printed[i])) | 1469 if (EQ (obj, being_printed[i])) |
1471 { | 1470 { |
1472 char buf[DECIMAL_PRINT_SIZE (long) + 1]; | 1471 char buf[DECIMAL_PRINT_SIZE (long) + 1]; |
1473 *buf = '#'; | 1472 *buf = '#'; |
1474 long_to_string (buf + 1, i); | 1473 long_to_string (buf + 1, i); |
1475 write_c_string (buf, printcharfun); | 1474 write_c_string (printcharfun, buf); |
1476 return; | 1475 return; |
1477 } | 1476 } |
1478 } | 1477 } |
1479 | 1478 |
1480 being_printed[print_depth] = obj; | 1479 being_printed[print_depth] = obj; |
1488 case Lisp_Type_Int_Even: | 1487 case Lisp_Type_Int_Even: |
1489 case Lisp_Type_Int_Odd: | 1488 case Lisp_Type_Int_Odd: |
1490 { | 1489 { |
1491 char buf[DECIMAL_PRINT_SIZE (EMACS_INT)]; | 1490 char buf[DECIMAL_PRINT_SIZE (EMACS_INT)]; |
1492 long_to_string (buf, XINT (obj)); | 1491 long_to_string (buf, XINT (obj)); |
1493 write_c_string (buf, printcharfun); | 1492 write_c_string (printcharfun, buf); |
1494 break; | 1493 break; |
1495 } | 1494 } |
1496 | 1495 |
1497 case Lisp_Type_Char: | 1496 case Lisp_Type_Char: |
1498 { | 1497 { |
1569 /* If deeper than spec'd depth, print placeholder. */ | 1568 /* If deeper than spec'd depth, print placeholder. */ |
1570 if (INTP (Vprint_level) | 1569 if (INTP (Vprint_level) |
1571 && print_depth > XINT (Vprint_level)) | 1570 && print_depth > XINT (Vprint_level)) |
1572 { | 1571 { |
1573 GCPRO2 (obj, printcharfun); | 1572 GCPRO2 (obj, printcharfun); |
1574 write_c_string ("...", printcharfun); | 1573 write_c_string (printcharfun, "..."); |
1575 UNGCPRO; | 1574 UNGCPRO; |
1576 break; | 1575 break; |
1577 } | 1576 } |
1578 } | 1577 } |
1579 | 1578 |
1594 #else /* not ERROR_CHECK_TYPES */ | 1593 #else /* not ERROR_CHECK_TYPES */ |
1595 /* We're in trouble if this happens! */ | 1594 /* We're in trouble if this happens! */ |
1596 if (print_readably) | 1595 if (print_readably) |
1597 signal_error (Qinternal_error, "printing illegal data type #o%03o", | 1596 signal_error (Qinternal_error, "printing illegal data type #o%03o", |
1598 make_int (XTYPE (obj))); | 1597 make_int (XTYPE (obj))); |
1599 write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ", | 1598 write_c_string (printcharfun, "#<EMACS BUG: ILLEGAL DATATYPE "); |
1600 printcharfun); | |
1601 write_fmt_string (printcharfun, "(#o%3o)", (int) XTYPE (obj)); | 1599 write_fmt_string (printcharfun, "(#o%3o)", (int) XTYPE (obj)); |
1602 write_c_string | 1600 write_c_string |
1603 (" Save your buffers immediately and please report this bug>", | 1601 (printcharfun, |
1604 printcharfun); | 1602 " Save your buffers immediately and please report this bug>"); |
1605 #endif /* not ERROR_CHECK_TYPES */ | 1603 #endif /* not ERROR_CHECK_TYPES */ |
1606 break; | 1604 break; |
1607 } | 1605 } |
1608 } | 1606 } |
1609 | 1607 |
1616 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 1614 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
1617 { | 1615 { |
1618 char pigbuf[350]; /* see comments in float_to_string */ | 1616 char pigbuf[350]; /* see comments in float_to_string */ |
1619 | 1617 |
1620 float_to_string (pigbuf, XFLOAT_DATA (obj)); | 1618 float_to_string (pigbuf, XFLOAT_DATA (obj)); |
1621 write_c_string (pigbuf, printcharfun); | 1619 write_c_string (printcharfun, pigbuf); |
1622 } | 1620 } |
1623 #endif /* LISP_FLOAT_TYPE */ | 1621 #endif /* LISP_FLOAT_TYPE */ |
1624 | 1622 |
1625 void | 1623 void |
1626 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 1624 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
1653 if (print_depth > 1) | 1651 if (print_depth > 1) |
1654 { | 1652 { |
1655 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist); | 1653 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist); |
1656 if (CONSP (tem)) | 1654 if (CONSP (tem)) |
1657 { | 1655 { |
1658 write_char_internal ("#", printcharfun); | 1656 write_c_string (printcharfun, "#"); |
1659 print_internal (XCDR (tem), printcharfun, escapeflag); | 1657 print_internal (XCDR (tem), printcharfun, escapeflag); |
1660 write_char_internal ("#", printcharfun); | 1658 write_c_string (printcharfun, "#"); |
1661 UNGCPRO; | 1659 UNGCPRO; |
1662 return; | 1660 return; |
1663 } | 1661 } |
1664 else | 1662 else |
1665 { | 1663 { |
1673 } | 1671 } |
1674 else | 1672 else |
1675 tem = make_int (1); | 1673 tem = make_int (1); |
1676 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist); | 1674 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist); |
1677 | 1675 |
1678 write_char_internal ("#", printcharfun); | 1676 write_c_string (printcharfun, "#"); |
1679 print_internal (tem, printcharfun, escapeflag); | 1677 print_internal (tem, printcharfun, escapeflag); |
1680 write_char_internal ("=", printcharfun); | 1678 write_c_string (printcharfun, "="); |
1681 } | 1679 } |
1682 } | 1680 } |
1683 write_c_string ("#:", printcharfun); | 1681 write_c_string (printcharfun, "#:"); |
1684 } | 1682 } |
1685 | 1683 |
1686 /* Does it look like an integer or a float? */ | 1684 /* Does it look like an integer or a float? */ |
1687 { | 1685 { |
1688 Intbyte *data = XSTRING_DATA (name); | 1686 Intbyte *data = XSTRING_DATA (name); |
1715 need here. It might be a good idea to copy equivalent code | 1713 need here. It might be a good idea to copy equivalent code |
1716 from FSF. --hniksic */ | 1714 from FSF. --hniksic */ |
1717 confusing = isfloat_string ((char *) data); | 1715 confusing = isfloat_string ((char *) data); |
1718 #endif | 1716 #endif |
1719 if (confusing) | 1717 if (confusing) |
1720 write_char_internal ("\\", printcharfun); | 1718 write_c_string (printcharfun, "\\"); |
1721 } | 1719 } |
1722 | 1720 |
1723 { | 1721 { |
1724 Bytecount i; | 1722 Bytecount i; |
1725 Bytecount last = 0; | 1723 Bytecount last = 0; |
1726 | 1724 |
1727 for (i = 0; i < size; i++) | 1725 for (i = 0; i < size; i++) |
1728 { | 1726 { |
1729 switch (XSTRING_BYTE (name, i)) | 1727 switch (string_byte (name, i)) |
1730 { | 1728 { |
1731 case 0: case 1: case 2: case 3: | 1729 case 0: case 1: case 2: case 3: |
1732 case 4: case 5: case 6: case 7: | 1730 case 4: case 5: case 6: case 7: |
1733 case 8: case 9: case 10: case 11: | 1731 case 8: case 9: case 10: case 11: |
1734 case 12: case 13: case 14: case 15: | 1732 case 12: case 13: case 14: case 15: |
1740 case ';': case '#' : case '(' : case ')': | 1738 case ';': case '#' : case '(' : case ')': |
1741 case ',': case '.' : case '`' : | 1739 case ',': case '.' : case '`' : |
1742 case '[': case ']' : case '?' : | 1740 case '[': case ']' : case '?' : |
1743 if (i > last) | 1741 if (i > last) |
1744 output_string (printcharfun, 0, name, last, i - last); | 1742 output_string (printcharfun, 0, name, last, i - last); |
1745 write_char_internal ("\\", printcharfun); | 1743 write_c_string (printcharfun, "\\"); |
1746 last = i; | 1744 last = i; |
1747 } | 1745 } |
1748 } | 1746 } |
1749 output_string (printcharfun, 0, name, last, size - last); | 1747 output_string (printcharfun, 0, name, last, size - last); |
1750 } | 1748 } |