/* 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();
}