annotate src/doprnt.c @ 4511:71bf2c5667ba ac-fix-2008-10-25

Fix g++ const char -> char warnings.
author Stephen J. Turnbull <stephen@xemacs.org>
date Sat, 25 Oct 2008 20:35:36 +0900
parents 4ca1ef2bdb6a
children 89e64783d068
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 /* Output like sprintf to a buffer of specified size.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Also takes args differently: pass one pointer to an array of strings
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 in addition to the format string which is separate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 Copyright (C) 1995 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
5 Copyright (C) 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 Rewritten by mly to use varargs.h.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 to full printf spec.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
9 Support for bignums, ratios, and bigfloats added April 2004 by Jerry James.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 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
15 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 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
19 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
28 /* Synched up with: Rewritten by Ben Wing. Not in FSF. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "lstream.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
36 static const char * const valid_flags = "-+ #0";
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
37 static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
38 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
39 "npyY"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
40 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
41 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
42 "FhHkK"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
43 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
44 ;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
45 static const char * const int_converters = "dic";
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
46 static const char * const unsigned_int_converters = "ouxX";
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
47 static const char * const double_converters = "feEgG";
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
48 static const char * const string_converters = "sS";
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
49 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
50 static const char * const bignum_converters = "npyY";
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
51 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
52 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
53 static const char * const bigfloat_converters = "FhHkK";
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
54 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 typedef struct printf_spec printf_spec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 struct printf_spec
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 int argnum; /* which argument does this spec want? This is one-based:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 The first argument given is numbered 1, the second
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 is 2, etc. This is to handle %##$x-type specs. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 int minwidth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 int precision;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 unsigned int minus_flag:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 unsigned int plus_flag:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 unsigned int space_flag:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 unsigned int number_flag:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 unsigned int zero_flag:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 unsigned int h_flag:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 unsigned int l_flag:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 unsigned int forwarding_precision:1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 char converter; /* converter character or 0 for dummy marker
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 indicating literal text at the end of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 specification */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 Bytecount text_before; /* position of the first character of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 block of literal text before this spec */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Bytecount text_before_len; /* length of that text */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 };
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 typedef union printf_arg printf_arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 union printf_arg
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 long l;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 unsigned long ul;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 double d;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
86 Ibyte *bp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
87 Lisp_Object obj;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 /* We maintain a list of all the % specs in the specification,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 along with the offset and length of the block of literal text
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 before each spec. In addition, we have a "dummy" spec that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 represents all the literal text at the end of the specification.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Its converter is 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 typedef struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Dynarr_declare (struct printf_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 } printf_spec_dynarr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 typedef struct
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 Dynarr_declare (union printf_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 } printf_arg_dynarr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
106 /* Append STRING (of length LEN bytes) to STREAM.
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
107 MINLEN is the minimum field width.
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
108 If MINUS_FLAG is set, left-justify the string in its field;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
109 otherwise, right-justify.
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
110 If ZERO_FLAG is set, pad with 0's; otherwise pad with spaces.
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
111 If MAXLEN is non-negative, the string is first truncated on the
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
112 right to that many characters.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 static void
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
117 doprnt_2 (Lisp_Object stream, const Ibyte *string, Bytecount len,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
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 Lstream *lstr = XLSTREAM (stream);
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
121 Charcount cclen = bytecount_to_charcount (string, len);
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
122 int to_add = minlen - cclen;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 /* Padding at beginning to right-justify ... */
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
125 if (!minus_flag)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
126 while (to_add-- > 0)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
127 Lstream_putc (lstr, zero_flag ? '0' : ' ');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
129 if (0 <= maxlen && maxlen < cclen)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
130 len = charcount_to_bytecount (string, maxlen);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Lstream_write (lstr, string, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 /* Padding at end to left-justify ... */
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
134 if (minus_flag)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
135 while (to_add-- > 0)
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
136 Lstream_putc (lstr, zero_flag ? '0' : ' ');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
139 static const Ibyte *
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
140 parse_off_posnum (const Ibyte *start, const Ibyte *end, int *returned_num)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
142 Ibyte arg_convert[100];
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
143 REGISTER Ibyte *arg_ptr = arg_convert;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 *returned_num = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 while (start != end && isdigit (*start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 577
diff changeset
148 if (arg_ptr - arg_convert >= (int) sizeof (arg_convert) - 1)
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 577
diff changeset
149 syntax_error ("Format converter number too large", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 *arg_ptr++ = *start++;
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 *arg_ptr = '\0';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 if (arg_convert != arg_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 *returned_num = atoi ((char *) arg_convert);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 return start;
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
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
158 #define NEXT_ASCII_BYTE(ch) \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
159 do { \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
160 if (fmt == fmt_end) \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
161 syntax_error ("Premature end of format string", Qunbound); \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
162 ch = *fmt; \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
163 if (ch >= 0200) \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
164 syntax_error ("Non-ASCII character in format converter spec", \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
165 Qunbound); \
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
166 fmt++; \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 #define RESOLVE_FLAG_CONFLICTS(spec) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 if (spec.space_flag && spec.plus_flag) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 spec.space_flag = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 if (spec.zero_flag && spec.space_flag) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 spec.zero_flag = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 static printf_spec_dynarr *
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
178 parse_doprnt_spec (const Ibyte *format, Bytecount format_length)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
180 const Ibyte *fmt = format;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
181 const Ibyte *fmt_end = format + format_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 printf_spec_dynarr *specs = Dynarr_new (printf_spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 int prev_argnum = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 struct printf_spec spec;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
188 const Ibyte *text_end;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
189 Ibyte ch;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 xzero (spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 if (fmt == fmt_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 return specs;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
194 text_end = (Ibyte *) memchr (fmt, '%', fmt_end - fmt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 if (!text_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 text_end = fmt_end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 spec.text_before = fmt - format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 spec.text_before_len = text_end - fmt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 fmt = text_end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 if (fmt != fmt_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 fmt++; /* skip over % */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 /* A % is special -- no arg number. According to ANSI specs,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 field width does not apply to %% conversion. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 if (fmt != fmt_end && *fmt == '%')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 spec.converter = '%';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 Dynarr_add (specs, spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 fmt++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 /* Is there a field number specifier? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
216 const Ibyte *ptr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 int fieldspec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 /* There is a format specifier */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 prev_argnum = fieldspec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 fmt = ptr + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 prev_argnum++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 spec.argnum = prev_argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 /* Parse off any flags */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 NEXT_ASCII_BYTE (ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 while (strchr (valid_flags, ch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 switch (ch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
237 case '-': spec.minus_flag = 1; break;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
238 case '+': spec.plus_flag = 1; break;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
239 case ' ': spec.space_flag = 1; break;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 case '#': spec.number_flag = 1; break;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
241 case '0': spec.zero_flag = 1; break;
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
242 default: ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 NEXT_ASCII_BYTE (ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 /* Parse off the minimum field width */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 fmt--; /* back up */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 * * means the field width was passed as an argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 * Mark the current spec as one that forwards its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 * field width and flags to the next spec in the array.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 * Then create a new spec and continue with the parsing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 if (fmt != fmt_end && *fmt == '*')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 spec.converter = '*';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 RESOLVE_FLAG_CONFLICTS(spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 Dynarr_add (specs, spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 xzero (spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 spec.argnum = ++prev_argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 fmt++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 if (spec.minwidth == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 spec.minwidth = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 /* Parse off any precision specified */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 NEXT_ASCII_BYTE (ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 if (ch == '.')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 * * means the precision was passed as an argument.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 * Mark the current spec as one that forwards its
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 * fieldwidth, flags and precision to the next spec in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 * the array. Then create a new spec and continue
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 * with the parse.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 if (fmt != fmt_end && *fmt == '*')
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 spec.converter = '*';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 spec.forwarding_precision = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 RESOLVE_FLAG_CONFLICTS(spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 Dynarr_add (specs, spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 xzero (spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 spec.argnum = ++prev_argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 fmt++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 if (spec.precision == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 spec.precision = 0;
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 NEXT_ASCII_BYTE (ch);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 /* No precision specified */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 spec.precision = -1;
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 /* Parse off h or l flag */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 if (ch == 'h' || ch == 'l')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 if (ch == 'h')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 spec.h_flag = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 spec.l_flag = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 NEXT_ASCII_BYTE (ch);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 if (!strchr (valid_converters, ch))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
316 syntax_error ("Invalid converter character", make_char (ch));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 spec.converter = ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 RESOLVE_FLAG_CONFLICTS(spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 Dynarr_add (specs, spec);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 867
diff changeset
324 RETURN_NOT_REACHED(specs); /* suppress compiler warning */
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 get_args_needed (printf_spec_dynarr *specs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 int args_needed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 REGISTER int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 /* Figure out how many args are needed. This may be less than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 the number of specs because a spec could be %% or could be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 missing (literal text at end of format string) or there
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 could be specs where the field number is explicitly given.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 We just look for the maximum argument number that's referenced. */
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 for (i = 0; i < Dynarr_length (specs); i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 char ch = Dynarr_at (specs, i).converter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 if (ch && ch != '%')
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 int argnum = Dynarr_at (specs, i).argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 if (argnum > args_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 args_needed = argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 return args_needed;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 static printf_arg_dynarr *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 printf_arg_dynarr *args = Dynarr_new (printf_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 union printf_arg arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 REGISTER int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 int args_needed = get_args_needed (specs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 xzero (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 for (i = 1; i <= args_needed; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 int j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 char ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 struct printf_spec *spec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 for (j = 0; j < Dynarr_length (specs); j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 spec = Dynarr_atp (specs, j);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 if (spec->argnum == i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 if (j == Dynarr_length (specs))
1318
b531bf8658e9 [xemacs-hg @ 2003-02-21 06:56:46 by ben]
ben
parents: 1204
diff changeset
376 syntax_error ("No conversion spec for argument", make_int (i));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 ch = spec->converter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 if (strchr (int_converters, ch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
382 if (spec->l_flag)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 arg.l = va_arg (vargs, long);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 else
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
385 /* int even if ch == 'c' or spec->h_flag:
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
386 "the type used in va_arg is supposed to match the
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
387 actual type **after default promotions**."
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
388 Hence we read an int, not a short, if spec->h_flag. */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
389 arg.l = va_arg (vargs, int);
428
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 else if (strchr (unsigned_int_converters, ch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
393 if (spec->l_flag)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 arg.ul = va_arg (vargs, unsigned long);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 else
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
396 /* unsigned int even if ch == 'c' or spec->h_flag */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
397 arg.ul = (unsigned long) va_arg (vargs, unsigned int);
428
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 else if (strchr (double_converters, ch))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 arg.d = va_arg (vargs, double);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 else if (strchr (string_converters, ch))
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
402 arg.bp = va_arg (vargs, Ibyte *);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
403 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
404 else if (strchr (bignum_converters, ch))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
405 arg.obj = va_arg (vargs, Lisp_Object);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
406 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
407 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
408 else if (strchr (bigfloat_converters, ch))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
409 arg.obj = va_arg (vargs, Lisp_Object);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
410 #endif
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
411 else ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 Dynarr_add (args, arg);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 return args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
419 /* Most basic entry point into string formatting.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
420
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
421 Generate output from a format-spec (either a Lisp string
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
422 FORMAT_RELOC, or a C string FORMAT_NONRELOC of length FORMAT_LENGTH
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
423 -- which *MUST NOT* come from Lisp string data, unless GC is
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
424 inhibited). Output goes to STREAM. Returns the number of bytes
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
425 stored into STREAM. Arguments are either C-type arguments in
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
426 va_list VARGS, or an array of Lisp objects in LARGS of size
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
427 NARGS. (Behavior is different in the two cases -- you either get
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
428 standard sprintf() behavior or `format' behavior.) */
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 static Bytecount
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
431 emacs_doprnt_1 (Lisp_Object stream, const Ibyte *format_nonreloc,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
432 Bytecount format_length, Lisp_Object format_reloc,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
433 int nargs, const Lisp_Object *largs, va_list vargs)
428
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 printf_spec_dynarr *specs = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 printf_arg_dynarr *args = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 REGISTER int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
439 int count;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 if (!NILP (format_reloc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 format_nonreloc = XSTRING_DATA (format_reloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 format_length = XSTRING_LENGTH (format_reloc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 if (format_length < 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
447 format_length = (Bytecount) strlen ((const char *) format_nonreloc);
428
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 specs = parse_doprnt_spec (format_nonreloc, format_length);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
450 count = record_unwind_protect_freeing_dynarr (specs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
451
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 if (largs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
454 /* allow too many args for string, but not too few */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 if (nargs < get_args_needed (specs))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 448
diff changeset
456 signal_error_1 (Qwrong_number_of_arguments,
1318
b531bf8658e9 [xemacs-hg @ 2003-02-21 06:56:46 by ben]
ben
parents: 1204
diff changeset
457 list3 (Qformat,
b531bf8658e9 [xemacs-hg @ 2003-02-21 06:56:46 by ben]
ben
parents: 1204
diff changeset
458 make_int (nargs),
b531bf8658e9 [xemacs-hg @ 2003-02-21 06:56:46 by ben]
ben
parents: 1204
diff changeset
459 !NILP (format_reloc) ? format_reloc :
b531bf8658e9 [xemacs-hg @ 2003-02-21 06:56:46 by ben]
ben
parents: 1204
diff changeset
460 make_string (format_nonreloc, format_length)));
428
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 args = get_doprnt_args (specs, vargs);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
465 record_unwind_protect_freeing_dynarr (args);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 for (i = 0; i < Dynarr_length (specs); i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 struct printf_spec *spec = Dynarr_atp (specs, i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 char ch;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 /* Copy the text before */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 if (!NILP (format_reloc)) /* refetch in case of GC below */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 format_nonreloc = XSTRING_DATA (format_reloc);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
476
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
477 doprnt_2 (stream, format_nonreloc + spec->text_before,
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
478 spec->text_before_len, 0, -1, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 ch = spec->converter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 if (!ch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 if (ch == '%')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
487 doprnt_2 (stream, (Ibyte *) &ch, 1, 0, -1, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 continue;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 /* The char '*' as converter means the field width, precision
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 was specified as an argument. Extract the data and forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 it to the next spec, to which it will apply. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 if (ch == '*')
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 struct printf_spec *nextspec = Dynarr_atp (specs, i + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 Lisp_Object obj = largs[spec->argnum - 1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 if (INTP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 if (spec->forwarding_precision)
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 nextspec->precision = XINT (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 nextspec->minwidth = spec->minwidth;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 nextspec->minwidth = XINT (obj);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
509 if (XINT (obj) < 0)
428
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 spec->minus_flag = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 nextspec->minwidth = - nextspec->minwidth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 }
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
515 nextspec->minus_flag = spec->minus_flag;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
516 nextspec->plus_flag = spec->plus_flag;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
517 nextspec->space_flag = spec->space_flag;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 nextspec->number_flag = spec->number_flag;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
519 nextspec->zero_flag = spec->zero_flag;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
525 syntax_error ("Invalid repositioning argument",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
526 make_int (spec->argnum));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 else if (ch == 'S' || ch == 's')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
530 Ibyte *string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 Bytecount string_len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 if (!largs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 string = Dynarr_at (args, spec->argnum - 1).bp;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
536 #if 0
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
537 /* [[ error() can be called with null string arguments.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 E.g., in fileio.c, the return value of strerror()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 is never checked. We'll print (null), like some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 printf implementations do. Would it be better (and safe)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 to signal an error instead? Or should we just use the
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
542 empty string? -dkindred@cs.cmu.edu 8/1997 ]]
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
543 Do not hide bugs. --ben
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 if (!string)
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
546 string = (Ibyte *) "(null)";
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
547 #else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
548 assert (string);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
549 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 string_len = strlen ((char *) string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 Lisp_Object obj = largs[spec->argnum - 1];
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
555 Lisp_Object ls;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 if (ch == 'S')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 /* For `S', prin1 the argument and then treat like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 a string. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
561 ls = Fprin1_to_string (obj, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 else if (STRINGP (obj))
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
564 ls = obj;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 else if (SYMBOLP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 ls = XSYMBOL (obj)->name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 /* convert to string using princ. */
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
570 ls = Fprin1_to_string (obj, Qt);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 }
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
572 string = XSTRING_DATA (ls);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
573 string_len = XSTRING_LENGTH (ls);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
576 doprnt_2 (stream, string, string_len, spec->minwidth,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 spec->precision, spec->minus_flag, spec->zero_flag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 /* Must be a number. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 union printf_arg arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 if (!largs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 arg = Dynarr_at (args, spec->argnum - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 Lisp_Object obj = largs[spec->argnum - 1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 if (CHARP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 obj = make_int (XCHAR (obj));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
594 #ifdef WITH_NUMBER_TYPES
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
595 if (!NUMBERP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
596 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 if (!INT_OR_FLOATP (obj))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
598 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 {
2267
5753220a0f80 [xemacs-hg @ 2004-09-14 02:53:13 by james]
james
parents: 1995
diff changeset
600 /* WARNING! This MUST be big enough for the sprintf below */
2272
4ec724310f33 [xemacs-hg @ 2004-09-14 20:54:29 by james]
james
parents: 2267
diff changeset
601 CIbyte msg[48];
4ec724310f33 [xemacs-hg @ 2004-09-14 20:54:29 by james]
james
parents: 2267
diff changeset
602 sprintf (msg,
2267
5753220a0f80 [xemacs-hg @ 2004-09-14 02:53:13 by james]
james
parents: 1995
diff changeset
603 "format specifier %%%c doesn't match argument type",
5753220a0f80 [xemacs-hg @ 2004-09-14 02:53:13 by james]
james
parents: 1995
diff changeset
604 ch);
2272
4ec724310f33 [xemacs-hg @ 2004-09-14 20:54:29 by james]
james
parents: 2267
diff changeset
605 syntax_error (msg, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 else if (strchr (double_converters, ch))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
608 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
609 #ifdef WITH_NUMBER_TYPES
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
610 if (INTP (obj) || FLOATP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
611 arg.d = XFLOATINT (obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
612 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
613 else if (BIGNUMP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
614 arg.d = bignum_to_double (XBIGNUM_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
615 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
616 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
617 else if (RATIOP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
618 arg.d = ratio_to_double (XRATIO_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
619 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
620 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
621 else if (BIGFLOATP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
622 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
623 arg.obj = obj;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
624 switch (ch)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
625 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
626 case 'f': ch = 'F'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
627 case 'e': ch = 'h'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
628 case 'E': ch = 'H'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
629 case 'g': ch = 'k'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
630 case 'G': ch = 'K'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
631 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
632 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
633 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
634 #else /* !WITH_NUMBER_TYPES */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
635 arg.d = XFLOATINT (obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
636 #endif /* WITH_NUMBER_TYPES */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
637 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
640 if (FLOATP (obj))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
641 obj = Ftruncate (obj);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
642 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
643 else if (BIGFLOATP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
644 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
645 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
646 bignum_set_bigfloat (scratch_bignum,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
647 XBIGFLOAT_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
648 if (strchr (unsigned_int_converters, ch) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
649 bignum_sign (scratch_bignum) < 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
650 dead_wrong_type_argument (Qnonnegativep, obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
651 obj =
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
652 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
653 #else /* !HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
654 obj = make_int (bigfloat_to_long (XBIGFLOAT_DATA (obj)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
655 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
656 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
657 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
658 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
659 else if (RATIOP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
660 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
661 arg.obj = obj;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
662 switch (ch)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
663 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
664 case 'i': case 'd': ch = 'n'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
665 case 'o': ch = 'p'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
666 case 'x': ch = 'y'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
667 case 'X': ch = 'Y'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
668 default: /* ch == 'u' */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
669 if (strchr (unsigned_int_converters, ch) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
670 ratio_sign (XRATIO_DATA (obj)) < 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
671 dead_wrong_type_argument (Qnonnegativep, obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
672 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
673 ch = 'n';
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
674 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
675 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
676 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
677 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
678 if (BIGNUMP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
679 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
680 arg.obj = obj;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
681 switch (ch)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
682 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
683 case 'i': case 'd': ch = 'n'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
684 case 'o': ch = 'p'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
685 case 'x': ch = 'y'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
686 case 'X': ch = 'Y'; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
687 default: /* ch == 'u' */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
688 if (strchr (unsigned_int_converters, ch) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
689 bignum_sign (XBIGNUM_DATA (obj)) < 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
690 dead_wrong_type_argument (Qnatnump, obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
691 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
692 ch = 'n';
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
693 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
694 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
695 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
696 if (INTP (obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
697 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
698 if (strchr (unsigned_int_converters, ch))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
699 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
700 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
701 if (XINT (obj) < 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
702 dead_wrong_type_argument (Qnatnump, obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
703 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
704 arg.ul = (unsigned long) XUINT (obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
705 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
706 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
707 arg.l = XINT (obj);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
708 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 if (ch == 'c')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
714 Ichar a;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 Bytecount charlen;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
716 Ibyte charbuf[MAX_ICHAR_LEN];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
718 a = (Ichar) arg.l;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
720 if (!valid_ichar_p (a))
2267
5753220a0f80 [xemacs-hg @ 2004-09-14 02:53:13 by james]
james
parents: 1995
diff changeset
721 {
5753220a0f80 [xemacs-hg @ 2004-09-14 02:53:13 by james]
james
parents: 1995
diff changeset
722 /* WARNING! This MUST be big enough for the sprintf below */
2272
4ec724310f33 [xemacs-hg @ 2004-09-14 20:54:29 by james]
james
parents: 2267
diff changeset
723 CIbyte msg[60];
4ec724310f33 [xemacs-hg @ 2004-09-14 20:54:29 by james]
james
parents: 2267
diff changeset
724 sprintf (msg, "invalid character value %d to %%c spec",
2267
5753220a0f80 [xemacs-hg @ 2004-09-14 02:53:13 by james]
james
parents: 1995
diff changeset
725 a);
2272
4ec724310f33 [xemacs-hg @ 2004-09-14 20:54:29 by james]
james
parents: 2267
diff changeset
726 syntax_error (msg, Qnil);
2267
5753220a0f80 [xemacs-hg @ 2004-09-14 02:53:13 by james]
james
parents: 1995
diff changeset
727 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
729 charlen = set_itext_ichar (charbuf, a);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
730 doprnt_2 (stream, charbuf, charlen, spec->minwidth,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 -1, spec->minus_flag, spec->zero_flag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
733 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
734 else if (strchr (bignum_converters, ch))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
735 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
736 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
737 if (BIGNUMP (arg.obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
738 {
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
739 Ibyte *text_to_print =
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
740 (Ibyte *) bignum_to_string (XBIGNUM_DATA (arg.obj),
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
741 ch == 'n' ? 10 :
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
742 (ch == 'p' ? 8 : 16));
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
743 doprnt_2 (stream, text_to_print,
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
744 strlen ((const char *) text_to_print),
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
745 spec->minwidth, -1, spec->minus_flag,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
746 spec->zero_flag);
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
747 xfree (text_to_print, Ibyte *);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
748 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
749 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
750 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
751 if (RATIOP (arg.obj))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
752 {
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
753 Ibyte *text_to_print =
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
754 (Ibyte *) ratio_to_string (XRATIO_DATA (arg.obj),
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
755 ch == 'n' ? 10 :
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
756 (ch == 'p' ? 8 : 16));
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
757 doprnt_2 (stream, text_to_print,
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
758 strlen ((const char *) text_to_print),
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
759 spec->minwidth, -1, spec->minus_flag,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
760 spec->zero_flag);
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
761 xfree (text_to_print, Ibyte *);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
762 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
763 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
764 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
765 #endif /* HAVE_BIGNUM || HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
766 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
767 else if (strchr (bigfloat_converters, ch))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
768 {
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
769 Ibyte *text_to_print =
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
770 (Ibyte *) bigfloat_to_string (XBIGFLOAT_DATA (arg.obj), 10);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
771 doprnt_2 (stream, text_to_print,
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
772 strlen ((const char *) text_to_print),
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
773 spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
774 xfree (text_to_print, Ibyte *);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
775 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1318
diff changeset
776 #endif /* HAVE_BIGFLOAT */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 {
3706
4ca1ef2bdb6a [xemacs-hg @ 2006-11-28 16:09:45 by aidan]
aidan
parents: 3705
diff changeset
779 Ascbyte *text_to_print = alloca_array (char, 350);
4ca1ef2bdb6a [xemacs-hg @ 2006-11-28 16:09:45 by aidan]
aidan
parents: 3705
diff changeset
780 Ascbyte constructed_spec[100];
4ca1ef2bdb6a [xemacs-hg @ 2006-11-28 16:09:45 by aidan]
aidan
parents: 3705
diff changeset
781 Ascbyte *p = constructed_spec;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
783 /* Mostly reconstruct the spec and use sprintf() to
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 format the string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
786 *p++ = '%';
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
787 if (spec->plus_flag) *p++ = '+';
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
788 if (spec->space_flag) *p++ = ' ';
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
789 if (spec->number_flag) *p++ = '#';
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
790 if (spec->minus_flag) *p++ = '-';
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
791 if (spec->zero_flag) *p++ = '0';
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
792
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
793 if (spec->minwidth >= 0)
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 568
diff changeset
794 {
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 568
diff changeset
795 long_to_string (p, spec->minwidth);
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 568
diff changeset
796 p += strlen (p);
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 568
diff changeset
797 }
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
798 if (spec->precision >= 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
800 *p++ = '.';
577
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 568
diff changeset
801 long_to_string (p, spec->precision);
910449c92002 [xemacs-hg @ 2001-05-25 10:04:26 by hrvojen]
hrvojen
parents: 568
diff changeset
802 p += strlen (p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 }
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
804
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 if (strchr (double_converters, ch))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
806 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
807 *p++ = ch;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
808 *p++ = '\0';
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
809 sprintf (text_to_print, constructed_spec, arg.d);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
810 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 {
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
813 *p++ = 'l'; /* Always use longs with sprintf() */
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
814 *p++ = ch;
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
815 *p++ = '\0';
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
816
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
817 if (strchr (unsigned_int_converters, ch))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
818 sprintf (text_to_print, constructed_spec, arg.ul);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
819 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 sprintf (text_to_print, constructed_spec, arg.l);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
823 doprnt_2 (stream, (Ibyte *) text_to_print,
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
824 strlen (text_to_print), 0, -1, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
829 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
833 /* Basic external entry point into string formatting. See
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
834 emacs_doprnt_1().
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
835 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
836
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
837 Bytecount
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
838 emacs_doprnt_va (Lisp_Object stream, const Ibyte *format_nonreloc,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
839 Bytecount format_length, Lisp_Object format_reloc,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
840 va_list vargs)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
841 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
842 return emacs_doprnt_1 (stream, format_nonreloc, format_length,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
843 format_reloc, 0, 0, vargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
844 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
845
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
846 /* Basic external entry point into string formatting. See
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
847 emacs_doprnt_1().
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
848 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
849
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
850 Bytecount
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
851 emacs_doprnt (Lisp_Object stream, const Ibyte *format_nonreloc,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
852 Bytecount format_length, Lisp_Object format_reloc,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
853 int nargs, const Lisp_Object *largs, ...)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 va_list vargs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 Bytecount val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 va_start (vargs, largs);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
858 val = emacs_doprnt_1 (stream, format_nonreloc, format_length,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
859 format_reloc, nargs, largs, vargs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 va_end (vargs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
864 /* Similar to `format' in that its arguments are Lisp objects rather than C
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
865 objects. (For the versions that take C objects, see the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
866 emacs_[v]sprintf... functions below.) Accepts the format string as
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
867 either a C string (FORMAT_NONRELOC, which *MUST NOT* come from Lisp
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
868 string data, unless GC is inhibited) or a Lisp string (FORMAT_RELOC).
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
869 Return resulting formatted string as a Lisp string.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
871 All arguments are GCPRO'd, including FORMAT_RELOC; this makes it OK to
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
872 pass newly created objects into this function (as often happens).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
874 #### It shouldn't be necessary to specify the number of arguments.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
875 This would require some rewriting of the doprnt() functions, though.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
876 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
879 emacs_vsprintf_string_lisp (const CIbyte *format_nonreloc,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
880 Lisp_Object format_reloc, int nargs,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
881 const Lisp_Object *largs)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
883 Lisp_Object stream;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 Lisp_Object obj;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
885 struct gcpro gcpro1, gcpro2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
886 GCPRO2 (largs[0], format_reloc);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
887 gcpro1.nvars = nargs;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
889 stream = make_resizing_buffer_output_stream ();
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
890 emacs_doprnt (stream, (Ibyte *) format_nonreloc, format_nonreloc ?
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
891 strlen (format_nonreloc) : 0,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
892 format_reloc, nargs, largs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 Lstream_flush (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 Lstream_byte_count (XLSTREAM (stream)));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
896 Lstream_delete (XLSTREAM (stream));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
901 /* Like emacs_vsprintf_string_lisp() but accepts its extra args directly
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
902 (using variable arguments), rather than as an array. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
903
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
905 emacs_sprintf_string_lisp (const CIbyte *format_nonreloc,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
906 Lisp_Object format_reloc, int nargs, ...)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
908 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
909 va_list va;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
910 int i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Lisp_Object obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
913 va_start (va, nargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
914 for (i = 0; i < nargs; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
915 args[i] = va_arg (va, Lisp_Object);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
916 va_end (va);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
917 obj = emacs_vsprintf_string_lisp (format_nonreloc, format_reloc, nargs,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
918 args);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
922 /* Like emacs_vsprintf_string_lisp() but returns a malloc()ed memory block.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
923 Return length out through LEN_OUT, if not null. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
924
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
925 Ibyte *
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
926 emacs_vsprintf_malloc_lisp (const CIbyte *format_nonreloc,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
927 Lisp_Object format_reloc, int nargs,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
928 const Lisp_Object *largs, Bytecount *len_out)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
929 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
930 Lisp_Object stream;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
931 Ibyte *retval;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
932 Bytecount len;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
933 struct gcpro gcpro1, gcpro2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
934
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
935 GCPRO2 (largs[0], format_reloc);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
936 gcpro1.nvars = nargs;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
937
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
938 stream = make_resizing_buffer_output_stream ();
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
939 emacs_doprnt (stream, (Ibyte *) format_nonreloc, format_nonreloc ?
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
940 strlen (format_nonreloc) : 0,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
941 format_reloc, nargs, largs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
942 Lstream_flush (XLSTREAM (stream));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
943 len = Lstream_byte_count (XLSTREAM (stream));
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2272
diff changeset
944 retval = xnew_ibytes (len + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
945 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
946 retval[len] = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
947 Lstream_delete (XLSTREAM (stream));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
948
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
949 if (len_out)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
950 *len_out = len;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
951 UNGCPRO;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
952 return retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
953 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
954
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
955 /* Like emacs_sprintf_string_lisp() but returns a malloc()ed memory block.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
956 Return length out through LEN_OUT, if not null. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
957
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
958 Ibyte *
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
959 emacs_sprintf_malloc_lisp (Bytecount *len_out, const CIbyte *format_nonreloc,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
960 Lisp_Object format_reloc, int nargs, ...)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
961 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
962 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
963 va_list va;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
964 int i;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
965 Ibyte *retval;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
966
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
967 va_start (va, nargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
968 for (i = 0; i < nargs; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
969 args[i] = va_arg (va, Lisp_Object);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
970 va_end (va);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
971 retval = emacs_vsprintf_malloc_lisp (format_nonreloc, format_reloc, nargs,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
972 args, len_out);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
973 return retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
974 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
975
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
976 /* vsprintf()-like replacement. Returns a Lisp string. Data
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
977 from Lisp strings is OK because we explicitly inhibit GC. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
978
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
980 emacs_vsprintf_string (const CIbyte *format, va_list vargs)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
982 Lisp_Object stream = make_resizing_buffer_output_stream ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 Lisp_Object obj;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
984 int count = begin_gc_forbidden ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
986 emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
987 vargs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 Lstream_flush (XLSTREAM (stream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 Lstream_byte_count (XLSTREAM (stream)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 Lstream_delete (XLSTREAM (stream));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
992 end_gc_forbidden (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
996 /* sprintf()-like replacement. Returns a Lisp string. Data
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
997 from Lisp strings is OK because we explicitly inhibit GC. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
998
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1000 emacs_sprintf_string (const CIbyte *format, ...)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1001 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1002 va_list vargs;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1003 Lisp_Object retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1004
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1005 va_start (vargs, format);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1006 retval = emacs_vsprintf_string (format, vargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1007 va_end (vargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1008 return retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1009 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1010
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1011 /* vsprintf()-like replacement. Returns a malloc()ed memory block. Data
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1012 from Lisp strings is OK because we explicitly inhibit GC. Return
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1013 length out through LEN_OUT, if not null. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1014
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1015 Ibyte *
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1016 emacs_vsprintf_malloc (const CIbyte *format, va_list vargs,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1017 Bytecount *len_out)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1019 int count = begin_gc_forbidden ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 Lisp_Object stream = make_resizing_buffer_output_stream ();
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1021 Ibyte *retval;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1022 Bytecount len;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1023
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1024 emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1025 vargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1026 Lstream_flush (XLSTREAM (stream));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1027 len = Lstream_byte_count (XLSTREAM (stream));
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2272
diff changeset
1028 retval = xnew_ibytes (len + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1029 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1030 retval[len] = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1031 end_gc_forbidden (count);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1032 Lstream_delete (XLSTREAM (stream));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1033
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1034 if (len_out)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1035 *len_out = len;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1036 return retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1037 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1038
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1039 /* sprintf()-like replacement. Returns a malloc()ed memory block. Data
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1040 from Lisp strings is OK because we explicitly inhibit GC. Return length
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1041 out through LEN_OUT, if not null. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1043 Ibyte *
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1044 emacs_sprintf_malloc (Bytecount *len_out, const CIbyte *format, ...)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1045 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1046 va_list vargs;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1047 Ibyte *retval;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1048
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1049 va_start (vargs, format);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1050 retval = emacs_vsprintf_malloc (format, vargs, len_out);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 va_end (vargs);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1052 return retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1053 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1054
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1055 /* vsprintf() replacement. Writes output into OUTPUT, which better
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1056 have enough space for the output. Data from Lisp strings is OK
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1057 because we explicitly inhibit GC. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1058
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1059 Bytecount
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1060 emacs_vsprintf (Ibyte *output, const CIbyte *format, va_list vargs)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1061 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1062 Bytecount retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1063 int count = begin_gc_forbidden ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1064 Lisp_Object stream = make_resizing_buffer_output_stream ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1065 Bytecount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1067 retval = emacs_doprnt_va (stream, (Ibyte *) format, strlen (format), Qnil,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1068 vargs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 Lstream_flush (XLSTREAM (stream));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1070 len = Lstream_byte_count (XLSTREAM (stream));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1071 memcpy (output, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1072 output[len] = '\0';
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1073 end_gc_forbidden (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 Lstream_delete (XLSTREAM (stream));
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1075
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1076 return retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1078
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1079 /* sprintf() replacement. Writes output into OUTPUT, which better
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1080 have enough space for the output. Data from Lisp strings is OK
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1081 because we explicitly inhibit GC. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1082
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1083 Bytecount
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 831
diff changeset
1084 emacs_sprintf (Ibyte *output, const CIbyte *format, ...)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1085 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1086 va_list vargs;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1087 Bytecount retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1088
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1089 va_start (vargs, format);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1090 retval = emacs_vsprintf (output, format, vargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1091 va_end (vargs);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1092 return retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1093 }