Here is my second set of patches to unroff for -me support and other fixes to troff and -ms support. This was prompted by a fix sent to me by another -me macro user. Hope you can add them to the "unofficial" patches on your Web info. G. Helffrich/U. Bristol, 7 Feb. 1997. Summary of fixes and enhancements: doc/Makefile - Add -me html documentation doc/unroff-html-me.1 - Document -me registers/features scm/troff.scm - Fix bug in am/de that didn't recognize macro termination parameter (so that strings other than ".." can end macro text). - Fix major bug in if/else nesting. If get input like .ie `yes`yes .ok .el .ie `no`yes` .no .el .no you need to evaluate the .el line to decide whether another if clause will be following. Previously didn't do this and unroff would declare this an improper if/else nesting. scm/html/common.scm - Alter site-specific options - Document preformatted text code - Between .nf/.fi pair generate preformatted text by emitting trailing
, which does not not cause switch to "computer" (fixed-pitch) font with some browsers. - Define action for \p (just breaks line, can't spread out like troff) - Eliminate equating \(*m with HTML "mu" and \(*b with HTML "esszet" - don't look good as compared to real Greek characters (see below). - Add Greek characters built from pictures. This relies on GIF characters by Karen Strom, U. Mass (email: kstrom@hanksville.phast.umass.edu), available by anonymous FTP. See http://donald.phast.umass.edu/kicons/greek.html for information and the GIFs themselves. The GIFs themselves should be installed in misc/gifs (see site-specific options). - Add \(!< and \(!> to generate "<" and ">" in HTML so that HTML elements can be generated in the troff text (through .Ha macro). - Fix for in-line EQ/EN handling (center in line rather than align to baseline - this isn't always what you want, however). - Support for .EN C command (multi-line "continued" equations) - Emit eqn definitions before table text so that in-table equations have the right context for evaluation. - Remove blank line following .TE, .EN and .PE - Permit centering to revert to a previous state if centering nested. scm/html/me.scm - Add footnote processing. Footnotes are either separate documents or anchors at the end of the document, depending on a selectable option split-section. - Implement $d register. - Add numbered paragraph support and general -me section support. - Make tag-para compact. - Implement -me sections. Recognizes +c macro to announce P, AB, A, B, C, RC, RA portions of document, and ++ to transition into new section. - Implement HTML titles, which relies on -me section features. If current section is "P" (preamble before document), then +c macro (begin chapter) generates a "title"

...

header at the beginning of the document. - Fix bug in .q macro - didn't evaluate arguments so no strings or number registers recognized. scm/html/ms.scm - Support for displays of type C and B (centered and block). scm/misc/hyper.scm - Fix bug in .Ha anchor processing (2nd parameter might be a list). misc/pstoppm.ps - Present version of PostScript to convert a PostScript file to a GIF file. misc/pictogif - Present version of pictogif to convert a "pic" type picture into a GIF file. misc/pstogif - Present version of pstogif to convert PostScript file to GIF file using gs (Ghostscript). Diffs follow. -------------------------------------------------------------------------------- diff -r -c3 unroff-1.0.orig/INSTALL unroff-1.0/INSTALL Common subdirectories: unroff-1.0.orig/doc and unroff-1.0/doc Common subdirectories: unroff-1.0.orig/elk and unroff-1.0/elk Common subdirectories: unroff-1.0.orig/misc and unroff-1.0/misc Common subdirectories: unroff-1.0.orig/scm and unroff-1.0/scm Common subdirectories: unroff-1.0.orig/src and unroff-1.0/src diff -r -c3 unroff-1.0.orig/doc/Makefile unroff-1.0/doc/Makefile *** unroff-1.0.orig/doc/Makefile Mon Apr 17 14:30:26 1995 --- unroff-1.0/doc/Makefile Mon Jul 8 22:35:17 1996 *************** *** 15,20 **** --- 15,21 ---- unroff-html.1.html\ unroff-html-man.1.html\ unroff-html-ms.1.html\ + unroff-html-me.1.html\ manual.html diff -r -c3 unroff-1.0.orig/doc/unroff-html-me.1 unroff-1.0/doc/unroff-html-me.1 *** unroff-1.0.orig/doc/unroff-html-me.1 Sat Feb 8 13:44:55 1997 --- unroff-1.0/doc/unroff-html-me.1 Thu Feb 1 17:51:17 1996 *************** *** 22,28 **** .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 --- 22,28 ---- .ds Dt \\$2 .. .\" ! .Sd $Date: 1996/02/02 21:29:31 $ .TH unroff-html-me 1 "\*(Dt" .SH NAME unroff-html-me \- back-end to translate `me' documents to HTML 2.0 *************** *** 126,134 **** .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: --- 126,136 ---- .LP .nf .if !\n(.U .ta 8n 16n 24n 32n 40n 48n 56n ! .(b .)b .(c .)c .(d .)d .(f ! .)f .(l .)l .(q .)q .(x .)x ! .(z .)z .b .bi .bx .hl .i ! .ip .np .pd .q .r .rb .sz ! .sh .u .uh .xp .++ .+c .fi .LP These predefined strings and number registers are recognized: *************** *** 135,141 **** .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 --- 137,143 ---- .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 \e** \e*# .fi .LP In addition, a number of macros are either silently ignored *************** *** 154,161 **** 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', --- 156,162 ---- future version: .LP .nf ! .sx .fi .LP The font switching macros are based on changes to the fonts `R', *************** *** 165,170 **** --- 166,188 ---- are unmounted by explicit .B .fp requests. + .LP + The special characters + .nf + + \e(!< and \e(!> + + .fi + respectively generate < and > in the resulting html. + These permit html elements to be put directly into the document text, + as in e.g. + .nf + + .Hr -symbolic next "\e(!" + + .fi + to generate a reference to some other part of the document via a selectable + image. .SH "SEE ALSO" .BR unroff (1), .BR unroff-html (1), *************** *** 186,188 **** --- 204,208 ---- as underlining is not supported by the HTML back-end of .I unroff \*(Ve. + .LP + The section setting options of the .sh macro are not implemented. Common subdirectories: unroff-1.0.orig/elk/scm and unroff-1.0/elk/scm Common subdirectories: unroff-1.0.orig/scm/html and unroff-1.0/scm/html Common subdirectories: unroff-1.0.orig/scm/misc and unroff-1.0/scm/misc diff -r -c3 unroff-1.0.orig/scm/troff.scm unroff-1.0/scm/troff.scm *** unroff-1.0.orig/scm/troff.scm Wed Aug 23 13:09:54 1995 --- unroff-1.0/scm/troff.scm Sun Apr 28 14:57:16 1996 *************** *** 332,363 **** (copy-apply read-line-expand parse-line parse-copy-mode)) (list-pop! arg-stack) "") ! (define (copy-macro-body) (let* ((s (read-line-expand)) (t (if (eof-object? s) #f (parse-copy-mode s)))) (cond ((not t) (warn "end-of-stream during macro definition")) ! ((not (string=? t "..\n")) (emit t) ! (copy-macro-body))))) (defrequest 'de ! (lambda (de name) (cond ((eqv? name "") (warn "missing name for .de")) (else (with-output-to-stream (macro-buffer-name name) ! (copy-macro-body)) ! (defmacro name expand-macro) "")))) (defrequest 'am ! (lambda (am name) (cond ((eqv? name "") (warn "missing name for .am")) (else (with-output-appended-to-stream (macro-buffer-name name) ! (copy-macro-body)) ! (defmacro name expand-macro) "")))) --- 332,365 ---- (copy-apply read-line-expand parse-line parse-copy-mode)) (list-pop! arg-stack) "") ! (define (copy-macro-body eom) (let* ((s (read-line-expand)) (t (if (eof-object? s) #f (parse-copy-mode s)))) (cond ((not t) (warn "end-of-stream during macro definition")) ! ((not (string=? t eom)) (emit t) ! (copy-macro-body eom))))) (defrequest 'de ! (lambda (de name . end) ! (let ((eom (if (null? end) "..\n" (concat "." (car end) "\n")))) (cond ((eqv? name "") (warn "missing name for .de")) (else (with-output-to-stream (macro-buffer-name name) ! (copy-macro-body eom)) ! (defmacro name expand-macro) ""))))) (defrequest 'am ! (lambda (am name . end) ! (let ((eom (if (null? end) "..\n" (concat "." (car end) "\n")))) (cond ((eqv? name "") (warn "missing name for .am")) (else (with-output-appended-to-stream (macro-buffer-name name) ! (copy-macro-body eom)) ! (defmacro name expand-macro) ""))))) *************** *** 364,369 **** --- 366,398 ---- ;;; -------------------------------------------------------------------------- ;;; if, if-else, else. + ;; Version of parse-pair that will pick off pair expression, evaluate and return + ;; remainder following. + (define (trim-leading-blanks stuff) + (let ((l (string-length stuff))) + (let loop ((i 0)) + (cond + ((>= i l) " ") + ((not (char=? #\space (string-ref stuff i))) + (substring stuff i l)) + (else (loop (+ i 1))))))) + + (define (parse-pair-rest stuff) + (let ((c (string-ref stuff 0)) + (l (string-length stuff)) + (result '#f)) + (let loop ((i 2)) + (cond + ((>= i l) (cons '#f stuff)) + ((not (char=? c (string-ref stuff i))) + (loop (+ i 1))) + (else + (set! result (parse-pair (substring stuff 0 (+ i 1)))) + (if result + (cons result (trim-leading-blanks (substring stuff (+ i 1) l))) + (loop (+ i 1)))))))) + + (defescape #\{ "") (defescape #\} "") (defrequest "\\}" "") ; do not complain about .\} *************** *** 373,402 **** (define if-stack '()) ! (define (if-request request condition rest) (let* ((doit? #f) (c (string-prune-left condition "!" condition)) (len (string-length c)) ! (neg? (not (eq? c condition)))) (cond ! ((and (= len 1) (char-alphabetic? (string-ref c 0))) (cond ! ((substring? c (option 'if-true)) (set! doit? #t)) ! ((substring? c (option 'if-false))) ! (else (warn "unknown if-condition `~a'" c)))) ((and (> len 0) (char-expression-delimiter? (string-ref c 0))) ! (let ((x (parse-expression c #f #\u))) ! (if x (set! doit? (not (zero? x)))))) (else ! (let ((pair (parse-pair c))) (if pair ! (set! doit? (string=? (car pair) (cdr pair))) ! (warn "if-condition `~a' not understood" c))))) (cond ! ((eq? neg? doit?) ! (unread-line (concat rest #\newline)) ! (skip-group)) (else (unread-line (hack-if-argument rest)))) (if (string=? request "ie") --- 402,446 ---- (define if-stack '()) ! (define (if-request request condition) (let* ((doit? #f) (c (string-prune-left condition "!" condition)) (len (string-length c)) ! (neg? (not (eq? c condition))) ! (rest "")) (cond ! ((< len 1) ! (warn "missing .~a condition" request)) ! ((and (char=? #\space (string-ref c 1)) (char-alphabetic? (string-ref c 0))) (cond ! ((substring? (string (string-ref c 0)) (option 'if-true)) (set! doit? #t)) ! ((substring? (string (string-ref c 0)) (option 'if-false))) ! (else (warn "unknown .~a condition `~a'" request c))) ! (set! rest (trim-leading-blanks (substring c 2 (string-length c))))) ((and (> len 0) (char-expression-delimiter? (string-ref c 0))) ! (let* ((rem (parse-expression-rest c #f #\u)) ! (x (car rem))) ! (if x (set! doit? (not (zero? x))) ! (warn "invalid .~a expression ~a" request c)) ! (set! rest (trim-leading-blanks (cdr rem))))) (else ! (let* ((rem (parse-pair-rest c)) ! (pair (car rem))) (if pair ! (set! doit? (string=? (caar rem) (cdar rem))) ! (warn ".~a condition `~a' not understood" request c)) ! (set! rest (cdr rem))))) ! ;; If compound .ie, watch out for another .ie in false clause -- need to do ! ;; extra skip-group, e.g. ! ;; .ie `yes`yes` .ok ! ;; .el .ie `no`yes` .no ! ;; .el .no (cond ! ((eq? neg? doit?) (begin ! (unread-line (concat rest #\newline)) (skip-group) ! (if (string=? ".ie" (substring rest 0 (min 3 (string-length rest)))) ! (skip-group)))) (else (unread-line (hack-if-argument rest)))) (if (string=? request "ie") *************** *** 421,428 **** ((null? if-stack) (warn ".el without matching .ie request")) ((car if-stack) ! (unread-line (concat rest #\newline)) ! (skip-group) (list-pop! if-stack)) (else (unread-line (hack-if-argument rest)) --- 465,478 ---- ((null? if-stack) (warn ".el without matching .ie request")) ((car if-stack) ! ;; If compound .ie, watch out for another .ie in false clause -- need to ! ;; do extra skip-group, e.g. ! ;; .ie `yes`yes` .ok ! ;; .el .ie `no`yes` .no ! ;; .el .no ! (unread-line (concat rest #\newline)) (skip-group) ! (if (string=? ".ie" (substring rest 0 (min 3 (string-length rest)))) ! (skip-group)) (list-pop! if-stack)) (else (unread-line (hack-if-argument rest)) diff -r -c3 unroff-1.0.orig/scm/html/common.scm unroff-1.0/scm/html/common.scm *** unroff-1.0.orig/scm/html/common.scm Sat Feb 8 13:44:57 1997 --- unroff-1.0/scm/html/common.scm Tue Aug 20 13:24:13 1996 *************** *** 9,22 **** ;;; 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) --- 9,23 ---- ;;; Configurable, site-specific definitions. (define-option 'troff-to-gif 'string ! "psroff -me -t | sed -e 's/showpage//g' > %1%; pstogif %1% -density 100") ;;; (define-option 'troff-to-text 'string ;;; "groff -Tlatin1 -P-b -P-u |sed '/^[ \t]*$/d' > %1%") (define-option 'troff-to-text 'string ! "neqn | nroff | col -b | sed '/^[ \t]*$/d' > %1%") ! (define-option 'troff-to-pic ! 'string "pictogif %1% -ps %2%") (define-option 'tbl 'string 'tbl) (define-option 'eqn 'string 'eqn) *************** *** 47,63 **** ;;; -------------------------------------------------------------------------- ;;; Preformatted text. (define preform? #f) ! (define (preform on?) (cond ((and on? (not preform?)) (defsentence #f) (with-font-preserved ! (begin (set! preform? #t) "
\n")))
          ((and (not on?) preform?)
            (defsentence sentence-event)
            (with-font-preserved
! 	    (begin (set! preform? #f) "
\n"))) (else ""))) (defrequest 'nf (lambda _ (preform #t))) --- 48,83 ---- ;;; -------------------------------------------------------------------------- ;;; Preformatted text. + ;;; This is used in various contexts: + ;;; 1. eqn text that is generated by running through neqn (see troff-to-text + ;;; and troff-to-preformat) + ;;; 2. .nf/.fi pair + + ;;; .nf/.fi text is suffixed with
at the end of each line. + ;;; Might prefer using
 
if: 1) the tt-preformat option is asserted; + ;;; or 2) a constant pitch font is selected (via the .cs x y; turned off + ;;; by .cs x). + (define preform? #f) ! (define (preform on? . pre?) ! (set! pre? (if (null? pre?) #f (car pre?))) (cond ((and on? (not preform?)) (defsentence #f) (with-font-preserved ! (begin ! (set! preform? #t) ! (if pre? ! "
"
! 		 (begin (defevent 'line 45 nofill-processor) "")))))
          ((and (not on?) preform?)
            (defsentence sentence-event)
            (with-font-preserved
! 	    (begin
! 	      (set! preform? #f)
! 	      (if (eventdef 'line 45)
! 		(begin (defevent 'line 45 #f) "")
! 		"
\n")))) (else ""))) (defrequest 'nf (lambda _ (preform #t))) *************** *** 71,76 **** --- 91,99 ---- (lambda (c) (if (not preform?) (surprise "tab outside .nf/.fi")) c)) + (define (nofill-processor c) + (if (eqv? c #\newline) + (emit "
\n"))) ;;; -------------------------------------------------------------------------- *************** *** 111,116 **** --- 134,140 ---- (defescape #\\ #\\) (defescape #\' #\') (defescape #\` #\`) + (defescape #\p "
") ; just break - can't spread like troff (defescape #\% "") (defescape "" *************** *** 139,146 **** (defspecial 'mu "×") ; multiplication (defspecial 'tm "®") (defspecial 'rg "®") - (defspecial '*m "µ") ; mu - (defspecial '*b "ß") ; beta (#223 is German sharp-s actually) (defspecial 'aa #\') ; acute accent (defspecial 'ga #\`) ; grave accent (defspecial 'br #\|) ; vertical box rule --- 163,168 ---- *************** *** 190,196 **** --- 212,269 ---- (defspecial 'bb "¦") ; broken bar (defspecial 'r! "¡") ; reverse exclamation mark (defspecial 'r? "¿") ; reverse question mark + (defspecial '!< "<") ; the real < for generating html elements + (defspecial '!> ">") ; the real > for generating html elements + (defspecial '*A "A") ; greek + (defspecial '*B "B") ; greek + (defspecial '*G (lambda _ (gifchar '*G))) + (defspecial '*D (lambda _ (gifchar '*D))) + (defspecial '*E "E") ; greek + (defspecial '*Z "Z") ; greek + (defspecial '*Y "H") ; greek + (defspecial '*H (lambda _ (gifchar '*H))) + (defspecial '*I "I") ; greek + (defspecial '*K "K") ; greek + (defspecial '*L (lambda _ (gifchar '*L))) + (defspecial '*M "M") ; greek + (defspecial '*N "N") ; greek + (defspecial '*C (lambda _ (gifchar '*C))) + (defspecial '*O "O") ; greek + (defspecial '*P (lambda _ (gifchar '*P))) + (defspecial '*R "P") ; greek + (defspecial '*S (lambda _ (gifchar '*S))) + (defspecial '*T "T") ; greek + (defspecial '*U (lambda _ (gifchar '*U))) + (defspecial '*F (lambda _ (gifchar '*F))) + (defspecial '*X "X") ; greek + (defspecial '*Q (lambda _ (gifchar '*Q))) + (defspecial '*W (lambda _ (gifchar '*W))) + (defspecial '*a (lambda _ (gifchar '*a))) + (defspecial '*b (lambda _ (gifchar '*b))) + (defspecial '*g (lambda _ (gifchar '*g))) + (defspecial '*d (lambda _ (gifchar '*d))) + (defspecial '*e (lambda _ (gifchar '*e))) + (defspecial '*z (lambda _ (gifchar '*z))) + (defspecial '*y (lambda _ (gifchar '*y))) + (defspecial '*h (lambda _ (gifchar '*h))) + (defspecial '*i (lambda _ (gifchar '*i))) + (defspecial '*k (lambda _ (gifchar '*k))) + (defspecial '*l (lambda _ (gifchar '*l))) + (defspecial '*m "µ") + (defspecial '*n (lambda _ (gifchar '*n))) + (defspecial '*c (lambda _ (gifchar '*c))) + (defspecial '*o (lambda _ (gifchar '*o))) + (defspecial '*p (lambda _ (gifchar '*p))) + (defspecial '*r (lambda _ (gifchar '*r))) + (defspecial '*s (lambda _ (gifchar '*s))) + (defspecial 'ts (lambda _ (gifchar 'ts))) + (defspecial '*t (lambda _ (gifchar '*t))) + (defspecial '*u (lambda _ (gifchar '*u))) + (defspecial '*f (lambda _ (gifchar '*f))) + (defspecial '*x (lambda _ (gifchar '*x))) + (defspecial '*q (lambda _ (gifchar '*q))) + (defspecial '*w (lambda _ (gifchar '*w))) (defspecial 'bu (lambda _ (warn "rendering \\(bu as `+'") #\+)) (defspecial 'sq (lambda _ (warn "rendering \\(sq as `o'") #\o)) *************** *** 197,204 **** --- 270,340 ---- (defspecial 'dg (lambda _ (warn "rendering \\(dg as `**'") "**")) (defspecial 'dd (lambda _ (warn "rendering \\(dd as `***'") "***")) + (define gif-table (make-table 100)) + (define (gif-greek char gif align) + (table-store! gif-table char (list gif align 'no))) + (gif-greek '*G "Gamma" "b") + (gif-greek '*D "Delta" "b") + (gif-greek '*H "Theta" "b") + (gif-greek '*L "Lambda" "b") + (gif-greek '*C "Xi" "b") + (gif-greek '*P "Pi" "b") + (gif-greek '*S "Sigma" "b") + (gif-greek '*U "Upsilon" "b") + (gif-greek '*F "Phi" "b") + (gif-greek '*Q "Psi" "b") + (gif-greek '*W "Omega" "b") + (gif-greek '*a "alpha" "b") + (gif-greek '*b "beta" "t") + (gif-greek '*g "gamma" "b") + (gif-greek '*d "delta" "b") + (gif-greek '*e "epsilon" "b") + (gif-greek '*z "zeta" "t") + (gif-greek '*y "eta" "t") + (gif-greek '*h "theta" "b") + (gif-greek '*i "iota" "b") + (gif-greek '*k "kappa" "b") + (gif-greek '*l "lambda" "b") + (gif-greek '*n "nu" "b") + (gif-greek '*c "xi" "t") + (gif-greek '*o "omicron" "b") + (gif-greek '*p "pi" "b") + (gif-greek '*r "rho" "t") + (gif-greek '*s "sigma" "b") + (gif-greek 'ts "sigma" "b") + (gif-greek '*t "tau" "b") + (gif-greek '*u "upsilon" "b") + (gif-greek '*f "phi" "b") + (gif-greek '*x "chi" "b") + (gif-greek '*q "psi" "b") + (gif-greek '*w "omega" "b") + + (define (gifchar char) + (let ((result (table-lookup gif-table char)) + (docname (option 'document))) + (cond + (result + (if (not docname) (begin + (warn "can't translate \\(~a if no document given, ? used" char) + "?") + (let* ((charname (list-ref result 0)) + (align (if (string=? "t" (list-ref result 1)) " align=top" "")) + (gifname (concat docname "." charname ".gif")) + (ref (concat "\"[""))) + (begin + (if (eq? 'no (list-ref result 2)) + (begin + (if (not (= 0 (shell-command + (substitute "/bin/cp %directory%/misc/gifs/%1%.gif %2%" charname gifname)))) + (warn "couldn't copy \\(~a - system problem" gifname)) + (set-car! (cddr result) 'yes))) + ref)))) + (else (warn "no translation for \\(~a, ? used" char) "?")))) + + ;;; -------------------------------------------------------------------------- ;;; Local motion requests and related stuff (mostly ignored). *************** *** 368,384 **** ;;; 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) --- 504,523 ---- ;;; 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) + ;;; + ;;; ***FIX*** If equation is in-line, it should be centered rather than + ;;; aligned to the baseline. (define (first-token x) (let loopi ((i 0) (imax (string-length x))) (cond ((>= i imax) #f) ! ((char=? #\space (string-ref x i)) (loopi (+ i 1) imax)) (else (let loopj ((j i)) (cond ! ((>= j imax) (substring x i imax)) ! ((not (char=? #\space (string-ref x j))) (loopj (+ j 1))) (else (substring x i j)))))))) (define (filter-eqn-state x) *************** *** 399,417 **** (define (copy-preprocess for-eqn? proc-1 proc-2 stop inline) (cond (inline ! (emit inline #\newline stop) (filter-eqn-line inline)) (else (let loop ((x (read-line-expand)) (use-output? (not for-eqn?))) (cond ((eof-object? x) use-output?) (else (proc-1 (proc-2 x)) ! (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 --- 538,577 ---- (define (copy-preprocess for-eqn? proc-1 proc-2 stop inline) (cond (inline ! (emit inline #\newline stop #\newline) (filter-eqn-line inline)) (else + (let ((stop-len (string-length stop))) (let loop ((x (read-line-expand)) (use-output? (not for-eqn?))) + (let ((x-len (string-length x))) (cond ((eof-object? x) use-output?) (else (proc-1 (proc-2 x)) ! (if (string=? stop (substring x 0 (min x-len stop-len))) ! ;; end of processing. Check if .EN C, in which case ! ;; following line should start .EQ, and both should ! ;; be processed simultaneously. ! (let ((mesee (substring x (min stop-len x-len) ! (min (+ stop-len 2) x-len)))) ! (if (and for-eqn? (string=? " C" mesee)) ! (let* ((next (read-line)) ! (next-len (- (string-length next) 1))) ! (if (string=? ".EQ C" ! (substring next 0 (min 5 next-len))) ! (begin ! (emit (parse-expand next)) ! (loop (read-line-expand) use-output?)) ! (unread-line next)))) ! use-output?) (loop (read-line-expand) (or (not for-eqn?) ! ;; Bug fix. filter-eqn-line does not recognize ! ;; "delim off" because it includes the newline ! ;; at the end-of-line in the test. Strip \n ! ;; before passing to filter-eqn-line ! (begin (filter-eqn-line (substring x 0 (- (string-length x) 1))) ! (filter-eqn-state x))))))))))))) (define image-seqnum 1) (define troff-to-gif *************** *** 473,481 **** (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))) --- 633,640 ---- (with-output-to-stream (substitute (concat #\| (option 'troff-to-pic)) ! (apply spread (if (null? (cddr args)) '("/dev/null") (cddr args))) ! psname) (emit start #\space (apply spread args) #\newline) (set! use-output? (copy-preprocess (eq? processor 'eqn) emit identity stop inline))) *************** *** 490,495 **** --- 649,662 ---- (with-output-to-stream (substitute (concat #\| (option processor) #\| (option 'troff-to-text)) tmpname) + ;; 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) (set! use-output? (copy-preprocess (eq? processor 'eqn) emit identity stop inline))) *************** *** 498,504 **** (if use-output? (if inline (with-font-preserved (concat (change-font 2) text)) ! (concat (preform #t) text (preform #f))) "")))) (define (troff-to-preform processor start stop what args inline) --- 665,671 ---- (if use-output? (if inline (with-font-preserved (concat (change-font 2) text)) ! (concat (preform #t #t) text (preform #f))) "")))) (define (troff-to-preform processor start stop what args inline) *************** *** 521,535 **** (defmacro 'TS (lambda (TS . args) ! ((troff-select-method 'handle-tbl) 'tbl ".TS" ".TE\n" "table" args #f))) (defmacro 'EQ (lambda (EQ . args) ! ((troff-select-method 'handle-eqn) 'eqn ".EQ" ".EN\n" "equation" args #f))) (defmacro 'PS (lambda (PS . args) ! ((troff-select-method 'handle-pic) 'pic ".PS" ".PE\n" "picture" args #f))) (defmacro 'TE "") (defmacro 'EN "") --- 688,702 ---- (defmacro 'TS (lambda (TS . args) ! ((troff-select-method 'handle-tbl) 'tbl ".TS" ".TE" "table" args #f))) (defmacro 'EQ (lambda (EQ . args) ! ((troff-select-method 'handle-eqn) 'eqn ".EQ" ".EN" "equation" args #f))) (defmacro 'PS (lambda (PS . args) ! ((troff-select-method 'handle-pic) 'pic ".PS" ".PE" "picture" args #f))) (defmacro 'TE "") (defmacro 'EN "") *************** *** 537,543 **** (defequation (lambda (eqn) ! ((troff-select-method 'handle-eqn) 'eqn ".EQ" ".EN\n" "equation" '() eqn))) --- 704,710 ---- (defequation (lambda (eqn) ! ((troff-select-method 'handle-eqn) 'eqn ".EQ" ".EN" "equation" '() eqn))) *************** *** 593,614 **** (lambda (ce num) (let ((n (if (eqv? num "") 1 (string->number num)))) (if n ! (center (round n)) (warn ".ce argument `~a' not understood" num))))) (define lines-to-center 0) ! (define (center n) ! (set! lines-to-center n) ! (defevent 'line 50 (if (positive? n) center-processor #f)) ! "") (define (center-processor c) ! (if (positive? (-- lines-to-center)) ! (if (eqv? c #\newline) ! (emit "
\n"))) ! (if (not (positive? lines-to-center)) ! (center 0))) --- 760,780 ---- (lambda (ce num) (let ((n (if (eqv? num "") 1 (string->number num)))) (if n ! (concat (preform #t) (center (round (1+ n)))) (warn ".ce argument `~a' not understood" num))))) (define lines-to-center 0) ! (define (center n . previous?) ! (let ((centering? (if (null? previous?) (positive? lines-to-center) (car previous?)))) ! (set! lines-to-center n) ! (defevent 'line 50 (if (positive? n) center-processor #f)) ! (if (positive? n) "
" (if centering? "
\n" "")))) (define (center-processor c) ! (let ((centering? (positive? lines-to-center))) ! (if (not (positive? (1- (-- lines-to-center)))) ! (emit (concat (center 0 centering?) (preform #f)))))) diff -r -c3 unroff-1.0.orig/scm/html/me.scm unroff-1.0/scm/html/me.scm *** unroff-1.0.orig/scm/html/me.scm Sat Feb 8 13:44:54 1997 --- unroff-1.0/scm/html/me.scm Mon May 6 16:10:27 1996 *************** *** 15,22 **** (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%]") --- 15,22 ---- (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 "[%1%]") ! (define-option 'footnote-anchor 'string "") *************** *** 32,48 **** (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 --- 32,55 ---- (defstring 'td (substitute "%monthname+% %day%, %year%")) (defnumreg '$c #\1) (defnumreg '$f #\1) (defnumreg '$m #\2) (defnumreg '$n #\2) + (defnumreg '$0 "") + (defnumreg '$1 "") + (defnumreg '$2 "") + (defnumreg '$3 "") + (defnumreg '$4 "") + (defnumreg '$5 "") + (defnumreg '$6 "") + (defstring '$n "") ;;; -------------------------------------------------------------------------- ;;; General bookkeeping. + (define para-number 0) ; numbered paragraph number (define split-sections? #f) ; #t if `split' option is positive *************** *** 49,59 **** (define-pair abstract abstract? "" "
\n") (define-pair title title? "

\n" "

\n") (define-pair secthdr secthdr? "

\n" "

\n") ! (define-pair tag-para tag-para? "
\n" "
\n") (define-pair list-para list-para? "\n") (define-pair quoted quoted? "
\n" "
\n") (define (reset-everything) (emit (reset-font) (center 0) --- 56,67 ---- (define-pair abstract abstract? "" "
\n") (define-pair title title? "

\n" "

\n") (define-pair secthdr secthdr? "

\n" "

\n") ! (define-pair tag-para tag-para? "
\n" "
\n") (define-pair list-para list-para? "\n") (define-pair quoted quoted? "
\n" "
\n") (define (reset-everything) + (set! para-number 0) (emit (reset-font) (center 0) *************** *** 62,71 **** (preform #f) (tag-para #f) (list-para #f) ! (reset-title-features)) ! (header-processor #f)) ! (define-nested-pair indent indent-level "
\n" "
\n") --- 70,78 ---- (preform #f) (tag-para #f) (list-para #f) ! (reset-title-features))) ! (define-nested-pair indent indent-level "
" "
\n") *************** *** 122,128 **** ((section toc) (car HTML-streams)) (footnote (if split-sections? (concat docname "-notes.html") ""))))) (format #f "~a" file type index ! (if contents (concat contents "\n") "")))) (define (make-anchor type index contents) (format #f "~a" type index contents)) --- 129,135 ---- ((section toc) (car HTML-streams)) (footnote (if split-sections? (concat docname "-notes.html") ""))))) (format #f "~a" file type index ! (if contents (concat contents "") "")))) (define (make-anchor type index contents) (format #f "~a" type index contents)) *************** *** 155,161 **** (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=")) --- 162,168 ---- (defevent 'start 10 (lambda _ ! (set! split-sections? (not (zero? (option 'split)))) (let ((docname (option 'document))) (if (not (or docname (option 'title))) (quit "you must set either document= or title=")) *************** *** 167,173 **** (lambda _ (reset-everything) (emit (indent 0)) ! (footnote-processor 'spill) (do () ((null? (cdr HTML-streams))) (pop-HTML-stream)) (if (option 'toc) (auto-toc-spill)) --- 174,180 ---- (lambda _ (reset-everything) (emit (indent 0)) ! (footnote-processor footnotes 'spill) (do () ((null? (cdr HTML-streams))) (pop-HTML-stream)) (if (option 'toc) (auto-toc-spill)) *************** *** 184,316 **** (concat (title #f) (begin1 (if got-title? "
\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) "

\n" (change-font 2)) ! (center 999))) ! (defmacro 'AI ! (lambda _ ! (emit (title #f) "
\n" (change-font 1)) ! (center 999))) - (defmacro 'AB - (lambda (AB . args) - (reset-everything) - (abstract #t) - (cond ((null? args) - "

ABSTRACT

\n

\n") - ((string=? (car args) "no") - "

\n") - (else - (concat "

" (parse (car args)) "

\n

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

" (make-anchor 'section seq sectno))) ! (else ! (emit "

" sectno))) ! (emit nbsp hdr "

\n") ! (++ seq)))) ! (set! inside? enter?) ""))) ;;; -------------------------------------------------------------------------- ;;; Font switching and related requests. --- 191,298 ---- (concat (title #f) (begin1 (if got-title? "
\n" "") (set! got-title? #f)))) ! (define in-section #f) ! (defmacro '+c ! (lambda (_ . hdr) ! (if (not (null? hdr)) ! (cond ! ((not in-section) (parse (car hdr))) ! ((string=? in-section "P") ! (concat (title #t) (parse (car hdr)) (title #f))) ! ((string=? in-section "AB") ! (concat (abstract #t) (parse (car hdr)) nbsp)) ! ((or (string=? in-section "A") ! (string=? in-section "B") ! (string=? in-section "C") ! (string=? in-section "RC") ! (string=? in-section "RA")) ! (concat (secthdr #t) (parse (car hdr)) (secthdr #f))) ! (else (begin (warn ".+c unknown section ~a" in-section) (parse hdr)))) ! ""))) ! (defmacro '++ ! (lambda (_ section . arg) ! (if (not (member (parse section) '("C" "A" "P" "AB" "B" "RC" "RA"))) ! (warn ".++ ~a ignored" section) ! (set! in-section (parse section))) ! (if abstract? (abstract #f) ""))) ;;; -------------------------------------------------------------------------- ! ;;; Sections. ! ;; If splitting sections, only prefix the header text with the section number ! ;; if dealing with sections > 0. (define header-processor ! (let ((seq 0)) ! (lambda (hdr depth) ! (cond ! ((and split-sections? (option 'toc)) ! (++ seq) ! (auto-toc-entry hdr "" depth (stringdef '$n)) ! (emit "

" ! (make-anchor 'section seq (stringdef '$n)))) ! (else ! (if (macrodef '$0) ! (emit (parse-line ! (format #f ".$0 \"~a\" ~a ~a" hdr (stringdef '$n) depth)))) ! (emit "

"))) ! (emit hdr "

\n") ""))) + ;;; @d from -me macros + ;;; 1st param is level, next (up to) 6 are the level values to set + (define (@d . args) + (if (and (not (null? args)) (string->number (car args))) + (defnumreg '$0 (car args))) + (if (and (positive? (string->number (numregdef '$0))) (not (null? (cdr args)))) + (let ((reg (format #f "$~a" (numregdef '$0)))) + (defnumreg reg + (number->string (if (and (numregdef reg) + (string->number (numregdef reg))) + (1+ (string->number (numregdef reg))) + 1))))) + (let (($n "")) + (if (>= (string->number (numregdef '$0)) 1) + (begin + (if (or (not (numregdef '$1)) (string=? "" (numregdef '$1))) + (defnumreg '$1 "1")) + (if (and (>= (length args) 3) (not (string=? "-" (list-ref args 2)))) + (defnumreg '$1 (list-ref args 2))) + (set! $n (format #f "~a" (numregdef '$1)))) + (defnumreg '$1 "")) + (do + ((i 2 (+ i 1))) + ((> i 6)) + (let ((reg (format #f "$~a" i))) + (if (>= (string->number (numregdef '$0)) i) + (begin + (if (or (not (numregdef reg)) (string=? "" (numregdef reg))) + (defnumreg reg "1")) + (if (and (>= (length args) (+ i 2)) (not (string=? "-" (list-ref args (1+ i))))) + (defnumreg reg (list-ref args (1+ i)))) + (set! $n (format #f "~a.~a" $n (numregdef reg)))) + (defnumreg reg "")))) + (defstring '$n $n))) + ;; .uh headings are considered level zero, and are split if split<0. + (defmacro 'uh + (lambda (uh . args) + (let ((hdr (if (> 1 (length args)) (parse (cadr args)) '()))) + (reset-everything) + (header-processor hdr 0)))) + (defmacro 'sh + (lambda (sh . args) + (let ((level (if (null? args) args (parse (car args)))) + (hdr (if (> (length args) 1) (parse (cadr args)) '())) + (rest (if (> (length args) 2) (parse (cddr args)) '()))) + (reset-everything) + (apply @d (append (list level '+ ) rest)) + (header-processor hdr (if (null? level) 0 (string->number level)))))) + + ;;; -------------------------------------------------------------------------- ;;; Font switching and related requests. *************** *** 341,350 **** (defmacro 'u (lambda (u) (with-font "I"))) ; 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) --- 323,332 ---- (defmacro 'u (lambda (u) (with-font "I"))) ; doesn't work (defmacro 'q ! (lambda (q . args) (let ((old current-font)) (if (null? args) "" ! (concat "``" (parse (car args)) "''" (if (null? (cdr args)) "" (parse (cadr args))) #\newline))))) (defmacro 'bx (lambda (bx word) *************** *** 355,406 **** ;;; -------------------------------------------------------------------------- ;;; 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) ! "

\n" ! (concat "

" (parse (car arg)) "
\n"))) ! (list-para? ! (cond ! ((non-tagged? arg) ! "
  • \n") ! (else ! (warn ".ip `arg' in a list that was begun as non-tagged") ! (concat "
  • " (parse (car arg)) "
    \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") --- 337,379 ---- ;;; -------------------------------------------------------------------------- ;;; Indented paragraph with optional label. ! (define (indented-paragraph op . arg) (define (non-tagged? s) (or (null? s) (member (car s) '("\\(bu" "\\(sq" "\\-")))) ! (if (equal? op "np") ! (begin ! (++ para-number) ! (indented-paragraph "ip" (number->string para-number))) ! (begin ! (emit (reset-font) (preform #f) (secthdr #f) (reset-title-features)) ! (cond ! (tag-para? ! (if (null? arg) ! "
    " ! (concat "
    " (parse (car arg)) "
    "))) ! (list-para? ! (cond ! ((non-tagged? arg) ! "
  • ") ! (else ! (warn ".~a `arg' in a list that was begun as non-tagged" op) ! (concat "
  • " (parse (car arg)) "
    \n")))) ! ((non-tagged? arg) ! (concat (list-para #t) (indented-paragraph op))) ! (else ! (concat (tag-para #t) (indented-paragraph op (car arg)))))))) (defmacro 'ip indented-paragraph) + (defmacro 'np indented-paragraph) ;;; -------------------------------------------------------------------------- ;;; Displays. + ;;; + ;;; **.(z .)z problem - .(q and .(c should be nestable inside these. + ;;; **should be treated more like a footnote or delayed text rather than a + ;;; **block. (define left-paren-b "(b") (define right-paren-b ")b") *************** *** 416,427 **** (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)))) --- 389,395 ---- (define inside-display? #f) (define indented-display? #f) ! (define (display-start type fill) (cond ((or (not (= (string-length type) 1)) (not (memq (string-ref type 0) '(#\I #\L #\C #\M)))) *************** *** 437,500 **** (if indented-display? (emit (indent '+)) (emit "
    ")) ! (if quote? (emit "
    \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 "
    ")) (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 <...>. --- 405,480 ---- (if indented-display? (emit (indent '+)) (emit "
    ")) ! (if (string=? type "C") (emit (center 999))) (set! inside-display? #t) ! (if (not (string=? fill "F")) (emit (preform #t))))) ! "") (defmacro left-paren-b (lambda (_ . args) (apply display-start (cond ! ((null? args) '("I" "U")) ! ((null? (cdr args)) (if (string=? (car args) "F") '("I" "F") (list (car args) "U"))) ! (else args))) "")) ! (defmacro left-paren-l (macrodef left-paren-b)) ! (defmacro left-paren-z (lambda (_ . args) ! (apply display-start ! (cond ! ((null? args) '("M" "U")) ! ((null? (cdr args)) (if (string=? (car args) "F") '("M" "F") (list (car args) "U"))) ! (else args))) ! "")) ! (define (display-end what) (cond ((not inside-display?) ! (warn ".~a without matching display start" what)) (else (set! inside-display? #f) (emit (with-font-preserved (preform #f) ! (if indented-display? (indent '-) "") ! (center 0)) (change-font display-saved-font))))) ! (defmacro right-paren-b ! (lambda _ (display-end right-paren-b))) ! (defmacro right-paren-l ! (lambda _ (display-end right-paren-l))) ! (defmacro right-paren-z ! (lambda _ (display-end right-paren-z))) ! (defmacro left-paren-c ; can't center in a block like troff ! (lambda (_ . args) ! (concat (preform #t) (center 999)))) + (defmacro right-paren-c + (lambda (_ . args) + (concat (center 0) (preform #f)))) + (defmacro left-paren-q + (lambda (_ . args) + (emit + (reset-font) + (center 0) + (quoted #f) + (preform #f) + (quoted #t)))) + + (defmacro right-paren-q + (lambda (_ . args) + (emit (quoted #f)))) + + ;;; -------------------------------------------------------------------------- ! ;;; Footnotes and delayed text. ;; Generating \[***] for \** allows us to defer creating the anchor from ;; string expansion time to output time. Otherwise we couldn't use <...>. *************** *** 501,632 **** (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 "

    \n") (let ((anchor (cond ((not (null? arg)) (parse (car arg))) ! ((positive? **-count) (substitute (option 'footnote-anchor) ! (number->string **-count))) (else #f)))) (if anchor ! (emit "" (make-anchor 'footnote next-footnote anchor) ! "" 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 "

    " (make-anchor 'section 0 hdr))) ! (else (emit "

    " hdr))) ! (emit "

    \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 "\n")) (emit "
    \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 "

    Table of Contents

    \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. --- 481,674 ---- (defstring '* "\\[***]") ! (define **-count (cons 1 #f)) (defspecial '*** (lambda _ ! (let ((inside? (cadr footnotes)) ! (anchor (substitute (option 'footnote-reference) ! (number->string (car **-count))))) ! (set-cdr! **-count #t) ! (if inside? anchor (footnote-anchor anchor (car **-count)))))) ! (define (footnote-anchor sym num) (with-font-preserved ! (concat (change-font 1) (make-href 'footnote num sym)))) ! ;; Both footnotes and delayed text are processed here. Delayed text never gets ! ;; split off into another document, but waits for .pd for inclusion. + (define footnotes (list '".(f" '#f '#f '"[footnotes]")) + (define delayed (list '".(d" '#f '#f '"[delayed-text%1%]")) + (define delayed-number 0) (define footnote-processor ! (lambda (what op . arg) ! (let ((stream-name (substitute (cadddr what) (number->string delayed-number))) ! (inside? (cadr what)) ! (stream (caddr what)) ! (req (car what)) ! (footnotes? (eq? what footnotes))) ! (case op ! (begin (cond (inside? ! (warn "nested ~a" req)) (else ! (set! inside? #t) (set-car! (cdr what) #t) ! (if footnotes? (set-cdr! **-count #f)) (set! stream (set-output-stream! ! (append-output-stream stream-name))) ! (set-car! (cddr what) stream) ! (emit "
    \n") (let ((anchor (cond ((not (null? arg)) (parse (car arg))) ! ((positive? (car **-count)) (substitute (option 'footnote-anchor) ! (number->string (car **-count)))) (else #f)))) (if anchor ! (emit (make-anchor 'footnote (car **-count) anchor))))))) (end (cond (inside? ! (set! inside? #f) (set-car! (cdr what) #f) ! (close-stream (set-output-stream! stream)) ! (set-car! (cddr what) #f) ! (if (and footnotes? (cdr **-count)) (set-car! **-count (1+ (car **-count))))) ! (else (warn ".)~a without matching ~a" (string-ref req 2) req)))) (spill ! (if inside? (quit "unterminated ~a at end of document" req)) ! (let ((contents (stream->string stream-name)) ! (hdr (substitute (if footnotes? (option 'footnotes-header) "")))) ! (close-stream stream) (set! stream #f) (set-car! (cddr what) #f) (cond ((not (eqv? contents "")) ! (if (and split-sections? footnotes?) (push-HTML-stream "-notes" ", footnotes")) ! (cond ((and split-sections? footnotes? (option 'toc)) (auto-toc-entry hdr "" 1 0) ! (emit "

    " (make-anchor 'section 0 hdr) "

    \n")) ! (else (if (not (eq? hdr "")) (emit "

    " hdr "

    \n")))) ! (emit contents "
    \n")) ! ((and footnotes? (cdr **-count)) ! (warn "footnote anchor used, but no .(f")))))) ""))) ! (define left-paren-f "(f") ! (define right-paren-f ")f") ! (define left-paren-d "(d") ! (define right-paren-d ")d") ! (defmacro left-paren-f ! (lambda (left-paren-f . arg) ! (apply footnote-processor footnotes 'begin arg))) + (defmacro right-paren-f + (lambda _ (footnote-processor footnotes 'end))) + (define delayed-# 1) + (define delayed-#-refs 0) + (define delayed-#-refs-save 0) + (defnumreg '$d + (lambda _ + (number->string delayed-#))) + (defstring '\# + (lambda _ + (++ delayed-#-refs) + (number->string delayed-#))) + + (defmacro left-paren-d + (lambda (left-paren-d . arg) + (set! delayed-#-refs-save delayed-#-refs) + (apply footnote-processor delayed 'begin arg))) + + (defmacro right-paren-d + (lambda _ + (footnote-processor delayed 'end) + (if (not (eq? delayed-#-refs-save delayed-#-refs)) (++ delayed-#)) + "")) + + (defmacro 'pd + (lambda _ + (footnote-processor delayed 'spill) + (++ delayed-number) + "")) + + + ;;; -------------------------------------------------------------------------- ;;; TOC macros. + + (define toc-keys + (lambda new + (list (cons 'name new) (cons 'stream #f) (cons 'inside? #f)))) + + (define toc-list (list (cons "toc" (toc-keys "toc")))) + (define toc-processor ! (let ((seq 0)) ! (lambda (op . arg) ! (define (toc-stream x) (string-append "[" x "]")) ! (define (toc-field x y) (if y (cdr (assq x y)) #f)) ! (define (toc-field-set x y z) (set-cdr! (assq x y) z)) ! (let* ((x (string-append "toc" (parse (car arg)))) ! (toc (assoc x toc-list))) ! (if (not toc) (begin ! (set! toc-list (append toc-list (list (cons x (toc-keys x))))) ! (set! toc (assoc x toc-list)))) (case op (begin (cond ! ((toc-field 'inside? toc) ! (warn "nested .~a" left-paren-x)) (else ! (toc-field-set 'inside? toc #t) (emit (make-anchor 'toc seq " ") #\newline) ! (toc-field-set 'stream toc ! (set-output-stream! (append-output-stream (toc-stream x)))) (if (option 'document) (emit (make-href 'toc seq #f))) (++ seq)))) (end (cond ! ((toc-field 'inside? toc) ! (toc-field-set 'inside? toc #f) (if (option 'document) (emit "\n")) (emit "
    \n") ! (close-stream (set-output-stream! (toc-field 'stream toc)))) ! (else (warn ".~a without matching .~a" right-paren-x left-paren-x)))) (spill ! (if (toc-field 'inside? toc) (warn "unterminated .~a" right-paren-x)) ! (emit (stream->string (toc-stream x))))) ! ) ""))) ! (define left-paren-x "(x") ! (define right-paren-x ")x") ! (define toc-active "x") ! (defmacro left-paren-x ! (lambda (_ . arg) ! (let ((this (if (null? arg) toc-active (parse (car arg))))) ! (apply toc-processor 'begin this (if (null? arg) '() (cdr arg))) ! (set! toc-active this) ! ""))) ! (defmacro right-paren-x ! (lambda (_ . arg) ! (apply toc-processor 'end toc-active arg))) + (defmacro 'xp + (lambda (xp . arg) + (reset-everything) + (apply toc-processor 'spill (if (null? arg) '(x) arg)))) + ;;; -------------------------------------------------------------------------- ;;; Paragraphs of various kinds. *************** *** 639,651 **** (defmacro 'hl "
    \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 --- 681,701 ---- (defmacro 'hl "
    \n") ; horizontal line across page + ;;; Base indent applies to paragraphs, everything except titles & footnotes + ;;; so it persists even across sections. Only .ba 0 shuts it off. + (defmacro 'ba + (lambda (ba . arg) + (cond + ((null? arg) (indent '-)) + ((and (string? (car arg)) (zero? (string->number (car arg)))) (indent 0)) + (else (indent '+))))) + ;;; -------------------------------------------------------------------------- ;;; 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 'll "") ; line length (defmacro 'xl "") ; line length (defmacro 'lh "") ; letterhead *************** *** 680,686 **** (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) --- 730,736 ---- (define (section-ignored request . _) (warn "section heading request .~a not supported" request)) ! (defmacro 'tp section-ignored) (defmacro 'sx section-ignored) (defmacro '$p section-ignored) (defmacro '$0 section-ignored) diff -r -c3 unroff-1.0.orig/scm/html/ms.scm unroff-1.0/scm/html/ms.scm *** unroff-1.0.orig/scm/html/ms.scm Wed Aug 23 13:10:21 1995 --- unroff-1.0/scm/html/ms.scm Sat Apr 27 22:28:30 1996 *************** *** 388,397 **** (define indented-display? #f) (define (display-start type) ! (if (or (string=? type "C") (string=? type "B")) ! (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 #\B)))) --- 388,397 ---- (define indented-display? #f) (define (display-start type) ! ;;(if (or (string=? type "C") (string=? type "B")) ! ;; (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 #\B)))) *************** *** 405,411 **** (emit (reset-font)) (set! indented-display? (string=? type "I")) (if indented-display? ! (emit (indent '+))) (set! inside-display? #t) (preform #t)))) --- 405,413 ---- (emit (reset-font)) (set! indented-display? (string=? type "I")) (if indented-display? ! (emit (indent '+)) ! (emit "
    ")) ! (if (string=? type "C") (emit (center 999))) (set! inside-display? #t) (preform #t)))) diff -r -c3 unroff-1.0.orig/scm/misc/hyper.scm unroff-1.0/scm/misc/hyper.scm *** unroff-1.0.orig/scm/misc/hyper.scm Sat Feb 8 13:44:57 1997 --- unroff-1.0/scm/misc/hyper.scm Mon Jul 8 22:24:48 1996 *************** *** 78,84 **** (list-push! ht-anchors (anchor-create name location)) (if (q 'emit-anchor?) (concat (format #f "~a" (parse-unquote name) ! (if (null? contents) " " (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" (parse-unquote name) ! (if (null? contents) " " (parse (car contents))))) "")))))) (define (resolve-ht-reference name location) *** /dev/null Sat Feb 8 03:31:00 1997 --- unroff-1.0/misc/pstoppm.ps Mon Jul 8 23:21:50 1996 *************** *** 0 **** --- 1,262 ---- + %! PS-Adobe-2.0 + %% Program for reading a .ps file and writing out a PPM file. + %% For Ghostscript 2.5.2. + %% + %% Modified by Eric verbeek 12/9/94: + %% Added user-callable procedures to set the papersize. + %% Modified by L. Peter Deutsch 9/10/92: + %% internal procedures didn't use `bind'; + %% grestoreall undid selection of PPM device. + %% Modified by L. Peter Deutsch 4/6/92: + %% Ghostscript 2.4 requires all 8 primary colors to be in the palette. + %% Modified by L. Peter Deutsch 1/17/92: + %% the palette for makeimagedevice is now a string, not an array. + %% Modified by L. Peter Deutsch 9/24/91: + %% allow starting page number to be specified. + %% Modified by L. Peter Deutsch 7/7/91 to keep track of page count + %% in a way that gets around save and restore. + %% Modified by L. Peter Deutsch 11/07/90 + %% to use filename.ppm for the first page, renamed to filename.1ppm + %% with subsequent pages .2ppm, etc. if more than one page. + %% Modified by Henry Minsky 11/03/90 + %% for each showpage, it writes out a ppm file with name filename.ppm.N + %% where N increments each showpage, starting at 1 + %% Modified by L. Peter Deutsch -- Aladdin Enterprises -- 08/25/90 -- + %% converted from a one-shot program to a utility package, + %% designed to be used from an interactive terminal. + %% Modified by L. Peter Deutsch -- Aladdin Enterprises -- 08/02/90 + %% Modified on 08/02/90 for using the CORRECT color map. + %% Modified 06/26/90 for a color file + %% Original version by Phillip Conrad - Perfect Byte, Inc. + %% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + %%%%%% Define the directory for holding the PPM information + + /ppmdict 30 dict def + ppmdict begin + + /Horz_dpi 72 def % defaults to screen density + /Vert_dpi 72 def + + /Horz_size 612 def % defaults to Letter size + /Vert_size 792 def + + /OutFilePrefix () def % default to null (current directory) + + /FirstPageNumber 1 def % any non-negative integer is OK + + /Palette1 def + /Palette8 + %========== Here we define all 256 color entries. ====== + %========== Colors were taken from the X Windows default colors, ====== + %========== hacked up a little so we get all 8 primaries. ====== + < + 000000 ffffff a8a8a8 ebebeb 5c5c5c 373737 5f929e 85ccdd + 345057 1f3034 729efe a0ddff 3f578c 263454 6186d8 2f2f64 + ffff00 b0e2ff ff0000 808080 efdf84 55fe55 fe0000 66fe57 + fe987a feca71 fefefe fe8d7c fea977 fec472 feb875 fe937b + fe957a feb575 98fe5d fe8b7d fea677 feb276 feaf76 febe74 + fe837e fefc6a fe0c9a fe0350 fe08b5 6715fe fefb3f fe544b + 00c000 20c000 40c000 60c000 80c000 a0c000 c0c000 e0c000 + 00ff00 20e000 40e000 60e000 80e000 a0e000 c0e000 e0e000 + 000040 200040 400040 600040 800040 a00040 c00040 e00040 + 002040 202040 402040 602040 802040 a02040 c02040 e02040 + 004040 204040 404040 604040 804040 a04040 c04040 e04040 + 006040 206040 406040 606040 806040 a06040 c06040 e06040 + 008040 208040 408040 608040 808040 a08040 c08040 e08040 + 00a040 20a040 40a040 60a040 80a040 a0a040 c0a040 e0a040 + 00c040 20c040 40c040 60c040 80c040 a0c040 c0c040 e0c040 + 00e040 20e040 40e040 60e040 80e040 a0e040 c0e040 e0e040 + 000080 200080 400080 600080 800080 a00080 c00080 e00080 + 002080 202080 402080 602080 802080 a02080 c02080 e02080 + 004080 204080 404080 604080 804080 a04080 c04080 e04080 + 006080 206080 406080 606080 806080 a06080 c06080 e06080 + 008080 208080 408080 608080 808080 a08080 c08080 e08080 + 00a080 20a080 40a080 60a080 80a080 a0a080 c0a080 e0a080 + 00c080 20c080 40c080 60c080 80c080 a0c080 c0c080 e0c080 + 00e080 20e080 40e080 60e080 80e080 a0e080 c0e080 e0e080 + 0000ff 2000c0 4000c0 6000c0 8000c0 a000c0 c000c0 ff00ff + 0020c0 2020c0 4020c0 6020c0 8020c0 a020c0 c020c0 e020c0 + 0040c0 2040c0 4040c0 6040c0 8040c0 a040c0 c040c0 e040c0 + 0060c0 2060c0 4060c0 6060c0 8060c0 a060c0 c060c0 e060c0 + 0080c0 2080c0 4080c0 6080c0 8080c0 a080c0 c080c0 e080c0 + 00a0c0 20a0c0 40a0c0 60a0c0 80a0c0 a0a0c0 c0a0c0 e0a0c0 + 00c0c0 20c0c0 40c0c0 60c0c0 80c0c0 a0c0c0 c0c0c0 e0c0c0 + 00ffff 20e0c0 40e0c0 60e0c0 80e0c0 a0e0c0 c0e0c0 e0e0c0 + > def + + % Define a procedure for computing the output file name for a given page. + /pagefilename % pagefilename -> Convert - + { /Palette exch def + /FileName exch def + + % Save and restore don't save and restore the contents of strings. + % Therefore, we use strings to hold the two variables whose values + % must persist across page boundaries (PageCount and WrotePage). + + /PageCountString 6 string def + 100000 PageCountString cvs pop + /WrotePage 1 string def + + /ScaleX Horz_dpi 72 div def + /ScaleY Vert_dpi 72 div def + + % /Width 85 Horz_dpi mul 5 add 10 div cvi def % add 5 to round up! + % /Height 11 Vert_dpi mul def + /Width Horz_size ScaleX mul cvi def + /Height Vert_size ScaleX mul cvi def + + FileName (.ps) concatstrings + /FileNameIn exch def % file name with extension + + [ScaleX 0.0 0.0 ScaleY neg 0.0 Height] + Width Height Palette makeimagedevice + /Device exch def + Device setdevice + + % For running the file, remove ppmdict from the dict stack + FileNameIn end run % ppmdict + ppmdict begin + WrotePage 0 get 0 eq { showpage } if % make sure the page got written + end % ppmdict + + } bind def + + end % ppmdict + + %%%%%% Define the user-callable procedures + + /ppmsetsize + { ppmdict begin + /Vert_size exch def + /Horz_size exch def + end + } bind def + + /ppmsetsize2letter + { 612 792 ppmsetsize + } bind def + + /ppmsetsize2legal + { 612 1008 ppmsetsize + } bind def + + /ppmsetsize2a4 + { 595 842 ppmsetsize + } bind def + + /ppmsetsize2a3 + { 842 1190 ppmsetsize + } bind def + + /ppmsetsize2a2 + { 1190 1684 ppmsetsize + } bind def + + /ppmsetsize2a1 + { 1684 2380 ppmsetsize + } bind def + + /ppmsetsize2a0 + { 2380 3368 ppmsetsize + } bind def + + /ppmsetdensity + { ppmdict begin + /Vert_dpi exch def + /Horz_dpi exch def + end + } bind def + + /ppmsetprefix + { ppmdict begin + /OutFilePrefix exch def + end + } bind def + + + /ppmsetfirstpagenumber + { cvi + ppmdict begin + /FirstPageNumber exch def + } bind def + + /ppm1run + { ppmdict begin Palette1 Convert + } bind def + + /ppm8run + { ppmdict begin Palette8 Convert + } bind def + + /ppm24run + { ppmdict begin null Convert + } bind def + + %%%%%% Display instructions for the user. + + %(Usage: (file) ppmNrun\n) print + %( converts file.ps to file.ppm (single page),\n) print + %( or file.1ppm, file.2ppm, ... (multi page).\n) print + %( N is # of bits per pixel (1, 8, or 24).\n) print + %(Examples: (golfer) ppm1run ..or.. (escher) ppm8run\n) print + %(Optional commands you can give first:\n) print + %( horiz_DPI vert_DPI ppmsetdensity\n) print + %( (dirname/) ppmsetprefix\n) print + %( page_num ppmsetfirstpagenumber\n) print + flush *** /dev/null Sat Feb 8 03:31:00 1997 --- unroff-1.0/misc/pictogif Sat Feb 8 15:14:04 1997 *************** *** 0 **** --- 1,60 ---- + #! /bin/sh + # Shell script to convert a picture to a gif file for inclusion into the + # html text. + # + # What constitutes a picture depends on the local system. At U. Bristol + # Geology, this is either an nplot file, or a raw, pre-sized Postscript file. + # Inclusion of one of these is signalled by the locally defined macros + # .PS / .PE + # .PS takes 5 parameters: + # 1 - picture height (in any unit acceptible to troff) + # 2 - width in units or inches ("-" for default) + # 3 - file name bearing picture (postscript or nplot text) + # 4 - file type (ps, np, gif) + # 5 - scale factor + # + # The script builds up input to the "pic" program that post-processes + # troff-generated PostScript output and inserts the picture into the stream. + # The resultant PostScript file is converted to a gif file for inclusion into + # the html stream. + + n=0 file=- out=- psfile=- scale=1.0 density=72 trans=-notrans + ftyp=unknown tmp=/tmp/pictogif$$ + while [ $# -gt 0 ]; do + case "$1" in + -density) + psfile="$2" ; shift + ;; + -ps) + psfile="$2" ; shift + ;; + -trans*) + trans= + ;; + *) + n=`expr $n + 1` + if [ $n = 1 ]; then file=$1 + elif [ $n = 2 ]; then ftyp=$1 + elif [ $n = 3 ]; then scale=$1 + else + echo "$0: Dont understand $1" > /dev/tty + exit 1 + fi + ;; + esac + shift + done + if [ "$file" = "-" ]; then + echo "$0: No input file given." + exit 1 + fi + if [ "$psfile" = "-" ]; then + echo "$0: No ps file given." + exit 1 + fi + + echo $file $scale > $tmp.pic + (echo .lo; cat -) | psroff -me -t | + sed -e 's/showpage//g' | pic -f $tmp.pic > $psfile + pstogif $trans -density $density $psfile + /bin/rm -f $tmp.pic *** /dev/null Sat Feb 8 03:31:00 1997 --- unroff-1.0/misc/pstogif Sat Feb 8 15:11:45 1997 *************** *** 0 **** --- 1,65 ---- + #! /bin/sh + # Shell script to convert a PostScript file to a gif file. The hard work is + # done by Ghostscript; you must have this available in order for the script + # to function properly. Final massaging of the text gets done by programs in + # the netpbm (portable bitmap manipulation) package, which also must be + # installed for the script to work. + + n=0 what=- density=72 depth=1 + tmp=/tmp/pstogif$$ ppmargs= cmd="sed -e s/showpage//g" + dirpps=/usr/share/data/ghostscript trans='-transparent rgb:ff/ff/ff' + while [ $# -gt 0 ]; do + case "$1" in + -density) + density="$2" ; shift + ;; + -depth) + depth="$2" ; shift + ;; + -interl*) + ppmargs="${ppmargs} $1" + ;; + -notrans*) + trans="" + ;; + -noedit) + cmd="cat -" + ;; + *) + n=`expr $n + 1` + if [ $n = 1 ]; then + if [ 0 != `expr "$1" : .*\.ps` ]; then + what=`expr "$1" : '\(.*\)\.ps'` + else + echo "$0: File name $1 must end with .ps" + fi + else + echo "$0: Dont understand $1" > /dev/tty + exit 1 + fi + ;; + esac + shift + done + if [ "$what" = "-" ]; then + echo "$0: No file input given." + exit 1 + fi + + cat << EOF > $tmp + $density $density ppmsetdensity + ppmsetsize2a4 + (${what}) ppm${depth}run + EOF + cat $tmp $what.ps | $cmd | gs -q -dNODISPLAY $dirpps/pstoppm.ps - + if [ -f $what.ppm ]; then + pnmcrop $what.ppm | ppmtogif $trans > $what.gif + /bin/rm -f $what.ppm + else + for i in `echo $what.[1-9]*ppm` ; do + j="`expr $i : '\(.*\)ppm'`.gif" + pnmcrop $i | ppmtogif $trans $ppmargs > $j + /bin/rm -f $i + done + fi + /bin/rm -f $tmp