massar@godot.UUCP (J.P. Massar) (02/28/85)
Following is code that implements (PRINT-TO-STRING <any> &optional <string>)
PRINT-TO-STRING returns a string representation of <any>. If <string> is
specified it destructively writes that representation into <string>. If
<string> is not long enough NIL is returned. If <string> is not present
and the resulting representation is > 10000 characters NIL is returned.
First, the following files have to be changed to make Elisp recognize
that PRINT-TO-STRING is a function which takes optional arguments, up to
a maximum of two. The correct line which replacing the current line
about PRINT-TO-STRING is given:
/usr/lib/emacs/elisp/bfunctions
PRINT-TO-STRING 1375 0 <any> &optional <string>
/usr/lib/emacs/elisp/bfdoc
1375 PRINT-TO-STRING <any> &OPTIONAL <string>
/usr/lib/emacs/elisp/bfargs
PRINT-TO-STRING 1375 0
<emacssrc>/elisp/defbf.h
#define BF_PRINT_TO_STRING 1375
Finally, the code which implements PRINT-TO-STRING in
<emacssrc>/elisp/bprint.c needs to be put in. Here is the diff:
*** obprint.c Tue Feb 26 23:53:32 1985
--- bprint.c Wed Feb 27 15:29:40 1985
***************
*** 16,21
#include "misc.h"
#include "output.h"
#include "portdefs.h"
#include "create.h"
#include "enew.h"
#include "esymbols.h"
--- 16,22 -----
#include "misc.h"
#include "output.h"
#include "portdefs.h"
+ #include "llio.h"
#include "create.h"
#include "enew.h"
#include "esymbols.h"
***************
*** 162,170
case BF_PRINT_TO_STRING :
! fprintf(dbgfp,"Not implemented yet\n");
! return(Nil_Symbol);
!
break;
default :
--- 163,231 -----
case BF_PRINT_TO_STRING :
! { int slen = 80,len;
! char *pstring;
! Ptr_Port pptr;
! Elisp_Val rval;
! Bool create_string;
!
! if (nargs < 1 || nargs > 2) goto bad_n_args;
! arg1 = Get_Nth_Arg(1,nargs);
!
! /* destructively write into already existing string */
!
! if (nargs == 2) {
!
! arg2 = Get_Nth_Arg(2,2);
! if (!IS_STRING(arg2)) {
! bad_arg_number = 2;
! goto bad_arg;
! }
!
! pstring = Get_string_chars(arg2);
! len = Get_string_length(arg2);
! pptr = lle_new_str_port(Out_String,pstring,len);
!
! /* string not big enough? */
!
! if (afz_print_ev(arg1,pptr)) {
! free(pptr);
! return(Nil_Symbol);
! }
!
! len = pptr -> n_written;
! *(pstring + len) = '\0';
! Set_string_length(arg2,len);
! free(pptr);
! return(arg2);
!
! }
!
! ptsloop:
!
! if (0 == (pstring = (char *) malloc(slen))) return(Nil_Symbol);
! pptr = lle_new_str_port(Out_String,pstring,slen);
!
! /* end-of-string before end of print? */
!
! if (afz_print_ev(arg1,pptr)) {
! if (slen > 10000) {
! rval = Nil_Symbol;
! }
! else {
! slen *= 2;
! free(pstring);
! free(pptr);
! goto ptsloop;
! }
! }
! else {
! rval = adg_mk_string(pptr -> string_ptr,pptr -> n_written);
! };
!
! free(pstring);
! free(pptr);
! return(rval);
break;
}
***************
*** 166,172
return(Nil_Symbol);
break;
!
default :
fprintf(dbgfp,"Internal Elisp Case Error\n");
--- 227,235 -----
free(pptr);
return(rval);
break;
!
! }
!
default :
fprintf(dbgfp,"Internal Elisp Case Error\n");
--
-- JP Massar, Thinking Machines Corporation, Cambridge, MA
-- ihnp4!godot!massar
-- massar@cca-unix