annotate src/print.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents 1c880911c386
children 943eaba38521
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Lisp object printing and output streams.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
3 Copyright (C) 1995, 1996, 2000 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not synched with FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 /* Seriously hacked on by Ben Wing for Mule. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "backtrace.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "console-tty.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "console-stream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "extents.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #include "sysfile.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
41 #ifdef WIN32_NATIVE
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
42 #include "console-msw.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
43 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #include <float.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 /* Define if not in float.h */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #ifndef DBL_DIG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #define DBL_DIG 16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 Lisp_Object Vstandard_output, Qstandard_output;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 /* The subroutine object for external-debugging-output is kept here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 for the convenience of the debugger. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
55 Lisp_Object Qexternal_debugging_output, Qalternate_debugging_output;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
56
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
57 #ifdef HAVE_MS_WINDOWS
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
58 Lisp_Object Qmswindows_debugging_output;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
59 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 /* Avoid actual stack overflow in print. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 static int print_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 /* Detect most circularities to print finite output. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 #define PRINT_CIRCLE 200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 static Lisp_Object being_printed[PRINT_CIRCLE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 /* Maximum length of list or vector to print in full; noninteger means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 effectively infinity */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Lisp_Object Vprint_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Lisp_Object Qprint_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 /* Maximum length of string to print in full; noninteger means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 effectively infinity */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Lisp_Object Vprint_string_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 Lisp_Object Qprint_string_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 /* Maximum depth of list to print in full; noninteger means
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 effectively infinity. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Lisp_Object Vprint_level;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 /* Label to use when making echo-area messages. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Lisp_Object Vprint_message_label;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 /* Nonzero means print newlines in strings as \n. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 int print_escape_newlines;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 int print_readably;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 /* Non-nil means print #: before uninterned symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Neither t nor nil means so that and don't clear Vprint_gensym_alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 on entry to and exit from print functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 Lisp_Object Vprint_gensym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Lisp_Object Vprint_gensym_alist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Lisp_Object Qdisplay_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 Lisp_Object Qprint_message_label;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 /* Force immediate output of all printed data. Used for debugging. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 int print_unbuffered;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 FILE *termscript; /* Stdio stream being used for copy of all output. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 int stdout_needs_newline;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
112 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
113 std_handle_out_external (FILE *stream, Lisp_Object lstream,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
114 const Extbyte *extptr, Bytecount extlen,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
115 /* is this really stdout/stderr?
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
116 (controls termscript writing) */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
117 int output_is_std_handle,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
118 int must_flush)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 if (stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
122 #ifdef WIN32_NATIVE
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
123 HANDLE errhand = GetStdHandle (STD_INPUT_HANDLE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
124 int no_useful_stderr = errhand == 0 || errhand == INVALID_HANDLE_VALUE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
125
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
126 if (!no_useful_stderr)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
127 no_useful_stderr = !PeekNamedPipe (errhand, 0, 0, 0, 0, 0);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
128 /* we typically have no useful stdout/stderr under windows if we're
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
129 being invoked graphically. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
130 if (no_useful_stderr)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
131 mswindows_output_console_string (extptr, extlen);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
132 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
134 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
135 fwrite (extptr, 1, extlen, stream);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
136 #ifdef WIN32_NATIVE
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
137 /* Q122442 says that pipes are "treated as files, not as
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
138 devices", and that this is a feature. Before I found that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
139 article, I thought it was a bug. Thanks MS, I feel much
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
140 better now. - kkm */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
141 must_flush = 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
142 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
143 if (must_flush)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
144 fflush (stream);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
145 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
148 Lstream_write (XLSTREAM (lstream), extptr, extlen);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
149
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
150 if (output_is_std_handle)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 if (termscript)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 fwrite (extptr, 1, extlen, termscript);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 fflush (termscript);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 stdout_needs_newline = (extptr[extlen - 1] != '\n');
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
161 /* #### The following function should be replaced a call to the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
162 emacs_doprnt_*() functions. This is the only way to ensure that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
163 I18N3 works properly (many implementations of the *printf()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
164 functions, including the ones included in glibc, do not implement
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
165 the %###$ argument-positioning syntax).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
166
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
167 Note, however, that to do this, we'd have to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
168
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
169 1) pre-allocate all the lstreams and do whatever else was necessary
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
170 to make sure that no allocation occurs, since these functions may be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
171 called from fatal_error_signal().
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
172
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
173 2) (to be really correct) make a new lstream that outputs using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
174 mswindows_output_console_string(). */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
175
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
176 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
177 std_handle_out_va (FILE *stream, const char *fmt, va_list args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
178 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
179 Intbyte kludge[8192];
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
180 Extbyte *extptr;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
181 Bytecount extlen;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
182 int retval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
183
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
184 retval = vsprintf ((char *) kludge, fmt, args);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
185 if (initialized && !fatal_error_in_progress)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
186 TO_EXTERNAL_FORMAT (DATA, (kludge, strlen ((char *) kludge)),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
187 ALLOCA, (extptr, extlen),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
188 Qnative);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
189 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
190 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
191 extptr = (Extbyte *) kludge;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
192 extlen = (Bytecount) strlen ((char *) kludge);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
193 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
194
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
195 std_handle_out_external (stream, Qnil, extptr, extlen, 1, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
196 return retval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
197 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
198
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
199 /* Output portably to stderr or its equivalent; call GETTEXT on the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
200 format string. Automatically flush when done. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
201
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
202 int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
203 stderr_out (const char *fmt, ...)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
204 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
205 int retval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
206 va_list args;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
207 va_start (args, fmt);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
208 retval =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
209 std_handle_out_va
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
210 (stderr, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
211 args);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
212 va_end (args);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
213 return retval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
214 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
215
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
216 /* Output portably to stdout or its equivalent; call GETTEXT on the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
217 format string. Automatically flush when done. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
218
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
219 int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
220 stdout_out (const char *fmt, ...)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
221 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
222 int retval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
223 va_list args;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
224 va_start (args, fmt);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
225 retval =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
226 std_handle_out_va
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
227 (stdout, initialized && !fatal_error_in_progress ? GETTEXT (fmt) : fmt,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
228 args);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
229 va_end (args);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
230 return retval;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
231 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
232
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
233 DOESNT_RETURN
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
234 fatal (const char *fmt, ...)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
235 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
236 va_list args;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
237 va_start (args, fmt);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
238
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
239 stderr_out ("\nXEmacs: ");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
240 std_handle_out_va (stderr, GETTEXT (fmt), args);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
241 stderr_out ("\n");
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
242
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
243 va_end (args);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
244 exit (1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
245 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
246
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
247 /* Write a string (in internal format) to stdio stream STREAM. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
248
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
249 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
250 write_string_to_stdio_stream (FILE *stream, struct console *con,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
251 const Intbyte *str,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
252 Bytecount offset, Bytecount len,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
253 Lisp_Object coding_system,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
254 int must_flush)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
255 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
256 Bytecount extlen;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
257 const Extbyte *extptr;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
258
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
259 /* #### yuck! sometimes this function is called with string data,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
260 and the following call may gc. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
261 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
262 Intbyte *puta = (Intbyte *) alloca (len);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
263 memcpy (puta, str + offset, len);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
264 TO_EXTERNAL_FORMAT (DATA, (puta, len),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
265 ALLOCA, (extptr, extlen),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
266 coding_system);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
267 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
268
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
269 if (stream)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
270 std_handle_out_external (stream, Qnil, extptr, extlen,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
271 stream == stdout || stream == stderr, must_flush);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
272 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
273 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
274 assert (CONSOLE_TTY_P (con));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
275 std_handle_out_external (0, CONSOLE_TTY_DATA (con)->outstream,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
276 extptr, extlen,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
277 CONSOLE_TTY_DATA (con)->is_stdio, must_flush);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
278 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
279 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
280
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 /* Write a string to the output location specified in FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 Arguments NONRELOC, RELOC, OFFSET, and LEN are as in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 buffer_insert_string_1() in insdel.c. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 static void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
286 output_string (Lisp_Object function, const Intbyte *nonreloc,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 Lisp_Object reloc, Bytecount offset, Bytecount len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 Charcount cclen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 /* We change the value of nonreloc (fetching it from reloc as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 necessary), but we don't want to pass this changed value on to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 other functions that take both a nonreloc and a reloc, or things
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 may get confused and an assertion failure in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 fixup_internal_substring() may get triggered. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
296 const Intbyte *newnonreloc = nonreloc;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 /* Emacs won't print while GCing, but an external debugger might */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 if (gc_in_progress) return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 /* Perhaps not necessary but probably safer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 GCPRO2 (function, reloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 fixup_internal_substring (newnonreloc, reloc, offset, &len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 if (STRINGP (reloc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 newnonreloc = XSTRING_DATA (reloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 cclen = bytecount_to_charcount (newnonreloc + offset, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 if (LSTREAMP (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 if (STRINGP (reloc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 /* Protect against Lstream_write() causing a GC and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 relocating the string. For small strings, we do it by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 alloc'ing the string and using a copy; for large strings,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 we inhibit GC. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 if (len < 65536)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
322 Intbyte *copied = alloca_array (Intbyte, len);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 memcpy (copied, newnonreloc + offset, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 Lstream_write (XLSTREAM (function), copied, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 record_unwind_protect (restore_gc_inhibit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 make_int (gc_currently_forbidden));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 gc_currently_forbidden = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 Lstream_write (XLSTREAM (function), newnonreloc + offset, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 if (print_unbuffered)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 Lstream_flush (XLSTREAM (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 else if (BUFFERP (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 CHECK_LIVE_BUFFER (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 buffer_insert_string (XBUFFER (function), nonreloc, reloc, offset, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 else if (MARKERP (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 /* marker_position() will err if marker doesn't point anywhere. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
350 Charbpos spoint = marker_position (function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 buffer_insert_string_1 (XMARKER (function)->buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 spoint, nonreloc, reloc, offset, len,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 Fset_marker (function, make_int (spoint + cclen),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 Fmarker_buffer (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 else if (FRAMEP (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 /* This gets used by functions not invoking print_prepare(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 such as Fwrite_char, Fterpri, etc.. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 struct frame *f = XFRAME (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 CHECK_LIVE_FRAME (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 if (!EQ (Vprint_message_label, echo_area_status (f)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 clear_echo_area_from_print (f, Qnil, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 else if (EQ (function, Qt) || EQ (function, Qnil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
372 Qterminal, print_unbuffered);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 Charcount iii;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 for (iii = ccoff; iii < cclen + ccoff; iii++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 call1 (function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 make_char (charptr_emchar_n (newnonreloc, iii)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 if (STRINGP (reloc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 newnonreloc = XSTRING_DATA (reloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 #define RESET_PRINT_GENSYM do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 if (!CONSP (Vprint_gensym)) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 Vprint_gensym_alist = Qnil; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 canonicalize_printcharfun (Lisp_Object printcharfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 if (NILP (printcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 printcharfun = Vstandard_output;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 if (EQ (printcharfun, Qt) || NILP (printcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 printcharfun = Fselected_frame (Qnil); /* print to minibuffer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 return printcharfun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 print_prepare (Lisp_Object printcharfun, Lisp_Object *frame_kludge)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 /* Emacs won't print while GCing, but an external debugger might */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 if (gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 RESET_PRINT_GENSYM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 printcharfun = canonicalize_printcharfun (printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 /* Here we could safely return the canonicalized PRINTCHARFUN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 However, if PRINTCHARFUN is a frame, printing of complex
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 structures becomes very expensive, because `append-message'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (called by echo_area_append) gets called as many times as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 output_string() is called (and that's a *lot*). append-message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 tries to keep top of the message-stack in sync with the contents
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 of " *Echo Area" buffer, consing a new string for each component
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 of the printed structure. For instance, if you print (a a),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 append-message will cons up the following strings:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 "("
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 "(a"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 "(a "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 "(a a"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 "(a a)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 and will use only the last one. With larger objects, this turns
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 into an O(n^2) consing frenzy that locks up XEmacs in incessant
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 garbage collection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 We prevent this by creating a resizing_buffer stream and letting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 the printer write into it. print_finish() will notice this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 stream, and invoke echo_area_append() with the stream's buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 only once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 if (FRAMEP (printcharfun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 CHECK_LIVE_FRAME (printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 *frame_kludge = printcharfun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 printcharfun = make_resizing_buffer_output_stream ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 return printcharfun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 print_finish (Lisp_Object stream, Lisp_Object frame_kludge)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 /* Emacs won't print while GCing, but an external debugger might */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 if (gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 RESET_PRINT_GENSYM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 /* See the comment in print_prepare(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 if (FRAMEP (frame_kludge))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 struct frame *f = XFRAME (frame_kludge);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 Lstream *str = XLSTREAM (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 CHECK_LIVE_FRAME (frame_kludge);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 Lstream_flush (str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 if (!EQ (Vprint_message_label, echo_area_status (f)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 clear_echo_area_from_print (f, Qnil, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 echo_area_append (f, resizing_buffer_stream_ptr (str),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 Qnil, 0, Lstream_byte_count (str),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 Vprint_message_label);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 Lstream_delete (str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 /* Used for printing a single-byte character (*not* any Emchar). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 #define write_char_internal(string_of_length_1, stream) \
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
481 output_string (stream, (const Intbyte *) (string_of_length_1), \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 Qnil, 0, 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 /* NOTE: Do not call this with the data of a Lisp_String, as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 printcharfun might cause a GC, which might cause the string's data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 to be relocated. To princ a Lisp string, use:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 print_internal (string, printcharfun, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 Also note that STREAM should be the result of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 canonicalize_printcharfun() (i.e. Qnil means stdout, not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 Vstandard_output, etc.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 void
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
494 write_string_1 (const Intbyte *str, Bytecount size, Lisp_Object stream)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
497 #ifdef ERROR_CHECK_CHARBPOS
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 assert (size >= 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 output_string (stream, str, Qnil, 0, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
504 write_c_string (const char *str, Lisp_Object stream)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
507 write_string_1 ((const Intbyte *) str, strlen (str), stream);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 DEFUN ("write-char", Fwrite_char, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
512 Output character CHARACTER to stream STREAM.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 STREAM defaults to the value of `standard-output' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
515 (character, stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
518 Intbyte str[MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 Bytecount len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
521 CHECK_CHAR_COERCE_INT (character);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
522 len = set_charptr_emchar (str, XCHAR (character));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 output_string (canonicalize_printcharfun (stream), str, Qnil, 0, len);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
524 return character;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 temp_output_buffer_setup (Lisp_Object bufname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 struct buffer *old = current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 Lisp_Object buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 /* #### This function should accept a Lisp_Object instead of a char *,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 so that proper translation on the buffer name can occur. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 Fset_buffer (Fget_buffer_create (bufname));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 current_buffer->read_only = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 Ferase_buffer (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 XSETBUFFER (buf, current_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 specbind (Qstandard_output, buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 set_buffer_internal (old);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 internal_with_output_to_temp_buffer (Lisp_Object bufname,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 Lisp_Object (*function) (Lisp_Object arg),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 Lisp_Object arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 Lisp_Object same_frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 Lisp_Object buf = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 GCPRO3 (buf, arg, same_frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 temp_output_buffer_setup (bufname);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 buf = Vstandard_output;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 arg = (*function) (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 temp_output_buffer_show (buf, same_frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 return unbind_to (speccount, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer, 1, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 The buffer is cleared out initially, and marked as unmodified when done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 All output done by BODY is inserted in that buffer by default.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 The buffer is displayed in another window, but not selected.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 The value of the last form in BODY is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 If BODY does not finish normally, the buffer BUFNAME is not displayed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 If variable `temp-buffer-show-function' is non-nil, call it at the end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 to get the buffer displayed. It gets one argument, the buffer to display.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 Lisp_Object name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 Lisp_Object val = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 /* #### should set the buffer to be translating. See print_internal(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 GCPRO2 (name, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 name = Feval (XCAR (args));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 CHECK_STRING (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 temp_output_buffer_setup (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 val = Fprogn (XCDR (args));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 temp_output_buffer_show (Vstandard_output, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 return unbind_to (speccount, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 DEFUN ("terpri", Fterpri, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 Output a newline to STREAM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 If STREAM is omitted or nil, the value of `standard-output' is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 write_char_internal ("\n", canonicalize_printcharfun (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 DEFUN ("prin1", Fprin1, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 Output the printed representation of OBJECT, any Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 Quoting characters are printed when needed to make output that `read'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 can handle, whenever this is possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 Output stream is STREAM, or value of `standard-output' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (object, stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 Lisp_Object frame = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 GCPRO2 (object, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 print_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 stream = print_prepare (stream, &frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 print_internal (object, stream, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 print_finish (stream, frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 return object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 DEFUN ("prin1-to-string", Fprin1_to_string, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 Return a string containing the printed representation of OBJECT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 any Lisp object. Quoting characters are used when needed to make output
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 that `read' can handle, whenever this is possible, unless the optional
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 second argument NOESCAPE is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 (object, noescape))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 Lisp_Object stream = make_resizing_buffer_output_stream ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 Lstream *str = XLSTREAM (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 /* gcpro OBJECT in case a caller forgot to do so */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 GCPRO3 (object, stream, result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 print_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 RESET_PRINT_GENSYM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 print_internal (object, stream, NILP (noescape));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 RESET_PRINT_GENSYM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 Lstream_flush (str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 result = make_string (resizing_buffer_stream_ptr (str),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 Lstream_byte_count (str));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 Lstream_delete (str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 DEFUN ("princ", Fprinc, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 Output the printed representation of OBJECT, any Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 No quoting characters are used; no delimiters are printed around
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 the contents of strings.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
676 Output stream is STREAM, or value of `standard-output' (which see).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (object, stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 Lisp_Object frame = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 GCPRO2 (object, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 stream = print_prepare (stream, &frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 print_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 print_internal (object, stream, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 print_finish (stream, frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 return object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 DEFUN ("print", Fprint, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 Output the printed representation of OBJECT, with newlines around it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 Quoting characters are printed when needed to make output that `read'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 can handle, whenever this is possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 Output stream is STREAM, or value of `standard-output' (which see).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (object, stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 Lisp_Object frame = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 GCPRO2 (object, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 stream = print_prepare (stream, &frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 print_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 write_char_internal ("\n", stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 print_internal (object, stream, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 write_char_internal ("\n", stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 print_finish (stream, frame);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 return object;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 /* Print an error message for the error DATA to STREAM. This is a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 complete implementation of `display-error', which used to be in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 Lisp (see prim/cmdloop.el). It was ported to C so it can be used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 efficiently by Ferror_message_string. Fdisplay_error and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 Ferror_message_string are trivial wrappers around this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 STREAM should be the result of canonicalize_printcharfun(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 print_error_message (Lisp_Object error_object, Lisp_Object stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 Lisp_Object type = Fcar_safe (error_object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 Lisp_Object method = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 /* No need to GCPRO anything under the assumption that ERROR_OBJECT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 is GCPRO'd. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 if (! (CONSP (error_object) && SYMBOLP (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 && CONSP (Fget (type, Qerror_conditions, Qnil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 goto error_throw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 tail = XCDR (error_object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 if (CONSP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 goto error_throw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 tail = Fget (type, Qerror_conditions, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 if (!(CONSP (tail) && SYMBOLP (XCAR (tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 goto error_throw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 else if (!NILP (Fget (XCAR (tail), Qdisplay_error, Qnil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 method = Fget (XCAR (tail), Qdisplay_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 goto error_throw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 tail = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 /* Default method */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 int first = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 int speccount = specpdl_depth ();
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
763 Lisp_Object frame = Qnil;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
764 struct gcpro gcpro1;
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
765 GCPRO1 (stream);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 specbind (Qprint_message_label, Qerror);
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
768 stream = print_prepare (stream, &frame);
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
769
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 tail = Fcdr (error_object);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 if (EQ (type, Qerror))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 print_internal (Fcar (tail), stream, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 tail = Fcdr (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 Lisp_Object errmsg = Fget (type, Qerror_message, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 if (NILP (errmsg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 print_internal (type, stream, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 print_internal (LISP_GETTEXT (errmsg), stream, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 write_c_string (first ? ": " : ", ", stream);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
787 /* Most errors have an explanatory string as their first argument,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
788 and it looks better not to put the quotes around it. */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
789 print_internal (Fcar (tail), stream,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
790 !(first && STRINGP (Fcar (tail))) ||
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
791 !NILP (Fget (type, Qerror_lacks_explanatory_string,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
792 Qnil)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 tail = Fcdr (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 first = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 }
438
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
796 print_finish (stream, frame);
84b14dcb0985 Import from CVS: tag r21-2-27
cvs
parents: 434
diff changeset
797 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 unbind_to (speccount, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 /* not reached */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 error_throw:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 if (NILP (method))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 write_c_string (GETTEXT ("Peculiar error "), stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 print_internal (error_object, stream, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 call2 (method, error_object, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 DEFUN ("error-message-string", Ferror_message_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 Convert ERROR-OBJECT to an error message, and return it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 The format of ERROR-OBJECT should be (ERROR-SYMBOL . DATA). The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 message is equivalent to the one that would be issued by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 `display-error' with the same argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 (error_object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 Lisp_Object result = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 Lisp_Object stream = make_resizing_buffer_output_stream ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 GCPRO1 (stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 print_error_message (error_object, stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 Lstream_flush (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 result = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 Lstream_byte_count (XLSTREAM (stream)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Lstream_delete (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 DEFUN ("display-error", Fdisplay_error, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 Display ERROR-OBJECT on STREAM in a user-friendly way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 (error_object, stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 print_error_message (error_object, canonicalize_printcharfun (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 Lisp_Object Vfloat_output_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 * This buffer should be at least as large as the max string size of the
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
858 * largest float, printed in the biggest notation. This is undoubtedly
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 * 20d float_output_format, with the negative of the C-constant "HUGE"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 * from <math.h>.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 * case of -1e307 in 20d float_output_format. What is one to do (short of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 * re-writing _doprnt to be more sane)?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 * -wsr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 float_to_string (char *buf, double data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
872 Intbyte *cp, c;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 int width;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 if (NILP (Vfloat_output_format)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 || !STRINGP (Vfloat_output_format))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 lose:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 sprintf (buf, "%.16g", data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 else /* oink oink */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 /* Check that the spec we have is fully valid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 This means not only valid for printf,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 but meant for floats, and reasonable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 cp = XSTRING_DATA (Vfloat_output_format);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 if (cp[0] != '%')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 if (cp[1] != '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 cp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 for (width = 0; (c = *cp, isdigit (c)); cp++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 width *= 10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 width += c - '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 if (*cp != 'e' && *cp != 'f' && *cp != 'g' && *cp != 'E' && *cp != 'G')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 if (width < (int) (*cp != 'e' && *cp != 'E') || width > DBL_DIG)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 if (cp[1] != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 sprintf (buf, (char *) XSTRING_DATA (Vfloat_output_format),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 /* added by jwz: don't allow "1.0" to print as "1"; that destroys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 the read-equivalence of lisp objects. (* x 1) and (* x 1.0) do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 not do the same thing, so it's important that the printed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 representation of that form not be corrupted by the printer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
917 Intbyte *s = (Intbyte *) buf; /* don't use signed chars here!
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 isdigit() can't hack them! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 if (*s == '-') s++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 for (; *s; s++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 /* if there's a non-digit, then there is a decimal point, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 it's in exponential notation, both of which are ok. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 if (!isdigit (*s))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 /* otherwise, we need to hack it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 *s++ = '.';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 *s++ = '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 *s = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 DONE_LABEL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 /* Some machines print "0.4" as ".4". I don't like that. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 if (buf [0] == '.' || (buf [0] == '-' && buf [1] == '.'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 for (i = strlen (buf) + 1; i >= 0; i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 buf [i+1] = buf [i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 buf [(buf [0] == '-' ? 1 : 0)] = '0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
943 #define ONE_DIGIT(figure) *p++ = n / (figure) + '0'
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
944 #define ONE_DIGIT_ADVANCE(figure) (ONE_DIGIT (figure), n %= (figure))
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
945
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
946 #define DIGITS_1(figure) ONE_DIGIT (figure)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
947 #define DIGITS_2(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_1 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
948 #define DIGITS_3(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_2 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
949 #define DIGITS_4(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_3 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
950 #define DIGITS_5(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_4 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
951 #define DIGITS_6(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_5 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
952 #define DIGITS_7(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_6 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
953 #define DIGITS_8(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_7 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
954 #define DIGITS_9(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_8 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
955 #define DIGITS_10(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_9 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
956
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
957 /* DIGITS_<11-20> are only used on machines with 64-bit longs. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
959 #define DIGITS_11(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_10 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
960 #define DIGITS_12(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_11 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
961 #define DIGITS_13(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_12 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
962 #define DIGITS_14(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_13 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
963 #define DIGITS_15(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_14 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
964 #define DIGITS_16(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_15 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
965 #define DIGITS_17(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_16 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
966 #define DIGITS_18(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_17 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
967 #define DIGITS_19(figure) ONE_DIGIT_ADVANCE (figure); DIGITS_18 ((figure) / 10)
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
968
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
969 /* Print NUMBER to BUFFER in base 10. This is completely equivalent
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
970 to `sprintf(buffer, "%ld", number)', only much faster.
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
971
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
972 The speedup may make a difference in programs that frequently
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
973 convert numbers to strings. Some implementations of sprintf,
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
974 particularly the one in GNU libc, have been known to be extremely
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
975 slow compared to this function.
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
976
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
977 BUFFER should accept as many bytes as you expect the number to take
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
978 up. On machines with 64-bit longs the maximum needed size is 24
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
979 bytes. That includes the worst-case digits, the optional `-' sign,
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
980 and the trailing \0. */
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
981
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
982 void
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 long_to_string (char *buffer, long number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 {
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
985 char *p = buffer;
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
986 long n = number;
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
987
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 #if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
989 /* We are running in a strange or misconfigured environment. Let
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
990 sprintf cope with it. */
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
991 sprintf (buffer, "%ld", n);
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
992 #else /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
994 if (n < 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 *p++ = '-';
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
997 n = -n;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1000 if (n < 10) { DIGITS_1 (1); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1001 else if (n < 100) { DIGITS_2 (10); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1002 else if (n < 1000) { DIGITS_3 (100); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1003 else if (n < 10000) { DIGITS_4 (1000); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1004 else if (n < 100000) { DIGITS_5 (10000); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1005 else if (n < 1000000) { DIGITS_6 (100000); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1006 else if (n < 10000000) { DIGITS_7 (1000000); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1007 else if (n < 100000000) { DIGITS_8 (10000000); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1008 else if (n < 1000000000) { DIGITS_9 (100000000); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1009 #if SIZEOF_LONG == 4
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1010 /* ``if (1)'' serves only to preserve editor indentation. */
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1011 else if (1) { DIGITS_10 (1000000000); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1012 #else /* SIZEOF_LONG != 4 */
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1013 else if (n < 10000000000L) { DIGITS_10 (1000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1014 else if (n < 100000000000L) { DIGITS_11 (10000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1015 else if (n < 1000000000000L) { DIGITS_12 (100000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1016 else if (n < 10000000000000L) { DIGITS_13 (1000000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1017 else if (n < 100000000000000L) { DIGITS_14 (10000000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1018 else if (n < 1000000000000000L) { DIGITS_15 (100000000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1019 else if (n < 10000000000000000L) { DIGITS_16 (1000000000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1020 else if (n < 100000000000000000L) { DIGITS_17 (10000000000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1021 else if (n < 1000000000000000000L) { DIGITS_18 (100000000000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1022 else { DIGITS_19 (1000000000000000000L); }
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1023 #endif /* SIZEOF_LONG != 4 */
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1024
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 *p = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 #endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 }
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1028
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1029 #undef ONE_DIGIT
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1030 #undef ONE_DIGIT_ADVANCE
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1031
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1032 #undef DIGITS_1
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1033 #undef DIGITS_2
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1034 #undef DIGITS_3
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1035 #undef DIGITS_4
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1036 #undef DIGITS_5
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1037 #undef DIGITS_6
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1038 #undef DIGITS_7
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1039 #undef DIGITS_8
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1040 #undef DIGITS_9
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1041 #undef DIGITS_10
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1042 #undef DIGITS_11
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1043 #undef DIGITS_12
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1044 #undef DIGITS_13
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1045 #undef DIGITS_14
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1046 #undef DIGITS_15
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1047 #undef DIGITS_16
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1048 #undef DIGITS_17
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1049 #undef DIGITS_18
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 571
diff changeset
1050 #undef DIGITS_19
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1053 print_vector_internal (const char *start, const char *end,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 Lisp_Object obj,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 int len = XVECTOR_LENGTH (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 int last = len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 if (INTP (Vprint_length))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 int max = XINT (Vprint_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 if (max < len) last = max;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 write_c_string (start, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 for (i = 0; i < last; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 Lisp_Object elt = XVECTOR_DATA (obj)[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 if (i != 0) write_char_internal (" ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 print_internal (elt, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 if (last != len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 write_c_string (" ...", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 write_c_string (end, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 print_cons (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 /* If print_readably is on, print (quote -foo-) as '-foo-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 (Yeah, this should really be what print-pretty does, but we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 don't have the rest of a pretty printer, and this actually
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 has non-negligible impact on size/speed of .elc files.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 if (print_readably &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 EQ (XCAR (obj), Qquote) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 CONSP (XCDR (obj)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 NILP (XCDR (XCDR (obj))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 obj = XCAR (XCDR (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 write_char_internal ("\'", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 print_internal (obj, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 write_char_internal ("(", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 int len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 int max = INTP (Vprint_length) ? XINT (Vprint_length) : INT_MAX;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 Lisp_Object tortoise;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 /* Use tortoise/hare to make sure circular lists don't infloop */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 for (tortoise = obj, len = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 CONSP (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 obj = XCDR (obj), len++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 if (len > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 write_char_internal (" ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 if (EQ (obj, tortoise) && len > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1125 printing_unreadable_object ("circular list");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 write_c_string ("... <circular list>", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 if (len & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 tortoise = XCDR (tortoise);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 if (len > max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 write_c_string ("...", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 print_internal (XCAR (obj), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 if (!LISTP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 write_c_string (" . ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 print_internal (obj, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 write_char_internal (")", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 print_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1160 Lisp_String *s = XSTRING (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 /* We distinguish between Bytecounts and Charcounts, to make
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 Vprint_string_length work correctly under Mule. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 Charcount size = string_char_length (s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 Charcount max = size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 Bytecount bcmax = string_length (s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 if (INTP (Vprint_string_length) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 XINT (Vprint_string_length) < max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 max = XINT (Vprint_string_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 bcmax = charcount_to_bytecount (string_data (s), max);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 if (max < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 max = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 bcmax = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 if (!escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 /* This deals with GC-relocation and Mule. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 output_string (printcharfun, 0, obj, 0, bcmax);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 if (max < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 write_c_string (" ...", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 Bytecount i, last = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 write_char_internal ("\"", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 for (i = 0; i < bcmax; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
1195 Intbyte ch = string_byte (s, i);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 if (ch == '\"' || ch == '\\'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 || (ch == '\n' && print_escape_newlines))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 if (i > last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 output_string (printcharfun, 0, obj, last,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 i - last);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 if (ch == '\n')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 write_c_string ("\\n", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 write_char_internal ("\\", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 /* This is correct for Mule because the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 character is either \ or " */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 write_char_internal (string_data (s) + i, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 last = i + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 if (bcmax > last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 output_string (printcharfun, 0, obj, last,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 bcmax - last);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 if (max < size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 write_c_string (" ...", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 write_char_internal ("\"", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 default_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 struct lcrecord_header *header =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 (struct lcrecord_header *) XPNTR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 char buf[200];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1239 printing_unreadable_object
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1240 ("#<%s 0x%x>",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1241 LHEADER_IMPLEMENTATION (&header->lheader)->name,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1242 header->uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 sprintf (buf, "#<%s 0x%x>",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 LHEADER_IMPLEMENTATION (&header->lheader)->name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 header->uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 char buf[200];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 (unsigned long) XPNTR (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 /* Emacs won't print while GCing, but an external debugger might */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 if (gc_in_progress) return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 /* #### Both input and output streams should have a flag associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 with them indicating whether output to that stream, or strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 read from the stream, get translated using Fgettext(). Such a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 stream is called a "translating stream". For the minibuffer and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 external-debugging-output this is always true on output, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 with-output-to-temp-buffer sets the flag to true for the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 it creates. This flag should also be user-settable. Perhaps it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 should be split up into two flags, one for input and one for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 output. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 /* Detect circularities and truncate them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 No need to offer any alternative--this is better than an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 for (i = 0; i < print_depth; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 if (EQ (obj, being_printed[i]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 {
603
1c880911c386 [xemacs-hg @ 2001-06-01 08:23:09 by martinb]
martinb
parents: 579
diff changeset
1291 char buf[DECIMAL_PRINT_SIZE (long) + 1];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 *buf = '#';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 long_to_string (buf + 1, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 being_printed[print_depth] = obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 print_depth++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 if (print_depth > PRINT_CIRCLE)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1303 signal_error (Qstack_overflow, "Apparently circular structure being printed", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 switch (XTYPE (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 case Lisp_Type_Int_Even:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 case Lisp_Type_Int_Odd:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 {
603
1c880911c386 [xemacs-hg @ 2001-06-01 08:23:09 by martinb]
martinb
parents: 579
diff changeset
1310 char buf[DECIMAL_PRINT_SIZE (EMACS_INT)];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 long_to_string (buf, XINT (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 case Lisp_Type_Char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 /* God intended that this be #\..., you know. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 char buf[16];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 Emchar ch = XCHAR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 char *p = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 *p++ = '?';
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1323 if (ch < 32)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1324 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1325 *p++ = '\\';
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1326 switch (ch)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1327 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1328 case '\t': *p++ = 't'; break;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1329 case '\n': *p++ = 'n'; break;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1330 case '\r': *p++ = 'r'; break;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1331 default:
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1332 *p++ = '^';
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1333 *p++ = ch + 64;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1334 if ((ch + 64) == '\\')
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1335 *p++ = '\\';
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1336 break;
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1337 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1338 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1339 else if (ch < 127)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 {
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1341 /* syntactically special characters should be escaped. */
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1342 switch (ch)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1343 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1344 case ' ':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1345 case '"':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1346 case '#':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1347 case '\'':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1348 case '(':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1349 case ')':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1350 case ',':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1351 case '.':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1352 case ';':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1353 case '?':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1354 case '[':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1355 case '\\':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1356 case ']':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1357 case '`':
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1358 *p++ = '\\';
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1359 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1360 *p++ = ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 else if (ch == 127)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1363 {
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1364 *p++ = '\\', *p++ = '^', *p++ = '?';
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1365 }
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1366 else if (ch < 160)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 *p++ = '\\', *p++ = '^';
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
1369 p += set_charptr_emchar ((Intbyte *) p, ch + 64);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 else
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1372 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
1373 p += set_charptr_emchar ((Intbyte *) p, ch);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1374 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1375
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
1376 output_string (printcharfun, (Intbyte *) buf, Qnil, 0, p - buf);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
1377
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 case Lisp_Type_Record:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 if (CONSP (obj) || VECTORP(obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 /* If deeper than spec'd depth, print placeholder. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 if (INTP (Vprint_level)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 && print_depth > XINT (Vprint_level))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 write_c_string ("...", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 if (LHEADER_IMPLEMENTATION (lheader)->printer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 ((LHEADER_IMPLEMENTATION (lheader)->printer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 (obj, printcharfun, escapeflag));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 default_object_printer (obj, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 #ifdef ERROR_CHECK_TYPECHECK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 #else /* not ERROR_CHECK_TYPECHECK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 char buf[128];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 /* We're in trouble if this happens! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 if (print_readably)
571
4326eeed6933 [xemacs-hg @ 2001-05-25 02:57:32 by martinb]
martinb
parents: 563
diff changeset
1417 signal_error (Qinternal_error, "printing illegal data type #o%03o",
579
0e1f61d4b978 [xemacs-hg @ 2001-05-26 06:11:03 by martinb]
martinb
parents: 577
diff changeset
1418 make_int (XTYPE (obj)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 write_c_string ("#<EMACS BUG: ILLEGAL DATATYPE ",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 sprintf (buf, "(#o%3o)", (int) XTYPE (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 write_c_string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 (" Save your buffers immediately and please report this bug>",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 #endif /* not ERROR_CHECK_TYPECHECK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 print_depth--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 print_float (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 char pigbuf[350]; /* see comments in float_to_string */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 float_to_string (pigbuf, XFLOAT_DATA (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 write_c_string (pigbuf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 /* #### Bug!! (intern "") isn't printed in some distinguished way */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 /* #### (the reader also loses on it) */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1452 Lisp_String *name = symbol_name (XSYMBOL (obj));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 Bytecount size = string_length (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 if (!escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 /* This deals with GC-relocation */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 Lisp_Object nameobj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 XSETSTRING (nameobj, name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 output_string (printcharfun, 0, nameobj, 0, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 /* If we print an uninterned symbol as part of a complex object and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 the flag print-gensym is non-nil, prefix it with #n= to read the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 object back with the #n# reader syntax later if needed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 if (!NILP (Vprint_gensym)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1470 /* #### Test whether this produces a noticeable slow-down for
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 printing when print-gensym is non-nil. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 && !EQ (obj, oblookup (Vobarray,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 string_data (symbol_name (XSYMBOL (obj))),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 string_length (symbol_name (XSYMBOL (obj))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 if (print_depth > 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 Lisp_Object tem = Fassq (obj, Vprint_gensym_alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 if (CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 write_char_internal ("#", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 print_internal (XCDR (tem), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 write_char_internal ("#", printcharfun);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1484 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 if (CONSP (Vprint_gensym_alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 /* Vprint_gensym_alist is exposed to Lisp, so we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 have to be careful. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 CHECK_CONS (XCAR (Vprint_gensym_alist));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 CHECK_INT (XCDR (XCAR (Vprint_gensym_alist)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 XSETINT (tem, XINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 XSETINT (tem, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 write_char_internal ("#", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 print_internal (tem, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 write_char_internal ("=", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 write_c_string ("#:", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 /* Does it look like an integer or a float? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
1511 Intbyte *data = string_data (name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 Bytecount confusing = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 if (size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 goto not_yet_confused; /* Really confusing */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 else if (isdigit (data[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 confusing = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 else if (size == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 goto not_yet_confused;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 else if (data[0] == '-' || data[0] == '+')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 confusing = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 goto not_yet_confused;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 for (; confusing < size; confusing++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 if (!isdigit (data[confusing]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 confusing = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 not_yet_confused:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 if (!confusing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 /* #### Ugh, this is needlessly complex and slow for what we
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 need here. It might be a good idea to copy equivalent code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 from FSF. --hniksic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 confusing = isfloat_string ((char *) data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 if (confusing)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 write_char_internal ("\\", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 Lisp_Object nameobj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 Bytecount i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 Bytecount last = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 XSETSTRING (nameobj, name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 for (i = 0; i < size; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 switch (string_byte (name, i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 case 0: case 1: case 2: case 3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 case 4: case 5: case 6: case 7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 case 8: case 9: case 10: case 11:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 case 12: case 13: case 14: case 15:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 case 16: case 17: case 18: case 19:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 case 20: case 21: case 22: case 23:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 case 24: case 25: case 26: case 27:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 case 28: case 29: case 30: case 31:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 case ' ': case '\"': case '\\': case '\'':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 case ';': case '#' : case '(' : case ')':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 case ',': case '.' : case '`' :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 case '[': case ']' : case '?' :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 if (i > last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 output_string (printcharfun, 0, nameobj, last, i - last);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 write_char_internal ("\\", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 last = i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 output_string (printcharfun, 0, nameobj, last, size - last);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1580 /* Useful on systems or in places where writing to stdout is unavailable or
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1581 not working. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 static int alternate_do_pointer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 static char alternate_do_string[5000];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 Append CHARACTER to the array `alternate_do_string'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 This can be used in place of `external-debugging-output' as a function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 to be passed to `print'. Before calling `print', set `alternate_do_pointer'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 to 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 (character))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
1594 Intbyte str[MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 Bytecount len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 int extlen;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1597 const Extbyte *extptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 CHECK_CHAR_COERCE_INT (character);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 len = set_charptr_emchar (str, XCHAR (character));
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1601 TO_EXTERNAL_FORMAT (DATA, (str, len),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1602 ALLOCA, (extptr, extlen),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1603 Qterminal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 alternate_do_pointer += extlen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 alternate_do_string[alternate_do_pointer] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 return character;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 DEFUN ("external-debugging-output", Fexternal_debugging_output, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 Write CHAR-OR-STRING to stderr or stdout.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 If optional arg STDOUT-P is non-nil, write to stdout; otherwise, write
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 to stderr. You can use this function to write directly to the terminal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 This function can be used as the STREAM argument of Fprint() or the like.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1616 Under MS Windows, this writes output to the console window (which is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1617 created, if necessary), unless XEmacs is being run noninteractively
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1618 \(i.e. using the `-batch' argument).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1619
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 If you have opened a termscript file (using `open-termscript'), then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 the output also will be logged to this file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 (char_or_string, stdout_p, device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 FILE *file = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 struct console *con = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 if (NILP (device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 if (!NILP (stdout_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 file = stdout;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 file = stderr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 CHECK_LIVE_DEVICE (device);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 if (!DEVICE_TTY_P (XDEVICE (device)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 !DEVICE_STREAM_P (XDEVICE (device)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1640 wtaerror ("Must be tty or stream device", device);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 con = XCONSOLE (DEVICE_CONSOLE (XDEVICE (device)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 if (DEVICE_TTY_P (XDEVICE (device)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 file = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 else if (!NILP (stdout_p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 file = CONSOLE_STREAM_DATA (con)->out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 file = CONSOLE_STREAM_DATA (con)->err;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 if (STRINGP (char_or_string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 write_string_to_stdio_stream (file, con,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 XSTRING_DATA (char_or_string),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 0, XSTRING_LENGTH (char_or_string),
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1654 Qterminal, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 603
diff changeset
1657 Intbyte str[MAX_EMCHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 Bytecount len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 CHECK_CHAR_COERCE_INT (char_or_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 len = set_charptr_emchar (str, XCHAR (char_or_string));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1662 write_string_to_stdio_stream (file, con, str, 0, len, Qterminal, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 return char_or_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 DEFUN ("open-termscript", Fopen_termscript, 1, 1, "FOpen termscript file: ", /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1669 Start writing all terminal output to FILENAME as well as the terminal.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1670 FILENAME = nil means just close any termscript file currently open.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1672 (filename))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 if (termscript != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1677 fclose (termscript);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1678 termscript = 0;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1679 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1680
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1681 if (! NILP (filename))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1682 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1683 filename = Fexpand_file_name (filename, Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1684 termscript = fopen ((char *) XSTRING_DATA (filename), "w");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 if (termscript == NULL)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1686 report_file_error ("Opening termscript", filename);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 #if 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 /* Debugging kludge -- unbuffered */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1693 static int debug_print_length = 50;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1694 static int debug_print_level = 15;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1695 static int debug_print_readably = -1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 debug_print_no_newline (Lisp_Object debug_print_obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 /* This function can GC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1701 int save_print_readably = print_readably;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1702 int save_print_depth = print_depth;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1703 Lisp_Object save_Vprint_length = Vprint_length;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1704 Lisp_Object save_Vprint_level = Vprint_level;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1705 Lisp_Object save_Vinhibit_quit = Vinhibit_quit;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 struct gcpro gcpro1, gcpro2, gcpro3;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1707 GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 if (gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 print_depth = 0;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1713 print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 print_unbuffered++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 /* Could use unwind-protect, but why bother? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 if (debug_print_length > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 Vprint_length = make_int (debug_print_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 if (debug_print_level > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 Vprint_level = make_int (debug_print_level);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1720
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 print_internal (debug_print_obj, Qexternal_debugging_output, 1);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1722 alternate_do_pointer = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1723 print_internal (debug_print_obj, Qalternate_debugging_output, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1724 #ifdef WIN32_NATIVE
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1725 /* Write out to the debugger, as well */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1726 print_internal (debug_print_obj, Qmswindows_debugging_output, 1);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1727 #endif
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1728
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1729 Vinhibit_quit = save_Vinhibit_quit;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1730 Vprint_level = save_Vprint_level;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1731 Vprint_length = save_Vprint_length;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1732 print_depth = save_print_depth;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1733 print_readably = save_print_readably;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 print_unbuffered--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 debug_print (Lisp_Object debug_print_obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 debug_print_no_newline (debug_print_obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 stderr_out ("\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 /* Debugging kludge -- unbuffered */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 /* This function provided for the benefit of the debugger. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 void debug_backtrace (void);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 debug_backtrace (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 int old_print_readably = print_readably;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 int old_print_depth = print_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 Lisp_Object old_print_length = Vprint_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 Lisp_Object old_print_level = Vprint_level;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 Lisp_Object old_inhibit_quit = Vinhibit_quit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 if (gc_in_progress)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 print_depth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 print_readably = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 print_unbuffered++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 /* Could use unwind-protect, but why bother? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 if (debug_print_length > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 Vprint_length = make_int (debug_print_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 if (debug_print_level > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 Vprint_level = make_int (debug_print_level);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 Fbacktrace (Qexternal_debugging_output, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 stderr_out ("\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 Vinhibit_quit = old_inhibit_quit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 Vprint_level = old_print_level;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 Vprint_length = old_print_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 print_depth = old_print_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 print_readably = old_print_readably;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 print_unbuffered--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 debug_short_backtrace (int length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 int first = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 struct backtrace *bt = backtrace_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 stderr_out (" [");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 while (length > 0 && bt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 if (!first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 stderr_out (", ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 if (COMPILED_FUNCTIONP (*bt->function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 #if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 Lisp_Object ann =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 compiled_function_annotation (XCOMPILED_FUNCTION (*bt->function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 Lisp_Object ann = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 if (!NILP (ann))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 stderr_out ("<compiled-function from ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 debug_print_no_newline (ann);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 stderr_out (">");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 stderr_out ("<compiled-function of unknown origin>");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 debug_print_no_newline (*bt->function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 first = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 length--;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 bt = bt->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 stderr_out ("]\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 #endif /* debugging kludge */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 syms_of_print (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1832 DEFSYMBOL (Qstandard_output);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1834 DEFSYMBOL (Qprint_length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1836 DEFSYMBOL (Qprint_string_length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1838 DEFSYMBOL (Qdisplay_error);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1839 DEFSYMBOL (Qprint_message_label);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 DEFSUBR (Fprin1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 DEFSUBR (Fprin1_to_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 DEFSUBR (Fprinc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 DEFSUBR (Fprint);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 DEFSUBR (Ferror_message_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 DEFSUBR (Fdisplay_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 DEFSUBR (Fterpri);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 DEFSUBR (Fwrite_char);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 DEFSUBR (Falternate_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 DEFSUBR (Fexternal_debugging_output);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 DEFSUBR (Fopen_termscript);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1852 DEFSYMBOL (Qexternal_debugging_output);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1853 DEFSYMBOL (Qalternate_debugging_output);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1854 #ifdef HAVE_MS_WINDOWS
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
1855 DEFSYMBOL (Qmswindows_debugging_output);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1856 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 DEFSUBR (Fwith_output_to_temp_buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 reinit_vars_of_print (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 alternate_do_pointer = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 vars_of_print (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 reinit_vars_of_print ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 DEFVAR_LISP ("standard-output", &Vstandard_output /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 Output stream `print' uses by default for outputting a character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 This may be any function of one argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 It may also be a buffer (output is inserted before point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 or a marker (output is inserted and the marker is advanced)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 or the symbol t (output appears in the minibuffer line).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 Vstandard_output = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 DEFVAR_LISP ("float-output-format", &Vfloat_output_format /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 The format descriptor string that lisp uses to print floats.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 This is a %-spec like those accepted by `printf' in C,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 but with some restrictions. It must start with the two characters `%.'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885 After that comes an integer precision specification,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 and then a letter which controls the format.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 The letters allowed are `e', `f' and `g'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 Use `e' for exponential notation "DIG.DIGITSeEXPT"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 Use `f' for decimal point notation "DIGITS.DIGITS".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 Use `g' to choose the shorter of those two formats for the number at hand.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 The precision in any of these cases is the number of digits following
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 the decimal point. With `f', a precision of 0 means to omit the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 decimal point. 0 is not allowed with `f' or `g'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 A value of nil means to use `%.16g'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 Regardless of the value of `float-output-format', a floating point number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 will never be printed in such a way that it is ambiguous with an integer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 that is, a floating-point number will always be printed with a decimal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 point and/or an exponent, even if the digits following the decimal point
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 are all zero. This is to preserve read-equivalence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 Vfloat_output_format = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 DEFVAR_LISP ("print-length", &Vprint_length /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 Maximum length of list or vector to print before abbreviating.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 A value of nil means no limit.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 Vprint_length = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 DEFVAR_LISP ("print-string-length", &Vprint_string_length /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 Maximum length of string to print before abbreviating.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 A value of nil means no limit.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 Vprint_string_length = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 DEFVAR_LISP ("print-level", &Vprint_level /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 Maximum depth of list nesting to print before abbreviating.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 A value of nil means no limit.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 Vprint_level = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 Non-nil means print newlines in strings as backslash-n.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 print_escape_newlines = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 DEFVAR_BOOL ("print-readably", &print_readably /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 If non-nil, then all objects will be printed in a readable form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 If an object has no readable representation, then an error is signalled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 When print-readably is true, compiled-function objects will be written in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 #[...] form instead of in #<compiled-function [...]> form, and two-element
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 lists of the form (quote object) will be written as the equivalent 'object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 Do not SET this variable; bind it instead.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 print_readably = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 /* #### I think this should default to t. But we'd better wait
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 until we see that it works out. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 DEFVAR_LISP ("print-gensym", &Vprint_gensym /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 If non-nil, then uninterned symbols will be printed specially.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 Uninterned symbols are those which are not present in `obarray', that is,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 those which were made with `make-symbol' or by calling `intern' with a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 second argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 When print-gensym is true, such symbols will be preceded by "#:",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 which causes the reader to create a new symbol instead of interning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 and returning an existing one. Beware: the #: syntax creates a new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 symbol each time it is seen, so if you print an object which contains
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 two pointers to the same uninterned symbol, `read' will not duplicate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 that structure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 If the value of `print-gensym' is a cons cell, then in addition
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 refrain from clearing `print-gensym-alist' on entry to and exit from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 printing functions, so that the use of #...# and #...= can carry over
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 for several separately printed objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 Vprint_gensym = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 Association list of elements (GENSYM . N) to guide use of #N# and #N=.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 In each element, GENSYM is an uninterned symbol that has been associated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 with #N= for the specified value of N.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 Vprint_gensym_alist = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 DEFVAR_LISP ("print-message-label", &Vprint_message_label /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 Label for minibuffer messages created with `print'. This should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 generally be bound with `let' rather than set. (See `display-message'.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 Vprint_message_label = Qprint;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 }