Mercurial > hg > xemacs-beta

comparison src/doprnt.c @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children de805c49cfc1
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
29 #include "lisp.h" 29 #include "lisp.h"
30 30
31 #include "buffer.h" 31 #include "buffer.h"
32 #include "lstream.h" 32 #include "lstream.h"
33 33
34 static CONST char *valid_flags = "-+ #0"; 34 static const char *valid_flags = "-+ #0";
35 35
36 static CONST char *valid_converters = "diouxXfeEgGcsS"; 36 static const char *valid_converters = "diouxXfeEgGcsS";
37 static CONST char *int_converters = "dic"; 37 static const char *int_converters = "dic";
38 static CONST char *unsigned_int_converters = "ouxX"; 38 static const char *unsigned_int_converters = "ouxX";
39 static CONST char *double_converters = "feEgG"; 39 static const char *double_converters = "feEgG";
40 static CONST char *string_converters = "sS"; 40 static const char *string_converters = "sS";
41 41
42 typedef struct printf_spec printf_spec; 42 typedef struct printf_spec printf_spec;
43 struct printf_spec 43 struct printf_spec
44 { 44 {
45 int argnum; /* which argument does this spec want? This is one-based: 45 int argnum; /* which argument does this spec want? This is one-based:
97 truncated to that many character. 97 truncated to that many character.
98 98
99 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */ 99 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
100 100
101 static void 101 static void
102 doprnt_1 (Lisp_Object stream, CONST Bufbyte *string, Bytecount len, 102 doprnt_1 (Lisp_Object stream, const Bufbyte *string, Bytecount len,
103 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag) 103 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
104 { 104 {
105 Charcount cclen; 105 Charcount cclen;
106 Bufbyte pad; 106 Bufbyte pad;
107 Lstream *lstr = XLSTREAM (stream); 107 Lstream *lstr = XLSTREAM (stream);
138 to_add--; 138 to_add--;
139 } 139 }
140 } 140 }
141 } 141 }
142 142
143 static CONST Bufbyte * 143 static const Bufbyte *
144 parse_off_posnum (CONST Bufbyte *start, CONST Bufbyte *end, int *returned_num) 144 parse_off_posnum (const Bufbyte *start, const Bufbyte *end, int *returned_num)
145 { 145 {
146 Bufbyte arg_convert[100]; 146 Bufbyte arg_convert[100];
147 REGISTER Bufbyte *arg_ptr = arg_convert; 147 REGISTER Bufbyte *arg_ptr = arg_convert;
148 148
149 *returned_num = -1; 149 *returned_num = -1;
176 if (spec.zero_flag && spec.space_flag) \ 176 if (spec.zero_flag && spec.space_flag) \
177 spec.zero_flag = 0; \ 177 spec.zero_flag = 0; \
178 } while (0) 178 } while (0)
179 179
180 static printf_spec_dynarr * 180 static printf_spec_dynarr *
181 parse_doprnt_spec (CONST Bufbyte *format, Bytecount format_length) 181 parse_doprnt_spec (const Bufbyte *format, Bytecount format_length)
182 { 182 {
183 CONST Bufbyte *fmt = format; 183 const Bufbyte *fmt = format;
184 CONST Bufbyte *fmt_end = format + format_length; 184 const Bufbyte *fmt_end = format + format_length;
185 printf_spec_dynarr *specs = Dynarr_new (printf_spec); 185 printf_spec_dynarr *specs = Dynarr_new (printf_spec);
186 int prev_argnum = 0; 186 int prev_argnum = 0;
187 187
188 while (1) 188 while (1)
189 { 189 {
190 struct printf_spec spec; 190 struct printf_spec spec;
191 CONST Bufbyte *text_end; 191 const Bufbyte *text_end;
192 Bufbyte ch; 192 Bufbyte ch;
193 193
194 xzero (spec); 194 xzero (spec);
195 if (fmt == fmt_end) 195 if (fmt == fmt_end)
196 return specs; 196 return specs;
214 continue; 214 continue;
215 } 215 }
216 216
217 /* Is there a field number specifier? */ 217 /* Is there a field number specifier? */
218 { 218 {
219 CONST Bufbyte *ptr; 219 const Bufbyte *ptr;
220 int fieldspec; 220 int fieldspec;
221 221
222 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec); 222 ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
223 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$') 223 if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
224 { 224 {
384 match the actual type **after default promotions**." */ 384 match the actual type **after default promotions**." */
385 385
386 if (strchr (int_converters, ch)) 386 if (strchr (int_converters, ch))
387 { 387 {
388 if (spec->h_flag) 388 if (spec->h_flag)
389 arg.i = va_arg (vargs, short); 389 arg.i = va_arg (vargs, int /* short */);
390 else if (spec->l_flag) 390 else if (spec->l_flag)
391 arg.l = va_arg (vargs, long); 391 arg.l = va_arg (vargs, long);
392 else 392 else
393 arg.i = va_arg (vargs, int); 393 arg.i = va_arg (vargs, int);
394 } 394 }
395 else if (strchr (unsigned_int_converters, ch)) 395 else if (strchr (unsigned_int_converters, ch))
396 { 396 {
397 if (spec->h_flag) 397 if (spec->h_flag)
398 arg.ui = va_arg (vargs, unsigned short); 398 arg.ui = va_arg (vargs, unsigned int /* unsigned short */);
399 else if (spec->l_flag) 399 else if (spec->l_flag)
400 arg.ul = va_arg (vargs, unsigned long); 400 arg.ul = va_arg (vargs, unsigned long);
401 else 401 else
402 arg.ui = va_arg (vargs, unsigned int); 402 arg.ui = va_arg (vargs, unsigned int);
403 } 403 }
421 if LARGS is non-zero, it should be a pointer to NARGS worth of 421 if LARGS is non-zero, it should be a pointer to NARGS worth of
422 Lisp arguments. Otherwise, VARGS should be a va_list referring 422 Lisp arguments. Otherwise, VARGS should be a va_list referring
423 to the arguments. */ 423 to the arguments. */
424 424
425 static Bytecount 425 static Bytecount
426 emacs_doprnt_1 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 426 emacs_doprnt_1 (Lisp_Object stream, const Bufbyte *format_nonreloc,
427 Lisp_Object format_reloc, Bytecount format_length, 427 Lisp_Object format_reloc, Bytecount format_length,
428 int nargs, 428 int nargs,
429 /* #### Gag me, gag me, gag me */ 429 /* #### Gag me, gag me, gag me */
430 CONST Lisp_Object *largs, va_list vargs) 430 const Lisp_Object *largs, va_list vargs)
431 { 431 {
432 printf_spec_dynarr *specs = 0; 432 printf_spec_dynarr *specs = 0;
433 printf_arg_dynarr *args = 0; 433 printf_arg_dynarr *args = 0;
434 REGISTER int i; 434 REGISTER int i;
435 int init_byte_count = Lstream_byte_count (XLSTREAM (stream)); 435 int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
438 { 438 {
439 format_nonreloc = XSTRING_DATA (format_reloc); 439 format_nonreloc = XSTRING_DATA (format_reloc);
440 format_length = XSTRING_LENGTH (format_reloc); 440 format_length = XSTRING_LENGTH (format_reloc);
441 } 441 }
442 if (format_length < 0) 442 if (format_length < 0)
443 format_length = (Bytecount) strlen ((CONST char *) format_nonreloc); 443 format_length = (Bytecount) strlen ((const char *) format_nonreloc);
444 444
445 specs = parse_doprnt_spec (format_nonreloc, format_length); 445 specs = parse_doprnt_spec (format_nonreloc, format_length);
446 if (largs) 446 if (largs)
447 { 447 {
448 /* allow too many args for string, but not too few */ 448 /* allow too many args for string, but not too few */
536 string_len = strlen ((char *) string); 536 string_len = strlen ((char *) string);
537 } 537 }
538 else 538 else
539 { 539 {
540 Lisp_Object obj = largs[spec->argnum - 1]; 540 Lisp_Object obj = largs[spec->argnum - 1];
541 struct Lisp_String *ls; 541 Lisp_String *ls;
542 542
543 if (ch == 'S') 543 if (ch == 'S')
544 { 544 {
545 /* For `S', prin1 the argument and then treat like 545 /* For `S', prin1 the argument and then treat like
546 a string. */ 546 a string. */
695 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count; 695 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
696 } 696 }
697 697
698 /* You really don't want to know why this is necessary... */ 698 /* You really don't want to know why this is necessary... */
699 static Bytecount 699 static Bytecount
700 emacs_doprnt_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 700 emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
701 Lisp_Object format_reloc, Bytecount format_length, int nargs, 701 Lisp_Object format_reloc, Bytecount format_length, int nargs,
702 CONST Lisp_Object *largs, ...) 702 const Lisp_Object *largs, ...)
703 { 703 {
704 va_list vargs; 704 va_list vargs;
705 Bytecount val; 705 Bytecount val;
706 va_start (vargs, largs); 706 va_start (vargs, largs);
707 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc, 707 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
730 730
731 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC 731 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
732 parameter, because this function can cause GC. */ 732 parameter, because this function can cause GC. */
733 733
734 Bytecount 734 Bytecount
735 emacs_doprnt_c (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 735 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
736 Lisp_Object format_reloc, Bytecount format_length, 736 Lisp_Object format_reloc, Bytecount format_length,
737 ...) 737 ...)
738 { 738 {
739 int val; 739 int val;
740 va_list vargs; 740 va_list vargs;
747 } 747 }
748 748
749 /* Like emacs_doprnt_c but the args come in va_list format. */ 749 /* Like emacs_doprnt_c but the args come in va_list format. */
750 750
751 Bytecount 751 Bytecount
752 emacs_doprnt_va (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 752 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
753 Lisp_Object format_reloc, Bytecount format_length, 753 Lisp_Object format_reloc, Bytecount format_length,
754 va_list vargs) 754 va_list vargs)
755 { 755 {
756 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc, 756 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
757 format_length, 0, 0, vargs); 757 format_length, 0, 0, vargs);
761 C arguments. This causes somewhat different behavior from 761 C arguments. This causes somewhat different behavior from
762 the above two functions (which should act like printf). 762 the above two functions (which should act like printf).
763 See `format' for a description of this behavior. */ 763 See `format' for a description of this behavior. */
764 764
765 Bytecount 765 Bytecount
766 emacs_doprnt_lisp (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 766 emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc,
767 Lisp_Object format_reloc, Bytecount format_length, 767 Lisp_Object format_reloc, Bytecount format_length,
768 int nargs, CONST Lisp_Object *largs) 768 int nargs, const Lisp_Object *largs)
769 { 769 {
770 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc, 770 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
771 format_length, nargs, largs); 771 format_length, nargs, largs);
772 } 772 }
773 773
774 /* Like the previous function but takes a variable number of arguments. */ 774 /* Like the previous function but takes a variable number of arguments. */
775 775
776 Bytecount 776 Bytecount
777 emacs_doprnt_lisp_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 777 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
778 Lisp_Object format_reloc, Bytecount format_length, 778 Lisp_Object format_reloc, Bytecount format_length,
779 int nargs, ...) 779 int nargs, ...)
780 { 780 {
781 va_list vargs; 781 va_list vargs;
782 int i; 782 int i;
794 /* The following four functions work like the above three but 794 /* The following four functions work like the above three but
795 return their output as a Lisp string instead of sending it 795 return their output as a Lisp string instead of sending it
796 to a stream. */ 796 to a stream. */
797 797
798 Lisp_Object 798 Lisp_Object
799 emacs_doprnt_string_c (CONST Bufbyte *format_nonreloc, 799 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
800 Lisp_Object format_reloc, Bytecount format_length, 800 Lisp_Object format_reloc, Bytecount format_length,
801 ...) 801 ...)
802 { 802 {
803 va_list vargs; 803 va_list vargs;
804 Lisp_Object obj; 804 Lisp_Object obj;
817 Lstream_delete (XLSTREAM (stream)); 817 Lstream_delete (XLSTREAM (stream));
818 return obj; 818 return obj;
819 } 819 }
820 820
821 Lisp_Object 821 Lisp_Object
822 emacs_doprnt_string_va (CONST Bufbyte *format_nonreloc, 822 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
823 Lisp_Object format_reloc, Bytecount format_length, 823 Lisp_Object format_reloc, Bytecount format_length,
824 va_list vargs) 824 va_list vargs)
825 { 825 {
826 /* I'm fairly sure that this function cannot actually GC. 826 /* I'm fairly sure that this function cannot actually GC.
827 That can only happen when the arguments to emacs_doprnt_1() are 827 That can only happen when the arguments to emacs_doprnt_1() are
840 Lstream_delete (XLSTREAM (stream)); 840 Lstream_delete (XLSTREAM (stream));
841 return obj; 841 return obj;
842 } 842 }
843 843
844 Lisp_Object 844 Lisp_Object
845 emacs_doprnt_string_lisp (CONST Bufbyte *format_nonreloc, 845 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
846 Lisp_Object format_reloc, Bytecount format_length, 846 Lisp_Object format_reloc, Bytecount format_length,
847 int nargs, CONST Lisp_Object *largs) 847 int nargs, const Lisp_Object *largs)
848 { 848 {
849 Lisp_Object obj; 849 Lisp_Object obj;
850 Lisp_Object stream = make_resizing_buffer_output_stream (); 850 Lisp_Object stream = make_resizing_buffer_output_stream ();
851 struct gcpro gcpro1; 851 struct gcpro gcpro1;
852 852
860 Lstream_delete (XLSTREAM (stream)); 860 Lstream_delete (XLSTREAM (stream));
861 return obj; 861 return obj;
862 } 862 }
863 863
864 Lisp_Object 864 Lisp_Object
865 emacs_doprnt_string_lisp_2 (CONST Bufbyte *format_nonreloc, 865 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
866 Lisp_Object format_reloc, Bytecount format_length, 866 Lisp_Object format_reloc, Bytecount format_length,
867 int nargs, ...) 867 int nargs, ...)
868 { 868 {
869 Lisp_Object obj; 869 Lisp_Object obj;
870 Lisp_Object stream = make_resizing_buffer_output_stream (); 870 Lisp_Object stream = make_resizing_buffer_output_stream ();