unroff-website/www/contrib/me-misc-patch.diff

     Here are my diffs to put partial -me support into unroff-1.0, and comments
to attach to the patch kit.  The problems fixed are listed below, and the
unimplemented features are noted.
     For the benefit of those wondering why -me implementation stopped where it
did, I use troff with -me to produce camera-ready copy articles for academic
journals.  The -me section support isn't very useful in this regard, so isn't
used by me.  [...]
					George Helffrich
					george@geology.bristol.ac.uk


me.scm
New code. Features not implemented are:
1.  No table of contents - .(x .)x .xp 
2.  No footnotes or delayed text - .(d .)d .pd .(f .)f \**
3.  No section handling - .sh .sx .uh .$p .$0-.$6
4.  Vestigial bits of -ms macros left in to be hacked in the future to -me
    use (footnotes and delayed text continue to be of value in an html
    document, in particular).

unroff-html-me.man
1.  Man page documentation.
      
manual.ms
1.  Explicit page length (for 8.5x11 removed).  Font position 5 doesn't
    exist for standard troff.
	   
common.scm
1.  Local configuration changes for local software names

2.  troff-to-text didn't contain "| col -b |" to get rid of backspaces & other
    escape info.

3.  Added new type "pic" for procedure pic-to-gif below, which is a local
    feature to handle a locally-define type of plot file.  (Not the pic
    of normal Unix, something with an unfortunately suggestive name.)

4.  .bp should cause a line break

5.  Implemented in Scheme procedures the code to save up state information
    for .EQ/.EN so that this can be re-emitted in troff-to-gif to process
    equations.  This fixes a bug that causes unroff to forget about .EQ/.EN
    "state" information such as define/ndefine/tdefine strings, gfont,
    gsize, etc.

    first-token returns the first token of equation text
    filter-eqn-state extends knowledge of .EQ/.EN text to include other
    statements that don't generate equations.

6.  Handle equations in tables by emitting .EQ/.EN before any table text
    so that environment is prepared for in-line table equations.

7.  troff-to-pic is a misnomer, but handles the pic-to-gif conversion.  It
    is very similar to troff-to-gif with differences in "processor" handling.

8.  Don't generate a line break after in-line gif pictures, there may be
    text following, as in e.g.
       This is an equation $x ~=~ y sup 2$, with following punctuation.

9.  .ti generates a message on negative indent, but still does a break.

hyper.scm
1.  Robustify .Ha macro so that no error generated if lacking final argument.
    Missing 2nd arg isn't really an error.

*** /dev/null	Tue Jan 23 11:17:38 1996
--- ./scm/html/me.scm	Fri Jan 19 21:24:37 1996
***************
*** 0 ****
--- 1,692 ----
+ ;;;; -*-Scheme-*-
+ ;;;;
+ ;;;; $Revision: 1.14 $
+ ;;;;
+ ;;;; `me' specific definitions for HTML output format
+ ;;;; Hacked from ms version by G. Helffrich/U. Bristol
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Options.
+ 
+ (define-option 'signature          'string    "")
+ (define-option 'split              'integer   0)
+ (define-option 'toc                'boolean   #t)
+ (define-option 'toc-header         'string    "Table of Contents")
+ (define-option 'pp-indent          'integer   3)
+ (define-option 'footnotes-header   'string    "Footnotes")
+ (define-option 'footnote-reference 'string    "[note %1%]")
+ (define-option 'footnote-anchor    'string    "[%1%]")
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Predefined strings and number registers.
+ 
+ (defstring 'lq  "``")
+ (defstring 'rq  "''")
+ (defstring '-  "--")    ; em-dash
+ (defstring 'mo (substitute "%monthname+%"))
+ (defstring 'dw (substitute "%weekday+%"))
+ (defstring 'dy (substitute "%day%"))
+ (defstring 'td (substitute "%monthname+% %day%, %year%"))
+ 
+ (defnumreg '$c #\1)
+ (defnumreg '$d #\1)
+ (defnumreg '$f #\1)
+ (defnumreg '$m #\2)
+ (defnumreg '$n #\2)
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; General bookkeeping.
+ 
+ 
+ (define split-sections? #f)    ; #t if `split' option is positive
+ 
+ 
+ (define-pair abstract   abstract?   ""               "<hr>\n")
+ (define-pair title      title?      "<h1>\n"         "</h1>\n")
+ (define-pair secthdr    secthdr?    "<h2>\n"         "</h2>\n")
+ (define-pair tag-para   tag-para?   "<dl>\n"         "</dl>\n")
+ (define-pair list-para  list-para?  "<ul>\n"         "</ul>\n")
+ (define-pair quoted     quoted?     "<blockquote>\n" "</blockquote>\n")
+ 
+ (define (reset-everything)
+   (emit
+     (reset-font)
+     (center 0)
+     (quoted #f)
+     (secthdr #f)
+     (preform #f)
+     (tag-para #f)
+     (list-para #f)
+     (reset-title-features))
+   (header-processor #f))
+ 
+ (define-nested-pair indent  indent-level  "<dl><dt><dd>\n" "</dl>\n")
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Manage HTML output files.
+ 
+ (define HTML-streams '())
+ 
+ (define (push-HTML-stream file-suffix title-suffix)
+   (let* ((docname (option 'document))
+ 	 (title (option 'title))
+ 	 (t (concat (if title title docname) title-suffix))
+ 	 (fn (if file-suffix (concat docname file-suffix ".html") #f))
+ 	 (s (if fn (open-output-stream fn) #f)))
+     (close-stream (set-output-stream! #f))
+     (set-output-stream! s)
+     (list-push! HTML-streams fn)
+     (emit-HTML-prolog)
+     (emit "<title>" (translate t) "</title>\n</head><body>\n")))
+ 
+ (define (pop-HTML-stream)
+   (if (not (eqv? (option 'signature) ""))
+       (emit "<p><hr>\n" (substitute (option 'signature))) #\newline)
+   (emit "</body>\n</html>\n")
+   (list-pop! HTML-streams)
+   (close-stream (set-output-stream! #f))
+   (if (and (not (null? HTML-streams)) (car HTML-streams))
+       (set-output-stream! (append-output-stream (car HTML-streams)))))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Callback procedure called by hyper.scm when creating hypertext anchor.
+ 
+ (define (query-anchor request label)
+   (lambda (op)
+     (case op
+       (allowed?       #t)
+       (emit-anchor?   #t)
+       (filename
+ 	(if (not (stream-file? (output-stream)))
+ 	    (car HTML-streams)
+ 	    (stream-target (output-stream)))))))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Generate hypertext reference and anchor.
+ 
+ (define (make-href type index contents)
+   (let* ((docname (option 'document))
+ 	 (file
+ 	   (case type
+ 	   ((section toc) (car HTML-streams))
+ 	   (footnote (if split-sections? (concat docname "-notes.html") "")))))
+     (format #f "<a href=\"~a#~a~a\">~a" file type index
+ 	       (if contents (concat contents "</a>\n") ""))))
+ 
+ (define (make-anchor type index contents)
+   (format #f "<a name=\"~a~a\">~a</a>" type index contents))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Automatically generated TOC.
+ 
+ (define auto-toc-entry
+   (let ((last-level 0))
+     (lambda (anchor entry level labelnum)
+       (with-output-appended-to-stream "[autotoc]"
+ 	(emit (repeat-string (- level last-level) "<ul>")
+ 	      (repeat-string (- last-level level) "</ul>"))
+ 	(set! last-level level)
+ 	(if (positive? level)
+ 	    (emit "<li>" (make-href 'section labelnum anchor) entry))))))
+ 
+ (define (auto-toc-spill)
+   (auto-toc-entry "" "" 0 0)
+   (let ((toc (stream->string "[autotoc]")))
+     (if (not (eqv? toc ""))
+ 	(emit "<h2>" (substitute (option 'toc-header)) "</h2>\n" toc))))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Start and exit event functions.
+ 
+ (defevent 'start 10
+   (lambda _
+     (set! split-sections? (positive? (option 'split)))
+     (let ((docname (option 'document)))
+       (if (not (or docname (option 'title)))
+ 	  (quit "you must set either document= or title="))
+       (if (and split-sections? (not docname))
+ 	  (quit "you must set document= for non-zero `split'"))
+       (push-HTML-stream (if docname "" #f) ""))))
+ 
+ (defevent 'exit 10
+   (lambda _
+     (reset-everything)
+     (emit (indent 0))
+     (footnote-processor 'spill)
+     (do () ((null? (cdr HTML-streams))) (pop-HTML-stream))
+     (if (option 'toc)
+         (auto-toc-spill))
+     (pop-HTML-stream)))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Title features, abstract.
+ 
+ (define got-title? #f)
+ 
+ (define (reset-title-features)
+   (concat (title #f)
+ 	  (begin1 (if got-title? "<hr>\n" "") (set! got-title? #f))))
+ 
+ (defmacro 'TL
+   (lambda _
+     (cond
+       (got-title?
+ 	(warn ".TL is only allowed once"))
+       (else
+         (reset-everything)
+         (set! got-title? #t)
+         (title #t)))))
+ 
+ (defmacro 'AU
+   (lambda _
+     (emit (title #f) "<p>\n" (change-font 2))
+     (center 999)))
+ 
+ (defmacro 'AI
+   (lambda _
+     (emit (title #f) "<br>\n" (change-font 1))
+     (center 999)))
+ 
+ (defmacro 'AB
+   (lambda (AB . args)
+     (reset-everything)
+     (abstract #t)
+     (cond ((null? args)
+ 	    "<h2>ABSTRACT</h2>\n<p>\n")
+           ((string=? (car args) "no")
+ 	    "<p>\n")
+ 	  (else
+ 	    (concat "<h2>" (parse (car args)) "</h2>\n<p>\n")))))
+ 
+ (defmacro 'AE
+   (lambda _
+     (cond (abstract?  (reset-everything) (abstract #f))
+ 	  (else       (warn ".AE without preceding .AB")))))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Numbered sections.
+ 
+ (define sections (list 0))
+ 
+ (define (increment-section! s n)
+   (if (positive? n)
+       (increment-section! (cdr s) (1- n))
+       (set-car! s (if (char? (car s))
+ 		      (integer->char (modulo (1+ (char->integer (car s))) 256))
+ 		      (1+ (car s))))
+       (set-cdr! s '())))
+ 
+ (define (section-number s n)
+   (if (zero? n)
+       ""
+       (format #f "~a.~a" (car s) (section-number (cdr s) (1- n)))))
+ 
+ (define (verify-section-number s)
+   (cond ((eqv? s "") #f)
+ 	((string->number s) (string->number s))
+ 	((char-alphabetic? (string-ref s 0)) (string-ref s 0))
+ 	(else #f)))
+ 
+ (define (numbered-section args)
+   (cond
+     ((null? args)
+       (increment-section! sections 0)
+       (defstring 'SN (section-number sections 1))
+       1)
+     ((string=? (car args) "S")
+       (cond
+ 	((null? (cdr args))
+ 	  (warn ".NH with `S' argument but no numbers")
+ 	  1)
+ 	(else
+ 	  (let ((new (map verify-section-number (cdr args))))
+ 	    (if (memq #f new)
+ 		(warn "bad section number in .NH request")
+ 		(set! sections new))
+ 	    (defstring 'SN (section-number new (length new)))
+             (length new)))))
+     (else
+       (let ((level (string->number (car args))))
+ 	(if (not level)
+ 	    (begin
+ 	      (warn "~a is not a valid section level" (car args))
+ 	      (set! level 1)))
+ 	(if (< (length sections) level)
+ 	    (append! sections (make-list (- level (length sections)) 0)))
+ 	(increment-section! sections (1- level))
+ 	(defstring 'SN (section-number sections level))
+ 	level))))
+ 
+ (defmacro 'NH
+   (lambda (NH . args)
+     (reset-everything)
+     (emit (indent 0))
+     (let ((level (numbered-section args)))
+       (if (and split-sections? (<= level (option 'split)))
+ 	  (let* ((sect (stringdef 'SN))
+ 	         (suff (concat #\- (string-prune-right sect "." sect))))
+ 	    (push-HTML-stream suff (concat ", section " sect))))
+       (header-processor #t level))))
+ 
+ (define header-processor
+   (let ((stream #f) (inside? #f) (seq 1) (level 0))
+     (lambda (enter? . arg)
+       (cond
+ 	((and enter? (not inside?))
+ 	  (set! level (car arg))
+ 	  (set! stream (set-output-stream! (open-output-stream "[header]"))))
+ 	((and inside? (not enter?))
+ 	  (close-stream (set-output-stream! stream))
+ 	  (let ((hdr (stream->string "[header]"))
+ 		(sectno (stringdef 'SN)))
+ 	    (cond
+ 	      ((and split-sections? (option 'toc))
+ 	        (auto-toc-entry (concat sectno #\space) hdr level seq)
+ 	        (emit "<h2>" (make-anchor 'section seq sectno)))
+ 	      (else
+ 		(emit "<h2>" sectno)))
+ 	    (emit nbsp hdr "</h2>\n")
+ 	    (++ seq))))
+       (set! inside? enter?)
+       "")))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Font switching and related requests.
+ 
+ (define (with-font font . args)
+   (let ((old current-font))
+   (cond
+     ((null? args)
+        (concat (change-font font) #\newline))
+     ((null? (cdr args))
+        (concat (change-font font) (parse (car args) #\newline)
+ 	       (change-font old)))
+     (else
+        (concat (change-font font) (parse (car args)) (change-font old)
+ 	       (parse (cadr args) #\newline))))))
+ 
+ (defmacro 'i (lambda (i . args)
+    (apply with-font (cons "I" args))))
+ (defmacro 'b (lambda (b . args) 
+    (apply with-font (cons "B" args))))
+ (defmacro 'r (lambda (r . args)
+    (apply with-font (cons "R" args))))
+ (defmacro 'rb (lambda (rb . args)
+    (apply with-font (cons "R" args))
+    (change-font "B")))
+ 
+ (defmacro 'bi (requestdef 'rb))
+ 
+ (defmacro 'u (lambda (u) (with-font "I")))    ; <u> doesn't work
+ 
+ (defmacro 'q
+   (lambda (q . args) (
+     (let ((old current-font))
+     (if (null? args) ""
+       (concat "``" (car args) "''" (cdr args)))))))
+ 
+ (defmacro 'bx
+   (lambda (bx word)
+     (parse word #\newline)))
+ 
+ (defmacro 'sz "")
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Indented paragraph with optional label.
+ 
+ (define (indented-paragraph ip . arg)
+   (define (non-tagged? s)
+     (or (null? s) (member (car s) '("\\(bu" "\\(sq" "\\-"))))
+   (emit (reset-font) (secthdr #f) (reset-title-features))
+   (header-processor #f)
+   (cond
+     (preform?
+       (surprise ".ip inside .nf/.fi")
+       (if (not (null? arg)) (concat (parse (car arg)) #\newline) #\newline))
+     (tag-para?
+       (if (null? arg)
+ 	  "<dt><dd><p>\n"
+ 	  (concat "<dt>" (parse (car arg)) "<dd>\n")))
+     (list-para?
+       (cond
+ 	((non-tagged? arg)
+ 	  "<li>\n")
+ 	(else
+           (warn ".ip `arg' in a list that was begun as non-tagged")
+           (concat "<li>" (parse (car arg)) "<br>\n"))))
+     ((non-tagged? arg)
+       (concat (list-para #t) (indented-paragraph IP)))
+     (else
+       (concat (tag-para #t) (indented-paragraph IP (car arg))))))
+ 
+ (defmacro 'ip indented-paragraph)
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Relative indent.
+ 
+ (define (relative-indent request . _)
+   (if preform?
+       (surprise ".RS/.RE inside .nf/.fi"))
+   (emit (reset-font) (tag-para #f) (list-para #f))
+   (with-preform-preserved
+     (indent (if (string=? request "RS") '+ '-))))
+ 
+ (defmacro 'RS relative-indent)
+ (defmacro 'RE relative-indent)
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Displays.
+ 
+ (define left-paren-b "(b")
+ (define right-paren-b ")b")
+ (define left-paren-q "(q")
+ (define right-paren-q ")q")
+ (define left-paren-c "(c")
+ (define right-paren-c ")c")
+ (define left-paren-l "(l")
+ (define right-paren-l ")l")
+ (define left-paren-z "(z")
+ (define right-paren-z ")z")
+ (define display-saved-font #f)
+ (define inside-display? #f)
+ (define indented-display? #f)
+ 
+ (define (display-start quote? type fill)
+ ;;(warn "got into display-start with quote ~a type `~a' and fill `~a'" quote? type fill)
+   (if (string=? type "C")
+       (begin
+ 	(warn "display type ~a not supported (using I)" type)
+ 	(set! type "I")))
+   (cond
+     ((or (not (= (string-length type) 1))
+ 	 (not (memq (string-ref type 0) '(#\I #\L #\C #\M))))
+       (warn "illegal display type `~a'" type))
+     (inside-display?
+       (warn "nested display ignored"))
+     (preform?
+       (warn "display inside .nf/.fi ignored"))
+     (else
+       (set! display-saved-font current-font)
+       (emit (reset-font))
+       (set! indented-display? (string=? type "I"))
+       (if indented-display?
+           (emit (indent '+))
+ 	  (emit "<br>"))
+       (if quote? (emit "<blockquote>\n"))
+       (set! inside-display? #t)
+       (if (string=? fill "U") (preform #t))
+       "")))
+ 
+ (defmacro left-paren-b
+   (lambda (_ . args)
+ ;;  (warn "in ~a with '~a'" left-paren-b args)
+     (apply display-start
+       (cond
+         ((null? args) '(#f "I" "U"))
+ 	((null? (cdr args)) (list #f (car args) "U"))
+ 	(else (list #f args))))
+ ;;  (if preform? (warn "~a preform #t" left-paren-b))
+     ""))
+ 
+ (defmacro left-paren-q
+   (lambda (_ . args)
+     (apply display-start (list '#t "L" "F"))))
+ 
+ (defmacro left-paren-c
+   (lambda (_ . args)
+     (apply display-start (list '#f "C" "F"))))
+ 
+ (defmacro left-paren-l (macrodef left-paren-b))
+ (defmacro left-paren-z (macrodef left-paren-b))
+ 
+ (define (display-end quote?)
+ ;; (warn "in display-end, quote? ~a preform ~a" quote? preform?)
+    (cond
+      ((not inside-display?)
+ 	(warn "~a without matching display start" left-paren-b))
+       (else
+ 	(set! inside-display? #f)
+ 	(if quote? (emit "</blockquote>"))
+ 	(emit
+ 	  (with-font-preserved
+ 	    (preform #f)
+ 	    (if indented-display? (indent '-) ""))
+ 	  (change-font display-saved-font)))))
+ 
+ (defmacro right-paren-b
+   (lambda _
+     (display-end #f)
+     ""))
+ 
+ (defmacro right-paren-q
+   (lambda _ (display-end #t)))
+ 
+ (defmacro right-paren-c
+   (lambda _ (display-end #f)))
+ 
+ (defmacro right-paren-l (macrodef right-paren-b))
+ (defmacro right-paren-z (macrodef right-paren-b))
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Footnotes.
+ 
+ ;; Generating \[***] for \** allows us to defer creating the anchor from
+ ;; string expansion time to output time.  Otherwise we couldn't use <...>.
+ 
+ (defstring '* "\\[***]")
+ 
+ (define **-count 0)
+ 
+ (defspecial '***
+   (lambda _
+     (++ **-count)
+     (footnote-anchor (substitute (option 'footnote-reference)
+ 				 (number->string **-count)))))
+ 
+ (define next-footnote 0)
+ 
+ (define (footnote-anchor sym)
+   (++ next-footnote)
+   (with-font-preserved
+     (concat (change-font 1) (make-href 'footnote next-footnote sym))))
+ 
+ ;; New request to generate a footnote anchor; an alternative to \**.
+ ;; Should be followed by .FS.  Do not use `.FA \**'.
+ 
+ (defmacro 'FA
+   (lambda (FA arg) (footnote-anchor (parse arg))))
+ 
+ 
+ (define footnote-processor
+   (let ((stream #f) (inside? #f))
+     (lambda (op . arg)
+       (case op
+       (begin
+         (cond
+ 	  (inside?
+ 	    (surprise "nested .FS"))
+ 	  (else
+ 	    (set! inside? #t)
+ 	    (set! stream (set-output-stream!
+ 			   (append-output-stream "[footnotes]")))
+ 	    (emit "<p>\n")
+ 	    (let ((anchor
+ 		    (cond ((not (null? arg))
+ 			    (parse (car arg)))
+ 			  ((positive? **-count)
+ 			    (substitute (option 'footnote-anchor)
+ 					(number->string **-count)))
+ 			  (else #f))))
+ 	      (if anchor
+ 		  (emit "<b>" (make-anchor 'footnote next-footnote anchor)
+ 			"</b>" nbsp))))))
+       (end
+ 	(cond
+ 	  (inside?
+ 	    (set! inside? #f)
+ 	    (close-stream (set-output-stream! stream)))
+ 	  (else (warn ".FE without matching .FS"))))
+       (spill
+ 	(if inside? (quit "unterminated footnote at end of document"))
+ 	(let ((contents (stream->string "[footnotes]"))
+ 	      (hdr (substitute (option 'footnotes-header))))
+ 	  (cond
+ 	    ((not (eqv? contents ""))
+ 	       (if split-sections?
+ 		   (push-HTML-stream "-notes" ", footnotes"))
+ 	       (cond ((and split-sections? (option 'toc))
+ 		       (auto-toc-entry hdr "" 1 0)
+ 		       (emit "<h2>" (make-anchor 'section 0 hdr)))
+ 		     (else (emit "<h2>" hdr)))
+ 	       (emit "</h2>\n" contents))
+ 	    ((positive? next-footnote)
+ 	      (warn "footnote anchor used, but no .FS"))))))
+     "")))
+ 
+ (defmacro 'FS
+   (lambda (FS . arg)
+     (apply footnote-processor 'begin arg)))
+ 
+ (defmacro 'FE
+   (lambda _ (footnote-processor 'end)))
+ 
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; TOC macros.
+ 
+ (define toc-processor
+   (let ((stream #f) (inside? #f) (seq 1))
+     (lambda (op . arg)
+       (case op
+       (begin
+         (cond
+ 	  (inside?
+ 	    (surprise "nested .XS"))
+ 	  (else
+ 	    (set! inside? #t)
+ 	    (emit (make-anchor 'toc seq "&#160;") #\newline)
+ 	    (set! stream (set-output-stream! (append-output-stream "[toc]")))
+ 	    (if (>= (length arg) 2)
+ 		(emit
+ 		  (repeat-string
+ 		    (get-hunits (parse-expression (cadr arg) 0 #\n)) nbsp)))
+ 	    (if (option 'document)
+ 	        (emit (make-href 'toc seq #f)))
+ 	    (++ seq))))
+       (end
+ 	(cond
+ 	  (inside?
+ 	    (set! inside? #f)
+ 	    (if (option 'document) (emit "</a>\n"))
+ 	    (emit "<br>\n")
+ 	    (close-stream (set-output-stream! stream)))
+ 	  (else (warn ".XE or .XA without matching .XS"))))
+       (spill
+ 	(if inside? (quit "unterminated .XE"))
+ 	(if (or (null? arg) (not (string=? (car arg) "no")))
+ 	    (emit "<h2>Table of Contents</h2>\n"))
+ 	(emit (stream->string "[toc]"))))
+     "")))
+ 
+ (defmacro 'XS
+   (lambda (XS . arg)
+     (apply toc-processor 'begin arg)))
+ 
+ (defmacro 'XE (lambda _ (toc-processor 'end)))
+ (defmacro 'XA (lambda _ (toc-processor 'end) (toc-processor 'begin)))
+ 
+ (defmacro 'PX
+   (lambda (PX . arg)
+     (apply toc-processor 'spill arg)))
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Paragraphs of various kinds.
+ 
+ (define-macro (define-paragraph request . body)
+   `(defmacro ,request (lambda _ (reset-everything) ,@body)))
+ 
+ (define-paragraph 'lp "<p>\n")
+ (define-paragraph 'pp (concat "<p>\n"
+ 			      (repeat-string (option 'pp-indent) nbsp)))
+ 
+ (defmacro 'hl "<hr>\n") ; horizontal line across page
+ 
+ 
+ ;;; --------------------------------------------------------------------------
+ ;;; Requests that must be ignored, either because the function cannot
+ ;;; be expressed in HTML or because they assume a page structure.
+ 
+ (defmacro 're "")    ; reset tabs
+ (defmacro 're "")    ; reset tabs
+ (defmacro 'll "")    ; line length
+ (defmacro 'xl "")    ; line length
+ (defmacro 'lh "")    ; letterhead
+ (defmacro 'he "")    ; header
+ (defmacro 'fo "")    ; footer
+ (defmacro 'eh "")    ; even header
+ (defmacro 'oh "")    ; odd header
+ (defmacro 'ef "")    ; even footer
+ (defmacro 'of "")    ; odd footer
+ (defmacro 'hx "")    ; suppress headers & footers on next page
+ (defmacro 'm1 "")    ; top of page spacing
+ (defmacro 'm2 "")    ; header to first line spacing
+ (defmacro 'm3 "")    ; footer to last line spacing
+ (defmacro 'm4 "")    ; footer to bottom of page spacint
+ (defmacro '$h "")    ; print header
+ (defmacro '$f "")    ; print footer
+ (defmacro '$H "")    ; top-of-page macro
+ (defmacro 'th "")    ; UCB thesis mode
+ (defmacro 'ac "")    ; ACM mode
+ (defmacro 'sk "")    ; skip page
+ (defmacro 'ro "")    ; roman page number
+ (defmacro 'ar "")    ; arabic page number
+ (defmacro 'pa "")    ; begin page N
+ 
+ (define (multi-column-ignored request . _)
+   (warn "multi-column request .~a not supported" request))
+ 
+ (defmacro '1c multi-column-ignored)
+ (defmacro '2c multi-column-ignored)
+ (defmacro 'bc multi-column-ignored)
+ 
+ (define (section-ignored request . _)
+   (warn "section heading request .~a not supported" request))
+ 
+ (defmacro 'sh section-ignored)
+ (defmacro 'sx section-ignored)
+ (defmacro '$p section-ignored)
+ (defmacro '$0 section-ignored)
+ (defmacro '$1 section-ignored)
+ (defmacro '$2 section-ignored)
+ (defmacro '$3 section-ignored)
+ (defmacro '$4 section-ignored)
+ (defmacro '$5 section-ignored)
+ (defmacro '$6 section-ignored)
*** /dev/null	Tue Jan 23 11:17:38 1996
--- ./doc/unroff-html-me.1	Wed Jan 24 21:53:26 1996
***************
*** 0 ****
--- 1,188 ----
+ .ds Ve 1.0
+ .\"
+ .de Ex
+ .RS
+ .nf
+ .nr sf \\n(.f
+ .if !\\n(.U \{\
+ .  ft B
+ .  if n .sp
+ .  if t .sp .5 \}
+ ..
+ .de Ee
+ .if !\\n(.U \{\
+ .  ft \\n(sf
+ .  if n .sp
+ .  if t .sp .5 \}
+ .fi
+ .RE
+ ..
+ .\"
+ .de Sd
+ .ds Dt \\$2
+ ..
+ .\"
+ .Sd $Date: 1996/01/24 21:29:31 $
+ .TH unroff-html-me 1 "\*(Dt"
+ .SH NAME
+ unroff-html-me \- back-end to translate `me' documents to HTML 2.0
+ .SH SYNOPSIS
+ .B unroff
+ [
+ .B \-fhtml
+ ] [
+ .B \-me
+ ] [
+ .IR file " | " option...\&
+ ]
+ .SH OVERVIEW
+ When called with the
+ .B \-fhtml
+ and
+ .B \-me
+ options, the troff translator
+ .I unroff
+ loads the back-end for converting \*(lqme\*(rq documents to the Hypertext
+ Markup Language (HTML) version 2.0.
+ .LP
+ Please read
+ .BR unroff (1)
+ first for an overview of the Scheme-based, programmable troff translator
+ and for a description of the generic options that exist in
+ addition to
+ .B \-f
+ and
+ .BR \-m .
+ The translation of basic troff requests, special characters,
+ escape sequences, etc. as well as the HTML-specific options
+ are described in
+ .BR unroff-html (1).
+ For information about extending and programming
+ .I unroff
+ also refer to the
+ .IR "Unroff Programmer's Manual" .
+ .SH OPTIONS
+ The
+ .B \-me
+ extension provides a number of keyword/value options in addition to
+ those listed in
+ .BR unroff (1)
+ and
+ .BR unroff-html (1):
+ .TP
+ .BR signature " (string)"
+ If non-empty, the value of this option together with a <hr> tag is
+ appended to each HTML output file created.
+ The
+ .I substitute
+ Scheme primitive (as described in the Programmer's Manual) is
+ applied to the value of the option, so that date, time, environment
+ variables, etc. can be interpolated.
+ .TP
+ .BR pp-indent " (integer)"
+ The number of non-breakable spaces (as specified by the predefined
+ Scheme variable
+ .IR nbsp )
+ to generate for a paragraph created by the
+ .B .pp
+ macro.
+ The default is 3.
+ This option, as well as
+ .BR signature ,
+ is typically set in the user-preferences file
+ .BR ~/.unroff ,
+ or in a document-specific Scheme file or at the beginning of
+ the document proper.
+ .SH FILES
+ .I unroff
+ reads and parses an \*(rqme\*(lq document composed of one or more
+ input files.
+ As usual, the special file name
+ .RB ` \- '
+ can be used to interpolate standard input.
+ If no file name is given in the command line,
+ .I unroff
+ reads from standard input.
+ .LP
+ The resulting HTML document is sent to standard output, unless a
+ file name prefix is assigned to the
+ .B document
+ option.
+ .SH EXAMPLE
+ To translate an \*(lqme\*(rq document composed of several
+ input files,
+ .I unroff
+ could be invoked like this:
+ .Ex
+ .if n \{unroff \-fhtml \-me document=thesis\e
+        intro.me 1.me 2.me 3.me app.me\}
+ .if !n unroff \-fhtml \-me document=thesis intro.me 1.me 2.me 3.me app.me
+ .Ee
+ The output file will have the name \*(lqthesis.html\*(rq.
+ .SH DESCRIPTION
+ The following 
+ .B \-me
+ macros are translated (in addition to any user-defined macros):
+ .LP
+ .nf
+ .if !\n(.U .ta 8n 16n 24n 32n 40n 48n 56n
+ 	.(b 	.)b 	.(c 	.)c 	.(l 	.)l 	.(q
+ 	.)q 	.(z 	.)z 	.b 	.bi 	.bx 	.hl
+ 	.i 	.ip 	.q 	.r 	.rb 	.sz 	.u
+ .fi
+ .LP
+ These predefined strings and number registers are recognized:
+ .LP
+ .nf
+ 	\e*(lq	\e*(rq	\e*-	\e*(mo	\e*(dw	\e*(dy	\e*(td
+ 	\en($c	\en($d	\en($f	\en($m	\en($n
+ .fi
+ .LP
+ In addition, a number of macros are either silently ignored
+ or cause a warning to be printed, because their function either
+ cannot be mapped to HTML 2.0 elements or assumes a page
+ structure:
+ .LP
+ .nf
+ 	.$H 	.$f 	.$h 	.1c 	.2c 	.ac 	.ar
+ 	.bc 	.ef 	.eh 	.fo 	.he 	.hx 	.lh
+ 	.ll 	.m1 	.m2 	.m3 	.m4 	.of 	.oh
+ 	.pa 	.ro 	.sk 	.th 	.xl
+ .fi
+ .LP
+ Finally, these macros are not implemented, but could be in a
+ future version:
+ .LP
+ .nf
+ 	.sh 	.sx 	.uh	.(f	.)f	.(d	.)d
+ 	.pd	.(x	.)x	.xp
+ .fi
+ .LP
+ The font switching macros are based on changes to the fonts `R',
+ `I', and `B', as explained under FONTS in
+ .BR unroff-html (1).
+ Of course, this fails if the fonts (which are mounted on startup)
+ are unmounted by explicit
+ .B .fp
+ requests.
+ .SH "SEE ALSO"
+ .BR unroff (1),
+ .BR unroff-html (1),
+ .BR troff (1),
+ .BR me "(5 or 7)."
+ .LP
+ Unroff Programmer's Manual.
+ .LP
+ http://www.informatik.uni-bremen.de/~net/unroff
+ .LP
+ Berners-Lee, Connolly, et al.,
+ HyperText Markup Language Specification\(em2.0,
+ Internet Draft, Internet Engineering Task Force.
+ .SH BUGS
+ The macro
+ .B .ul
+ is currently mapped to a call to
+ .BR .i ,
+ as underlining is not supported by the HTML back-end of
+ .I unroff
+ \*(Ve.
diff -c -r /tmp/unroff-1.0/doc/manual.ms ./doc/manual.ms
*** /tmp/unroff-1.0/doc/manual.ms	Mon Aug 21 13:02:41 1995
--- ./doc/manual.ms	Thu Jan 18 11:41:14 1996
***************
*** 6,13 ****
  .ds Sc http://www-swiss.ai.mit.edu/scheme-home.html
  .ds Md .
  .
! .fp 5 C
! .pl 11i
  .
  .de Es
  .ie n .DS I 3n
--- 6,13 ----
  .ds Sc http://www-swiss.ai.mit.edu/scheme-home.html
  .ds Md .
  .
! ..fp 5 C
! ..pl 11i
  .
  .de Es
  .ie n .DS I 3n
***************
*** 65,71 ****
  .if \\n+P>2 .br
  .Ha \\$1 "(\\$2\\*(xx)"
  ..
! .
  .TL
  unroff \*(Ve Programmer's Manual
  .AU
--- 65,71 ----
  .if \\n+P>2 .br
  .Ha \\$1 "(\\$2\\*(xx)"
  ..
! ..bp
  .TL
  unroff \*(Ve Programmer's Manual
  .AU
diff -c -r /tmp/unroff-1.0/scm/html/common.scm ./scm/html/common.scm
*** /tmp/unroff-1.0/scm/html/common.scm	Wed Aug 23 13:10:19 1995
--- ./scm/html/common.scm	Sun Jan 21 23:02:29 1996
***************
*** 9,24 ****
  ;;; Configurable, site-specific definitions.
  
  (define-option 'troff-to-gif  'string
!   "groff -ms > %1%; /usr/www/lib/latex2html/pstogif %1% -out %2%")
  
  (define-option 'troff-to-text 'string
!    "groff -Tlatin1 -P-b -P-u |sed '/^[ \t]*$/d' > %1%")
  
! (define-option 'tbl 'string 'gtbl)
! (define-option 'eqn 'string 'geqn)
! (define-option 'pic 'string 'gpic)
  
  
  ;; A non-breaking space that is really non-breaking even in broken browsers:
  
  (define nbsp "&#160;<tt> </tt>")
--- 9,28 ----
  ;;; Configurable, site-specific definitions.
  
  (define-option 'troff-to-gif  'string
!   "psroff -me -t | sed -e 's/showpage//g' > %1%; pstogif %1% -out %2%")
  
+ ;;; (define-option 'troff-to-text 'string
+ ;;;    "groff -Tlatin1 -P-b -P-u |sed '/^[ \t]*$/d' > %1%")
  (define-option 'troff-to-text 'string
!    "nroff | col -b | sed '/^[ \t]*$/d' > %1%")
  
! (define-option 'troff-to-pic  'string "pictogif %1% -ps %2% -gif %3%")
  
+ (define-option 'tbl 'string 'tbl)
+ (define-option 'eqn 'string 'eqn)
+ (define-option 'pic 'string 'pic)
  
+ 
  ;; A non-breaking space that is really non-breaking even in broken browsers:
  
  (define nbsp "&#160;<tt> </tt>")
***************
*** 36,42 ****
  
  (define-option 'handle-eqn    'string "gif")  ; gif/text/copy
  (define-option 'handle-tbl    'string "text") ;
! (define-option 'handle-pic    'string "gif")  ;
  
  
  
--- 40,46 ----
  
  (define-option 'handle-eqn    'string "gif")  ; gif/text/copy
  (define-option 'handle-tbl    'string "text") ;
! (define-option 'handle-pic    'string "pic")  ;
  
  
  
***************
*** 81,87 ****
  (defrequest 'ps "")
  (defrequest 'vs "")
  (defrequest 'pl "")
! (defrequest 'bp "")
  (defrequest 'ns "")
  (defrequest 'rs "")
  (defrequest 'wh "")
--- 85,91 ----
  (defrequest 'ps "")
  (defrequest 'vs "")
  (defrequest 'pl "")
! (defrequest 'bp "<br>\n")
  (defrequest 'ns "")
  (defrequest 'rs "")
  (defrequest 'wh "")
***************
*** 361,366 ****
--- 365,401 ----
  ;;; --------------------------------------------------------------------------
  ;;; tbl, eqn, pic.
  
+ ;;; Processing for eqn saves all preceding eqn environment commands, which
+ ;;; are emitted at the beginning of any equation to configure the environment.
+ ;;; (G. Helffrich/U. Bristol)
+ 
+ (define (first-token x)
+    (let loopi ((i 0) (imax (string-length x)))
+       (cond
+ 	 ((>= i imax) #f)
+ 	 ((string=? " " (substring x i (+ i 1))) (loopi (+ i 1) imax))
+ 	 (else
+ 	    (let loopj ((j i))
+ 	       (cond
+ 		  ((>= j imax) (substring x i (+ imax 1)))
+ 		  ((not (string=? " " (substring x j (+ j 1)))) (loopj (+ j 1)))
+ 		  (else (substring x i j))))))))
+ 
+ (define (filter-eqn-state x)
+    (let ((token (first-token x)))
+      (cond
+        ((or (string=? token "delim")
+ 	   (string=? token "gfont")
+ 	   (string=? token "gsize")
+ 	   (string=? token "ndefine")
+ 	   (string=? token "tdefine")
+ 	   (string=? token "define")) 
+ 	  (begin
+ 	     (with-output-appended-to-stream "[eqn-state]" (emit x))
+ 	  #f))
+        ((not token) #f)
+        (else #t))))
+    
  (define (copy-preprocess for-eqn? proc-1 proc-2 stop inline)
    (cond
      (inline
***************
*** 375,386 ****
  	           (if (string=? x stop)
  		       use-output?
  		       (loop (read-line-expand)
! 			     (or (not for-eqn?) (filter-eqn-line x))))))))))
  
  (define troff-to-gif
-   (let ((image-seqnum 1))
      (lambda (processor start stop what args inline)
!       (let ((docname (option 'document)))
          (if (not docname)
  	    (begin
  	      (warn "~a skipped, because no `document' option given" what)
--- 410,425 ----
  	           (if (string=? x stop)
  		       use-output?
  		       (loop (read-line-expand)
! 			     (or (not for-eqn?) 
! 				(begin (filter-eqn-line x) (filter-eqn-state x)))))))))))
  
+ (define image-seqnum 1)
  (define troff-to-gif
      (lambda (processor start stop what args inline)
!       (let ((docname (option 'document))
! 	    (filter (if (eq? processor 'tbl)
! 			 (apply spread (list (option 'tbl) "|" (option 'eqn)))
! 			 (option processor))))
          (if (not docname)
  	    (begin
  	      (warn "~a skipped, because no `document' option given" what)
***************
*** 391,410 ****
  	           (psname (concat docname #\- num ".ps"))
  	           (gifname (concat docname #\- num ".gif"))
  		   (ref (concat "<img src=\"" gifname
! 				"\" alt=\"[" what "]\">\n"))
  		   (use-output? #f))
  	      (++ image-seqnum)
                (with-output-to-stream
! 	        (substitute (concat #\| (option processor)
  				    #\| (option 'troff-to-gif)) psname gifname)
  	        (emit start #\space (apply spread args) #\newline)
  		(set! use-output? (copy-preprocess (eq? processor 'eqn)
  				     emit identity stop inline)))
  	      (remove-file psname)
  	      (if use-output?
                    (if inline ref (concat "<p>" ref "<p>\n"))
! 		  (remove-file gifname) "")))))))
  
  (define (troff-to-text processor start stop what args inline)
    (let* ((tmpname (substitute "%tmpname%"))
  	 (use-output? #f))
--- 430,489 ----
  	           (psname (concat docname #\- num ".ps"))
  	           (gifname (concat docname #\- num ".gif"))
  		   (ref (concat "<img src=\"" gifname
! 				"\" alt=\"[" what "]\">"))
  		   (use-output? #f))
  	      (++ image-seqnum)
                (with-output-to-stream
! 	        (substitute (concat #\| filter
  				    #\| (option 'troff-to-gif)) psname gifname)
+ 		;; If generating tbl output, handle equations in table text by
+ 		;; emitting an .EQ/.EN with the state information for eqn.  If
+ 		;; no equations, this will do nothing, but if there are the
+ 		;; proper initial eqn state will be set up.
+ 		(if (eq? processor 'tbl) (begin
+ 		   (emit ".EQ\n")
+ 		   (emit (stream->string "[eqn-state]"))
+ 		   (emit ".EN\n")))
  	        (emit start #\space (apply spread args) #\newline)
+ 		;; Emit saved state of eqn before any new equations
+ 		(if (eq? processor 'eqn) (emit (stream->string "[eqn-state]")))
  		(set! use-output? (copy-preprocess (eq? processor 'eqn)
  				     emit identity stop inline)))
  	      (remove-file psname)
  	      (if use-output?
                    (if inline ref (concat "<p>" ref "<p>\n"))
! 		  (remove-file gifname) ""))))))
  
+ (define troff-to-pic
+     (lambda (processor start stop what args inline)
+       (let ((docname (option 'document)))
+         (if (not docname)
+ 	    (begin
+ 	      (warn "~a skipped, because no `document' option given" what)
+ 	      (if (not inline)
+ 		  (skip-lines stop))
+ 	      "")
+             (let* ((num (number->string image-seqnum))
+ 	           (psname (concat docname #\- num ".ps"))
+ 	           (gifname (concat docname #\- num ".gif"))
+ 		   (ref (concat "<img src=\"" gifname
+ 				"\" alt=\"[" what "]\">"))
+ 		   (use-output? #f))
+ 	      (++ image-seqnum)
+               (with-output-to-stream
+ 	        (substitute
+ 		   (concat #\| (option 'troff-to-pic))
+ 		   (apply spread (cddr args))
+ 		   psname 
+ 		   gifname)
+ 	        (emit start #\space (apply spread args) #\newline)
+ 		(set! use-output? (copy-preprocess (eq? processor 'eqn)
+ 				     emit identity stop inline)))
+ 	      (remove-file psname)
+ 	      (if use-output?
+                   (if inline ref (concat "<p>" ref "<p>\n"))
+ 		  (remove-file gifname) ""))))))
+ 
  (define (troff-to-text processor start stop what args inline)
    (let* ((tmpname (substitute "%tmpname%"))
  	 (use-output? #f))
***************
*** 435,440 ****
--- 514,520 ----
      (cond ((string=? method "gif")  troff-to-gif)
  	  ((string=? method "text") troff-to-text)
  	  ((string=? method "copy") troff-to-preform)
+ 	  ((string=? method "pic") troff-to-pic)
  	  (else
  	    (warn "bad value `~a' for ~a, assuming `text'" method option-name)
  	    troff-to-text))))
***************
*** 485,491 ****
    (lambda (ti num)
      (let ((n (if (eqv? num "") 0 (get-hunits (parse-expression num 0 #\m)))))
        (if (negative? n)
! 	  (warn ".ti with negative indent ignored")
            (concat "<br>\n" (repeat-string n nbsp))))))
  
  
--- 565,573 ----
    (lambda (ti num)
      (let ((n (if (eqv? num "") 0 (get-hunits (parse-expression num 0 #\m)))))
        (if (negative? n)
! 	  (begin
! 	     (warn "negative indent on .ti ignored")
! 	    "<br>\n")
            (concat "<br>\n" (repeat-string n nbsp))))))
  
  
diff -c -r /tmp/unroff-1.0/scm/misc/hyper.scm ./scm/misc/hyper.scm
*** /tmp/unroff-1.0/scm/misc/hyper.scm	Mon Aug 21 13:09:08 1995
--- ./scm/misc/hyper.scm	Mon Jan 22 00:21:04 1996
***************
*** 65,71 ****
  ;;; .Ha label anchor-text
  
  (defmacro 'Ha
!   (lambda (Ha name contents)
      (let* ((q (ht-querier '.Ha name))
  	   (location (q 'filename)))
        (cond
--- 65,71 ----
  ;;; .Ha label anchor-text
  
  (defmacro 'Ha
!   (lambda (Ha name . contents)
      (let* ((q (ht-querier '.Ha name))
  	   (location (q 'filename)))
        (cond
***************
*** 78,84 ****
            (list-push! ht-anchors (anchor-create name location))
  	  (if (q 'emit-anchor?)
  	      (concat (format #f "<a name=\"~a\">~a</a>" (parse-unquote name)
! 		      (parse contents)))
  	      ""))))))
  
  (define (resolve-ht-reference name location)
--- 78,84 ----
            (list-push! ht-anchors (anchor-create name location))
  	  (if (q 'emit-anchor?)
  	      (concat (format #f "<a name=\"~a\">~a</a>" (parse-unquote name)
! 		      (if (null? contents) " " (parse contents))))
  	      ""))))))
  
  (define (resolve-ht-reference name location)