conservatory
/
unroff-website
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
unroff-website/www/contrib/misc-patch-2.diff

2511 lines
77 KiB
Diff
Raw Permalink Blame History

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 <br>,
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" <h1>...</h1> 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(!<img src=""next.gif"" alt=""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) "<pre>\n")))
((and (not on?) preform?)
(defsentence sentence-event)
(with-font-preserved
! (begin (set! preform? #f) "</pre>\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 <br> at the end of each line.
+ ;;; Might prefer using <pre> </pre> 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?
! "<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) "")
! "</pre>\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 "<br>\n")))
;;; --------------------------------------------------------------------------
***************
*** 111,116 ****
--- 134,140 ----
(defescape #\\ #\\)
(defescape #\' #\')
(defescape #\` #\`)
+ (defescape #\p "<br>") ; just break - can't spread like troff
(defescape #\% "")
(defescape ""
***************
*** 139,146 ****
(defspecial 'mu "&#215;") ; multiplication
(defspecial 'tm "&#174;")
(defspecial 'rg "&#174;")
- (defspecial '*m "&#181;") ; mu
- (defspecial '*b "&#223;") ; 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 "&#166;") ; broken bar
(defspecial 'r! "&#161;") ; reverse exclamation mark
(defspecial 'r? "&#191;") ; 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 "&#181;")
+ (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 "<img src=\"" gifname
+ "\" alt=\"[" charname "]\"" align ">")))
+ (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 "<br>\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) "<center>" (if centering? "</center>\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 "<b>[%1%]</b>")
! (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? "" "<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)
--- 56,67 ----
(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 compact>\n" "</dl>\n")
(define-pair list-para list-para? "<ul>\n" "</ul>\n")
(define-pair quoted quoted? "<blockquote>\n" "</blockquote>\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 "<dl><dt><dd>\n" "</dl>\n")
--- 70,78 ----
(preform #f)
(tag-para #f)
(list-para #f)
! (reset-title-features)))
! (define-nested-pair indent indent-level "<dl><dt><dd>" "</dl>\n")
***************
*** 122,128 ****
((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))
--- 129,135 ----
((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>") ""))))
(define (make-anchor type index contents)
(format #f "<a name=\"~a~a\">~a</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? "<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.
--- 191,298 ----
(concat (title #f)
(begin1 (if got-title? "<hr>\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 "<h2>"
! (make-anchor 'section seq (stringdef '$n))))
! (else
! (if (macrodef '$0)
! (emit (parse-line
! (format #f ".$0 \"~a\" ~a ~a" hdr (stringdef '$n) depth))))
! (emit "<h2>")))
! (emit hdr "</h2>\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"))) ; <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)
--- 323,332 ----
(defmacro 'u (lambda (u) (with-font "I"))) ; <u> 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)
! "<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")
--- 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)
! "<dt><dd>"
! (concat "<dt>" (parse (car arg)) "<dd>")))
! (list-para?
! (cond
! ((non-tagged? arg)
! "<li>")
! (else
! (warn ".~a `arg' in a list that was begun as non-tagged" op)
! (concat "<li>" (parse (car arg)) "<br>\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 "<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 <...>.
--- 405,480 ----
(if indented-display?
(emit (indent '+))
(emit "<br>"))
! (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 "<p>\n")
(let ((anchor
(cond ((not (null? arg))
(parse (car arg)))
! ((positive? **-count)
(substitute (option 'footnote-anchor)
! (number->string **-count)))
(else #f))))
(if anchor
! (emit "<b>" (make-anchor 'footnote next-footnote anchor)
! "</b>" nbsp))))))
(end
(cond
(inside?
! (set! inside? #f)
! (close-stream (set-output-stream! stream)))
! (else (warn ".FE without matching .FS"))))
(spill
! (if inside? (quit "unterminated footnote at end of document"))
! (let ((contents (stream->string "[footnotes]"))
! (hdr (substitute (option 'footnotes-header))))
(cond
((not (eqv? contents ""))
! (if split-sections?
(push-HTML-stream "-notes" ", footnotes"))
! (cond ((and split-sections? (option 'toc))
(auto-toc-entry hdr "" 1 0)
! (emit "<h2>" (make-anchor 'section 0 hdr)))
! (else (emit "<h2>" hdr)))
! (emit "</h2>\n" contents))
! ((positive? next-footnote)
! (warn "footnote anchor used, but no .FS"))))))
"")))
! (defmacro 'FS
! (lambda (FS . arg)
! (apply footnote-processor 'begin arg)))
! (defmacro 'FE
! (lambda _ (footnote-processor 'end)))
;;; --------------------------------------------------------------------------
;;; TOC macros.
(define toc-processor
! (let ((stream #f) (inside? #f) (seq 1))
! (lambda (op . arg)
(case op
(begin
(cond
! (inside?
! (surprise "nested .XS"))
(else
! (set! inside? #t)
(emit (make-anchor 'toc seq "&#160;") #\newline)
! (set! stream (set-output-stream! (append-output-stream "[toc]")))
! (if (>= (length arg) 2)
! (emit
! (repeat-string
! (get-hunits (parse-expression (cadr arg) 0 #\n)) nbsp)))
(if (option 'document)
(emit (make-href 'toc seq #f)))
(++ seq))))
(end
(cond
! (inside?
! (set! inside? #f)
(if (option 'document) (emit "</a>\n"))
(emit "<br>\n")
! (close-stream (set-output-stream! stream)))
! (else (warn ".XE or .XA without matching .XS"))))
(spill
! (if inside? (quit "unterminated .XE"))
! (if (or (null? arg) (not (string=? (car arg) "no")))
! (emit "<h2>Table of Contents</h2>\n"))
! (emit (stream->string "[toc]"))))
"")))
! (defmacro 'XS
! (lambda (XS . arg)
! (apply toc-processor 'begin arg)))
! (defmacro 'XE (lambda _ (toc-processor 'end)))
! (defmacro 'XA (lambda _ (toc-processor 'end) (toc-processor 'begin)))
! (defmacro 'PX
! (lambda (PX . arg)
! (apply toc-processor 'spill arg)))
;;; --------------------------------------------------------------------------
;;; Paragraphs of various kinds.
--- 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 "<br>\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 "<h2>" (make-anchor 'section 0 hdr) "</h2>\n"))
! (else (if (not (eq? hdr "")) (emit "<h2>" hdr "</h2>\n"))))
! (emit contents "<br>\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 "&#160;") #\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 "</a>\n"))
(emit "<br>\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 "<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
--- 681,701 ----
(defmacro 'hl "<hr>\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 "<br>"))
! (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 name=\"~a\">~a</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 name=\"~a\">~a</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 <ff 00> 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 % <int|null> pagefilename -> <string
+ { OutFilePrefix FileName concatstrings (.) concatstrings
+ exch dup null ne
+ { 1 sub FirstPageNumber add (xxxxxx) cvs concatstrings }
+ { pop }
+ ifelse (ppm) concatstrings
+ } bind def
+
+ % Redefine copypage and showpage appropriately.
+ /copypage
+ { ppmdict begin
+
+ /PageCount PageCountString cvi 100000 sub def
+ /PageCount PageCount 1 add def
+
+ PageCount 1 eq
+ { null pagefilename % first page
+ }
+ { PageCount 2 eq
+ { % second page, rename first
+ null pagefilename 1 pagefilename
+ (Renaming ) print 1 index print ( to ) print
+ dup print (\n) print
+ flush
+ renamefile
+ } if
+ PageCount pagefilename
+ } ifelse
+ /FileNameOut exch def
+
+ FileNameOut (w) file
+ /FileDescOut exch def
+
+ (Writing ) print FileNameOut print (\n) print
+ flush
+ FileDescOut Device writeppmfile
+ FileDescOut closefile
+
+ WrotePage 0 1 put % /WrotePage true def
+ PageCount 100000 add PageCountString cvs pop
+
+ end
+ } bind userdict begin odef end
+ /showpage
+ { copypage erasepage initgraphics
+ } bind userdict begin odef end
+
+ % Redefine grestoreall so it doesn't undo the device selection
+ /grestoreall /grestoreall load def
+ /grestoreall
+ { ppmdict begin grestoreall Device setdevice end
+ } bind userdict begin odef end
+
+ /Convert % the main procedure
+ % <filename> <palette> 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
Reference in New Issue View Git Blame Copy Permalink