From 6389cc89311f8c1dabc0a861fbebd9472a49d4a6 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 12 Jan 2008 18:32:30 +0000 Subject: [PATCH] add master index svn: r8310 original commit: 13025bff7a53c82b0367ece5932fc92b3150f50c --- collects/scribble/basic.ss | 141 ++++++++++++++------- collects/scribble/html-render.ss | 63 +++++---- collects/scribble/latex-render.ss | 17 ++- collects/scribble/manual.ss | 7 +- collects/scribble/scribble.css | 1 - collects/scribble/struct.ss | 4 +- collects/scribblings/scribble/struct.scrbl | 6 +- 7 files changed, 155 insertions(+), 84 deletions(-) diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss index ef6fcbbb..6e1f69dd 100644 --- a/collects/scribble/basic.ss +++ b/collects/scribble/basic.ss @@ -157,7 +157,7 @@ ;; ---------------------------------------- - (provide section-index index index* as-index index-section) + (provide section-index index index* as-index index-section index-flow-elements) (define (section-index . elems) (make-part-index-decl (map element->string elems) elems)) @@ -192,58 +192,107 @@ key content))) - (define (index-section #:tag [tag #f]) + (define (index-section #:title [title "Index"] #:tag [tag #f]) (make-unnumbered-part #f `((part ,(or tag "doc-index"))) - '("Index") + (list title) 'index null - (make-flow (list (make-delayed-flow-element - (lambda (renderer sec ri) - (let ([l null]) - (hash-table-for-each - (collected-info-info - (part-collected-info - (collected-info-parent - (part-collected-info sec ri)) - ri)) - (lambda (k v) - (when (and (pair? k) - (eq? 'index-entry (car k))) - (set! l (cons (cons (cadr k) v) l))))) - (let ([l (sort - l - (lambda (a b) - (let loop ([a (cadr a)][b (cadr b)]) - (cond - [(null? a) #t] - [(null? b) #f] - [(string-ci=? (car a) (car b)) - (loop (cdr a) (cdr b))] - [else - (string-cilist "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]) + (cond + [(null? alpha) null] + [(null? i) (add-letter (car alpha) + (loop i (cdr alpha)))] + [else (let* ([strs (cadr (car i))] + [letter (if (or (null? strs) + (string=? "" (car strs))) + #f + (string-ref (car strs) 0))]) + (cond + [(not letter) (loop (cdr i) alpha)] + [(char-ci>? letter (car alpha)) + (add-letter (car alpha) + (loop i (cdr alpha)))] + [(char-ci=? letter (car alpha)) + (hash-table-put! alpha-starts (car i) letter) + (list* (make-element (make-target-url + (format "#alpha:~a" letter) + #f) + (list (string (car alpha)))) + " " + (loop (cdr i) (cdr alpha)))] + [else (loop (cdr i) alpha)]))]))))))) + (list (make-flow (list (make-paragraph (list 'nbsp))))) + (map (lambda (i) + (list (make-flow + (list + (make-paragraph + (list + (let ([e (make-link-element + "indexlink" + (commas (caddr i)) + (car i))]) + (let ([letter (hash-table-get alpha-starts i #f)]) + (if letter + (make-element (make-url-anchor (format "alpha:~a" letter)) + (list e)) + e))))))))) + l))))))))) + ;; ---------------------------------------- (provide table-of-contents diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index 0455d9b4..3f26a912 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -182,7 +182,7 @@ (part-parts (caar l))) (cdr l))))] [else (cons (car l) (loop (cdr l)))])))]) - (if (null? toc-content) + (if (and #f (null? toc-content)) null `((div ((class "tocview")) (div ((class "tocviewtitle")) @@ -253,6 +253,8 @@ (cond [(toc-target-element? a) (cons a (loop (cdr c)))] + [(toc-element? a) + (cons a (loop (cdr c)))] [(element? a) (append (loop (element-content a)) (loop (cdr c)))] @@ -284,25 +286,27 @@ ((class "tocsublist") (cellspacing "0")) ,@(map (lambda (p) - (parameterize ([current-no-links #t] - [extra-breaking? #t]) - `(tr - (td - ,@(if (part? p) - `((span ((class "tocsublinknumber")) - ,@(format-number (collected-info-number - (part-collected-info p ri)) - '((tt nbsp))))) - '("")) - (a ((href ,(if (part? p) - (format "#~a" (anchor-name (tag-key (car (part-tags p)) ri))) - (format "#~a" (anchor-name (tag-key (target-element-tag p) ri))))) - (class ,(if (part? p) - "tocsubseclink" - "tocsublink"))) - ,@(if (part? p) - (render-content (or (part-title-content p) '("???")) d ri) - (render-content (element-content p) d ri))))))) + `(tr + (td + ,@(if (part? p) + `((span ((class "tocsublinknumber")) + ,@(format-number (collected-info-number + (part-collected-info p ri)) + '((tt nbsp))))) + '("")) + ,@(if (toc-element? p) + (render-content (toc-element-toc-content p) d ri) + (parameterize ([current-no-links #t] + [extra-breaking? #t]) + `((a ((href ,(if (part? p) + (format "#~a" (anchor-name (tag-key (car (part-tags p)) ri))) + (format "#~a" (anchor-name (tag-key (target-element-tag p) ri))))) + (class ,(if (part? p) + "tocsubseclink" + "tocsublink"))) + ,@(if (part? p) + (render-content (or (part-title-content p) '("???")) d ri) + (render-content (element-content p) d ri))))))))) ps)))))))) (define/public (render-one-part d ri fn number) @@ -478,7 +482,14 @@ (if (current-no-links) (super render-element e part ri) (parameterize ([current-no-links #t]) - `((a ((href ,(target-url-addr style))) ,@(super render-element e part ri)))))] + `((a ((href ,(target-url-addr style)) + ,@(if (string? (target-url-style style)) + `((class ,(target-url-style style))) + null)) + ,@(super render-element e part ri)))))] + [(url-anchor? style) + `((a ((name ,(url-anchor-name style))) + ,@(super render-element e part ri)))] [(image-file? style) `((img ((src ,(install-file (image-file-path style))))))] [else (super render-element e part ri)]))) @@ -737,7 +748,7 @@ (list (make-element (if parent - (make-target-url "index.html") + (make-target-url "index.html" #f) "nonavigation") contents-content)) (if index @@ -761,7 +772,8 @@ (if parent (make-target-url (if prev (derive-filename prev) - "index.html")) + "index.html") + #f) "nonavigation") prev-content) sep-element @@ -770,13 +782,14 @@ (make-target-url (if (toc-part? parent) (derive-filename parent) - "index.html")) + "index.html") + #f) "nonavigation") up-content) sep-element (make-element (if next - (make-target-url (derive-filename next)) + (make-target-url (derive-filename next) #f) "nonavigation") next-content)) d diff --git a/collects/scribble/latex-render.ss b/collects/scribble/latex-render.ss index af25af42..435fed77 100644 --- a/collects/scribble/latex-render.ss +++ b/collects/scribble/latex-render.ss @@ -244,9 +244,12 @@ [opt (cond [(equal? tableform "longtable") "[l]"] [(equal? tableform "tabular") "[t]"] - [else ""])]) - (unless (or (null? (table-flowss t)) - (null? (car (table-flowss t)))) + [else ""])] + [flowss (if index? + (cddr (table-flowss t)) + (table-flowss t))]) + (unless (or (null? flowss) + (null? (car flowss))) (parameterize ([current-table-mode (if inline? (current-table-mode) (list tableform t))] @@ -273,14 +276,14 @@ [(center) "c"] [(right) "r"] [else "l"]))) - (car (table-flowss t)) + (car flowss) (cdr (or (and (list? (table-style t)) (assoc 'alignment (or (table-style t) null))) - (cons #f (map (lambda (x) #f) (car (table-flowss t)))))))))]) - (let loop ([flowss (table-flowss t)] + (cons #f (map (lambda (x) #f) (car flowss))))))))]) + (let loop ([flowss flowss] [row-styles (cdr (or (and (list? (table-style t)) (assoc 'row-styles (table-style t))) - (cons #f (map (lambda (x) #f) (table-flowss t)))))]) + (cons #f (map (lambda (x) #f) flowss))))]) (let ([flows (car flowss)] [row-style (car row-styles)]) (let loop ([flows flows]) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index c47fc9b7..0b2194c2 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -306,8 +306,11 @@ (define (procedure . str) (make-element "schemeresult" (append (list "#")))) - (define (link url . str) - (make-element (make-target-url url) (decode-content str))) + (define (link url #:underline? [underline? #t] . str) + (make-element (make-target-url url (if underline? + #f + "plainlink")) + (decode-content str))) (define (schemeerror . str) (make-element "schemeerror" (decode-content str))) diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css index 998a2403..d3f8e466 100644 --- a/collects/scribble/scribble.css +++ b/collects/scribble/scribble.css @@ -136,7 +136,6 @@ font-weight: bold; } .tocsub { - margin-top: 1em; text-align: left; background-color: #DCF5F5; } diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index f4be3e84..c18c6fb0 100644 --- a/collects/scribble/struct.ss +++ b/collects/scribble/struct.ss @@ -158,6 +158,7 @@ ;; content = list of elements [element ([style any/c] [content list?])] + [(toc-element element) ([toc-content list?])] [(target-element element) ([tag tag?])] [(toc-target-element target-element) ()] [(page-target-element target-element) ()] @@ -174,7 +175,8 @@ [parent (or/c false/c part?)] [info any/c])] - [target-url ([addr string?])] + [target-url ([addr string?][style any/c])] + [url-anchor ([name string?])] [image-file ([path path-string?])]) ;; ---------------------------------------- diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl index 50c6168d..0fad019d 100644 --- a/collects/scribblings/scribble/struct.scrbl +++ b/collects/scribblings/scribble/struct.scrbl @@ -462,9 +462,11 @@ Computed for each part by the @techlink{collect pass}. } -@defstruct[target-url ([addr string?])]{ +@defstruct[target-url ([addr string?] + [style any/c])]{ -Used as a style for an @scheme[element].} +Used as a style for an @scheme[element]. The @scheme[style] at this +layer is a style for the hyperlink.} @defstruct[image-file ([path path-string?])]{