home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / boxtex.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  12.9 KB  |  344 lines
  1. ;-*- mode:lisp; package:boxer;base: 10.; fonts:cptfont -*-
  2.  
  3. ;; (C) Copyright 1985 Massachusetts Institute of Technology
  4. ;;
  5. ;; Permission to use, copy, modify, distribute, and sell this software
  6. ;; and its documentation for any purpose is hereby granted without fee,
  7. ;; provided that the above copyright notice appear in all copies and that
  8. ;; both that copyright notice and this permission notice appear in
  9. ;; supporting documentation, and that the name of M.I.T. not be used in
  10. ;; advertising or publicity pertaining to distribution of the software
  11. ;; without specific, written prior permission.  M.I.T. makes no
  12. ;; representations about the suitability of this software for any
  13. ;; purpose.  It is provided "as is" without express or implied warranty.
  14. ;;
  15.  
  16. ;;;; The Boxer Manual Compiler
  17. ;;;
  18. ;;; How to convert from BOXER structure into a TEX/LATEX file
  19. ;;;
  20. ;;; This code is hacked up specifically for the BOXER Manual.  If you want to wirte your
  21. ;;; own conversion routines, the core of the code (should be fairly portable) is in the 
  22. ;;; functions TEXIFY-BOX, TEXIFY-ROW and TEXIFY-CHA. The functions which convert BOXER 
  23. ;;; structure into TeX files which use the TeX Box drawing macros are TEXIFY-BOXER-EXAMPLE-BOX
  24. ;;; and TEXIFY-BOXER-EXAMPLE-ROW.
  25. ;;;
  26. ;;; The following conventions for the manual (in Boxer) are assumed:
  27. ;;;
  28. ;;; In general, successive levels of box correspond to successive levels of formatting
  29. ;;; i.e. \chapter, \section, etc.  with the name of the Box as the name of the section
  30. ;;;
  31. ;;; Individual characters in boxer can be made to expand into arbitrary sequences of 
  32. ;;; characters in the corresponding TeX File by pushing a pair consisting of the character
  33. ;;; and a function to be FUNCALLed onto the variable *SPECIAL-TEX-CHA-HANDLER-ALIST*.  The 
  34. ;;; function is called woth 2 args, the character being dispatched on and the output stream
  35. ;;;
  36. ;;; In the same way, boxes can also be expanded into an arbitrary sequence of TeX commands
  37. ;;; by pushing a consisting of the BOX and a function (2 args also) onto the variable
  38. ;;; *SPECIAL-TEX-BOX-HANDLER-ALIST*.  The list is searched using BOX-EQUAL?
  39. ;;;
  40. ;;; BOXER Functions are documented as Label Pairs consisting of 
  41. ;;;      FUNCTION-NAME : <Function Documentation Box>
  42. ;;; The <Function Documentation Box> consists of a first line which is composed of the name 
  43. ;;; of the function and its args,  The args are enclosed in angle brackets.
  44. ;;; Successive lines consist of text and then a line with "***" on it after which are examples
  45.  
  46.  
  47.  
  48. ;;; Some useful variables...
  49.  
  50. (DEFVAR *SECTION-BOX-LEVEL-ALIST* '((1 . "\chapter") (2 . "\section") (3 . "\subsection")
  51.                     (4 . "\subsubsection")))
  52.  
  53. (DEFVAR *BOX-TYPE-TEX-COMMAND-ALIST* '((DOIT-BOX . "\doitbox")
  54.                        (DATA-BOX . "\databox")
  55.                        (GRAPHICS-BOX . "\graphicsbox")
  56.                        (GRAPHICS-DATA-BOX . "\gdbox")
  57.                        (SPRITE-BOX . "\spritebox")
  58.                        (LL-BOX . "\llbox")))
  59.  
  60. (DEFVAR *TEX-MINIMUM-BOX-SIZE* "3em,1.6em")
  61.  
  62. (DEFVAR *TEX-GRAPHICS-BOX-SIZE* "200pt,150pt")
  63.  
  64. (DEFVAR *SPECIAL-TEX-CHA-HANDLER-ALIST* '((#/< . MATH-MODE-CHARACTER)
  65.                       (#/> . MATH-MODE-CHARACTER)
  66.                       (#/= . MATH-MODE-CHARACTER)
  67.                       (#/| . MATH-MODE-CHARACTER)
  68.                       (#/^ . COMMAND-CHARACTER)
  69.                       (#/ . GEQ-CHARACTER)
  70.                       (#/ . LEQ-CHARACTER)
  71.                       (#/* . AST-CHARACTER)))
  72.  
  73. (DEFVAR *SPECIAL-TEX-BOX-HANDLER-ALIST* `((,(MAKE-BOX '(("BOXER"))) . BOXER-NAME-HANDLER)
  74.                       (,(MAKE-BOX '(("TRUE")))  . TEX-TRUE-BOX)
  75.                       (,(MAKE-BOX '(("FALSE"))) . TEX-FALSE-BOX)))
  76.  
  77. (DEFVAR *FONT-CHANGE-ALIST* '((0 . "\rm") (1 . "\em") (2 . "\sf") (3 . "\em")))
  78.  
  79. (DEFVAR WITHIN-FUNCTION-DOC NIL "Within a function definition environment")
  80.  
  81. (DEFVAR CURRENT-FONT NIL)
  82.  
  83. ;;; we set up a separate readtable becaue we keep losing on things like parens...
  84.  
  85. (DEFVAR *BOXER-TEX-READTABLE* (COPY-READTABLE SI:INITIAL-READTABLE))
  86.  
  87. (DEFMACRO WITH-TEX-READTABLE (&BODY BODY)
  88.   `(PROGV '(*BOXER-READTABLE*) `(,*BOXER-TEX-READTABLE*)
  89.      . ,BODY))
  90.  
  91. (EVAL-WHEN (LOAD)
  92.  
  93. ;;; give us the minimal boxer syntax and make everything else alphabetic
  94. (SET-SYNTAX-FROM-CHAR *STRT-ROW-CODE* #/( *BOXER-TEX-READTABLE*)
  95. (SET-SYNTAX-FROM-CHAR *STOP-ROW-CODE* #/) *BOXER-TEX-READTABLE*)
  96. (SET-SYNTAX-MACRO-CHAR *STRT-BOX-CODE*
  97.                'BOXTEX-STRT-BOX-READER-MACRO
  98.                *BOXER-TEX-READTABLE*)
  99. ;(SET-SYNTAX-MACRO-CHAR *STOP-BOX-CODE*
  100. ;               'BOXER-STOP-BOX-READER-MACRO
  101. ;               *BOXER-READTABLE*)
  102. (SET-SYNTAX-MACRO-CHAR #/:
  103.                'BOXTEX-LABELLING-CHA-READER-MACRO
  104.                *BOXER-TEX-READTABLE*)
  105. (SET-SYNTAX-MACRO-CHAR #/,
  106.                'BOXTEX-FUNCTIONDOC-SEPARATOR-READER-MACRO
  107.                *BOXER-TEX-READTABLE*)
  108. (SET-SYNTAX-FROM-DESCRIPTION #/| 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  109. (SET-SYNTAX-FROM-DESCRIPTION #/; 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  110. (SET-SYNTAX-FROM-DESCRIPTION #/` 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  111. (SET-SYNTAX-FROM-DESCRIPTION #/( 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  112. (SET-SYNTAX-FROM-DESCRIPTION #/) 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  113. (SET-SYNTAX-FROM-DESCRIPTION #/# 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  114. (SET-SYNTAX-FROM-DESCRIPTION #// 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  115. (SET-SYNTAX-FROM-DESCRIPTION #/' 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  116. (SET-SYNTAX-FROM-DESCRIPTION #/. 'SI:ALPHABETIC *BOXER-TEX-READTABLE*)
  117.  
  118. )
  119.  
  120. ;;;; reader macros
  121.  
  122. (DEFUN BOXTEX-FUNCTIONDOC-SEPARATOR-READER-MACRO (LIST IGNORE)
  123.   (VALUES (NCONC LIST (NCONS :FUNCTION-SEPARATOR)) NIL T))
  124.  
  125. (DEFUN BOXTEX-STRT-BOX-READER-MACRO (IGNORE STREAM)
  126.   (MULTIPLE-VALUE-BIND (VAL ERROR-P)
  127.       (IGNORE-ERRORS (FUNCALL STREAM ':TYI-A-BOX))
  128.     (IF ERROR-P
  129.     (VALUES '[ NIL NIL)
  130.     (VALUES VAL NIL NIL))))
  131.  
  132. (DEFUN BOXTEX-LABELLING-CHA-READER-MACRO (LIST-SO-FAR STREAM)
  133.   (LET ((NEXT-NONBLANK-CHAR (TYIPEEK T STREAM *STOP-ROW-CODE*)))
  134.     (IF (EQ LIST-SO-FAR ':TOPLEVEL)
  135.     (VALUES (NCONS (MAKE-LABEL-PAIR NIL
  136.                     (IF (= NEXT-NONBLANK-CHAR *STOP-ROW-CODE*)
  137.                         ':NO-ELEMENT
  138.                         (READ STREAM ':NO-ELEMENT))))
  139.         NIL T)
  140.     (LET* ((LAST (get-sensible-last-thing-from list-so-far))
  141.            (LAST-ELEMENT (CAR LAST)))
  142.       (RPLACA LAST (MAKE-LABEL-PAIR LAST-ELEMENT
  143.                     (IF (= NEXT-NONBLANK-CHAR *STOP-ROW-CODE*)
  144.                         ':NO-ELEMENT
  145.                         (READ STREAM ':NO-ELEMENT))))
  146.       (VALUES LIST-SO-FAR NIL T)))))
  147.  
  148.  
  149.  
  150. (DEFUN TEXIFY-CHA (CHA STREAM)
  151.   (LET ((SPECIAL-CHA-HANDLER (CDR (ASSQ (CHA-CODE CHA) *SPECIAL-TEX-CHA-HANDLER-ALIST*))))
  152.     (WHEN (AND CURRENT-FONT
  153.            ( (FONT-NO CHA) CURRENT-FONT)
  154.            (ASSQ (FONT-NO CHA) *FONT-CHANGE-ALIST*))
  155.       (SETQ CURRENT-FONT (FONT-NO CHA))
  156.       (FORMAT STREAM "~A{}" (CDR (ASSQ (FONT-NO CHA) *FONT-CHANGE-ALIST*))))
  157.     (IF (NULL SPECIAL-CHA-HANDLER)
  158.     (SEND STREAM :TYO CHA)
  159.     (FUNCALL SPECIAL-CHA-HANDLER CHA STREAM))))
  160.  
  161. (DEFUN COLLECT-ARGS-FOR-FUNCTION-DECLARATION (ENTRIES)
  162.   (DECLARE (VALUES ARGS REST-OF-ENTRIES))
  163.   (LOOP WITH ARGS = NIL
  164.     FOR REST = ENTRIES THEN (CDR REST)
  165.     FOR ARG = (CAR REST)
  166.     UNTIL (NULL REST)
  167.     WHEN (EQ ARG ':FUNCTION-SEPARATOR)
  168.       RETURN (VALUES ARGS (CDR REST))
  169.     DO (SETQ ARGS (APPEND ARGS (NCONS ARG)))
  170.     FINALLY
  171.       (RETURN (VALUES ARGS NIL))))
  172.  
  173. (DEFUN TEXIFY-FUNCTION-DECLARATION-ENTRIES (ENTRIES STREAM)
  174.   (FORMAT STREAM "\fcn{")
  175.   (DOLIST (CHA (LISTARRAY (STRING (CAR ENTRIES))))
  176.     (TEXIFY-CHA CHA STREAM))
  177.   (FORMAT STREAM "}")
  178.   (MULTIPLE-VALUE-BIND (ARGS REST)
  179.       (COLLECT-ARGS-FOR-FUNCTION-DECLARATION (CDR ENTRIES))
  180.     (DOLIST (ARG ARGS)
  181.       (FORMAT STREAM "\argument{")
  182.       (DOLIST (CHA (LISTARRAY (STRING ARG)))
  183.     (TEXIFY-CHA CHA STREAM))
  184.       (FORMAT STREAM "} "))
  185.     (UNLESS (NULL REST)
  186.       (FORMAT STREAM ", ")
  187.       (TEXIFY-FUNCTION-DECLARATION-ENTRIES REST STREAM))))
  188.  
  189. (DEFUN TEXIFY-FUNCTION-DECLARATION-ROW (FUNCTION-ROW STREAM)
  190.   (FORMAT STREAM "~%~%\functiondoc{")
  191.   (TEXIFY-FUNCTION-DECLARATION-ENTRIES (TELL FUNCTION-ROW :ENTRIES) STREAM)
  192.   (FORMAT STREAM "}~%~%"))
  193.  
  194. (DEFUN TEXIFY-FUNCTION-DOC (LABEL-PAIR OUTPUT-STREAM)
  195.   (LET ((BOX (LABEL-PAIR-ELEMENT LABEL-PAIR))
  196.     (WITHIN-FUNCTION-DOC T))
  197.     (TEXIFY-FUNCTION-DECLARATION-ROW (TELL BOX :FIRST-INFERIOR-ROW) OUTPUT-STREAM)
  198.     (LOOP WITH EXAMPLE-FLAG = NIL
  199.       FOR ROW IN (CDR (TELL BOX :ROWS))
  200.       FOR ROW-STRING = (TELL ROW :TEXT-STRING)
  201.       WHEN (STRING-SEARCH "***" ROW-STRING)
  202.         DO (SETQ EXAMPLE-FLAG T)
  203.            (FORMAT OUTPUT-STREAM "~%\startboxerexample~%")
  204.       DO (COND ((STRING-SEARCH "***" ROW-STRING))
  205.            ((NULL EXAMPLE-FLAG) (TEXIFY-ROW ROW OUTPUT-STREAM))
  206.            (T (TEXIFY-BOXER-EXAMPLE-ROW ROW OUTPUT-STREAM)))
  207.       FINALLY
  208.         (WHEN EXAMPLE-FLAG
  209.           (FORMAT OUTPUT-STREAM "~%\stopboxerexample~%")))))
  210.  
  211. (DEFUN CALCULATE-BOX-SIZE-FOR-TEX (BOX)
  212.   "returns either a string <WIDTH>,<HEIGHT> or a s(for stretch) string"
  213.   (COND ((GRAPHICS-BOX? BOX) *TEX-GRAPHICS-BOX-SIZE*)
  214.     ((AND (= 1 (TELL BOX :LENGTH-IN-ROWS))
  215.           (< (ROW-LENGTH-IN-CHAS (TELL BOX :FIRST-INFERIOR-ROW)) 5)
  216.           (NULL (SUBSET #'BOX? (TELL (TELL BOX :FIRST-INFERIOR-ROW) :CHAS))))
  217.      *TEX-MINIMUM-BOX-SIZE*)
  218.     (T "s")))
  219.  
  220. (DEFUN TEXIFY-BOXER-EXAMPLE-BOX (BOX STREAM)
  221.   (LET ((HEADER (CDR (ASSQ (TYPEP BOX) *BOX-TYPE-TEX-COMMAND-ALIST*))))
  222.     (WHEN (NOT (NULL (TELL BOX :NAME-ROW)))
  223.       (FORMAT STREAM "\nametab{~A}" (TELL  BOX :NAME)))
  224.     (IF (NULL HEADER) (FERROR "There are currently no TeX macros for ~A's" (TYPEP BOX))
  225.     (SEND STREAM :STRING-OUT HEADER)
  226.     (FORMAT STREAM "[~A]{" (CALCULATE-BOX-SIZE-FOR-TEX BOX))
  227.     (UNLESS (GRAPHICS-BOX? BOX)
  228.       (DOLIST (ROW (TELL BOX :ROWS))
  229.         (TEXIFY-BOXER-EXAMPLE-ROW ROW STREAM)))
  230.     (SEND STREAM :TYO #/}))))
  231.  
  232. (DEFUN TEXIFY-BOXER-EXAMPLE-ROW (ROW STREAM)
  233.   (FORMAT STREAM "\row{")
  234.   (LOOP WITH RETURN-FLAG = NIL
  235.     FOR CHA IN (TELL ROW :CHAS)
  236.     DO (COND ((BOX? CHA)
  237.           (TEXIFY-BOXER-EXAMPLE-BOX CHA STREAM))
  238.          ((CHAR= CHA #/|)
  239.           (SETQ RETURN-FLAG T) (FORMAT STREAM "\return{"))
  240.          (T (TEXIFY-CHA CHA STREAM)))
  241.     FINALLY
  242.       (WHEN RETURN-FLAG (SEND STREAM :TYO #/})))
  243.   (SEND STREAM :TYO #/}))
  244.  
  245. (DEFUN TEXIFY-ROW (ROW STREAM &OPTIONAL (LEVEL 0))
  246.   (LET ((ENTRIES (IGNORE-ERRORS (TELL ROW :ENTRIES)))    ;in case of special chas in the text
  247.     (CHAS (TELL ROW :CHAS)))        ;like {'s and }'s
  248.     (LET ((CURRENT-FONT 0))
  249.       (IF (NOT (NULL (SUBSET #'(LAMBDA (E) (AND (LABEL-PAIR? E)
  250.                         (BOX? (LABEL-PAIR-ELEMENT E))))
  251.                  ENTRIES)))
  252.       (DOLIST (ENTRY ENTRIES)
  253.         (COND ((AND (LABEL-PAIR? ENTRY) (BOX? (LABEL-PAIR-ELEMENT ENTRY)))
  254.            (TEXIFY-FUNCTION-DOC ENTRY STREAM))
  255.           ((BOX? ENTRY) (TEXIFY-BOX ENTRY STREAM (1+ LEVEL)))
  256.           ((OR (NUMBERP ENTRY) (SYMBOLP ENTRY))
  257.            (FORMAT STREAM "~A " ENTRY))
  258.           (T (FERROR "unrecognized type in ~A" ROW))))
  259.       (DOLIST (CHA CHAS)
  260.         (COND ((BOX? CHA) (TEXIFY-BOX CHA STREAM (1+ LEVEL)))
  261.           (T (TEXIFY-CHA CHA STREAM)))))
  262.       (WHEN ( 0 CURRENT-FONT)
  263.     ;;reset the current font for the next row
  264.     (FORMAT STREAM "\rm"))
  265.       (FORMAT STREAM "~%")))
  266.   (FORMAT T "."))                ;a blip for the user
  267.  
  268. (DEFUN TEXIFY-BOX (BOX OUTPUT-STREAM &OPTIONAL (LEVEL 0))
  269.   (WITH-TEX-READTABLE
  270.     (LET ((ROWS (TELL BOX :ROWS))
  271.       (HEADING (CDR (ASSQ LEVEL *SECTION-BOX-LEVEL-ALIST*)))
  272.       (BOX-HANDLER (CDR (ASS #'BOX-EQUAL? BOX *SPECIAL-TEX-BOX-HANDLER-ALIST*))))
  273.       (IF (NOT (NULL BOX-HANDLER))
  274.       (FUNCALL BOX-HANDLER BOX OUTPUT-STREAM)
  275.       (COND ((AND (NOT (NULL HEADING)) (NOT (NULL (TELL BOX :NAME-ROW))))
  276.          ;; named boxes are used for sectioning
  277.          (TERPRI) (DOTIMES (I LEVEL) (FORMAT T "  "))
  278.          (FORMAT T "[~A : ~A" HEADING (TELL BOX :NAME))
  279.          (TELL OUTPUT-STREAM :STRING-OUT (FORMAT NIL "~%~%~A{~A}~%~%"
  280.                              HEADING (TELL BOX :NAME))))
  281.         (T (FORMAT T "~%[")))
  282.       ;; now process the rows themselves
  283.       (LOOP WITH EXAMPLE-FLAG = NIL
  284.         FOR ROW IN ROWS
  285.         FOR EXAMPLE-DELIMITER = (AND (NULL (TELL ROW :BOXES-IN-ROW))
  286.                          (STRING-SEARCH "***" (TELL ROW :TEXT-STRING)))
  287.         WHEN EXAMPLE-DELIMITER
  288.           DO (COND ((NULL EXAMPLE-FLAG)
  289.                 (SETQ EXAMPLE-FLAG T)
  290.                 (FORMAT OUTPUT-STREAM "~%\startboxerexample~%"))
  291.                (T
  292.                 (SETQ EXAMPLE-FLAG NIL)
  293.                 (FORMAT OUTPUT-STREAM "~%\stopboxerexample~%")))
  294.         DO (COND ((NOT (NULL EXAMPLE-DELIMITER)))
  295.              ((NULL EXAMPLE-FLAG) (TEXIFY-ROW ROW OUTPUT-STREAM LEVEL))
  296.              (T (TEXIFY-BOXER-EXAMPLE-ROW ROW OUTPUT-STREAM)))
  297.         FINALLY
  298.           (WHEN (NOT (NULL EXAMPLE-FLAG))
  299.             (FORMAT OUTPUT-STREAM "~%\stopboxerexample~%")))
  300.       (FORMAT T "]~%")))))
  301.  
  302.  
  303. (DEFUN MAKE-CHAPTER-FROM-BOX (BOX TITLE)
  304.   (ZWEI:WITH-EDITOR-STREAM (S :PATHNAME TITLE)
  305.     (TEXIFY-BOX BOX S 1)))
  306.  
  307. ;;; special cha handlers
  308.  
  309. (DEFUN MATH-MODE-CHARACTER (CHA STREAM)
  310.   (FORMAT STREAM "$~C$" CHA))
  311.  
  312. (DEFUN COMMAND-CHARACTER (CHA STREAM)
  313.   (FORMAT STREAM "\~C{}" CHA))
  314.  
  315. (DEFUN GEQ-CHARACTER (IGNORE STREAM)
  316.   (FORMAT STREAM "$\geq$"))
  317.  
  318. (DEFUN LEQ-CHARACTER (IGNORE STREAM)
  319.   (FORMAT STREAM "$\leq$"))
  320.  
  321. (DEFUN AST-CHARACTER (IGNORE STREAM)
  322.   (FORMAT STREAM "$\ast$"))
  323.  
  324. ;;; special box handlers
  325.  
  326. (DEFUN BOXER-NAME-HANDLER (BOX STREAM)
  327.   BOX                        ;bound but never used...
  328.   (FORMAT STREAM "\BOXER "))
  329.  
  330. (DEFUN TEX-TRUE-BOX (BOX STREAM)
  331.   BOX
  332.   (FORMAT STREAM "\true"))
  333.  
  334. (DEFUN TEX-FALSE-BOX (BOX STREAM)
  335.   BOX
  336.   (FORMAT STREAM "\false"))
  337.  
  338. ;;; need this to make the keywording procedure work
  339. ;;; WARNING, don't use this for anything else.  It is INCREDIBLY  DANGEROUS
  340. ;;; for example, directly calling it ANYWHERE will cause you to lose horribly
  341.  
  342. (DEFBOXER-FUNCTION PORT-TO-POINT ()
  343.   (MAKE-EVDATA ROWS `((,(PORT-TO-INTERNAL (POINT-BOX))))))
  344.