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 " ") #\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 " <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 " <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)