home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume26 / schemeweb / part01 / sweb.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-27  |  8.1 KB  |  323 lines
  1. /* SchemeWEB -- WEB for Scheme.  John D. Ramsdell.
  2.  * Simple support for literate programming in Scheme.
  3.  * This file generates both a Scheme weave program and
  4.  * a Scheme tangle program depending on if TANGLE is defined.
  5.  */
  6.  
  7. #if !defined lint
  8. static char ID[] = "$Header: sweb.c,v 1.2 90/07/17 07:25:01 ramsdell Exp $";
  9. static char copyright[] = "Copyright 1990 by The MITRE Corporation.";
  10. #endif
  11. /*
  12.  * Copyright 1990 by The MITRE Corporation
  13.  *
  14.  * This program is free software; you can redistribute it and/or modify
  15.  * it under the terms of the GNU General Public License as published by
  16.  * the Free Software Foundation; either version 1, or (at your option)
  17.  * any later version.
  18.  *
  19.  * This program is distributed in the hope that it will be useful,
  20.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  21.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22.  * GNU General Public License for more details.
  23.  * 
  24.  * For a copy of the GNU General Public License, write to the 
  25.  * Free Software Foundation, Inc., 675 Mass Ave, 
  26.  * Cambridge, MA 02139, USA.
  27.  */
  28.  
  29. /* SchemeWEB defines a new source file format in which source lines
  30. are divided into text and code.  Lines of code start with a line
  31. beginning with '(', and continue until the line that contains the
  32. matching ')'.  The text lines remain, and they are treated as
  33. comments.  If the first character of a text line is ';', it is
  34. stripped from the output.  This is provided for those who want to use
  35. an unmodified version of their Scheme system's LOAD.  When producing a
  36. document, both the text lines and the code lines are copied into the
  37. document source file, but the code lines are surrounded by a pair of
  38. formatting commands, as is comments beginning with ';' within code
  39. lines.  SchemeWEB is currently set up for use with LaTeX. */
  40.  
  41. /* Define TANGLE to make a program which translates SchemeWEB source
  42. into Scheme source. */
  43.  
  44. /* Define SAVE_LEADING_SEMICOLON if you want text lines to be copied 
  45. with any leading semicolon. */
  46.  
  47. #include <stdio.h>
  48.  
  49. typedef enum {FALSE, TRUE} bool;
  50.  
  51. #define putstring(s) (fputs(s, stdout))
  52.  
  53. #if defined TANGLE
  54. #define sweb_putchar(c) (putchar(c))
  55. #else
  56. /* Modify the following for use with something other than LaTeX. */
  57. #define BEGIN_COMMENT    "\\notastyped{"
  58. #define BEGIN_CODE    "\\begin{astyped}"
  59. #define END_CODE    "\\end{astyped}"
  60. void sweb_putchar (c)
  61.       int c;
  62. {                /* Raps \verb around characters */
  63.   switch (c) {            /* which LaTeX handles specially. */
  64.   case '\\': 
  65.   case  '{': 
  66.   case  '}': 
  67.   case  '$': 
  68.   case  '&': 
  69.   case  '#': 
  70.   case  '^': 
  71.   case  '_': 
  72.   case  '%': 
  73.   case  '~': 
  74.     putstring("\\verb-");
  75.     putchar(c);
  76.     putchar('-');
  77.     break;
  78.   default: putchar(c);
  79.   }
  80. }
  81. #endif
  82.  
  83. /* Error message for end of file found in code. */
  84. bool report_eof_in_code()
  85. {
  86.   fprintf(stderr, "End of file within a code section.\n");
  87.   return TRUE;
  88. }
  89.  
  90. /* All input occurs in the following routines so that TAB characters
  91. can be expanded. TeX treats TAB characters as a space--not what is
  92. wanted. */
  93. int ch_buf;
  94. bool buf_used = FALSE;
  95. int lineno = 1;
  96.  
  97. #undef getchar()
  98. int getchar()
  99. {
  100.   int c;
  101.   static int spaces = 0;    /* Spaces left to print a TAB. */
  102.   static int column = 0;    /* Current input column. */
  103.   if (buf_used) {
  104.     buf_used = FALSE;
  105.     return ch_buf;
  106.   }
  107.   if (spaces > 0) {
  108.     spaces--;
  109.     return ' ';
  110.   }
  111.   switch (c = getc(stdin)) {
  112.   case '\t':
  113.     spaces = 7 - (7&column);    /* Maybe this should be 7&(~column). */
  114.     column += spaces + 1;
  115.     return ' ';
  116.   case '\n':
  117.     lineno++;
  118.     column = 0;
  119.     return c;
  120.   default:
  121.     column++;
  122.     return c;
  123.   }
  124. }
  125.  
  126. void ungetchar(c)
  127.      int c;
  128. {
  129.   buf_used = TRUE;
  130.   ch_buf = c;
  131. }
  132.  
  133. bool copy_text_saw_eof()
  134. {
  135.   int c;
  136.   while (1) {
  137.     c = getchar();
  138.     if (c == EOF) return TRUE;
  139.     if (c == '\n') return FALSE;
  140. #if !defined TANGLE    
  141.     putchar(c);
  142. #endif
  143.   }
  144. }
  145.  
  146. bool copy_comment_saw_eof()    /* This copies comments */
  147. {                /* within code sections. */
  148. #if !defined TANGLE  
  149.   putstring(BEGIN_COMMENT);
  150.   putchar(';');
  151. #endif  
  152.   if (copy_text_saw_eof()) return TRUE;
  153. #if !defined TANGLE  
  154.   putchar('}');
  155. #endif  
  156.   putchar('\n');
  157.   return FALSE;
  158. }
  159.  
  160. bool after_sexpr_failed()    /* Copies comments in a code */
  161. {                /* section that follow a */
  162.   int c;            /* complete S-expr. */
  163.   while (1)            /* It fails when there is */
  164.     switch (c = getchar()) {    /* something other than */ 
  165.     case EOF:            /* white space or a comment, */
  166.       return report_eof_in_code(); /* such as an extra ')'. */
  167.     case ';': 
  168. #if !defined TANGLE  
  169.       putstring(BEGIN_COMMENT);
  170.       putchar(c);
  171. #endif  
  172.       if (copy_text_saw_eof()) return report_eof_in_code();
  173. #if !defined TANGLE  
  174.       putchar('}');
  175. #endif  
  176.       putchar('\n');
  177.       return FALSE;
  178.     case '\n':
  179.       putchar(c);
  180.       return FALSE;
  181.     case ' ':
  182. #if !defined TANGLE
  183.       putchar(c);
  184. #endif
  185.       break;
  186.     default:
  187.       fprintf(stderr,
  188.           "Found \"%c\"  after an S-expr finished.\n",
  189.           c);
  190.       return TRUE;
  191.     }
  192. }
  193.  
  194. bool copy_string_saw_eof()
  195. {
  196.   int c;
  197.   while (1) {
  198.     c = getchar();
  199.     if (c == EOF) return TRUE;
  200.     sweb_putchar(c);
  201.     switch (c) {
  202.     case '"': return FALSE;
  203.     case '\\':
  204.       c = getchar();
  205.       if (c == EOF) return TRUE;
  206.       sweb_putchar(c);
  207.     }
  208.   }
  209. }
  210.  
  211. bool maybe_char_syntax_saw_eof()
  212. {                /* Makes sure that the character */
  213.   int c;            /* #\( does not get counted in */
  214.   c = getchar();        /* balancing parentheses. */
  215.   if (c == EOF) return TRUE;
  216.   if (c != '\\') {
  217.     ungetchar(c);
  218.     return FALSE;
  219.   }
  220.   sweb_putchar(c);
  221.   c = getchar();
  222.   if (c == EOF) return TRUE;
  223.   sweb_putchar(c);
  224.   return FALSE;
  225. }
  226.  
  227. bool copy_code_failed()        /* Copies a code section */
  228. {                /* containing one S-expr. */
  229.   int parens = 1;        /* Used to balance parentheses. */
  230.   int c;
  231.   while (1) {            /* While parens are not balanced, */
  232.     c = getchar();
  233.     if (c == EOF)        /* report failure on EOF and */
  234.       return report_eof_in_code();
  235.     if (c == ';')        /* report failure on EOF in a comment. */
  236.       if (copy_comment_saw_eof()) return report_eof_in_code();
  237.       else continue;
  238.     sweb_putchar(c);        /* Write the character and then see */
  239.     switch (c) {        /* if it requires special handling. */
  240.     case '(':
  241.       parens++;
  242.       break;
  243.     case ')':
  244.       parens--;            
  245.       if (parens == 0)        /* Parentheses balance! */
  246.     return after_sexpr_failed(); /* Report the result of */
  247.       break;            /* post S-expr processing. */
  248.     case '"':            /* Report failure on EOF in a string. */
  249.       if (copy_string_saw_eof()) {
  250.     fprintf(stderr, "End of file found within a string.\n");
  251.     return TRUE;
  252.       }
  253.       break;
  254.     case '#':            /* Report failure on EOF in a character. */
  255.       if (maybe_char_syntax_saw_eof()) return report_eof_in_code();
  256.       break;
  257.     }
  258.   }
  259. }
  260.  
  261. int filter()
  262. {
  263.   int c;
  264.   while (1) {            /* At loop start it's in text mode */
  265.     c = getchar();        /* and at the begining of a line. */
  266.     if (c == '(') {        /* text mode changed to code mode. */
  267. #if !defined TANGLE
  268.       putstring(BEGIN_CODE); putchar('\n');
  269. #endif
  270.       do {            /* Copy code. */
  271.     putchar(c);
  272.     if (copy_code_failed()) {
  273.       fprintf(stderr,
  274.           "Error in the code section containing line %d.\n",
  275.           lineno);
  276.       return 1;
  277.     }
  278.     c = getchar();        /* Repeat when there is code */
  279.       } while (c == '(');    /* immediately after some code. */
  280. #if !defined TANGLE
  281.       fputs(END_CODE, stdout); putc('\n', stdout);
  282. #endif
  283.     }
  284.     /* Found a text line--now in text mode. */
  285. #if !defined SAVE_LEADING_SEMICOLON
  286.     if (c == ';') c = getchar();
  287. #endif
  288.     ungetchar(c);
  289.     if (copy_text_saw_eof()) return 0; /* Copy a text line. */
  290. #if !defined TANGLE
  291.     putchar('\n');
  292. #endif
  293.   }
  294. }
  295.  
  296. int main (argc, argv)        /* For machines which do not */
  297.      int argc;            /* support argc and argv, */
  298.      char *argv[];        /* just change main. */
  299. {
  300.   switch (argc) {
  301.   case 3:
  302.     if (NULL == freopen(argv[2], "w", stdout)) {
  303.       fprintf(stderr, "Cannot open %s for writing.\n", argv[2]);
  304.       break;
  305.     }
  306.   case 2:
  307.     if (NULL == freopen(argv[1], "r", stdin)) {
  308.       fprintf(stderr, "Cannot open %s for reading.\n", argv[1]);
  309.       break;
  310.     }
  311.   case 1:
  312.     return filter();
  313.   }
  314.   fprintf(stderr, 
  315. #if defined TANGLE
  316.       "Usage: %s [SchemeWEB file] [Scheme file]\n",
  317. #else
  318.       "Usage: %s [SchemeWEB file] [LaTeX file]\n", 
  319. #endif
  320.       argv[0]);
  321.   return 1;
  322. }
  323.