[Gcl-commits] gcl ofile.d debian/changelog lsp/gcl_iolib.lsp

[Camm Maguire]

CVSROOT:        /cvsroot/gcl
Module name:    gcl
Changes by:     Camm Maguire <camm>     06/06/18 16:16:41

Modified files:
        o              : file.d 
        debian         : changelog 
        lsp            : gcl_iolib.lsp 

Log message:
        preliminary temp stream facility

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/gcl/o/file.d?cvsroot=gcl&r1=1.63&r2=1.64
http://cvs.savannah.gnu.org/viewcvs/gcl/debian/changelog?cvsroot=gcl&r1=1.1090&r2=1.1091
http://cvs.savannah.gnu.org/viewcvs/gcl/lsp/gcl_iolib.lsp?cvsroot=gcl&r1=1.12&r2=1.13

Patches:
Index: o/file.d
===================================================================
RCS file: /cvsroot/gcl/gcl/o/file.d,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -b -r1.63 -r1.64
--- o/file.d    7 Jun 2006 15:04:58 -0000       1.63
+++ o/file.d    18 Jun 2006 16:16:41 -0000      1.64
@@ -147,6 +147,35 @@
        FEerror("Unexpected end of ~S.", 1, strm);
 }
 
+DEFUNO_NEW("TEMP-STREAM",object,fStemp_stream,SI
+          ,2,2,NONE,OO,OO,OO,OO,void,siLtemp_stream,(object x,object ext),"") {
+  
+  object st;
+  char *c,*d;
+  int l;
+  check_type(x,t_string);
+  check_type(ext,t_string);
+  if (!(c=alloca(x->st.st_fillp+ext->st.st_fillp+8)))
+    FEerror("Cannot allocate temp name space",0);
+  if (!(d=alloca(x->st.st_fillp+ext->st.st_fillp+8)))
+    FEerror("Cannot allocate temp name space",0);
+  memcpy(c,x->st.st_self,x->st.st_fillp);
+  memcpy(c+x->st.st_fillp,"XXXXXX",6);
+  c[x->st.st_fillp+6]=0;
+  l=mkstemp(c);
+  memcpy(d,c,x->st.st_fillp+6);
+  memcpy(d+x->st.st_fillp+6,".",1);
+  memcpy(d+x->st.st_fillp+7,ext->st.st_self,ext->st.st_fillp);
+  d[x->st.st_fillp+ext->st.st_fillp+7]=0;
+  if (rename(c,d))
+    FEerror("Cannot rename ~s to 
~s",2,make_simple_string(c),make_simple_string(d));
+  st=make_simple_string(d);
+  x=open_stream(st,smm_output,sKsupersede,Cnil);
+  close(l);
+  RETURN1(x);
+
+}
+
 DEFUNO_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI
          ,1,1,NONE,OO,OO,OO,OO,void,siLterminal_input_stream_p,(object x),"")
 {

Index: debian/changelog
===================================================================
RCS file: /cvsroot/gcl/gcl/debian/changelog,v
retrieving revision 1.1090
retrieving revision 1.1091
diff -u -b -r1.1090 -r1.1091
--- debian/changelog    17 Jun 2006 19:26:58 -0000      1.1090
+++ debian/changelog    18 Jun 2006 16:16:41 -0000      1.1091
@@ -181,8 +181,9 @@
     conversion),speed up proper-list type-or, give fdefinition a lisp
     definition to set up the prototype (removes a number of * returns)
   * eq uniq types, values return type autoproclamation support
+  * preliminary temp stream facility
 
- -- Camm Maguire <address@hidden>  Sat, 17 Jun 2006 19:26:49 +0000
+ -- Camm Maguire <address@hidden>  Sun, 18 Jun 2006 16:16:21 +0000
 
 gclcvs (2.7.0-53) unstable; urgency=low
 

Index: lsp/gcl_iolib.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/lsp/gcl_iolib.lsp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- lsp/gcl_iolib.lsp   5 Jun 2006 22:02:45 -0000       1.12
+++ lsp/gcl_iolib.lsp   18 Jun 2006 16:16:41 -0000      1.13
@@ -230,6 +230,10 @@
          ((subtypep1 (stream-element-type ostream) 'character)
           (length (let ((*print-escape* nil)) (write-to-string object)))))))
 
+(defmacro with-temp-file ((s pn) (tmp ext) &rest body) 
+  `(let* ((,s (temp-stream ,tmp ,ext)) 
+         (,pn (stream-object1 ,s))) 
+     (unwind-protect (progn ,@body) (close ,s))))
 
 (defmacro with-open-file ((stream . filespec) . body)
   (declare (optimize (safety 1)))