Mercurial > hg > xemacs-beta

comparison src/doprnt.c @ 412:697ef44129c6 r21-2-14

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