summaryrefslogtreecommitdiffstats
path: root/script.c
diff options
context:
space:
mode:
authorRob Browning <rlb@cs.utexas.edu>1997-12-12 17:29:42 -0600
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:24 -0800
commitf64b2806c1d66a1341bb8b1491f384169ab1d65f (patch)
tree8b97dbe3640c60927959b0e63461ef9fcae591e0 /script.c
parent6dcb175d7f34d9f5a0b3ba623f94454ec16a73d6 (diff)
parent1edcb9b62a1a520eddae8403c19d841c9b18737f (diff)
downloadscm-f64b2806c1d66a1341bb8b1491f384169ab1d65f.tar.gz
scm-f64b2806c1d66a1341bb8b1491f384169ab1d65f.zip
Import Debian changes 5b3-1debian/5b3-1
scm (5b3-1) unstable; urgency=low * New maintainer * New version * libc6
Diffstat (limited to 'script.c')
-rw-r--r--script.c384
1 files changed, 384 insertions, 0 deletions
diff --git a/script.c b/script.c
new file mode 100644
index 0000000..e1a63f1
--- /dev/null
+++ b/script.c
@@ -0,0 +1,384 @@
+/* Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING. If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE. If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way. To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.
+ */
+
+/* "script.c" argv tricks for `#!' scripts.
+ Author: Aubrey Jaffer */
+
+#include <ctype.h>
+#include "scm.h"
+
+#ifdef __IBMC__
+# include <io.h>
+#endif /* def __IBMC__ */
+
+#ifdef linux
+# include <unistd.h> /* for X_OK define */
+#endif /* def linux */
+#ifdef __svr4__
+# include <unistd.h> /* for X_OK define */
+#else
+# ifdef __sgi__
+# include <unistd.h> /* for X_OK define */
+# endif /* def __sgi__ */
+#endif /* def __svr4__ */
+
+/* Concatentate str2 onto str1 at position n and return concatenated
+ string if file exists; 0 otherwise. */
+
+char *scm_cat_path(str1, str2, n)
+ char *str1;
+ const char *str2;
+ long n;
+{
+ if (!n) n = strlen(str2);
+ if (str1)
+ {
+ long len = strlen(str1);
+ str1 = (char *)realloc(str1, (sizet)(len + n + 1));
+ if (!str1) return 0L;
+ strncat(str1 + len, str2, n);
+ return str1;
+ }
+ str1 = (char *)malloc((sizet)(n + 1));
+ if (!str1) return 0L;
+ str1[0] = 0;
+ strncat(str1, str2, n);
+ return str1;
+}
+
+char *scm_try_path(path)
+ char *path;
+{
+ FILE *f;
+ /* fprintf(stderr, "Trying %s\n", path);fflush(stderr); */
+ if (!path) return 0L;
+ SYSCALL(f = fopen(path, "r"););
+ if (f) {
+ fclose(f);
+ return path;
+ }
+ free(path);
+ return 0L;
+}
+
+char *scm_sep_init_try(path, sep, initname)
+ char *path;
+ const char *sep, *initname;
+{
+ if (path) path = scm_cat_path(path, sep, 0L);
+ if (path) path = scm_cat_path(path, initname, 0L);
+ return scm_try_path(path);
+}
+
+#ifndef LINE_INCREMENTORS
+# define LINE_INCREMENTORS '\n'
+# ifdef MSDOS
+# define WHITE_SPACES ' ':case '\t':case '\r':case '\f':case 26
+# else
+# define WHITE_SPACES ' ':case '\t':case '\r':case '\f'
+# endif /* def MSDOS */
+#endif /* ndef LINE_INCREMENTORS */
+
+#ifndef MAXPATHLEN
+# define MAXPATHLEN 80
+#endif /* ndef MAXPATHLEN */
+#ifndef X_OK
+# define X_OK 1
+#endif /* ndef X_OK */
+
+#ifdef unix
+# include <stdio.h>
+
+char *script_find_executable(name)
+ const char *name;
+{
+ char tbuf[MAXPATHLEN];
+ int i = 0;
+ FILE *f;
+
+ /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */
+ if (access(name, X_OK)) return 0L;
+ f = fopen(name, "r");
+ if (!f) return 0L;
+ if ((fgetc(f)=='#') && (fgetc(f)=='!')) {
+ while (1) switch (tbuf[i++] = fgetc(f)) {
+ case /*WHITE_SPACES*/ ' ':case '\t':case '\r':case '\f':
+ case EOF:
+ tbuf[--i] = 0;
+ fclose(f);
+ return scm_cat_path(0L, tbuf, 0L);
+ }
+ }
+ fclose(f);
+ return scm_cat_path(0L, name, 0L);
+}
+#endif /* unix */
+
+#ifdef MSDOS
+
+# define DEFAULT_PATH "C:\\DOS"
+# define PATH_DELIMITER ';'
+# define ABSOLUTE_FILENAME_P(fname) ((fname[0] == '\\') \
+ || (fname[0] && (fname[1] == ':')))
+
+char *dld_find_executable(file)
+ const char *file;
+{
+ /* fprintf(stderr, "dld_find_executable %s -> %s\n", file, scm_cat_path(0L, file, 0L)); fflush(stderr); */
+ return scm_cat_path(0L, file, 0L);
+}
+#endif /* def MSDOS */
+
+/* Given dld_find_executable()'s best guess for the pathname of this
+ executable, find (and verify the existence of) initname in the
+ implementation-vicinity of this program. Returns a newly allocated
+ string if successful, 0 if not */
+
+char *scm_find_impl_file(exec_path, generic_name, initname, sep)
+ char *exec_path;
+ const char *generic_name, *initname, *sep;
+{
+ char *sepptr = strrchr(exec_path, sep[0]);
+ char *extptr = exec_path + strlen(exec_path);
+ char *path = 0;
+ /* fprintf(stderr, "dld_find_e %s\n", exec_path); fflush(stderr); */
+ if (sepptr) {
+ long sepind = sepptr - exec_path + 1L;
+
+ /* In case exec_path is in the source directory, look first in
+ exec_path's directory. */
+ path = scm_cat_path(0L, exec_path, sepind - 1L);
+ path = scm_sep_init_try(path, sep, initname);
+ if (path) return path;
+
+#ifdef MSDOS
+ if (!strcmp(extptr - 4, ".exe") || !strcmp(extptr - 4, ".com") ||
+ !strcmp(extptr - 4, ".EXE") || !strcmp(extptr - 4, ".COM"))
+ extptr = extptr - 4;
+#endif /* def MSDOS */
+
+ if (generic_name &&
+ !strncmp(exec_path + sepind, generic_name, extptr - exec_path))
+ generic_name = 0;
+
+ /* If exec_path is in directory "exe" or "bin": */
+ path = scm_cat_path(0L, exec_path, sepind - 1L);
+ sepptr = path + sepind - 4;
+ if (!strcmp(sepptr, "exe") || !strcmp(sepptr, "bin") ||
+ !strcmp(sepptr, "EXE") || !strcmp(sepptr, "BIN")) {
+ char *peer;
+
+ /* Look for initname in peer directory "lib". */
+ if (path) {
+ strncpy(sepptr, "lib", 3);
+ path = scm_sep_init_try(path, sep, initname);
+ if (path) return path;
+ }
+
+ /* Look for initname in peer directories "lib" and "src" in
+ subdirectory with the name of the executable (sans any type
+ extension like .EXE). */
+ for(peer="lib";!0;peer="src") {
+ path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L);
+ if (path) {
+ strncpy(path + sepind - 4, peer, 3);
+ path[extptr - exec_path] = 0;
+ path = scm_sep_init_try(path, sep, initname);
+ if (path) return path;
+ }
+ if (!strcmp(peer,"src")) break;
+ }
+
+ if (generic_name) {
+
+ /* Look for initname in peer directories "lib" and "src" in
+ subdirectory with the generic name. */
+ for(peer="lib";!0;peer="src") {
+ path = scm_cat_path(0L, exec_path, sepind);
+ if (path) {
+ strncpy(path + sepind - 4, "lib", 3);
+ path = scm_cat_path(path, generic_name, 0L);
+ path = scm_sep_init_try(path, sep, initname);
+ if (path) return path;
+ }
+ if (!strcmp(peer,"src")) break;
+ }}}
+
+#ifdef MSDOS
+ if (strlen(extptr)) {
+ /* If exec_path has type extension, look in a subdirectory with
+ the name of the executable sans the executable file's type
+ extension. */
+ path = scm_cat_path(0L, exec_path, extptr - exec_path + 0L);
+ path = scm_sep_init_try(path, sep, initname);
+ if (path) return path;
+
+ if (generic_name) {
+
+ /* Also look in generic_name subdirectory. */
+ path = scm_cat_path(0L, exec_path, sepind);
+ if (path) path = scm_cat_path(path, generic_name, 0L);
+ path = scm_sep_init_try(path, sep, initname);
+ if (path) return path;
+ }}
+#endif /* def MSDOS */
+ }
+ else {
+
+ /* We don't have a parse-able exec_path. The only path to try is
+ just initname. */
+ path = scm_cat_path(0L, initname, 0L);
+ if (path) path = scm_try_path(path);
+ if (path) return path;
+ }
+ return 0L;
+}
+
+char *script_read_arg(f)
+ FILE *f;
+{
+ sizet tlen = 1;
+ int tind = 0, qted = 0, chr;
+ char *tbuf = (char *)malloc((1 + tlen) * sizeof(char));
+ if (!tbuf) return 0L;
+ while (1) switch (chr = getc(f)) {
+ case WHITE_SPACES:
+ continue;
+ case LINE_INCREMENTORS:
+ case EOF:
+ free(tbuf);
+ return 0L;
+ default:
+ goto morearg;
+ }
+morearg:
+ while (1) {
+ switch (tbuf[tind++] = chr) {
+ case WHITE_SPACES:
+ case LINE_INCREMENTORS:
+ if (qted) break;
+ case EOF: goto endarg;
+ case '!':
+ if (qted) break;
+ switch (chr = getc(f)) {
+ case '#':
+ if (1==tind) return 0L;
+ goto endarg;
+ default: tbuf[tind++] = chr; break;
+ }
+ break;
+ case '"': qted = !qted; tind--; break;
+ case '\\':
+ switch (tbuf[tind - 1] = getc(f)) {
+ case '\n': --tind; break;
+ case 'n': tbuf[tind - 1] = '\n'; break;
+ case 'r': tbuf[tind - 1] = '\r'; break;
+ case 't': tbuf[tind - 1] = '\t'; break;
+ case 'b': tbuf[tind - 1] = '\b'; break;
+ /* case '0': tbuf[tind - 1] = '\0'; break; */
+ default:;
+ }
+ default:;
+ }
+ if (tind >= tlen) {
+ tbuf = (char *)realloc(tbuf, (1 + (2 * tlen)) * sizeof(char));
+ if (!tbuf) return 0L;
+ tlen = 2 * tlen;
+ }
+ chr = getc(f);
+ }
+endarg:
+ tbuf[--tind] = 0;
+ return tbuf;
+}
+
+int script_meta_arg_P(arg)
+ char *arg;
+{
+ if ('\\' != arg[0]) return 0L;
+#ifdef MSDOS
+ return !arg[1];
+#else
+ switch (arg[1]) {
+ case 0:
+ case '%':
+ case WHITE_SPACES: return !0;
+ default: return 0L;}
+#endif
+}
+
+char **script_process_argv(argc, argv)
+ int argc;
+ char **argv;
+{
+ int nargc = argc, argi = 1, nargi = 1;
+ char *narg, **nargv;
+ if (!(argc > 2 && script_meta_arg_P(argv[1]))) return 0L;
+ if (!(nargv = (char **)malloc((1 + nargc) * sizeof(char*)))) return 0L;
+ nargv[0] = argv[0];
+ while (((argi+1) < argc) && (script_meta_arg_P(argv[argi]))) {
+ FILE *f = fopen(argv[++argi], "r");
+ if (f) {
+ nargc--; /* to compensate for replacement of '\\' */
+ while (1) switch (getc(f)) {
+ case EOF: return 0L;
+ default: continue;
+ case '\n': goto found_args;
+ }
+ found_args: while ((narg = script_read_arg(f)))
+ if (!(nargv = (char **)realloc(nargv, (1 + ++nargc) * sizeof(char*))))
+ return 0L;
+ else nargv[nargi++] = narg;
+ fclose(f);
+ nargv[nargi++] = argv[argi++];
+ }
+ }
+ while (argi <= argc) nargv[nargi++] = argv[argi++];
+ return nargv;
+}
+
+int script_count_argv(argv)
+ char **argv;
+{
+ int argc = 0;
+ while (argv[argc]) argc++;
+ return argc;
+}