From 177964f81055367da1b7aec8638dfc8a63ec99c5 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 7 Feb 2020 19:01:35 -0800
Subject: file-put-buf: new argument; also, new file-place-buf

Like file-put-buf but doesn't overwrite the file.

* lisplib.c (getput_set_entries): New autoload for
file-place-buf.

* share/txr/stdlib/getput.tl (file-put-buf): New
argument for seeking into the file.
(file-place-buf): New function.

* txr.1: Documented.
---
 lisplib.c                  |  3 ++-
 share/txr/stdlib/getput.tl | 10 +++++++++-
 txr.1                      | 17 ++++++++++++++++-
 3 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/lisplib.c b/lisplib.c
index 73e9f286..8fc31c9a 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -516,7 +516,8 @@ static val getput_set_entries(val dlt, val fun)
     lit("file-get"), lit("file-put"), lit("file-append"),
     lit("file-get-string"), lit("file-put-string"), lit("file-append-string"),
     lit("file-get-lines"), lit("file-put-lines"), lit("file-append-lines"),
-    lit("file-get-buf"), lit("file-put-buf"), lit("file-append-buf"),
+    lit("file-get-buf"), lit("file-put-buf"),
+    lit("file-place-buf"), lit("file-append-buf"),
     lit("command-get"), lit("command-put"),
     lit("command-get-string"), lit("command-put-string"),
     lit("command-get-lines"), lit("command-put-lines"),
diff --git a/share/txr/stdlib/getput.tl b/share/txr/stdlib/getput.tl
index a50ee109..b075e812 100644
--- a/share/txr/stdlib/getput.tl
+++ b/share/txr/stdlib/getput.tl
@@ -84,8 +84,16 @@
   (with-stream (s (open-file name "rb"))
     (sys:get-buf-common s bytes seek)))
 
-(defun file-put-buf (name buf)
+(defun file-put-buf (name buf : (seek 0))
   (with-stream (s (open-file name "wb"))
+    (unless (zerop seek)
+      (seek-stream s seek :from-current))
+    (put-buf buf 0 s)))
+
+(defun file-place-buf (name buf : (seek 0))
+  (with-stream (s (open-file name "r+"))
+    (unless (zerop seek)
+      (seek-stream s seek :from-current))
     (put-buf buf 0 s)))
 
 (defun file-append-buf (name buf)
diff --git a/txr.1 b/txr.1
index 04d68357..9765dc2f 100644
--- a/txr.1
+++ b/txr.1
@@ -24990,7 +24990,8 @@ stream doesn't support seeking.
 
 .coNP Functions @, file-put-buf @ file-append-buf and @ command-put-buf
 .synb
-.mets (file-put-buf < name << buf )
+.mets (file-put-buf < name < buf << skip-bytes )
+.mets (file-place-buf < name < buf << skip-bytes )
 .mets (file-append-buf < name << buf )
 .mets (command-put-buf < cmd << buf )
 .syne
@@ -25003,6 +25004,20 @@ writes the contents of the buffer object
 .meta buf
 into the file, and then closes the file.  If the file doesn't exist, it is
 created.  If it exists, it is truncated to zero length and overwritten.
+The default value of the optional
+.meta skip-bytes
+parameter is zero. If an argument is given, it must be a non-negative integer.
+If it is nonzero, then after opening the file, before writing the buffer,
+the function will seek to an offset of that many bytes from the start of the
+file. The contents of
+.meta buf
+will be written at that offset.
+
+The
+.code file-place-buf
+function doees not truncate an existing file to zero length.
+In all other regards, it is equivalent to
+.codn file-put-buf .
 
 The
 .code file-append-buf
-- 
cgit v1.2.3