From 4d146f1a7b4089c822b68255a19e26d70459a3c2 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 1 Dec 2007 13:33:13 +0000 Subject: [PATCH] make scribble executable work svn: r7883 --- collects/scribble/info.ss | 4 +- collects/scribble/run-scribble.ss | 64 -------------------------- collects/scribble/run.ss | 2 +- collects/scribble/scribble.ss | 74 +++---------------------------- collects/scribble/text-render.ss | 2 +- 5 files changed, 9 insertions(+), 137 deletions(-) delete mode 100644 collects/scribble/run-scribble.ss diff --git a/collects/scribble/info.ss b/collects/scribble/info.ss index e796d2cb0c..6b190494fc 100644 --- a/collects/scribble/info.ss +++ b/collects/scribble/info.ss @@ -1,6 +1,6 @@ (module info setup/infotab (define name "Scribble") - (define blurb '("MzScheme extensions for writing text.")) + (define blurb '("Text and documention typesetting.")) (define mzscheme-launcher-names '("scribble")) - (define mzscheme-launcher-libraries '("run-scribble.ss")) + (define mzscheme-launcher-libraries '("scribble.ss")) (define compile-omit-files '("test-reader.ss"))) diff --git a/collects/scribble/run-scribble.ss b/collects/scribble/run-scribble.ss deleted file mode 100644 index f0b0b01ea0..0000000000 --- a/collects/scribble/run-scribble.ss +++ /dev/null @@ -1,64 +0,0 @@ -(module run-scribble mzscheme - - (require (lib "cmdline.ss")) - - (define exe-name 'scribble) ; for errors - - (define (error* msg . args) - (apply raise-user-error exe-name msg args)) - - (define formats - `([sexpr ,(lambda (v) - ((dynamic-require '(lib "pretty.ss") 'pretty-print) v))])) - (define default-format 'sexpr) - - (define (format->renderer format) - (cond [(assq format formats) - => (lambda (f) - (let ([f (cadr f)]) - (cond [(procedure? f) f] - [else (error 'format->renderer - "internal error: ~s" f)])))] - [else (error* "unknown format ~e (use -L for a list of formats)" - format)])) - - (provide render-file) - (define (render-file input output format) - (unless (file-exists? input) - (error* "cannot find input file: ~e" input)) - (let* ([contents (dynamic-require `(file ,input) 'contents)] - [renderer (format->renderer format)] - [render (lambda () (renderer contents))]) - (if output (with-output-to-file output render #:exists 'truncate) (render)))) - - (provide main) - (define (main args) - (define *output-name #f) - (define *format #f) - (command-line (car args) (cdr args) - [once-each - [("-o" "--output") output-name "output name (sometimes a directory)" - (set! *output-name output-name)] - [("-f" "--format") format "output format (implies suffix)" - "(use -L to list available formats)" - (set! *format (string->symbol format))] - [("-L" "--list-formats") "show available output-formats" - (printf "Available formats:\n") - (for-each (lambda (f) (printf " ~a\n" (car f))) formats) - (printf "The default is ~a\n" default-format) - (exit)]] - [args (input-file) - (let* ([fmt (cond [*format *format] - [(and *output-name - (regexp-match #rx"[.]([^.]+)$" *output-name)) - => (lambda (m) (string->symbol (cadr m)))] - [else default-format])] - [output (or *output-name (path-replace-suffix - input-file (symbol->string fmt)))] - [output (and (not (equal? "-" output)) output)]) - (render-file input-file output fmt))])) - - (main (cons (symbol->string exe-name) - (vector->list (current-command-line-arguments)))) - -) diff --git a/collects/scribble/run.ss b/collects/scribble/run.ss index 1001fe1489..3647beca4b 100644 --- a/collects/scribble/run.ss +++ b/collects/scribble/run.ss @@ -54,7 +54,7 @@ [("++info-in") file "load format-specific link information form " (current-info-input-files (cons file (current-info-input-files)))]] - [args file file])) + [args (file . another-file) (cons file another-file)])) (define (build-docs-files files) (build-docs (map (lambda (file) diff --git a/collects/scribble/scribble.ss b/collects/scribble/scribble.ss index 7ebc31e054..8b49969bed 100644 --- a/collects/scribble/scribble.ss +++ b/collects/scribble/scribble.ss @@ -1,73 +1,9 @@ -(module scribble mzscheme - (require (prefix a: "reader.ss") (lib "kw.ss") (lib "list.ss")) - (provide (all-from-except mzscheme read read-syntax define lambda) - (rename a:read read) (rename a:read-syntax read-syntax) - (rename define/kw define) (rename lambda/kw lambda)) +#lang scheme/base - ;; -------------------------------------------------------------------------- - ;; Utilities +(require "run.ss") - (define-syntax define* - (syntax-rules () - [(_ (name . args) . body) - (begin (provide name) (define/kw (name . args) . body))] - [(_ name val) - (begin (provide name) (define name val))])) +(define files (get-command-line-files + (current-command-line-arguments))) - (define-syntax define-format-element - (syntax-rules () - ([_ name tag] - (begin (define (name . args) (cons tag args)) - (provide name))))) - ;; allows specifying attributes through sub-elements - (define (subs->keys x keys) - (let ([syms+keys - (append (map (lambda (k) (string->symbol (keyword->string k))) keys) - keys)] - [tag (car x)]) - (define (amb-error key) - (error tag "ambiguous `~a' specification" key)) - (let loop ([xs (cdr x)] [kvs '()] [seen '()]) - (if (not (or (null? xs) (null? (cdr xs)) (not (keyword? (car xs))))) - (let ([key (car xs)]) - (when (memq key seen) (amb-error key)) - (loop (cddr xs) (list* (cadr xs) key kvs) (cons key seen))) - (let loop ([xs xs] [body '()] [seen seen]) - (cond [(null? xs) - (cons tag (append (reverse kvs) (reverse body)))] - [(or (not (pair? (car xs))) (not (memq (caar xs) syms+keys))) - (loop (cdr xs) (cons (car xs) body) seen)] - [else - (let ([key (if (keyword? (caar xs)) - (caar xs) - (string->keyword (symbol->string (caar xs))))]) - (when (memq key seen) (amb-error (caar xs))) - (when (and (pair? (cdar xs)) (keyword? (cadar xs))) - (error tag "sub-element for `~s' key as its own keys" - (caar xs))) - (set! kvs (list* (cdar xs) key kvs)) - (loop (cdr xs) body (cons key seen)))])))))) - - ;; -------------------------------------------------------------------------- - ;; Formatting values and functions - - (define* (document . body) - (subs->keys (cons 'document body) '(#:title #:author #:date))) - - (define-format-element b 'bold) - (define-format-element bf 'bold) - (define-format-element bold 'bold) - (define-format-element i 'italic) - (define-format-element it 'italic) - (define-format-element italic 'italic) - (define-format-element u 'underline) - (define-format-element ul 'underline) - (define-format-element underline 'underline) - (define-format-element tt 'tt) - - (define-format-element title 'title) - (define-format-element author 'author) - ;; (define-format-element date 'date) - - ) +(build-docs-files files) diff --git a/collects/scribble/text-render.ss b/collects/scribble/text-render.ss index 5d306a8419..fce2f4aa9c 100644 --- a/collects/scribble/text-render.ss +++ b/collects/scribble/text-render.ss @@ -18,7 +18,7 @@ render-flow-element) (define/override (render-part d ht) - (let ([number (collected-info-number (part-collected-info d))]) + (let ([number (collected-info-number (part-collected-info d ht))]) (when (or (ormap values number) (part-title-content d)) (newline))