diff --git a/scribble-lib/scribble/contract-render.rkt b/scribble-lib/scribble/contract-render.rkt index 4e9782a81a..5205ca59ef 100644 --- a/scribble-lib/scribble/contract-render.rkt +++ b/scribble-lib/scribble/contract-render.rkt @@ -116,7 +116,7 @@ ;; we just take the first one here (define background-label-p (open-input-string (get-output-string background-label-port))) - (define background-label-line (read-line background-label-p)) + (define background-label-line (read-line background-label-p 'any)) (define text-p (the-text-p)) (define-values (before-line _1 _2) (port-next-location text-p)) @@ -130,7 +130,7 @@ ;; the spaces that appear at the ends of the lines (let ([p (open-input-string (get-output-string block-port))]) (let loop () - (define l (read-line p)) + (define l (read-line p 'any)) (unless (eof-object? l) (display (regexp-replace #rx" *$" l "") text-p) (newline text-p) @@ -139,15 +139,14 @@ (define-values (after-line _3 _4) (port-next-location text-p)) (define txt-loc (cons before-position (- after-line before-line))) (define ri (the-ri)) - (for ([(k v) (in-hash ents)]) - (let ([k (tag-key k ri)]) - (hash-set! index-table k (cons txt-loc (hash-ref index-table k '())))))) + (for ([k (in-hash-keys ents)]) + (let ([k (tag-key k ri)]) (hash-set! index-table k (cons txt-loc (hash-ref index-table k '())))))) (define (r-blockss+cont blockss mode index-table) (for* ([blocks (in-list blockss)] - [block (in-list blocks)]) - (unless (eq? block 'cont) - (r-block block mode index-table)))) + [block (in-list blocks)] + #:unless (eq? block 'cont)) + (r-block block mode index-table))) (define (r-blockss blockss mode index-table) (for ([blocks (in-list blockss)]) diff --git a/scribble-lib/scribble/example.rkt b/scribble-lib/scribble/example.rkt index 9f0ccf6dde..3041c00d45 100644 --- a/scribble-lib/scribble/example.rkt +++ b/scribble-lib/scribble/example.rkt @@ -15,8 +15,7 @@ make-log-based-eval scribble-exn->string - scribble-eval-handler - make-log-based-eval) + scribble-eval-handler) (define example-title (make-paragraph (list "Example:"))) diff --git a/scribble-lib/scribble/markdown-render.rkt b/scribble-lib/scribble/markdown-render.rkt index 18bb48ef1e..d7fc6db631 100644 --- a/scribble-lib/scribble/markdown-render.rkt +++ b/scribble-lib/scribble/markdown-render.rkt @@ -104,26 +104,24 @@ (displayln "```")] [else - (define strs (map (lambda (flows) - (map (lambda (d) - (cond - [(eq? d 'cont) d] - [else - (define o (open-output-string)) - (parameterize ([current-indent 0] - [current-output-port o]) - (render-block d part ht #f)) - (regexp-split - #rx"\n" - (regexp-replace #rx"\n$" (get-output-string o) ""))])) - flows)) - flowss)) - (define widths (map (lambda (col) - (for/fold ([d 0]) ([i (in-list col)]) - (if (eq? i 'cont) - 0 - (apply max d (map string-length i))))) - (apply map list strs))) + (define strs (for/list ([flows (in-list flowss)]) + (map + (lambda (d) + (cond + [(eq? d 'cont) d] + [else + (define o (open-output-string)) + (parameterize ([current-indent 0] + [current-output-port o]) + (render-block d part ht #f)) + (regexp-split #rx"\n" + (regexp-replace #rx"\n$" (get-output-string o) ""))])) + flows))) + (define widths (for/list ([col (in-list (apply map list strs))]) + (for/fold ([d 0]) ([i (in-list col)]) + (if (eq? i 'cont) + 0 + (apply max d (map string-length i)))))) (define (x-length col) (if (eq? col 'cont) 0 (length col))) (for/fold ([indent? #f]) ([row (in-list strs)]) @@ -152,12 +150,12 @@ (if (null? flows) null (append* (begin - (printf "* ") + (display "* ") (parameterize ([current-indent (make-indent 2)]) (render-flow (car flows) part ht #t))) (for/list ([d (in-list (cdr flows))]) (indented-newline) - (printf "* ") + (display "* ") (parameterize ([current-indent (make-indent 2)]) (render-flow d part ht #f)))))) diff --git a/scribble-lib/scribble/racket.rkt b/scribble-lib/scribble/racket.rkt index f2665c8130..7b0dbb1a3a 100644 --- a/scribble-lib/scribble/racket.rkt +++ b/scribble-lib/scribble/racket.rkt @@ -793,9 +793,8 @@ (out ". " (if (positive? quote-depth) value-color paren-color)) (set! src-col (+ src-col 3))) (hash-set! next-col-map src-col dest-col) - ((loop init-line! quote-depth first-expr? #f) l (if (and expr? (zero? quote-depth)) - srcless-step - #f))])) + ((loop init-line! quote-depth first-expr? #f) l (and (and expr? (zero? quote-depth)) + srcless-step))])) (out (case sh [(#\[) "]"] [(#\{) "}"] @@ -885,11 +884,9 @@ ;; constructed: [(and expr? (zero? quote-depth)) (define l (apply append - (map (lambda (p) - (let ([p (syntax-e p)]) - (list (forced-pair-car p) - (forced-pair-cdr p)))) - (reverse l2)))) + (for/list ([p (in-list (reverse l2))]) + (let ([p (syntax-e p)]) + (list (forced-pair-car p) (forced-pair-cdr p)))))) (datum->syntax #f (cons (datum->syntax #f @@ -942,10 +939,9 @@ (hash-set! next-col-map init-col dest-col) ((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0 expr? #f) c #f) (if (list? suffix) - (map (lambda (sfx) - (finish-line!) - (out sfx #f)) - suffix) + (for/list ([sfx (in-list suffix)]) + (finish-line!) + (out sfx #f)) (out suffix #f)) (unless (null? content) (finish-line!)) @@ -1156,10 +1152,12 @@ (do-syntax-ize v col line (box #hasheq()) #f (and expr? 0) #f)) (define (graph-count ht graph?) - (and graph? - (let ([n (hash-ref (unbox ht) '#%graph-count 0)]) - (set-box! ht (hash-set (unbox ht) '#%graph-count (add1 n))) - n))) + (cond + [graph? + (define n (hash-ref (unbox ht) '#%graph-count 0)) + (set-box! ht (hash-set (unbox ht) '#%graph-count (add1 n))) + n] + [else #f])) (define-struct forced-pair (car cdr)) @@ -1182,15 +1180,13 @@ [(and (struct? v) (prefab-struct-key v)) (andmap quotable? (vector->list (struct->vector v)))] - [(struct? v) (if (custom-write? v) - (case (or (and (custom-print-quotable? v) - (custom-print-quotable-accessor v)) - 'self) - [(self always) #t] - [(never) #f] - [(maybe) - (andmap quotable? (vector->list (struct->vector v)))]) - #f)] + [(struct? v) (and (custom-write? v) + (case (or (and (custom-print-quotable? v) + (custom-print-quotable-accessor v)) + 'self) + [(self always) #t] + [(never) #f] + [(maybe) (andmap quotable? (vector->list (struct->vector v)))]))] [(struct-proxy? v) #f] [(mpair? v) #f] [else #t])]))) @@ -1298,41 +1294,43 @@ [no-cons? 1] ; '(' [else 6]) ; `(list ' 1)) - (define r (let ([l (let loop ([col (+ col delta vec-sz graph-sz)] - [v (cond - [(vector? v) - (vector->short-list v values)] - [(struct? v) - (cons (let ([pf (prefab-struct-key v)]) - (if pf - (prefab-struct-key v) - (object-name v))) - (cdr (vector->list (struct->vector v qq-ellipses))))] - [else v])]) - (cond - [(null? v) null] - [else - (define i (do-syntax-ize (car v) col line ht #f qq #f)) - (cons i (loop (+ col 1 (syntax-span i)) (cdr v)))]))]) - (datum->syntax #f - (cond - [(vector? v) (short-list->vector v l)] - [(struct? v) - (define pf (prefab-struct-key v)) - (if pf - (apply make-prefab-struct (prefab-struct-key v) (cdr l)) - (make-struct-proxy (car l) (cdr l)))] - [else l]) - (vector #f line - (+ graph-sz col) - (+ 1 graph-sz col) - (+ 1 - vec-sz - delta - (if (zero? (length l)) - 0 - (sub1 (length l))) - (apply + (map syntax-span l))))))) + (define l + (let loop ([col (+ col delta vec-sz graph-sz)] + [v (cond + [(vector? v) (vector->short-list v values)] + [(struct? v) + (cons (let ([pf (prefab-struct-key v)]) + (if pf + (prefab-struct-key v) + (object-name v))) + (cdr (vector->list (struct->vector v qq-ellipses))))] + [else v])]) + (cond + [(null? v) null] + [else + (define i (do-syntax-ize (car v) col line ht #f qq #f)) + (cons i (loop (+ col 1 (syntax-span i)) (cdr v)))]))) + (define r + (datum->syntax #f + (cond + [(vector? v) (short-list->vector v l)] + [(struct? v) + (define pf (prefab-struct-key v)) + (if pf + (apply make-prefab-struct (prefab-struct-key v) (cdr l)) + (make-struct-proxy (car l) (cdr l)))] + [else l]) + (vector #f + line + (+ graph-sz col) + (+ 1 graph-sz col) + (+ 1 + vec-sz + delta + (if (zero? (length l)) + 0 + (sub1 (length l))) + (apply + (map syntax-span l)))))) (unless graph? (set-box! ht (hash-set (unbox ht) v #f))) (cond @@ -1441,11 +1439,8 @@ [(hash-eq? v) make-immutable-hasheq] [(hash-eqv? v) make-immutable-hasheqv] [else make-immutable-hash]) - (map (lambda (p) - (let ([p (syntax-e p)]) - (cons (syntax->datum (car p)) - (cdr p)))) - (syntax->list pairs))) + (for/list ([p (in-list (syntax->list pairs))]) + (let ([p (syntax-e p)]) (cons (syntax->datum (car p)) (cdr p))))) (vector (syntax-source pairs) (syntax-line pairs) (max 0 (- (syntax-column pairs) undelta)) diff --git a/scribble-lib/scribble/search.rkt b/scribble-lib/scribble/search.rkt index 44cc07961d..cd0078487a 100644 --- a/scribble-lib/scribble/search.rkt +++ b/scribble-lib/scribble/search.rkt @@ -174,19 +174,18 @@ (cond [a (loop queue - (append (map (lambda (m) - (if (pair? m) - (list (module-path-index-rejoin (car m) mod) - (list-ref m 2) - defn-phase - (list-ref m 1) - (list-ref m 3)) - (list (module-path-index-rejoin m mod) - id - defn-phase - import-phase - export-phase))) - (reverse (cadr a))) + (append (for/list ([m (in-list (reverse (cadr a)))]) + (if (pair? m) + (list (module-path-index-rejoin (car m) mod) + (list-ref m 2) + defn-phase + (list-ref m 1) + (list-ref m 3)) + (list (module-path-index-rejoin m mod) + id + defn-phase + import-phase + export-phase))) rqueue) need-result?)] ;; A dead end may not be our fault: the files could diff --git a/scribble-lib/scribble/sigplan.rkt b/scribble-lib/scribble/sigplan.rkt index d57ed2d5a6..420a2b9518 100644 --- a/scribble-lib/scribble/sigplan.rkt +++ b/scribble-lib/scribble/sigplan.rkt @@ -8,44 +8,19 @@ scribble/latex-properties (for-syntax racket/base)) -(provide/contract - [abstract - (->* () () #:rest (listof pre-content?) - block?)] - [subtitle - (->* () () #:rest (listof pre-content?) - content?)] - [authorinfo - (-> pre-content? pre-content? pre-content? - block?)] - [conferenceinfo - (-> pre-content? pre-content? - block?)] - [copyrightyear - (->* () () #:rest (listof pre-content?) - block?)] - [copyrightdata - (->* () () #:rest (listof pre-content?) - block?)] - [exclusive-license - (->* () () - block?)] - [doi - (->* () () #:rest (listof pre-content?) - block?)] - [to-appear - (->* () () #:rest pre-content? - block?)] - [category - (->* (pre-content? pre-content? pre-content?) - ((or/c #f pre-content?)) - content?)] - [terms - (->* () () #:rest (listof pre-content?) - content?)] - [keywords - (->* () () #:rest (listof pre-content?) - content?)]) +(provide (contract-out + [abstract (->* () () #:rest (listof pre-content?) block?)] + [subtitle (->* () () #:rest (listof pre-content?) content?)] + [authorinfo (-> pre-content? pre-content? pre-content? block?)] + [conferenceinfo (-> pre-content? pre-content? block?)] + [copyrightyear (->* () () #:rest (listof pre-content?) block?)] + [copyrightdata (->* () () #:rest (listof pre-content?) block?)] + [exclusive-license (->* () () block?)] + [doi (->* () () #:rest (listof pre-content?) block?)] + [to-appear (->* () () #:rest pre-content? block?)] + [category (->* (pre-content? pre-content? pre-content?) ((or/c #f pre-content?)) content?)] + [terms (->* () () #:rest (listof pre-content?) content?)] + [keywords (->* () () #:rest (listof pre-content?) content?)])) (provide preprint 10pt nocopyright onecolumn noqcourier notimes include-abstract) diff --git a/scribble-lib/scribble/tag.rkt b/scribble-lib/scribble/tag.rkt index fa9e861715..abd89dda5f 100644 --- a/scribble-lib/scribble/tag.rkt +++ b/scribble-lib/scribble/tag.rkt @@ -51,38 +51,41 @@ (cond [(or (string? v) (bytes? v) (list? v)) (define b (hash-ref interned v #f)) - (if b - (or (weak-box-value b) - ;; just in case the value is GCed before we extract it: - (intern-taglet v)) - (begin - (hash-set! interned v (make-weak-box v)) - v))] + (cond + [b + (or (weak-box-value b) + ;; just in case the value is GCed before we extract it: + (intern-taglet v))] + [else + (hash-set! interned v (make-weak-box v)) + v])] [else v]))) (define (do-module-path-index->taglet mod) ;; Derive the name from the module path: (define p (collapse-module-path-index mod (lambda () (build-path (current-directory) "dummy")))) - (if (path? p) - ;; If we got a path back anyway, then it's best to use the resolved - ;; name; if the current directory has changed since we - ;; the path-index was resolved, then p might not be right. Also, - ;; the resolved path might be a symbol instead of a path. - (let ([rp (resolved-module-path-name (module-path-index-resolve mod))]) - (if (path? rp) - (intern-taglet (path->collects-relative rp)) - rp)) - (let ([p (if (and (pair? p) (eq? (car p) 'planet)) - ;; Normalize planet verion number based on current - ;; linking: - (let-values ([(path pkg) (get-planet-module-path/pkg p #f #f)]) - (list* 'planet - (cadr p) - (list (car (caddr p)) (cadr (caddr p)) (pkg-maj pkg) (pkg-min pkg)) - (cdddr p))) - ;; Otherwise the path is fully normalized: - p)]) - (intern-taglet p)))) + (cond + [(path? p) + ;; If we got a path back anyway, then it's best to use the resolved + ;; name; if the current directory has changed since we + ;; the path-index was resolved, then p might not be right. Also, + ;; the resolved path might be a symbol instead of a path. + (define rp (resolved-module-path-name (module-path-index-resolve mod))) + (if (path? rp) + (intern-taglet (path->collects-relative rp)) + rp)] + [else + (let ([p (if (and (pair? p) (eq? (car p) 'planet)) + ;; Normalize planet verion number based on current + ;; linking: + (let-values ([(path pkg) (get-planet-module-path/pkg p #f #f)]) + (list* 'planet + (cadr p) + (list (car (caddr p)) (cadr (caddr p)) (pkg-maj pkg) (pkg-min pkg)) + (cdddr p))) + ;; Otherwise the path is fully normalized: + p)]) + (intern-taglet p))])) (define collapsed (make-weak-hasheq)) (define (module-path-index->taglet mod)