System: unroff version 1.0 Patch #: 2 Priority: high Required-Distribution: source Description: README: o Updated information about Elk from Elk 2.2 to Elk 3.0 doc/*.1: o A wrong URL was mentioned in the manual pages scm/troff.scm: o Inline Scheme expressions were evaluated in the wrong environment scm/html/common.scm: o The call to groff has been changed to allow for text using Latin 1 characters o Fixed several bugs in the code implementing .nf and .fi o .sp with a zero argument now causes a break scm/html/ms.scm: o ".NH S" now accepts letters as section numbers o .IP now recognizes en-dash as a special label o .XS now accepts an optional indent argument src/*: o Fixed two bugs in the streams code o Code now makes use of Elk 3.0 features in a few places (optional) elk/scm/*: o Updated the Scheme runtime environment from Elk 2.2 to Elk 3.0 Fix: From rn, say "| patch -p -N -d DIR", where DIR is the top of your unroff source or binary directory tree. Outside of rn, say "cd DIR; patch -p -N string '[##])))) ! (copy-apply (lambda () (read p)) eval))) ((string=? delim ">>") (copy-exec ".>>\n" "transparent output")) (else --- 276,282 ---- (with-output-to-stream '[##] (copy-exec ".##\n" "inline Scheme execution")) (let ((p (open-input-string (stream->string '[##])))) ! (copy-apply (lambda () (read p)) \##-eval))) ((string=? delim ">>") (copy-exec ".>>\n" "transparent output")) (else *************** *** 283,289 **** (defrequest '\## (lambda (\## sexpr) (let ((p (open-input-string sexpr))) ! (copy-apply (lambda () (read p)) eval)))) (defrequest '>> (lambda (>> code) (emit code #\newline))) --- 286,292 ---- (defrequest '\## (lambda (\## sexpr) (let ((p (open-input-string sexpr))) ! (copy-apply (lambda () (read p)) \##-eval)))) (defrequest '>> (lambda (>> code) (emit code #\newline))) *** 1.18 1995/06/02 13:15:36 --- scm/html/common.scm 1995/08/23 12:10:19 *************** *** 12,18 **** "groff -ms > %1%; /usr/www/lib/latex2html/pstogif %1% -out %2%") (define-option 'troff-to-text 'string ! "groff -Tascii |col -b |sed '/^[ \t]*$/d' > %1%") (define-option 'tbl 'string 'gtbl) (define-option 'eqn 'string 'geqn) --- 12,18 ---- "groff -ms > %1%; /usr/www/lib/latex2html/pstogif %1% -out %2%") (define-option 'troff-to-text 'string ! "groff -Tlatin1 -P-b -P-u |sed '/^[ \t]*$/d' > %1%") (define-option 'tbl 'string 'gtbl) (define-option 'eqn 'string 'geqn) *************** *** 43,61 **** ;;; -------------------------------------------------------------------------- ;;; Preformatted text. ! (define-pair preform preform? "
\n" "
\n") ! (defrequest 'nf ! (lambda _ ! (if (not preform?) ! (defsentence #f)) ! (with-font-preserved (preform #t)))) ! (defrequest 'fi ! (lambda _ ! (if preform? ! (defsentence sentence-event)) ! (with-font-preserved (preform #f)))) (define-macro (with-preform-preserved . body) `(let (($p preform?)) --- 43,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))) ! (defrequest 'fi (lambda _ (preform #f))) (define-macro (with-preform-preserved . body) `(let (($p preform?)) *************** *** 474,479 **** --- 476,483 ---- (warn ".sp with negative spacing ignored")) (preform? (repeat-string n "\n")) + ((zero? n) + "
\n") (else (with-font-preserved (repeat-string n "

\n"))))))) *** 1.12 1995/04/12 13:57:44 --- scm/html/ms.scm 1995/08/23 12:10:21 *************** *** 223,229 **** (define (increment-section! s n) (if (positive? n) (increment-section! (cdr s) (1- n)) ! (set-car! s (1+ (car s))) (set-cdr! s '()))) (define (section-number s n) --- 223,231 ---- (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) *************** *** 231,236 **** --- 233,244 ---- "" (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) *************** *** 243,249 **** (warn ".NH with `S' argument but no numbers") 1) (else ! (let ((new (map string->number (cdr args)))) (if (memq #f new) (warn "bad section number in .NH request") (set! sections new)) --- 251,257 ---- (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)) *************** *** 330,336 **** (define (indented-paragraph IP . arg) (define (non-tagged? s) ! (or (null? s) (string=? (car s) "\\(bu") (string=? (car s) "\\(sq"))) (emit (reset-font) (secthdr #f) (reset-title-features)) (header-processor #f) (cond --- 338,344 ---- (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 *************** *** 526,531 **** --- 534,543 ---- (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)))) *************** *** 544,553 **** (emit (stream->string "[toc]")))) ""))) ! (defmacro 'XS (lambda _ (toc-processor 'begin))) (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))) --- 556,568 ---- (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))) *************** *** 596,602 **** (parse word #\newline))) (define (multi-column-ignored request . _) ! (warn "multi-column request .~a not suppored" request)) (defmacro 'MC multi-column-ignored) (defmacro '1C multi-column-ignored) --- 611,617 ---- (parse word #\newline))) (define (multi-column-ignored request . _) ! (warn "multi-column request .~a not supported" request)) (defmacro 'MC multi-column-ignored) (defmacro '1C multi-column-ignored) *** 1.13 1995/04/25 20:05:50 --- src/stream.c 1995/08/23 12:11:06 *************** *** 109,117 **** } void safe_write_char(char c) { ! if (Truep(ostream)) STREAM(ostream)->write(STREAM(ostream), &c, 1); ! else if (putc(c, stdout) == EOF) write_error("stdout"); } --- 109,118 ---- } void safe_write_char(char c) { ! if (Truep(ostream)) { ! STREAM(ostream)->pos++; STREAM(ostream)->write(STREAM(ostream), &c, 1); ! } else if (putc(c, stdout) == EOF) write_error("stdout"); } *************** *** 378,384 **** static Object p_stream_target(Object x) { if (!Truep(x)) ! return Void; Check_Type(x, T_Stream); return Make_String(STREAM(x)->target, strlen(STREAM(x)->target)); } --- 379,385 ---- static Object p_stream_target(Object x) { if (!Truep(x)) ! return Make_String("", 0); Check_Type(x, T_Stream); return Make_String(STREAM(x)->target, strlen(STREAM(x)->target)); } *** 1.20 1995/04/25 20:05:50 --- src/unroff.c 1995/08/23 12:11:05 *************** *** 199,205 **** --- 199,209 ---- init_prim(); init_scmtable(); init_stream(); + #ifdef ELK_MAJOR + Set_Error_Tag("load"); + #else Error_Tag = "load"; + #endif boot_code(); load_rc_file(); if (tflag) { *************** *** 210,216 **** --- 214,224 ---- test_mode(); return 0; } + #ifdef ELK_MAJOR + Set_Error_Tag("main-loop"); + #else Error_Tag = "main-loop"; + #endif while (optind < ac) do_argument(av[optind++]); if (!got_filename) *** 1.17 1995/06/02 13:15:55 --- src/unroff.h 1995/08/23 12:11:07 *************** *** 32,43 **** /* Prototypes for IEEE FP functions that may be missing: */ extern int finite(double); #include "scheme.h" ! /* Prototypes that are missing from "scheme.h" in the current Elk release: */ extern void Elk_Init(int ac, char **av, int call_inits, char *filename); extern void Load_Source_Port(Object); --- 32,45 ---- /* Prototypes for IEEE FP functions that may be missing: */ + #ifndef finite extern int finite(double); + #endif #include "scheme.h" ! /* Prototypes that were missing from "scheme.h" in some Elk releases: */ extern void Elk_Init(int ac, char **av, int call_inits, char *filename); extern void Load_Source_Port(Object); *** elk/README.old Fri Jun 2 16:12:43 1995 --- elk/README Wed Aug 23 14:12:48 1995 *************** *** 1,4 **** This directory holds a minimal, self-contained Elk runtime environment. ! All the files have been copied from the Elk 2.2 distribution. If you have Elk installed at your site, you can replace this directory by a symbolic link to your site's Elk runtime directory. --- 1,4 ---- This directory holds a minimal, self-contained Elk runtime environment. ! All the files have been copied from the Elk 3.0 distribution. If you have Elk installed at your site, you can replace this directory by a symbolic link to your site's Elk runtime directory. *** elk/scm/debug.scm.old Fri Jun 2 16:12:43 1995 --- elk/scm/debug.scm Mon Aug 7 19:20:10 1995 *************** *** 1,6 **** ;;; -*-Scheme-*- ;;; ! ;;; A simple debugger (needs much work) (define (backtrace . args) (if (> (length args) 1) --- 1,6 ---- ;;; -*-Scheme-*- ;;; ! ;;; A simple debugger (improvements by Thomas M. Breuel ). (define (backtrace . args) (if (> (length args) 1) *************** *** 8,41 **** (if (not (null? args)) (if (not (eq? (type (car args)) 'control-point)) (error 'backtrace "argument must be a control point"))) ! (let ((trace ! (apply backtrace-list args)) ! (maxlen 28)) (if (null? args) (set! trace (cdddr trace))) ! (for-each ! (lambda (frame) ! (let* ((func ! (format #f "~s" (vector-ref frame 0))) ! (indent ! (- maxlen (string-length func)))) ! (display func) ! (if (negative? indent) ! (begin ! (newline) ! (set! indent maxlen))) ! (do ((i indent (1- i))) ! ((> 0 i)) ! (display " "))) ! (fluid-let ! ((print-depth 2) ! (print-length 3)) ! (display (vector-ref frame 1))) ! (newline)) ! trace)) ! #v) ! (define (show env) (fluid-let ((print-length 2) (print-depth 2)) --- 8,49 ---- (if (not (null? args)) (if (not (eq? (type (car args)) 'control-point)) (error 'backtrace "argument must be a control point"))) ! (let ((trace (apply backtrace-list args))) (if (null? args) (set! trace (cdddr trace))) ! (show-backtrace trace 0 999999))) ! (define (show-backtrace trace start-frame end-frame) ! (define (rjust n x) ! (let* ((y (string-append (make-string n #\space) x)) ! (l (string-length y))) ! (substring y (- l n) l))) ! (let ((maxlen 28)) ! (let loop ((frames (list-tail trace start-frame)) (num start-frame)) ! (if (or (null? frames) (>= num end-frame)) #v ! (let ((frame (car frames))) ! (let* ((func ! (format #f "~s" (vector-ref frame 0))) ! (indent ! (- maxlen (+ 5 (string-length func))))) ! (display (rjust 4 (number->string num))) ! (display " ") ! (display func) ! (if (negative? indent) ! (begin ! (newline) ! (set! indent maxlen))) ! (do ((i indent (1- i))) ! ((> 0 i)) ! (display " "))) ! (fluid-let ! ((print-depth 2) ! (print-length 3)) ! (display (vector-ref frame 1))) ! (newline)) ! (loop (cdr frames) (1+ num)))))) ! ! (define (show-environment env) (fluid-let ((print-length 2) (print-depth 2)) *************** *** 52,68 **** (let ((frame) (trace) (help-text ! '("q -- quit inspector" ! "f -- print current frame" ! "u -- go up one frame" ! "d -- go down one frame" ! "^ -- go to top frame" ! "$ -- go to bottom frame" ! "e -- eval expressions in environment" ! "p -- pretty-print procedure" ! "v -- show environment" ! " -- pretty-print n-th argument" ! "o -- obarray information"))) (define (inspect-command-loop) (let ((input) (done #f)) --- 60,80 ---- (let ((frame) (trace) (help-text ! '("q -- quit inspector" ! "f -- print current frame" ! "u -- go up one frame" ! "d -- go down one frame" ! "^ -- go to top frame" ! "$ -- go to bottom frame" ! "g -- goto to n-th frame" ! "e -- eval expressions in environment" ! "p -- pretty-print procedure" ! "v -- show environment" ! " -- pretty-print n-th argument" ! "b -- show backtrace starting at current frame" ! "t -- show top of bracktrace starting at current frame" ! "z -- show and move top of backtrace starting at current frame" ! "o -- obarray information"))) (define (inspect-command-loop) (let ((input) (done #f)) *************** *** 95,102 **** (format #t "Already on bottom frame.~%") (set! frame (1+ frame)) (print-frame))) (v ! (show (vector-ref (list-ref trace frame) 2))) (e (format #t "Type ^D to return to Inspector.~%") (let loop () --- 107,122 ---- (format #t "Already on bottom frame.~%") (set! frame (1+ frame)) (print-frame))) + (g + (set! input (read)) + (if (integer? input) + (set! frame + (cond ((negative? input) 0) + ((>= input (length trace)) (1- (length trace))) + (else input))) + (format #t "Frame number must be an integer.~%"))) (v ! (show-environment (vector-ref (list-ref trace frame) 2))) (e (format #t "Type ^D to return to Inspector.~%") (let loop () *************** *** 112,117 **** --- 132,145 ---- (p (pp (vector-ref (list-ref trace frame) 0)) (newline)) + (z + (show-backtrace trace frame (+ frame 10)) + (set! frame (+ frame 9)) + (if (>= frame (length trace)) (set! frame (1- (length trace))))) + (t + (show-backtrace trace frame (+ frame 10))) + (b + (show-backtrace trace frame 999999)) (o (let ((l (map length (oblist)))) (let ((n 0)) *************** *** 134,140 **** (inspect-command-loop)))) (define (print-frame) ! (format #t "~%Frame ~s of ~s:~%~%" (1+ frame) (length trace)) (let* ((f (list-ref trace frame)) (args (vector-ref f 1))) (format #t "Procedure: ~s~%" (vector-ref f 0)) (format #t "Environment: ~s~%" (vector-ref f 2)) --- 162,168 ---- (inspect-command-loop)))) (define (print-frame) ! (format #t "~%Frame ~s of ~s:~%~%" frame (1- (length trace))) (let* ((f (list-ref trace frame)) (args (vector-ref f 1))) (format #t "Procedure: ~s~%" (vector-ref f 0)) (format #t "Environment: ~s~%" (vector-ref f 2)) *************** *** 146,155 **** (do ((i 1 (1+ i)) (args args (cdr args))) ((null? args)) (format #t "Argument ~s: ~s~%" i (car args)))))) (newline)) (set! inspect (lambda () - (set! frame 0) (set! trace (backtrace-list)) (set! trace (cddr trace)) (do ((t trace (cdr t)) (f 1 (1+ f))) ((null? t)) --- 174,188 ---- (do ((i 1 (1+ i)) (args args (cdr args))) ((null? args)) (format #t "Argument ~s: ~s~%" i (car args)))))) (newline)) + + (define (find-frame proc) + (let loop ((l trace) (i 0)) + (cond ((null? l) -1) + ((eq? (vector-ref (car l) 0) proc) i) + (else (loop (cdr l) (1+ i)))))) (set! inspect (lambda () (set! trace (backtrace-list)) (set! trace (cddr trace)) (do ((t trace (cdr t)) (f 1 (1+ f))) ((null? t)) *************** *** 160,165 **** --- 193,201 ---- (format #t "[inspector: fixing improper arglist in frame ~s]~%" f) (set-cdr! last (cons (cdr last) '()))))))) + (set! frame (find-frame error-handler)) + (if (negative? frame) + (set! frame 0)) (format #t "Inspector (type ? for help):~%") (let loop () (if (call-with-current-continuation *** elk/scm/initscheme.scm.old Fri Jun 2 16:12:42 1995 --- elk/scm/initscheme.scm Mon Aug 7 19:20:11 1995 *************** *** 11,17 **** ;;; Primitives that are part of the core functionality but are not ! ;;; implemented in C: (define (expt x y) --- 11,18 ---- ;;; Primitives that are part of the core functionality but are not ! ;;; implemented in C. This is a bad thing, because extension or ! ;;; application writers should be able to rely on P_Expt(). (define (expt x y) *************** *** 33,39 **** (define call/cc call-with-current-continuation) ! ;;; Backwards compatibility: (define (close-port p) (if (input-port? p) (close-input-port p) (close-output-port p))) --- 34,41 ---- (define call/cc call-with-current-continuation) ! ;;; Backwards compatibility. These procedures are really obsolete; ! ;;; please do not use them any longer. (define (close-port p) (if (input-port? p) (close-input-port p) (close-output-port p))) *** elk/scm/pp.scm.old Fri Jun 2 16:12:42 1995 --- elk/scm/pp.scm Mon Aug 7 19:20:11 1995 *************** *** 37,43 **** #v)) (define (flat-size s) ! (fluid-let ((print-length 1000) (print-depth 100)) (string-length (format #f "~a" s)))) (define (pp-object x) --- 37,43 ---- #v)) (define (flat-size s) ! (fluid-let ((print-length 50) (print-depth 10)) (string-length (format #f "~a" s)))) (define (pp-object x)