1293 lines
38 KiB
Diff
1293 lines
38 KiB
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 " ") #\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)
|
|
|
|
|