Mercurial > hg > xemacs-beta

comparison src/doprnt.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents fdefd0186b75
children e38acbeb1cae
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* Output like sprintf to a buffer of specified size. 1 /* Output like sprintf to a buffer of specified size.
2 Also takes args differently: pass one pointer to an array of strings 2 Also takes args differently: pass one pointer to an array of strings
3 in addition to the format string which is separate. 3 in addition to the format string which is separate.
4 Copyright (C) 1995 Free Software Foundation, Inc. 4 Copyright (C) 1995 Free Software Foundation, Inc.
5 Copyright (C) 2001 Ben Wing.
5 Rewritten by mly to use varargs.h. 6 Rewritten by mly to use varargs.h.
6 Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded 7 Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
7 to full printf spec. 8 to full printf spec.
8 9
9 This file is part of XEmacs. 10 This file is part of XEmacs.
96 right to that many characters. 97 right to that many characters.
97 98
98 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. */
99 100
100 static void 101 static void
101 doprnt_1 (Lisp_Object stream, const Intbyte *string, Bytecount len, 102 doprnt_2 (Lisp_Object stream, const Intbyte *string, Bytecount len,
102 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag) 103 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
103 { 104 {
104 Lstream *lstr = XLSTREAM (stream); 105 Lstream *lstr = XLSTREAM (stream);
105 Charcount cclen = bytecount_to_charcount (string, len); 106 Charcount cclen = bytecount_to_charcount (string, len);
106 int to_add = minlen - cclen; 107 int to_add = minlen - cclen;
389 } 390 }
390 391
391 return args; 392 return args;
392 } 393 }
393 394
394 /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH. 395 /* Most basic entry point into string formatting.
395 Output goes in BUFFER, which has room for BUFSIZE bytes. 396
396 If the output does not fit, truncate it to fit. 397 Generate output from a format-spec (either a Lisp string
397 Returns the number of bytes stored into BUFFER. 398 FORMAT_RELOC, or a C string FORMAT_NONRELOC of length FORMAT_LENGTH
398 LARGS or VARGS points to the arguments, and NARGS says how many. 399 -- which *MUST NOT* come from Lisp string data, unless GC is
399 if LARGS is non-zero, it should be a pointer to NARGS worth of 400 inhibited). Output goes to STREAM. Returns the number of bytes
400 Lisp arguments. Otherwise, VARGS should be a va_list referring 401 stored into STREAM. Arguments are either C-type arguments in
401 to the arguments. */ 402 va_list VARGS, or an array of Lisp objects in LARGS of size
403 NARGS. (Behavior is different in the two cases -- you either get
404 standard sprintf() behavior or `format' behavior.) */
402 405
403 static Bytecount 406 static Bytecount
404 emacs_doprnt_1 (Lisp_Object stream, const Intbyte *format_nonreloc, 407 emacs_doprnt_1 (Lisp_Object stream, const Intbyte *format_nonreloc,
405 Lisp_Object format_reloc, Bytecount format_length, 408 Bytecount format_length, Lisp_Object format_reloc,
406 int nargs, 409 int nargs, const Lisp_Object *largs, va_list vargs)
407 /* #### Gag me, gag me, gag me */
408 const Lisp_Object *largs, va_list vargs)
409 { 410 {
410 printf_spec_dynarr *specs = 0; 411 printf_spec_dynarr *specs = 0;
411 printf_arg_dynarr *args = 0; 412 printf_arg_dynarr *args = 0;
412 REGISTER int i; 413 REGISTER int i;
413 int init_byte_count = Lstream_byte_count (XLSTREAM (stream)); 414 int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
415 int count;
414 416
415 if (!NILP (format_reloc)) 417 if (!NILP (format_reloc))
416 { 418 {
417 format_nonreloc = XSTRING_DATA (format_reloc); 419 format_nonreloc = XSTRING_DATA (format_reloc);
418 format_length = XSTRING_LENGTH (format_reloc); 420 format_length = XSTRING_LENGTH (format_reloc);
419 } 421 }
420 if (format_length < 0) 422 if (format_length < 0)
421 format_length = (Bytecount) strlen ((const char *) format_nonreloc); 423 format_length = (Bytecount) strlen ((const char *) format_nonreloc);
422 424
423 specs = parse_doprnt_spec (format_nonreloc, format_length); 425 specs = parse_doprnt_spec (format_nonreloc, format_length);
426 count = record_unwind_protect_freeing_dynarr (specs);
427
424 if (largs) 428 if (largs)
425 { 429 {
426 /* allow too many args for string, but not too few */ 430 /* allow too many args for string, but not too few */
427 if (nargs < get_args_needed (specs)) 431 if (nargs < get_args_needed (specs))
428 signal_error_1 (Qwrong_number_of_arguments, 432 signal_error_1 (Qwrong_number_of_arguments,
432 make_string (format_nonreloc, format_length))); 436 make_string (format_nonreloc, format_length)));
433 } 437 }
434 else 438 else
435 { 439 {
436 args = get_doprnt_args (specs, vargs); 440 args = get_doprnt_args (specs, vargs);
441 record_unwind_protect_freeing_dynarr (args);
437 } 442 }
438 443
439 for (i = 0; i < Dynarr_length (specs); i++) 444 for (i = 0; i < Dynarr_length (specs); i++)
440 { 445 {
441 struct printf_spec *spec = Dynarr_atp (specs, i); 446 struct printf_spec *spec = Dynarr_atp (specs, i);
443 448
444 /* Copy the text before */ 449 /* Copy the text before */
445 if (!NILP (format_reloc)) /* refetch in case of GC below */ 450 if (!NILP (format_reloc)) /* refetch in case of GC below */
446 format_nonreloc = XSTRING_DATA (format_reloc); 451 format_nonreloc = XSTRING_DATA (format_reloc);
447 452
448 doprnt_1 (stream, format_nonreloc + spec->text_before, 453 doprnt_2 (stream, format_nonreloc + spec->text_before,
449 spec->text_before_len, 0, -1, 0, 0); 454 spec->text_before_len, 0, -1, 0, 0);
450 455
451 ch = spec->converter; 456 ch = spec->converter;
452 457
453 if (!ch) 458 if (!ch)
454 continue; 459 continue;
455 460
456 if (ch == '%') 461 if (ch == '%')
457 { 462 {
458 doprnt_1 (stream, (Intbyte *) &ch, 1, 0, -1, 0, 0); 463 doprnt_2 (stream, (Intbyte *) &ch, 1, 0, -1, 0, 0);
459 continue; 464 continue;
460 } 465 }
461 466
462 /* The char '*' as converter means the field width, precision 467 /* The char '*' as converter means the field width, precision
463 was specified as an argument. Extract the data and forward 468 was specified as an argument. Extract the data and forward
491 } 496 }
492 continue; 497 continue;
493 } 498 }
494 499
495 if (largs && (spec->argnum < 1 || spec->argnum > nargs)) 500 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
496 syntax_error ("Invalid repositioning argument", make_int (spec->argnum)); 501 syntax_error ("Invalid repositioning argument",
502 make_int (spec->argnum));
497 503
498 else if (ch == 'S' || ch == 's') 504 else if (ch == 'S' || ch == 's')
499 { 505 {
500 Intbyte *string; 506 Intbyte *string;
501 Bytecount string_len; 507 Bytecount string_len;
502 508
503 if (!largs) 509 if (!largs)
504 { 510 {
505 string = Dynarr_at (args, spec->argnum - 1).bp; 511 string = Dynarr_at (args, spec->argnum - 1).bp;
506 /* error() can be called with null string arguments. 512 #if 0
513 /* [[ error() can be called with null string arguments.
507 E.g., in fileio.c, the return value of strerror() 514 E.g., in fileio.c, the return value of strerror()
508 is never checked. We'll print (null), like some 515 is never checked. We'll print (null), like some
509 printf implementations do. Would it be better (and safe) 516 printf implementations do. Would it be better (and safe)
510 to signal an error instead? Or should we just use the 517 to signal an error instead? Or should we just use the
511 empty string? -dkindred@cs.cmu.edu 8/1997 518 empty string? -dkindred@cs.cmu.edu 8/1997 ]]
519 Do not hide bugs. --ben
512 */ 520 */
513 if (!string) 521 if (!string)
514 string = (Intbyte *) "(null)"; 522 string = (Intbyte *) "(null)";
523 #else
524 assert (string);
525 #endif
515 string_len = strlen ((char *) string); 526 string_len = strlen ((char *) string);
516 } 527 }
517 else 528 else
518 { 529 {
519 Lisp_Object obj = largs[spec->argnum - 1]; 530 Lisp_Object obj = largs[spec->argnum - 1];
536 } 547 }
537 string = string_data (ls); 548 string = string_data (ls);
538 string_len = string_length (ls); 549 string_len = string_length (ls);
539 } 550 }
540 551
541 doprnt_1 (stream, string, string_len, spec->minwidth, 552 doprnt_2 (stream, string, string_len, spec->minwidth,
542 spec->precision, spec->minus_flag, spec->zero_flag); 553 spec->precision, spec->minus_flag, spec->zero_flag);
543 } 554 }
544 555
545 else 556 else
546 { 557 {
586 597
587 if (!valid_char_p (a)) 598 if (!valid_char_p (a))
588 syntax_error ("invalid character value %d to %%c spec", make_char (a)); 599 syntax_error ("invalid character value %d to %%c spec", make_char (a));
589 600
590 charlen = set_charptr_emchar (charbuf, a); 601 charlen = set_charptr_emchar (charbuf, a);
591 doprnt_1 (stream, charbuf, charlen, spec->minwidth, 602 doprnt_2 (stream, charbuf, charlen, spec->minwidth,
592 -1, spec->minus_flag, spec->zero_flag); 603 -1, spec->minus_flag, spec->zero_flag);
593 } 604 }
594 else 605 else
595 { 606 {
596 /* ASCII Decimal representation uses 2.4 times as many 607 /* ASCII Decimal representation uses 2.4 times as many
642 sprintf (text_to_print, constructed_spec, arg.ul); 653 sprintf (text_to_print, constructed_spec, arg.ul);
643 else 654 else
644 sprintf (text_to_print, constructed_spec, arg.l); 655 sprintf (text_to_print, constructed_spec, arg.l);
645 } 656 }
646 657
647 doprnt_1 (stream, (Intbyte *) text_to_print, 658 doprnt_2 (stream, (Intbyte *) text_to_print,
648 strlen (text_to_print), 0, -1, 0, 0); 659 strlen (text_to_print), 0, -1, 0, 0);
649 } 660 }
650 } 661 }
651 } 662 }
652 663
653 /* #### will not get freed if error */ 664 unbind_to (count);
654 if (specs)
655 Dynarr_free (specs);
656 if (args)
657 Dynarr_free (args);
658 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count; 665 return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
659 } 666 }
660 667
661 /* You really don't want to know why this is necessary... */ 668 /* Basic external entry point into string formatting. See
662 static Bytecount 669 emacs_doprnt_1().
663 emacs_doprnt_2 (Lisp_Object stream, const Intbyte *format_nonreloc, 670 */
664 Lisp_Object format_reloc, Bytecount format_length, int nargs, 671
665 const Lisp_Object *largs, ...) 672 Bytecount
673 emacs_doprnt_va (Lisp_Object stream, const Intbyte *format_nonreloc,
674 Bytecount format_length, Lisp_Object format_reloc,
675 va_list vargs)
676 {
677 return emacs_doprnt_1 (stream, format_nonreloc, format_length,
678 format_reloc, 0, 0, vargs);
679 }
680
681 /* Basic external entry point into string formatting. See
682 emacs_doprnt_1().
683 */
684
685 Bytecount
686 emacs_doprnt (Lisp_Object stream, const Intbyte *format_nonreloc,
687 Bytecount format_length, Lisp_Object format_reloc,
688 int nargs, const Lisp_Object *largs, ...)
666 { 689 {
667 va_list vargs; 690 va_list vargs;
668 Bytecount val; 691 Bytecount val;
669 va_start (vargs, largs); 692 va_start (vargs, largs);
670 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc, 693 val = emacs_doprnt_1 (stream, format_nonreloc, format_length,
671 format_length, nargs, largs, vargs); 694 format_reloc, nargs, largs, vargs);
672 va_end (vargs); 695 va_end (vargs);
673 return val; 696 return val;
674 } 697 }
675 698
676 /*********************** external entry points ***********************/ 699 /* Similar to `format' in that its arguments are Lisp objects rather than C
677 700 objects. (For the versions that take C objects, see the
678 #ifdef I18N3 701 emacs_[v]sprintf... functions below.) Accepts the format string as
679 /* A note about I18N3 translating: the format string should get 702 either a C string (FORMAT_NONRELOC, which *MUST NOT* come from Lisp
680 translated, but not under all circumstances. When the format 703 string data, unless GC is inhibited) or a Lisp string (FORMAT_RELOC).
681 string is a Lisp string, what should happen is that Fformat() 704 Return resulting formatted string as a Lisp string.
682 should format the untranslated args[0] and return that, and also 705
683 call Fgettext() on args[0] and, if that is different, format it 706 All arguments are GCPRO'd, including FORMAT_RELOC; this makes it OK to
684 and store it in the `string-translatable' property of 707 pass newly created objects into this function (as often happens).
685 the returned string. See Fgettext(). */ 708
686 #endif 709 #### It shouldn't be necessary to specify the number of arguments.
687 710 This would require some rewriting of the doprnt() functions, though.
688 /* Send formatted output to STREAM. The format string comes from 711 */
689 either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
690 strlen() to determine the length) or from FORMAT_RELOC, which
691 should be a Lisp string. Return the number of bytes written
692 to the stream.
693
694 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
695 parameter, because this function can cause GC. */
696
697 Bytecount
698 emacs_doprnt_c (Lisp_Object stream, const Intbyte *format_nonreloc,
699 Lisp_Object format_reloc, Bytecount format_length,
700 ...)
701 {
702 int val;
703 va_list vargs;
704
705 va_start (vargs, format_length);
706 val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
707 format_length, 0, 0, vargs);
708 va_end (vargs);
709 return val;
710 }
711
712 /* Like emacs_doprnt_c but the args come in va_list format. */
713
714 Bytecount
715 emacs_doprnt_va (Lisp_Object stream, const Intbyte *format_nonreloc,
716 Lisp_Object format_reloc, Bytecount format_length,
717 va_list vargs)
718 {
719 return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
720 format_length, 0, 0, vargs);
721 }
722
723 /* Like emacs_doprnt_c but the args are Lisp objects instead of
724 C arguments. This causes somewhat different behavior from
725 the above two functions (which should act like printf).
726 See `format' for a description of this behavior. */
727
728 Bytecount
729 emacs_doprnt_lisp (Lisp_Object stream, const Intbyte *format_nonreloc,
730 Lisp_Object format_reloc, Bytecount format_length,
731 int nargs, const Lisp_Object *largs)
732 {
733 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
734 format_length, nargs, largs);
735 }
736
737 /* Like the previous function but takes a variable number of arguments. */
738
739 Bytecount
740 emacs_doprnt_lisp_2 (Lisp_Object stream, const Intbyte *format_nonreloc,
741 Lisp_Object format_reloc, Bytecount format_length,
742 int nargs, ...)
743 {
744 va_list vargs;
745 int i;
746 Lisp_Object *foo = alloca_array (Lisp_Object, nargs);
747
748 va_start (vargs, nargs);
749 for (i = 0; i < nargs; i++)
750 foo[i] = va_arg (vargs, Lisp_Object);
751 va_end (vargs);
752
753 return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
754 format_length, nargs, foo);
755 }
756
757 /* The following four functions work like the above three but
758 return their output as a Lisp string instead of sending it
759 to a stream. */
760 712
761 Lisp_Object 713 Lisp_Object
762 emacs_doprnt_string_c (const Intbyte *format_nonreloc, 714 emacs_vsprintf_string_lisp (const CIntbyte *format_nonreloc,
763 Lisp_Object format_reloc, Bytecount format_length, 715 Lisp_Object format_reloc, int nargs,
764 ...) 716 const Lisp_Object *largs)
765 { 717 {
766 va_list vargs; 718 Lisp_Object stream;
767 Lisp_Object obj; 719 Lisp_Object obj;
768 Lisp_Object stream = make_resizing_buffer_output_stream (); 720 struct gcpro gcpro1, gcpro2;
769 struct gcpro gcpro1; 721 GCPRO2 (largs[0], format_reloc);
770 722 gcpro1.nvars = nargs;
771 GCPRO1 (stream); 723
772 va_start (vargs, format_length); 724 stream = make_resizing_buffer_output_stream ();
773 emacs_doprnt_1 (stream, format_nonreloc, format_reloc, 725 emacs_doprnt (stream, (Intbyte *) format_nonreloc, format_nonreloc ?
774 format_length, 0, 0, vargs); 726 strlen (format_nonreloc) : 0,
775 va_end (vargs); 727 format_reloc, nargs, largs);
776 Lstream_flush (XLSTREAM (stream)); 728 Lstream_flush (XLSTREAM (stream));
777 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), 729 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
778 Lstream_byte_count (XLSTREAM (stream))); 730 Lstream_byte_count (XLSTREAM (stream)));
731 Lstream_delete (XLSTREAM (stream));
779 UNGCPRO; 732 UNGCPRO;
733 return obj;
734 }
735
736 /* Like emacs_vsprintf_string_lisp() but accepts its extra args directly
737 (using variable arguments), rather than as an array. */
738
739 Lisp_Object
740 emacs_sprintf_string_lisp (const CIntbyte *format_nonreloc,
741 Lisp_Object format_reloc, int nargs, ...)
742 {
743 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
744 va_list va;
745 int i;
746 Lisp_Object obj;
747
748 va_start (va, nargs);
749 for (i = 0; i < nargs; i++)
750 args[i] = va_arg (va, Lisp_Object);
751 va_end (va);
752 obj = emacs_vsprintf_string_lisp (format_nonreloc, format_reloc, nargs,
753 args);
754 return obj;
755 }
756
757 /* Like emacs_vsprintf_string_lisp() but returns a malloc()ed memory block.
758 Return length out through LEN_OUT, if not null. */
759
760 Intbyte *
761 emacs_vsprintf_malloc_lisp (const CIntbyte *format_nonreloc,
762 Lisp_Object format_reloc, int nargs,
763 const Lisp_Object *largs, Bytecount *len_out)
764 {
765 Lisp_Object stream;
766 Intbyte *retval;
767 Bytecount len;
768 struct gcpro gcpro1, gcpro2;
769
770 GCPRO2 (largs[0], format_reloc);
771 gcpro1.nvars = nargs;
772
773 stream = make_resizing_buffer_output_stream ();
774 emacs_doprnt (stream, (Intbyte *) format_nonreloc, format_nonreloc ?
775 strlen (format_nonreloc) : 0,
776 format_reloc, nargs, largs);
777 Lstream_flush (XLSTREAM (stream));
778 len = Lstream_byte_count (XLSTREAM (stream));
779 retval = (Intbyte *) xmalloc (len + 1);
780 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
781 retval[len] = '\0';
780 Lstream_delete (XLSTREAM (stream)); 782 Lstream_delete (XLSTREAM (stream));
781 return obj; 783
782 } 784 if (len_out)
785 *len_out = len;
786 UNGCPRO;
787 return retval;
788 }
789
790 /* Like emacs_sprintf_string_lisp() but returns a malloc()ed memory block.
791 Return length out through LEN_OUT, if not null. */
792
793 Intbyte *
794 emacs_sprintf_malloc_lisp (Bytecount *len_out, const CIntbyte *format_nonreloc,
795 Lisp_Object format_reloc, int nargs, ...)
796 {
797 Lisp_Object *args = alloca_array (Lisp_Object, nargs);
798 va_list va;
799 int i;
800 Intbyte *retval;
801
802 va_start (va, nargs);
803 for (i = 0; i < nargs; i++)
804 args[i] = va_arg (va, Lisp_Object);
805 va_end (va);
806 retval = emacs_vsprintf_malloc_lisp (format_nonreloc, format_reloc, nargs,
807 args, len_out);
808 return retval;
809 }
810
811 /* vsprintf()-like replacement. Returns a Lisp string. Data
812 from Lisp strings is OK because we explicitly inhibit GC. */
783 813
784 Lisp_Object 814 Lisp_Object
785 emacs_doprnt_string_va (const Intbyte *format_nonreloc, 815 emacs_vsprintf_string (const CIntbyte *format, va_list vargs)
786 Lisp_Object format_reloc, Bytecount format_length, 816 {
787 va_list vargs) 817 Lisp_Object stream = make_resizing_buffer_output_stream ();
788 {
789 /* I'm fairly sure that this function cannot actually GC.
790 That can only happen when the arguments to emacs_doprnt_1() are
791 Lisp objects rather than C args. */
792 Lisp_Object obj; 818 Lisp_Object obj;
793 Lisp_Object stream = make_resizing_buffer_output_stream (); 819 int count = begin_gc_forbidden ();
794 struct gcpro gcpro1; 820
795 821 emacs_doprnt_va (stream, (Intbyte *) format, strlen (format), Qnil,
796 GCPRO1 (stream); 822 vargs);
797 emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
798 format_length, 0, 0, vargs);
799 Lstream_flush (XLSTREAM (stream)); 823 Lstream_flush (XLSTREAM (stream));
800 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), 824 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
801 Lstream_byte_count (XLSTREAM (stream))); 825 Lstream_byte_count (XLSTREAM (stream)));
802 UNGCPRO;
803 Lstream_delete (XLSTREAM (stream)); 826 Lstream_delete (XLSTREAM (stream));
827 end_gc_forbidden (count);
804 return obj; 828 return obj;
805 } 829 }
806 830
831 /* sprintf()-like replacement. Returns a Lisp string. Data
832 from Lisp strings is OK because we explicitly inhibit GC. */
833
807 Lisp_Object 834 Lisp_Object
808 emacs_doprnt_string_lisp (const Intbyte *format_nonreloc, 835 emacs_sprintf_string (const CIntbyte *format, ...)
809 Lisp_Object format_reloc, Bytecount format_length, 836 {
810 int nargs, const Lisp_Object *largs) 837 va_list vargs;
811 { 838 Lisp_Object retval;
812 Lisp_Object obj; 839
840 va_start (vargs, format);
841 retval = emacs_vsprintf_string (format, vargs);
842 va_end (vargs);
843 return retval;
844 }
845
846 /* vsprintf()-like replacement. Returns a malloc()ed memory block. Data
847 from Lisp strings is OK because we explicitly inhibit GC. Return
848 length out through LEN_OUT, if not null. */
849
850 Intbyte *
851 emacs_vsprintf_malloc (const CIntbyte *format, va_list vargs,
852 Bytecount *len_out)
853 {
854 int count = begin_gc_forbidden ();
813 Lisp_Object stream = make_resizing_buffer_output_stream (); 855 Lisp_Object stream = make_resizing_buffer_output_stream ();
814 struct gcpro gcpro1; 856 Intbyte *retval;
815 857 Bytecount len;
816 GCPRO1 (stream); 858
817 emacs_doprnt_2 (stream, format_nonreloc, format_reloc, 859 emacs_doprnt_va (stream, (Intbyte *) format, strlen (format), Qnil,
818 format_length, nargs, largs); 860 vargs);
819 Lstream_flush (XLSTREAM (stream)); 861 Lstream_flush (XLSTREAM (stream));
820 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), 862 len = Lstream_byte_count (XLSTREAM (stream));
821 Lstream_byte_count (XLSTREAM (stream))); 863 retval = (Intbyte *) xmalloc (len + 1);
822 UNGCPRO; 864 memcpy (retval, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
865 retval[len] = '\0';
866 end_gc_forbidden (count);
823 Lstream_delete (XLSTREAM (stream)); 867 Lstream_delete (XLSTREAM (stream));
824 return obj; 868
825 } 869 if (len_out)
826 870 *len_out = len;
827 Lisp_Object 871 return retval;
828 emacs_doprnt_string_lisp_2 (const Intbyte *format_nonreloc, 872 }
829 Lisp_Object format_reloc, Bytecount format_length, 873
830 int nargs, ...) 874 /* sprintf()-like replacement. Returns a malloc()ed memory block. Data
831 { 875 from Lisp strings is OK because we explicitly inhibit GC. Return length
832 Lisp_Object obj; 876 out through LEN_OUT, if not null. */
877
878 Intbyte *
879 emacs_sprintf_malloc (Bytecount *len_out, const CIntbyte *format, ...)
880 {
881 va_list vargs;
882 Intbyte *retval;
883
884 va_start (vargs, format);
885 retval = emacs_vsprintf_malloc (format, vargs, len_out);
886 va_end (vargs);
887 return retval;
888 }
889
890 /* vsprintf() replacement. Writes output into OUTPUT, which better
891 have enough space for the output. Data from Lisp strings is OK
892 because we explicitly inhibit GC. */
893
894 Bytecount
895 emacs_vsprintf (Intbyte *output, const CIntbyte *format, va_list vargs)
896 {
897 Bytecount retval;
898 int count = begin_gc_forbidden ();
833 Lisp_Object stream = make_resizing_buffer_output_stream (); 899 Lisp_Object stream = make_resizing_buffer_output_stream ();
834 struct gcpro gcpro1; 900 Bytecount len;
901
902 retval = emacs_doprnt_va (stream, (Intbyte *) format, strlen (format), Qnil,
903 vargs);
904 Lstream_flush (XLSTREAM (stream));
905 len = Lstream_byte_count (XLSTREAM (stream));
906 memcpy (output, resizing_buffer_stream_ptr (XLSTREAM (stream)), len);
907 output[len] = '\0';
908 end_gc_forbidden (count);
909 Lstream_delete (XLSTREAM (stream));
910
911 return retval;
912 }
913
914 /* sprintf() replacement. Writes output into OUTPUT, which better
915 have enough space for the output. Data from Lisp strings is OK
916 because we explicitly inhibit GC. */
917
918 Bytecount
919 emacs_sprintf (Intbyte *output, const CIntbyte *format, ...)
920 {
835 va_list vargs; 921 va_list vargs;
836 int i; 922 Bytecount retval;
837 Lisp_Object *foo = alloca_array (Lisp_Object, nargs); 923
838 924 va_start (vargs, format);
839 va_start (vargs, nargs); 925 retval = emacs_vsprintf (output, format, vargs);
840 for (i = 0; i < nargs; i++)
841 foo[i] = va_arg (vargs, Lisp_Object);
842 va_end (vargs); 926 va_end (vargs);
843 927 return retval;
844 GCPRO1 (stream); 928 }
845 emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
846 format_length, nargs, foo);
847 Lstream_flush (XLSTREAM (stream));
848 obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
849 Lstream_byte_count (XLSTREAM (stream)));
850 UNGCPRO;
851 Lstream_delete (XLSTREAM (stream));
852 return obj;
853 }