Stand-alone application support.

* txr.c (sysroot_init): Don't print "unable to calculate
sysroot" error message in the fallback case, and
use the absolute path of the executable directory
as the sysroot in this case.
(txr_main): Define static area prefixed by @(txr): header. If
a string is present in this data area then process it as an
argument.  Treat the *args* variable carefully.  If we use the
stored string as the argument, save the args in orig_args
variable, then later bind *args* to that. In the -e, -p and
related options processing, we bind *args* to the original
list so args are available to the expression being evaluated.
If the expression mutates *args* then we keep the mutated args
whether or not we are processing the stored string.

* txr.1: Documented in new sction, STAND-ALONE
APPLICATION SUPPORT.

2 files changed, 150 insertions, 18 deletions

diff --git a/txr.1 b/txr.1
index 4ad3ebbb..ebb4d7dc 100644
--- a/txr.1
+++ b/txr.1
@@ -42479,6 +42479,113 @@ running with setuid privilege. No group IDs are added to the list which
 need to be retracted when privileges are dropped. The supplementary
 groups also persist across the execution of a setuid/setgid script.
 
+.SH* STAND-ALONE APPLICATION SUPPORT
+
+The \*(TX executable image supports a general mechanism by means of which
+a custom program can be packaged as an apparent stand-alone executable.
+
+.SS* The Internal Argument String
+
+The \*(TX executable contains a 128 byte data area preceded by the
+seven-byte ASCII character sequence
+.strn @(txr): .
+The 128 byte data area which follows this identifying prefix
+represents a null-terminated UTF-8 string. In the stock executable,
+this area is filled with null bytes.
+
+If the \*(TX executable is edited such that this area is replaced
+with a non-empty, null-terminated UTF-8 string, the program will,
+for the purposes of command line argument processing, treat this string as if
+it were the one and only command line argument. (The original command
+line arguments are still retained in the
+.code *args*
+and
+.code *args-full*
+variables).
+
+.TP* Example:
+
+Suppose that \*(TX is copied to an executable in the same directory called
+.code myapp
+(or
+.code myapp.exe
+on an operating system which requires the
+.code .exe
+suffix). Also suppose that in the same directory, there exists a file
+called
+.codn myscript.tl .
+
+This
+.code myapp
+executable can then be edited so that the data area which follows the
+.code @(txr):
+bytes contains the following string:
+
+.cblk
+  --args|-e|(load `@{txr-path}/main.tl`)
+.cble
+
+When the
+.code myapp
+executable is invoked, it will process the above string as a single
+command line argument, causing the
+.code main.tl
+\*(TL source file to be loaded.
+Any arguments passed to
+.code myapp
+are ignored and available to
+.code main.tl
+via the
+.code *args*
+variable.
+
+.SS* Deployment Directory Structure
+
+The \*(TX executable may require library files, depending on the
+functionality invoked by the program code. Library files are located
+relative to the installation directory, called the
+.IR sysroot .
+The executable tries to dynamically determine the sysroot from
+its own location, according to this directory structure:
+
+.cblk
+  /path/to/sysroot/bin/txr
+               .../share/txr/stdlib/cadr.tl
+                         .../stdlib/except.tl
+                                    ...
+.cble
+
+The above structure is assumed if the executable finds itself
+in a directory named
+.strn bin .
+
+Otherwise, if the executable finds itself in a directory not
+named
+.strn bin ,
+the following structure is expected:
+
+.cblk
+  /path/to/installation/txr
+                    .../share/txr/stdlib/cadr.tl
+                    .../share/txr/stdlib/except.tl
+                                         ...
+.cble
+
+When a custom application is deployed using a possibly renamed
+.code txr
+executable, one of the above structures should be observed:
+either the sysroot with a
+.code bin
+subdirectory where the executable is located, on the
+same level with the
+.code share
+directory, or else the second structure in which the
+.code share
+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.
+
+
 .SH* DEBUGGER
 \*(TX has a simple, crude, built-in debugger. The debugger is invoked by adding
 the
diff --git a/txr.c b/txr.c
index 5243c941..ef82c84a 100644
--- a/txr.c
+++ b/txr.c
@@ -295,6 +295,8 @@ static val sysroot(val target)
 
 static void sysroot_init(void)
 {
+  val prog_dir;
+
 #if HAVE_WINDOWS_H
   val slash = regex_compile(lit("\\\\"), nil);
 #endif
@@ -303,6 +305,7 @@ static void sysroot_init(void)
 #if HAVE_WINDOWS_H
   prog_path = regsub(slash, lit("/"), prog_path);
 #endif
+  prog_dir = dirname(prog_path);
 
   if (!(maybe_sysroot(lit(TXR_REL_PATH)) ||
         maybe_sysroot(lit(TXR_REL_PATH EXE_SUFF)) ||
@@ -310,9 +313,7 @@ static void sysroot_init(void)
         maybe_sysroot(lit(PROG_NAME EXE_SUFF)) ||
         maybe_sysroot(substitute_basename(lit(TXR_REL_PATH), prog_path))))
   {
-    format(std_error, lit("~a: unable to calculate sysroot\n"),
-           prog_string, nao);
-    sysroot_path = lit("");
+    sysroot_path = prog_dir;
   }
 
   stdlib_path = sysroot(lit("share/txr/stdlib"));
@@ -322,7 +323,7 @@ static void sysroot_init(void)
            toint(lit(TXR_VER), nil));
   reg_varl(intern(lit("txr-version"), user_package),
            toint(lit(TXR_VER), nil));
-  reg_varl(intern(lit("txr-path"), user_package), dirname(prog_path));
+  reg_varl(intern(lit("txr-path"), user_package), prog_dir);
 }
 
 static int license(void)
@@ -438,6 +439,7 @@ static void no_dbg_support(val arg)
 
 int txr_main(int argc, char **argv)
 {
+  uses_or2;
   val specstring = nil;
   val spec = nil;
   val spec_file = nil;
@@ -453,8 +455,11 @@ int txr_main(int argc, char **argv)
   val self_path_s = intern(lit("self-path"), user_package);
   val compat_var = lit("TXR_COMPAT");
   val compat_val = getenv_wrap(compat_var);
+  val orig_args = nil;
   list_collect_decl(arg_list, arg_tail);
 
+  static char alt_args_buf[128 + 7] = "@(txr):", *alt_args = alt_args_buf + 7;
+
   setvbuf(stderr, 0, _IOLBF, 0);
 
   if (compat_val && length(compat_val) != zero) {
@@ -480,7 +485,10 @@ int txr_main(int argc, char **argv)
 
   arg_list = cdr(arg_list);
 
-  if (argc <= 1) {
+  if (*alt_args) {
+    orig_args = arg_list;
+    arg_list = list(string_utf8(alt_args), nao);
+  } else if (argc <= 1) {
     drop_privilege();
 #if HAVE_TERMIOS
     banner();
@@ -710,32 +718,49 @@ int txr_main(int argc, char **argv)
         break;
       case 'e':
         drop_privilege();
-        reg_varl(self_path_s, lit("cmdline-expr"));
-        reg_var(args_s, arg_list);
-
-        eval_intrinsic(lisp_parse(arg, std_error, colon_k,
-                                  lit("cmdline-expr"), colon_k),
-                       make_env(bindings, nil, nil));
-        evaled = t;
-        arg_list = cdr(lookup_global_var(args_s));
+        {
+          val args_saved = or2(orig_args, arg_list);
+          val args_new;
+
+          reg_varl(self_path_s, lit("cmdline-expr"));
+          reg_var(args_s, or2(orig_args, arg_list));
+
+          eval_intrinsic(lisp_parse(arg, std_error, colon_k,
+                                    lit("cmdline-expr"), colon_k),
+                         make_env(bindings, nil, nil));
+          evaled = t;
+          args_new = cdr(lookup_global_var(args_s));
+
+          if (args_new != args_saved) {
+            arg_list = args_new;
+            orig_args = nil;
+          }
+        }
         break;
       case 'p':
       case 'P':
       case 't':
+        drop_privilege();
         {
           val (*pf)(val obj, val out) = if3(c_chr(opt) == 'p',
                                             prinl,
                                             if3(c_chr(opt) == 'P',
                                                 pprinl,
                                                 tprint));
-          drop_privilege();
+          val args_saved = or2(orig_args, arg_list);
+          val args_new;
+
           reg_varl(self_path_s, lit("cmdline-expr"));
-          reg_var(args_s, arg_list);
+          reg_var(args_s, or2(orig_args, arg_list));
           pf(eval_intrinsic(lisp_parse(arg, std_error, colon_k,
                                        lit("cmdline-expr"), colon_k),
                             make_env(bindings, nil, nil)), std_output);
           evaled = t;
-          arg_list = cdr(lookup_global_var(args_s));
+          args_new = cdr(lookup_global_var(args_s));
+          if (args_new != args_saved) {
+            arg_list = args_new;
+            orig_args = nil;
+          }
         }
         break;
       }
@@ -871,7 +896,7 @@ int txr_main(int argc, char **argv)
     }
   }
 
-  reg_var(args_s, arg_list);
+  reg_var(args_s, or2(orig_args, arg_list));
   reg_varl(intern(lit("self-path"), user_package), spec_file_str);
 
   if (!txr_lisp_p)
@@ -926,7 +951,7 @@ repl:
            lit("Note: operating in TXR ~a compatibility mode "
                "due to environment variable.\n"),
            num(opt_compat), nao);
-  reg_var(args_s, arg_list);
+  reg_var(args_s, or2(orig_args, arg_list));
   reg_varl(intern(lit("self-path"), user_package), lit("listener"));
   repl(bindings, std_input, std_output);
 #endif