// The beastie main program // // This file is part of Beastie // SPDX-FileCopyrightText: 2023 Norman Gray // SPDX-License-Identifier: BSD-2-Clause #if __GNUC__ && !defined(__clang__) // When used with -std=c99, gcc doesn't define various functions // unless various feature-test macros are defined. // Here, we want setenv and some others. // See feature_test_macros(7) // // both llvm and GCC define __GNUC__, but only the former defines __clang__ // (see discussion in README-developer.md) #define _XOPEN_SOURCE 600 #endif #include "config.h" #include #include #include #include #include #include #if HAVE_ALLOCA_H #include #endif #include "beastie.h" #include "core.h" #include "util.h" #include "util-extra.h" #include "version.h" static const char version_string[] = "version " BEASTIE_VERSION ", " BEASTIE_RELEASEDATE; static const char* progname; extern int biblineno; extern int bstlineno; extern int auxlineno; extern int auxdebug; extern int authorsdebug; extern int markdowndebug; extern int mdinlinedebug; s7_scheme* S7; void Usage(int exit_status) { fprintf((exit_status == 0 ? stdout : stderr), "Usage: %s [opts] [file.aux/bib/bst/scm/md]\n" "\n" "opts: [-EhqrvV] [-d int] [-e '(expr)']\n" " [-I input] [-O output] [-l loadfile] [-m module]\n" "input: bib | bst | scm | aux | md | json\n" "output: sxml | json | bstscm | xml | xhtml | python | bib\n", progname); exit(exit_status); } static void set_debug_flags(const char* flag_string) { s7_int flags; if (flag_string == NULL) { return; // JUMP OUT, without error } else if (*flag_string == '\0') { //fprintf(stderr, "Missing argument to -d\n"); flags = 0; } else { char* endptr; flags = (s7_int)strtol(flag_string, &endptr, 0); if (*endptr != '\0') { fprintf(stderr, "Malformed debug-flags argument -d %s (ignored)\n", flag_string); return; // JUMP OUT } } // the following flags must match the numbers declared // for the macro %module-verbosity-flag% in the // various .scm modules authorsdebug = flags & 4; auxdebug = flags & 8; markdowndebug = flags & 32; mdinlinedebug = flags & 32; // fprintf(stderr, "debug=%ld\n", flags); if (flags < 0) { scheme_eval("verbosity", s7_make_integer(S7, 0xffffffff), NULL); } else { scheme_eval("verbosity", s7_make_integer(S7, flags), NULL); } scheme_eval("verbosity", s7_make_symbol(S7, "up"), NULL); } int main(int argc, char** argv) { enum { input_none, // don't expect anything from stdin input_bib, input_bst, input_scm, input_repl, input_aux, input_markdown, input_json, input_show_version // no input, just show version and exit } input_type = input_bib; enum { output_sexp, output_json, output_bstscm, output_xml, output_xhtml, output_python, output_bib } output_type = output_sexp; int local_verbosity = 1; // as opposed to the verbosity in runtime.scm char emacs_repl = 0; // if true, force an emacs-compatbile REPL StringBuilder command_line_exprs = NULL; // accumulate -e option values progname = argv[0]; S7 = s7_init(); { // Information about beastie itself. // All of these should be read-only. // // Some are filled in by core.c:initialise_runtime // // Doing this this way feels vaguely clumsy, as if I should be // reading a .scm file generated by the Makefile, but any // alternative seems to end up oddly much more intricate than // I expect. int v[] = {BEASTIE_VERSIONINTS,0,0,0,0}; // {n,m,p,0,0,0,0} s7_pointer l = s7_inlet(S7, s7_list(S7, 9, s7_cons(S7, s7_make_symbol(S7, "version-string"), s7_make_string(S7, version_string)), s7_cons(S7, s7_make_symbol(S7, "version-integers"), s7_list(S7, 4, s7_make_integer(S7, v[0]), s7_make_integer(S7, v[1]), s7_make_integer(S7, v[2]), s7_make_integer(S7, v[3]))), s7_cons(S7, s7_make_symbol(S7, "date"), s7_make_string(S7, BEASTIE_RELEASEDATE)), s7_cons(S7, s7_make_symbol(S7, "revision"), s7_make_string(S7, BEASTIE_REVISION)), s7_cons(S7, s7_make_symbol(S7, "s7-version"), s7_make_string(S7, S7_VERSION ", " S7_DATE)), s7_cons(S7, s7_make_symbol(S7, "build-platform"), s7_make_string(S7, BEASTIE_BUILD_PLATFORM)), // the following three aren't currently documented, // but are here mostly for runtime.scm:main/version s7_cons(S7, s7_make_symbol(S7, "_repository-info"), s7_make_string(S7, BEASTIE_HOMEREPO ", " BEASTIE_VCSINFO)), s7_cons(S7, s7_make_symbol(S7, "_copyright+licence"), s7_make_string(S7, "Copyright Norman Gray, " BEASTIE_COPYRIGHTYEARS ", available under the 2-clause BSD licence")), s7_cons(S7, s7_make_symbol(S7, "_homepage"), s7_make_string(S7, BEASTIE_HOMEPAGE)))); const char* ldoc = "`(*beastie* 'key)` : return information about beastie.\n" "The `key` can be:\n" " * `version-string` : show the beastie version, as a string\n" " * `version-integers` : show the beastie version, as a list of integers.\n" " * `date` : the beastie release date\n" " * `icu-version` : if ICU is compiled in, this is\n" // initialised later " a list containing the ICU major, minor and patchlevel version numbers;\n" " else `#f`\n" " * `icu-version-string` : if ICU is compiled in,\n" // later " this is a major.minor.patch version string\n" " * `unicode-version` : the (string) version of the Unicode Character Database\n" " which is built in (and used either with ICU or internal support).\n" " * `build-platform` : the platform which the program\n" " was built on, as a string\n" " * `run-platform` : the platform the program\n" // later " is running on, as a string\n" "\n" "Returns an undefined value if the key is unrecognised."; s7_define_constant_with_documentation(S7, "*beastie*", l, ldoc); } // prefer more prolix stack traces by default s7_eval_c_string(S7, "(set! (*s7* 'stacktrace-defaults) '(30 80 120 80 #f))"); initialise_runtime(S7); set_debug_flags(getenv("BEASTIE_DEBUG_FLAGS")); { // if we are invoked using the name 'repl', then force repl mode char* slash = strrchr(progname, '/'); if (slash == NULL) { if (strcmp(progname, "repl") == 0) { input_type = input_repl; } } else if (strcmp(slash+1, "repl") == 0) { input_type = input_repl; } // We want to adjust option processing in the input_repl case. // This is because by default Emacs will add an option // `-emacs` (though not in every case), and we want to treat // this the same as (our) option -E. Same for -band. // The MIT scheme manpage suggests that these _should_ be // options --emacs and --band, but the single-dash cases are // what xscheme.el actually does. } // GNU getopt permutes its options by default, // unless POSIXLY_CORRECT is set. // If this permutation is allowed to happen, then script options, // after a .scm argument, are moved forward to being ./beastie options, // which isn't right. setenv("POSIXLY_CORRECT", "1", 0); int ch; while ((ch = getopt(argc, argv, "d:D:e:EhI:l:L:m:O:qrvV")) != -1) { switch (ch) { case 'e': // argument is (expr ...) if (input_type == input_repl && strcmp(optarg, "macs") == 0) { // special case: this is the REPL, and we've been // given option -emacs (by xscheme.el) emacs_repl = 1; } else { // we're not sophisticated here: we simple concatenate // all of the -e arguments into one string which is // evaluated below, and don't try to ensure that each // -e option is a separate expr if (command_line_exprs == NULL) { if ((command_line_exprs = make_stringbuilder()) == NULL) { error_exit("Can't allocate stringbuilder for expr!"); } } else { // separate -e arguments // (partly so that -e '(pri' -e 'ntf "boo")' won't work) stringbuilder_append_c(command_line_exprs, '\n'); } stringbuilder_append_s(command_line_exprs, optarg); } break; case 'E': emacs_repl = 1; break; case 'l': if (! s7_load(S7, optarg)) { error_exit("Can't load file %s", optarg); } break; case 'L': { char *errmsg; if (unicode_set_locale(optarg, &errmsg) != 0) { error_exit("Unable to set local %s: %s", optarg, errmsg); } if (local_verbosity > 1) { fprintf(stderr, "locale set to %s\n", unicode_get_locale()); } } break; case 'D': // This option is documented, in doc/beastie.1 with 'This // option does noting useful in this version of beastie.' // // This was originally intended to be a way of setting // scheme or .bst variables on the command line, but // setting scheme variables can probably be more clearly // done with the `-e` option, and setting .bst variables is // possibly now complicated in the current // (re-re-)implementation of bst.scm (true?), so this // would require more thought. Most recently, this turned // into a configuratiom mechanism, but the configuration // stuff is now controlled primarily by environment // variables. // // I may resuscitate that in future, so don't delete the // following code quite yet. #if 1 error_exit("Don't use the -D option in this version of beastie"); #else { char* equals = strchr(optarg, '='); s7_pointer v; if (equals == NULL) { v = s7_make_integer(S7, 1); } else { *equals = '\0'; equals++; if (*equals == '\0') { v = s7_f(S7); } else { char* endp; int i = strtol(equals, &endp, 10); if (*endp == '\0') { v = s7_make_integer(S7, i); } else { v = s7_make_string(S7, equals); } } } scheme_eval("config", s7_make_symbol(S7, optarg), v, NULL); } #endif break; case 'I': // input type if (input_type == input_repl) { fprintf(stderr, "Invoked as `repl`, so option -I ignored\n"); } else if (strcmp(optarg, "bib") == 0) { input_type = input_bib; } else if (strcmp(optarg, "bst") == 0) { input_type = input_bst; output_type = output_bstscm; // default } else if (strcmp(optarg, "scm") == 0) { input_type = input_scm; } else if (strcmp(optarg, "aux") == 0) { input_type = input_aux; } else if (strcmp(optarg, "md") == 0) { input_type = input_markdown; } else if (strcmp(optarg, "json") == 0) { input_type = input_json; } else { error_exit("Unexpected -I input type: %s", optarg); } break; case 'O': // output type if (strcmp(optarg, "sxml") == 0) { output_type = output_sexp; } else if (strcmp(optarg, "json") == 0) { output_type = output_json; } else if (strcmp(optarg, "bstscm") == 0) { output_type = output_bstscm; } else if (strcmp(optarg, "xml") == 0) { output_type = output_xml; } else if (strcmp(optarg, "xhtml") == 0) { output_type = output_xhtml; } else if (strcmp(optarg, "python") == 0) { output_type = output_python; } else if (strcmp(optarg, "bib") == 0) { output_type = output_bib; } else { error_exit("Unexpected -O output type: %s", optarg); } break; case 'm': { const char fmt[] = "(call/error-handler (lambda () (module/let* '%s (rootlet) #f)))"; size_t buflen = sizeof(fmt) + strlen(optarg); char* buf = alloca(buflen); snprintf(buf, buflen, fmt, optarg); //fprintf(stderr, "buf=<%s>\n", buf); s7_pointer result = s7_eval_c_string(S7, buf); if (! s7_boolean(S7, result)) { error_exit("Can't load module %s", optarg); } } break; case 'r': input_type = input_repl; break; case 'v': scheme_eval("verbosity", s7_make_symbol(S7, "up"), NULL); unicode_verbosity(+1); local_verbosity++; break; case 'q': scheme_eval("verbosity", s7_make_symbol(S7, "down"), NULL); unicode_verbosity(-1); local_verbosity--; break; case 'd': set_debug_flags(optarg); break; case 'h': Usage(0); case 'V': input_type = input_show_version; break; case '?': //fprintf(stderr, "Unexpected option '%c'\n", ch); Usage(1); default: // shouldn't happen error_exit("Unhandled option '%c'", ch); } } argc -= optind; argv += optind; const char* inputfile; // TODO: what should `echo "" | beastie` do? // (it currently objects) if (argc == 0) { inputfile = NULL; if (input_type == input_none) { if (local_verbosity > 1) fprintf(stderr, "No input\n"); exit(0); } } else if (input_type == input_repl || input_type == input_show_version) { inputfile = argv[0]; // nothing fancy } else { // There is an argument. // If the file extension of this is one we recognise, // then override the input_type. If we don't recognise // anything, we exit with an error message. inputfile = argv[0]; const char* ext = strrchr(inputfile, '.'); if (ext == NULL) ext = ""; if (strcmp(ext, ".bib") == 0) { input_type = input_bib; } else if (strcmp(ext, ".bst") == 0) { input_type = input_bst; output_type = output_bstscm; } else if (strcmp(ext, ".aux") == 0) { input_type = input_aux; } else if (strcmp(ext, ".scm") == 0) { input_type = input_scm; } else if (strcmp(ext, ".md") == 0) { input_type = input_markdown; } else if (strcmp(ext, ".json") == 0) { input_type = input_json; } else { // a special case, to accommodate being bibtex-alike: // if the input file doesn't end in .aux, but there exists // a file when we append this extension, then use that. char* buf = (char*)malloc(strlen(inputfile) + 5); if (buf == NULL) { error_exit("Unable to malloc %ld bytes!", (strlen(inputfile) + 5)); } sprintf(buf, "%s.aux", inputfile); struct stat S; if (local_verbosity > 1) fprintf(stderr, "Trying to open .aux file <%s>\n", buf); if (stat(buf, &S) == 0) { // the corresponding aux file exists input_type = input_aux; inputfile = buf; } else { free(buf); fprintf(stderr, "%s: Unrecognised file extension: %s\n", progname, inputfile); Usage(1); } } } assert(input_type != input_none); s7_pointer command_line_arguments = s7_nil(S7); // inputfile being NULL indicates there are no arguments to collect if (inputfile != NULL) { // inputfile is argv[0], possibly adjusted for (int i=argc-1; i>=1; i--) { command_line_arguments = s7_cons(S7, s7_make_string(S7, argv[i]), command_line_arguments); } command_line_arguments = s7_cons(S7, s7_make_string(S7, inputfile), command_line_arguments); } // this should generally be constant, but let the user // change it if they really want to s7_define_variable(S7, "*command-line*", command_line_arguments); const char* input_symbol; switch (input_type) { case input_bib: input_symbol = "bib"; break; case input_bst: input_symbol = "bst"; break; case input_scm: input_symbol = "scm"; break; case input_aux: input_symbol = "aux"; break; case input_markdown: input_symbol = "markdown"; break; case input_json: input_symbol = "json"; break; case input_repl: if (!emacs_repl // default is emacs_repl=0 && isatty(0) // tty input && s7_load(S7, "repl.scm")) { // repl.scm is available input_symbol = "repl/s7"; } else { input_symbol = "repl/basic"; } break; case input_show_version: input_symbol = "show-version"; break; default: assert(! "unhandled case in input_type"); } const char* output_symbol; switch (output_type) { case output_sexp: output_symbol = "sexp"; break; case output_json: output_symbol = "json"; break; case output_bstscm: output_symbol = "bstscm"; break; case output_xml: output_symbol = "xml"; break; case output_xhtml: output_symbol = "xhtml"; break; case output_python: output_symbol = "python"; break; case output_bib: output_symbol = "bib"; break; default: assert(! "unhandled case in output_type"); } assert(input_symbol != NULL); assert(output_symbol != NULL); if (command_line_exprs != NULL) { // the command_line_exprs are evaluated for side-effects, // thus including (define x 1) won't define x in the top-level // (currently -- should I support this?) const char fmt[] = "(call/error-handler (lambda () %s))"; stringbuilder_terminate(command_line_exprs); size_t buflen = sizeof(fmt) + command_line_exprs->len + 1; char* buf = alloca(buflen); snprintf(buf, buflen, fmt, command_line_exprs->buf); s7_pointer expr_result = s7_eval_c_string(S7, buf); if (! s7_boolean(S7, expr_result)) { error_exit("Can't evaluate expression %s", command_line_exprs->buf); } } if (local_verbosity > 1) { fprintf(stderr, "# beastie: %s -> %s, cmdline", input_symbol, output_symbol); if (s7_is_null(S7, command_line_arguments)) { fprintf(stderr, " empty"); } else { for (s7_pointer a=command_line_arguments; !s7_is_null(S7, a); a=s7_cdr(a)) { fprintf(stderr, " <%s>", s7_string(s7_car(a))); } } printf("\n"); } s7_pointer result = scheme_eval("main", s7_make_symbol(S7, input_symbol), s7_make_symbol(S7, output_symbol), command_line_arguments, NULL); exit(s7_integer(result)); // A more elaborate way of dealing with what a previous version of // main returned: // // Hmm: does this still usefully match what load/error-handler returns? // if (s7_is_list(S7, result) // && !s7_is_null(S7, result) // && s7_is_eqv(S7, s7_car(result), s7_make_symbol(S7, "error"))) { // exit_status = 1; // } else { // exit_status = 0; // } }