comparison src/doprnt.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
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 {
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 */
655 { 655 {
656 strcat (constructed_spec, "."); 656 strcat (constructed_spec, ".");
657 long_to_string (constructed_spec + strlen (constructed_spec), 657 long_to_string (constructed_spec + strlen (constructed_spec),
658 spec->precision); 658 spec->precision);
659 } 659 }
660 sprintf (constructed_spec + strlen (constructed_spec), "%c", ch);
661 660
662 /* sprintf the mofo */ 661 /* sprintf the mofo */
663 /* we have to use separate calls to sprintf(), rather than 662 /* we have to use separate calls to sprintf(), rather than
664 a single big conditional, because of the different types 663 a single big conditional, because of the different types
665 of the arguments */ 664 of the arguments */
666 if (strchr (double_converters, ch)) 665 if (strchr (double_converters, ch))
667 sprintf (text_to_print, constructed_spec, arg.d); 666 {
667 sprintf (constructed_spec + strlen (constructed_spec),
668 "%c", ch);
669 sprintf (text_to_print, constructed_spec, arg.d);
670 }
668 else if (strchr (unsigned_int_converters, ch)) 671 else if (strchr (unsigned_int_converters, ch))
669 { 672 {
673 sprintf (constructed_spec + strlen (constructed_spec),
674 "%c", ch);
670 if (spec->l_flag) 675 if (spec->l_flag)
671 sprintf (text_to_print, constructed_spec, arg.ul); 676 sprintf (text_to_print, constructed_spec, arg.ul);
672 else 677 else
673 sprintf (text_to_print, constructed_spec, arg.ui); 678 sprintf (text_to_print, constructed_spec, arg.ui);
674 } 679 }
675 else 680 else
676 { 681 {
682 if (spec->zero_flag && spec->minwidth)
683 sprintf (constructed_spec + strlen (constructed_spec),
684 "0%d%c", spec->minwidth, ch);
685 else
686 sprintf (constructed_spec + strlen (constructed_spec),
687 "%c", ch);
677 if (spec->l_flag) 688 if (spec->l_flag)
678 sprintf (text_to_print, constructed_spec, arg.l); 689 sprintf (text_to_print, constructed_spec, arg.l);
679 else 690 else
680 sprintf (text_to_print, constructed_spec, arg.i); 691 sprintf (text_to_print, constructed_spec, arg.i);
681 } 692 }
695 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count; 706 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
696 } 707 }
697 708
698 /* You really don't want to know why this is necessary... */ 709 /* You really don't want to know why this is necessary... */
699 static Bytecount 710 static Bytecount
700 emacs_doprnt_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 711 emacs_doprnt_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
701 Lisp_Object format_reloc, Bytecount format_length, int nargs, 712 Lisp_Object format_reloc, Bytecount format_length, int nargs,
702 CONST Lisp_Object *largs, ...) 713 const Lisp_Object *largs, ...)
703 { 714 {
704 va_list vargs; 715 va_list vargs;
705 Bytecount val; 716 Bytecount val;
706 va_start (vargs, largs); 717 va_start (vargs, largs);
707 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc, 718 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
730 741
731 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC 742 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
732 parameter, because this function can cause GC. */ 743 parameter, because this function can cause GC. */
733 744
734 Bytecount 745 Bytecount
735 emacs_doprnt_c (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 746 emacs_doprnt_c (Lisp_Object stream, const Bufbyte *format_nonreloc,
736 Lisp_Object format_reloc, Bytecount format_length, 747 Lisp_Object format_reloc, Bytecount format_length,
737 ...) 748 ...)
738 { 749 {
739 int val; 750 int val;
740 va_list vargs; 751 va_list vargs;
747 } 758 }
748 759
749 /* Like emacs_doprnt_c but the args come in va_list format. */ 760 /* Like emacs_doprnt_c but the args come in va_list format. */
750 761
751 Bytecount 762 Bytecount
752 emacs_doprnt_va (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 763 emacs_doprnt_va (Lisp_Object stream, const Bufbyte *format_nonreloc,
753 Lisp_Object format_reloc, Bytecount format_length, 764 Lisp_Object format_reloc, Bytecount format_length,
754 va_list vargs) 765 va_list vargs)
755 { 766 {
756 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc, 767 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
757 format_length, 0, 0, vargs); 768 format_length, 0, 0, vargs);
761 C arguments. This causes somewhat different behavior from 772 C arguments. This causes somewhat different behavior from
762 the above two functions (which should act like printf). 773 the above two functions (which should act like printf).
763 See `format' for a description of this behavior. */ 774 See `format' for a description of this behavior. */
764 775
765 Bytecount 776 Bytecount
766 emacs_doprnt_lisp (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 777 emacs_doprnt_lisp (Lisp_Object stream, const Bufbyte *format_nonreloc,
767 Lisp_Object format_reloc, Bytecount format_length, 778 Lisp_Object format_reloc, Bytecount format_length,
768 int nargs, CONST Lisp_Object *largs) 779 int nargs, const Lisp_Object *largs)
769 { 780 {
770 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc, 781 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
771 format_length, nargs, largs); 782 format_length, nargs, largs);
772 } 783 }
773 784
774 /* Like the previous function but takes a variable number of arguments. */ 785 /* Like the previous function but takes a variable number of arguments. */
775 786
776 Bytecount 787 Bytecount
777 emacs_doprnt_lisp_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, 788 emacs_doprnt_lisp_2 (Lisp_Object stream, const Bufbyte *format_nonreloc,
778 Lisp_Object format_reloc, Bytecount format_length, 789 Lisp_Object format_reloc, Bytecount format_length,
779 int nargs, ...) 790 int nargs, ...)
780 { 791 {
781 va_list vargs; 792 va_list vargs;
782 int i; 793 int i;
794 /* The following four functions work like the above three but 805 /* The following four functions work like the above three but
795 return their output as a Lisp string instead of sending it 806 return their output as a Lisp string instead of sending it
796 to a stream. */ 807 to a stream. */
797 808
798 Lisp_Object 809 Lisp_Object
799 emacs_doprnt_string_c (CONST Bufbyte *format_nonreloc, 810 emacs_doprnt_string_c (const Bufbyte *format_nonreloc,
800 Lisp_Object format_reloc, Bytecount format_length, 811 Lisp_Object format_reloc, Bytecount format_length,
801 ...) 812 ...)
802 { 813 {
803 va_list vargs; 814 va_list vargs;
804 Lisp_Object obj; 815 Lisp_Object obj;
817 Lstream_delete (XLSTREAM (stream)); 828 Lstream_delete (XLSTREAM (stream));
818 return obj; 829 return obj;
819 } 830 }
820 831
821 Lisp_Object 832 Lisp_Object
822 emacs_doprnt_string_va (CONST Bufbyte *format_nonreloc, 833 emacs_doprnt_string_va (const Bufbyte *format_nonreloc,
823 Lisp_Object format_reloc, Bytecount format_length, 834 Lisp_Object format_reloc, Bytecount format_length,
824 va_list vargs) 835 va_list vargs)
825 { 836 {
826 /* I'm fairly sure that this function cannot actually GC. 837 /* I'm fairly sure that this function cannot actually GC.
827 That can only happen when the arguments to emacs_doprnt_1() are 838 That can only happen when the arguments to emacs_doprnt_1() are
840 Lstream_delete (XLSTREAM (stream)); 851 Lstream_delete (XLSTREAM (stream));
841 return obj; 852 return obj;
842 } 853 }
843 854
844 Lisp_Object 855 Lisp_Object
845 emacs_doprnt_string_lisp (CONST Bufbyte *format_nonreloc, 856 emacs_doprnt_string_lisp (const Bufbyte *format_nonreloc,
846 Lisp_Object format_reloc, Bytecount format_length, 857 Lisp_Object format_reloc, Bytecount format_length,
847 int nargs, CONST Lisp_Object *largs) 858 int nargs, const Lisp_Object *largs)
848 { 859 {
849 Lisp_Object obj; 860 Lisp_Object obj;
850 Lisp_Object stream = make_resizing_buffer_output_stream (); 861 Lisp_Object stream = make_resizing_buffer_output_stream ();
851 struct gcpro gcpro1; 862 struct gcpro gcpro1;
852 863
860 Lstream_delete (XLSTREAM (stream)); 871 Lstream_delete (XLSTREAM (stream));
861 return obj; 872 return obj;
862 } 873 }
863 874
864 Lisp_Object 875 Lisp_Object
865 emacs_doprnt_string_lisp_2 (CONST Bufbyte *format_nonreloc, 876 emacs_doprnt_string_lisp_2 (const Bufbyte *format_nonreloc,
866 Lisp_Object format_reloc, Bytecount format_length, 877 Lisp_Object format_reloc, Bytecount format_length,
867 int nargs, ...) 878 int nargs, ...)
868 { 879 {
869 Lisp_Object obj; 880 Lisp_Object obj;
870 Lisp_Object stream = make_resizing_buffer_output_stream (); 881 Lisp_Object stream = make_resizing_buffer_output_stream ();