save-exe: new function.

* lisplib.c (save_exe_instantiate, save_exe_set_entries): New
static functions.
(lisplib_init): Register auto-load of save-exe module, keyed
to save-exe symbol.

* share/txr/stdlib/save-exe.tl: New file.

* txr.1: Removing txr-embedded-arg.txr documentation and
documenting save-exe in its place.

* txr-embedded-arg.txr: File removed.

4 files changed, 86 insertions, 80 deletions

diff --git a/lisplib.c b/lisplib.c
index f548c360..5772845d 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -734,6 +734,24 @@ static val op_instantiate(val set_fun)
   return nil;
 }
 
+static val save_exe_instantiate(val set_fun)
+{
+  funcall1(set_fun, nil);
+  load(format(nil, lit("~asave-exe"), stdlib_path, nao));
+  return nil;
+}
+
+static val save_exe_set_entries(val dlt, val fun)
+{
+  val name[] = {
+    lit("save-exe"),
+    nil
+  };
+
+  set_dlt_entries(dlt, name, fun);
+  return nil;
+}
+
 val dlt_register(val dlt,
                  val (*instantiate)(val),
                  val (*set_entries)(val, val))
@@ -782,6 +800,8 @@ void lisplib_init(void)
   if (!opt_compat || opt_compat >= 185)
     dlt_register(dl_table, op_instantiate, op_set_entries);
 
+  dlt_register(dl_table, save_exe_instantiate, save_exe_set_entries);
+
   reg_fun(intern(lit("try-load"), system_package), func_n1(lisplib_try_load));
 }
 
diff --git a/share/txr/stdlib/save-exe.tl b/share/txr/stdlib/save-exe.tl
new file mode 100644
index 00000000..dada28a3
--- /dev/null
+++ b/share/txr/stdlib/save-exe.tl
@@ -0,0 +1,38 @@
+;; Copyright 2019
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright notice, this
+;;    list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright notice,
+;;    this list of conditions and the following disclaimer in the documentation
+;;    and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defun save-exe (path string)
+  (let* ((fbuf (file-get-buf txr-exe-path))
+         (bs (make-buf-stream fbuf))
+         (pre (progn
+                (stream-set-prop bs :byte-oriented t)
+                (scan-until-match #/@\(txr\)/ bs)))
+         (sbuf (ffi-put string (ffi (zarray 128 char)))))
+    (unless pre
+      (throwf 'error "~s: ~a isn't a TXR executable" 'save-txr-exe path))
+    (put-buf sbuf 0 bs)
+    (file-put-buf path fbuf)
+    (chmod path #o766)))
diff --git a/txr-embedded-arg.txr b/txr-embedded-arg.txr
deleted file mode 100755
index 8b48095d..00000000
--- a/txr-embedded-arg.txr
+++ /dev/null
@@ -1,32 +0,0 @@
-@(do
-   (defun stream-positioned-to-right-place (name)
-     (let* ((stream (open-file name "r+b"))
-            (pre (progn (stream-set-prop stream :byte-oriented t)
-                        (read-until-match #/@\(txr\)/ stream t))))
-       (when (or (empty pre) (not (search-str pre "@(txr)")))
-          (throwf 'error "~a isn't a TXR executable" name))
-       stream)))
-@(next :args)
-@(cases)
--w
-@string
-@file
-@  (eof)
-@  (do
-     (let* ((f (stream-positioned-to-right-place file))
-            (b (ffi-put string (ffi (zarray 128 char)))))
-       (put-buf b 0 f)))
-@(or)
-@file
-@  (eof)
-@  (do
-     (let ((f (stream-positioned-to-right-place file))
-           (b (make-buf 128)))
-       (fill-buf b 0 f)
-       (put-line (ffi-get b (ffi (zarray 128 char))))))
-@(or)
-@   (output)
-usage: @{self-path} [-w string] txr-executable
-@   (end)
-@   (do (exit 1))
-@(end)
diff --git a/txr.1 b/txr.1
index f915b133..ee97aaf7 100644
--- a/txr.1
+++ b/txr.1
@@ -65567,6 +65567,10 @@ and
 .code *args-full*
 variables).
 
+The function
+.code save-exe
+creates a copy of the \*(TX executable with a custom internal argument.
+
 .TP* Example:
 
 Suppose that \*(TX is copied to an executable in the same directory called
@@ -65649,66 +65653,42 @@ directory is a subdirectory of the executable directory.
 If one of these structures is not observed, the application
 may fail due to the failure of a library file to load.
 
-.coSS Utility program @ txr-embedded-arg.txr
+.coSS Function @ save-exe
 .synb
-.mets txr txr-embedded-arg.txr [ -w < new-string ] < executable
+.mets (save-exe < path << arg-string )
 .syne
 .desc
-At the root of the \*(TX source code tree, a program called
-.code txr-embedded-arg.txr
-is provided. This program can display or modify the
-embedded argument string inside a \*(TX executable.
-
 The
-.meta executable
-argument must always be present. It should refer to a \*(TX
-executable.
+.code save-exe
+function produces an edited copy of the \*(TX executable at the specified
+.metn path ,
+inserting
+.meta arg-string
+as the internal argument string.
 
-If the
-.code -w
-option and its
-.meta new-string
-argument are omitted, then
-.meta executable
-is examined, and the contents of embedded argument data
-area
-.code @(txr):
-are displayed on standard output (including all
-the padding/terminating null bytes), followed by a newline.
+In order for the copied executable to be useful, the required installation
+directory structure must be provided around it, as described in the
+previous section, Deployment Directory Structure.
 
-If
-.code -w
-option and its argument
-are present, then
-.code new-string
-is truncated to 127 bytes, if necessary, and written into
-the embedded argument data area of
-.codn executable ,
-padded with sufficient null bytes to write a complete unit of 128 bytes.
-Nothing is displayed on standard output.
+The return value of
+.code save-exe
+is unspecified.
 
-Note that
-.code new-string
-is treated as a UTF-8 representation. The 127 character limit is on the
-number of UTF-8 bytes, not Unicode characters.
+The
+.code arg-string
+should encode to 127 bytes of UTF-8 or less, or else it will be abruptly
+truncated, possibly in the middle of a UTF-8 sequence.
 
 .TP* Example:
 
-The following is a POSIX shell command, which writes a
-.code --args
-argument into the embedded data area of the
-"myapp" executable. This argument encodes two
-arguments:
-.code -e
-specifying an expression which will cause the executable
-to load a
-.str main.tl
-file that is co-located in the same directory as
-that executable.
+Create a copy of \*(TX called
+.code myapp
+which will load a file called
+.code main.tl
+that is located in the same directory.
 
 .cblk
-  txr txr-embedded-arg.txr \e
-    -w '--args=-e=(load `@{txr-path}main.tl`)' myapp
+  (save-exe "myapp" "--args|-e|(load `@(dir-name txr-path)/main.tl`)")
 .cble
 
 .SH* DEBUGGER