summaryrefslogtreecommitdiff
path: root/web/schemeweb2/sweb.c
diff options
context:
space:
mode:
Diffstat (limited to 'web/schemeweb2/sweb.c')
-rw-r--r--web/schemeweb2/sweb.c488
1 files changed, 488 insertions, 0 deletions
diff --git a/web/schemeweb2/sweb.c b/web/schemeweb2/sweb.c
new file mode 100644
index 0000000000..4f9ba55900
--- /dev/null
+++ b/web/schemeweb2/sweb.c
@@ -0,0 +1,488 @@
+/* SchemeWEB2 --- Matthieu MOY matthieu.moy@ensimag.imag.fr
+ * Largely based on
+ * SchemeWEB -- WEB for Lisp. John D. Ramsdell.
+ * Simple support for literate programming in Lisp.
+ */
+
+/* Any people who want to include pretty print to this software is welcome */
+
+/* $Id: sweb.c,v 2.1 94/07/21 11:30:36 ramsdell Exp $ */
+
+#ifndef lint
+static char vcid[] = "$Id: sweb.c,v 2.1 94/07/21 11:30:36 ramsdell Exp $";
+static char copyright[] = "Copyright 1994 by The MITRE Corporation.";
+#endif /* lint */
+
+#define VERSION "2.1"
+
+/*
+ * Copyright 1994 by The MITRE Corporation
+ *
+ * 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 1, 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.
+ *
+ * For a copy of the GNU General Public License, write to the
+ * Free Software Foundation, Inc., 675 Mass Ave,
+ * Cambridge, MA 02139, USA.
+ */
+
+/*
+This program processes SchemeWEB files. A SchemeWEB file is a Lisp
+source file which contains code sections and comment sections, but
+each section is identified in a novel way. A code section begins with
+a line whose first character is a left parenthesis. It continues
+until a line is found which contains the parenthesis that matches the
+one which started the code section. The remaining lines of text in
+the source file are treated as comments. Several operations involving
+SchemeWEB files are provided by the this program. See the manual
+page for a complete description of the various operations.
+*/
+
+/* SchemeWEB is currently set up for use with LaTeX. */
+
+/* Define TANGLE to make a program which translates SchemeWEB source
+into Scheme source by default. */
+
+#define SAVE_LEADING_SEMICOLON
+/* Define SAVE_LEADING_SEMICOLON if you want text lines to be copied
+with any leading semicolon while weaving. */
+
+#include <stdio.h>
+
+typedef
+enum
+{myFALSE, myTRUE}
+bool
+;
+
+/* Runtime flags */
+bool weaving; /* Weaving or tangling? */
+bool strip_comments; /* Strip comments while tangling except inside code section. */
+bool strip_all_comments; /* Strip all comments while tangling. */
+
+/* Formatting commands added into weaved documents. */
+char *begin_comment = "\\mbox{"; /* This pair is used */
+char *end_comment = "}"; /* to surround comments in code. */
+char *begin_code = "\\begin{flushleft}\n"; /* This pair is used */
+char *end_code = "\\end{flushleft}\n"; /* to surround code. */
+char *code_line_separator = "\\\\ ";
+char *begin_code_line = "\\verb|"; /* This pair is used */
+char *end_code_line = "|"; /* to surround code lines. */
+
+/* Information for error messages. */
+char *prog = NULL; /* Name of program. */
+char *src = NULL; /* Name of input file. */
+int lineno = 1; /* Line number. */
+
+/* Output occurs through putchar, putstring, and code_putchar. */
+
+#define putstring(s) (fputs(s, stdout))
+
+int /* Used while printing */
+code_putchar(c) /* a code section. */
+ int c;
+{
+ if (c == '|' && weaving) return putstring("|\\verb-|-\\verb|");
+ else return putchar(c);
+}
+
+/* All input occurs in the following routines so that TAB characters
+can be expanded while weaving. TeX treats TAB characters as a
+space--not what is wanted. */
+
+int ch_buf; /* Used to implement */
+bool buf_used = myFALSE; /* one character push back. */
+
+int
+getchr()
+{
+ int c;
+ static int spaces = 0; /* Spaces left to print a TAB. */
+ static int column = 0; /* Current input column. */
+ if (buf_used) {
+ buf_used = myFALSE;
+ return ch_buf;
+ }
+ if (spaces > 0) {
+ spaces--;
+ return ' ';
+ }
+ switch (c = getc(stdin)) {
+ case '\t':
+ if (!weaving) return c;
+ spaces = 7 - (7&column); /* Maybe this should be 7&(~column). */
+ column += spaces + 1;
+ return ' ';
+ case '\n':
+ lineno++;
+ column = 0;
+ return c;
+ default:
+ column++;
+ return c;
+ }
+}
+
+void
+ungetchr(c)
+ int c;
+{
+ buf_used = myTRUE;
+ ch_buf = c;
+}
+
+/* Error message for end of file found in code. */
+bool
+report_eof_in_code()
+{
+ fprintf(stderr, "End of file within a code section.\n");
+ return myTRUE;
+}
+
+bool
+copy_text_saw_eof() /* Copies a line of text out. */
+{ /* Used while printing */
+ int c; /* a text section. */
+ while (1) {
+ c = getchr();
+ if (c == EOF) return myTRUE;
+ if (c == '\n') return myFALSE;
+ putchar(c);
+ }
+}
+
+
+/* Added by Matthieu MOY */
+bool
+copy_text_saw_eof_strip_tex_comments() /* Copies a line of text out. */
+{ /* Used while printing */
+ int c; /* a text section. */
+ while (1) {
+ c = getchr();
+ if (c == EOF) return myTRUE;
+ if (c == '\n') return myFALSE;
+ if (c == '%')
+ while (1) {
+ c = getchr();
+ switch(c) {
+ case '\n': return myFALSE;
+ case EOF: return myTRUE;
+ }
+ }
+ /* Added by Matthieu MOY */
+ if (c == '#') putchar('\\');
+ putchar(c);
+ }
+}
+
+bool
+strip_text_saw_eof() /* Gobbles up a line of input. */
+{
+ int c;
+ while (1) {
+ c = getchr();
+ if (c == EOF) return myTRUE;
+ if (c == '\n') return myFALSE;
+ }
+}
+
+bool /* This copies comments */
+copy_comment_saw_eof() /* within code sections. */
+{
+ if (weaving) putstring(begin_comment);
+ putchar(';');
+ if (copy_text_saw_eof_strip_tex_comments()) return myTRUE;
+ if (weaving) putstring(end_comment);
+ return myFALSE;
+}
+
+bool /* Copies a string found */
+copy_string_saw_eof() /* within a code section. */
+{
+ int c;
+ while (1) {
+ c = getchr();
+ if (c == EOF) return myTRUE;
+ if (c == '\n') { /* Found a string which continues on */
+ if (weaving) /* Added by Matthieu MOY */
+ putstring(end_code_line); /* a new line. */
+ putchar(c); /* Close existing line, and then */
+ if (weaving) { /* Added by Matthie MOY */
+ putstring(code_line_separator); /* begin copying the rest of */
+ putstring(begin_code_line); /* on the next line. */
+ }
+ continue;
+ }
+ code_putchar(c);
+ switch (c) {
+ case '"': return myFALSE;
+ case '\\':
+ c = getchr();
+ if (c == EOF) return myTRUE;
+ code_putchar(c);
+ }
+ }
+}
+
+bool
+maybe_char_syntax_saw_eof()
+{ /* Makes sure that the character */
+ int c; /* #\( does not get counted in */
+ c = getchr(); /* balancing parentheses. */
+ if (c == EOF) return myTRUE;
+ if (c != '\\') {
+ ungetchr(c);
+ return myFALSE;
+ }
+ code_putchar(c);
+ c = getchr();
+ if (c == EOF) return myTRUE;
+ code_putchar(c);
+ return myFALSE;
+}
+
+bool /* Copies a code section */
+copy_code_failed() /* containing S-exprs. */
+{
+ int parens = 1; /* Used to balance parentheses. */
+ int c;
+ while (1) { /* While parens are not balanced, */
+ c = getchr();
+ if (c == EOF) /* Report failure on EOF. */
+ return report_eof_in_code();
+ if (c == '\n' && weaving)
+ putstring(end_code_line);
+ if (c == ';') { /* Report failure on EOF in a comment. */
+ if (weaving) putstring(end_code_line);
+ if (strip_comments
+ /* Modifyed by Matthieu MOY */
+ ? (strip_all_comments ? strip_text_saw_eof() : copy_comment_saw_eof())
+ : copy_comment_saw_eof())
+ return report_eof_in_code();
+ else
+ c = '\n';
+ }
+ code_putchar(c); /* Write the character and then see */
+ switch (c) { /* if it requires special handling. */
+ case '(':
+ parens++;
+ break;
+ case ')':
+ parens--;
+ if (parens < 0) {
+ fprintf(stderr, "Too many right parentheses found.\n");
+ return myTRUE;
+ }
+ break;
+ case '"': /* Report failure on EOF in a string. */
+ if (copy_string_saw_eof()) {
+ fprintf(stderr, "End of file found within a string.\n");
+ return myTRUE;
+ }
+ break;
+ case '#': /* Report failure on EOF in a character. */
+ if (maybe_char_syntax_saw_eof())
+ return report_eof_in_code();
+ break;
+ case '\n':
+ if (parens == 0) return myFALSE;
+ if (weaving) {
+ putstring(code_line_separator);
+ putstring(begin_code_line);
+ }
+ }
+ }
+}
+
+int
+schemeweb()
+{
+ int c;
+ if(weaving)
+ {
+ putstring("\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\
+\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\n");
+ putstring("\% Code generated by SchemeWeb from a .sw file. \%\n");
+ putstring("\% Any change will be lost ! \%\n");
+ putstring("\% DO NOT EDIT please. \%\n");
+ putstring("\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\
+\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\%\n");
+ }
+ else
+ {
+ putstring(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n");
+ putstring(";; Code generated by SchemeWeb from a .sw file. ;;\n");
+ putstring(";; Any change will be lost ! ;;\n");
+ putstring(";; DO NOT EDIT please. ;;\n");
+ putstring(";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n");
+ }
+ while (1) { /* At loop start it's in text mode */
+ c = getchr(); /* and at the begining of a line. */
+ if (c == '(') { /* text mode changed to code mode. */
+ if (weaving) putstring(begin_code);
+ do { /* Copy code. */
+ if (weaving) putstring(begin_code_line);
+ putchar(c);
+ if (copy_code_failed()) {
+ /* fputs(prog, stderr); */
+ if (src != NULL)
+ fprintf(stderr, "%s:", src);
+ else
+ fputs("<stdin>:", stderr);
+ fprintf(stderr,
+ "%d: Error in a code section.\n",
+ lineno);
+ return 1;
+ }
+ c = getchr(); /* Repeat when there is code */
+ } while (c == '('); /* immediately after some code. */
+ if (weaving) putstring(end_code);
+ }
+ /* Found a text line--now in text mode. */
+#if !defined SAVE_LEADING_SEMICOLON
+ if (c == ';' && weaving)
+ c = getchr();
+#endif
+ if (c == EOF) return 0; /* Files that do not end with */
+ ungetchr(c); /* a newline are okay. */
+
+ if (strip_comments) {
+ if (strip_text_saw_eof()) return 0;
+ }
+ else {
+ if (c != '\n' && !weaving) putchar(';');
+ if (copy_text_saw_eof()) return 0; /* Copy a text line. */
+ putchar('\n');
+ }
+ }
+}
+
+int /* Removes any semicolons */
+untangle() /* than start a line of text. */
+{
+ int c;
+
+ while (1) { /* At a beginning of a line of text */
+ c = getchar(); /* when at this point in the code. */
+ if (c == EOF) return 0;
+ if (c != ';') putchar(c);
+ while (c != '\n') {
+ c = getchar();
+ if (c == EOF) return 0;
+ putchar(c);
+ }
+ }
+}
+
+bool /* Open the file arguments */
+open_file_args_failed(argc, argv)
+ int argc;
+ char *argv[];
+{
+ switch (argc) {
+ case 2:
+ case 1:
+ src = argv[0]; /* Save for error messages. */
+ if (NULL == freopen(argv[0], "r", stdin)) {
+ fprintf(stderr, "Cannot open %s for reading.\n", argv[0]);
+ break;
+ }
+ if (argc == 2 && NULL == freopen(argv[1], "w", stdout)) {
+ fprintf(stderr, "Cannot open %s for writing.\n", argv[1]);
+ break;
+ }
+ case 0:
+ return myFALSE;
+ }
+ return myTRUE;
+}
+
+int
+usage()
+{
+ fprintf(stderr,
+ "Usage: %s [-stuvwx] [input_file [output_file]]\n%s%s%s%s%s%s%s%s",
+ prog,
+ "\t-h: print this help message\n",
+ "\t-s: tangle input stripping all comments\n",
+ "\t-ss: tangle input stripping comments except inside code\n",
+ "\t-t: tangle input retaining comments\n",
+ "\t-u: untangle input\n",
+ "\t-v: print version information\n",
+ "\t-w: weave input\n",
+ "\t-x: weave input and exclude line breaks in code sections\n");
+ fprintf(stderr, "The default option is %s.\n",
+#if defined TANGLE
+ "-t"
+#else
+ "-w"
+#endif
+ );
+ return 1;
+}
+
+int
+main (argc, argv)
+ int argc;
+ char *argv[];
+{
+ bool untangling = myFALSE;
+#if defined TANGLE
+ weaving = myFALSE;
+#else
+ weaving = myTRUE;
+#endif
+ strip_comments = myFALSE;
+ strip_all_comments = myTRUE;
+
+ prog = argv[0]; /* Save program name for error messages. */
+
+ /* Option processing. Note only one option can be requested at a time. */
+ /* -s: tangle input stripping comments. */
+ /* -ss: tangle input stripping comments except inside code section. */
+ /* -t: tangle input retaining comments. */
+ /* -u: untangle input. */
+ /* -v: print version information. */
+ /* -w: weave input. */
+ /* -x: weave input and exclude line breaks in code sections. */
+ if (argc > 1 && argv[1][0] == '-') {
+ switch (argv[1][1]) {
+ case 's': weaving = myFALSE; strip_comments = myTRUE;
+ if (argv[1][2] == 's') {
+ strip_all_comments = myFALSE;
+ argv[1][2] = argv[1][3]; /* Simulate one argument */
+ }
+ break;
+ case 't': weaving = myFALSE; break;
+ case 'u': untangling = myTRUE; break;
+ case 'v':
+ fprintf(stderr, "This is SchemeWEB version %s.\n", VERSION);
+ return 0;
+ case 'w': weaving = myTRUE; break;
+ case 'x': weaving = myTRUE; code_line_separator = "\\\\* "; break;
+ case 'h': return usage(); break;
+ default:
+ fprintf(stderr, "Bad option: -%c.\n", argv[1][1]);
+ return usage();
+ }
+ if (argv[1][2] != '\0') {
+ fprintf(stderr, "Only one option allowed.\n");
+ return usage();
+ }
+ argc--; argv++;
+ }
+
+ if (open_file_args_failed(argc - 1, argv + 1)) return usage();
+
+ if (untangling) return untangle();
+ return schemeweb();
+}
+
+