mostly cosmetics, very minor bug in index cleanup

svn: r10004

original commit: 46528afa5bacfdbe1ac01c8659ba49d14e927dd3
This commit is contained in:
Eli Barzilay 2008-05-28 18:24:58 +00:00
parent ac120cf546
commit 2e2b73be67
6 changed files with 45 additions and 62 deletions

View File

@ -165,9 +165,7 @@
[(part tech cite)
(let ([rhs (cadr k)])
(if (or (string? rhs) (pair? rhs))
(list (car k) (cons prefix (if (pair? rhs)
rhs
(list rhs))))
(list (car k) (cons prefix (if (pair? rhs) rhs (list rhs))))
k))]
[(index-entry)
(let ([v (convert-key prefix (cadr k))])
@ -191,8 +189,7 @@
(collect-block p ci)))
(define/public (collect-block p ci)
(cond
[(table? p) (collect-table p ci)]
(cond [(table? p) (collect-table p ci)]
[(itemization? p) (collect-itemization p ci)]
[(blockquote? p) (collect-blockquote p ci)]
[(delayed-block? p) (void)]
@ -212,24 +209,19 @@
(define/public (collect-element i ci)
(if (part-relative-element? i)
(let ([content
(or (hash-ref (collect-info-relatives ci) i #f)
(let ([content (or (hash-ref (collect-info-relatives ci) i #f)
(let ([v ((part-relative-element-collect i) ci)])
(hash-set! (collect-info-relatives ci) i v)
v))])
(collect-content content ci))
(begin
(when (target-element? i) (collect-target-element i ci))
(begin (when (target-element? i) (collect-target-element i ci))
(when (index-element? i) (collect-index-element i ci))
(when (collect-element? i) ((collect-element-collect i) ci))
(when (element? i)
(for ([e (element-content i)])
(collect-element e ci))))))
(for ([e (element-content i)]) (collect-element e ci))))))
(define/public (collect-target-element i ci)
(collect-put! ci
(generate-tag (target-element-tag i) ci)
(list i)))
(collect-put! ci (generate-tag (target-element-tag i) ci) (list i)))
(define/public (collect-index-element i ci)
(collect-put! ci
@ -242,10 +234,7 @@
;; global-info resolution
(define/public (resolve ds fns ci)
(let ([ri (make-resolve-info ci
(make-hasheq)
(make-hash)
(make-hash))])
(let ([ri (make-resolve-info ci (make-hasheq) (make-hash) (make-hash))])
(start-resolve ds fns ri)
ri))

View File

@ -4,8 +4,8 @@
(require "decode.ss"
"struct.ss"
"config.ss"
mzlib/list
mzlib/class
scheme/list
scheme/class
setup/main-collects
syntax/modresolve
(for-syntax scheme/base))
@ -25,7 +25,7 @@
(define (convert-tag tag content)
(if (list? tag)
(apply append (map (lambda (t) (convert-tag t content)) tag))
(append-map (lambda (t) (convert-tag t content)) tag)
`((part ,(or tag (gen-tag content))))))
(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
@ -176,19 +176,19 @@
(define (index* word-seq content-seq . s)
(let ([key (make-generated-tag)])
(record-index (map clean-up-index-string word-seq) content-seq key (decode-content s))))
(record-index (map clean-up-index-string word-seq)
content-seq key (decode-content s))))
(define (index word-seq . s)
(let ([word-seq (if (string? word-seq) (list word-seq) word-seq)])
(apply index* (map clean-up-index-string word-seq) word-seq s)))
(apply index* word-seq word-seq s)))
(define (as-index . s)
(let ([key (make-generated-tag)]
[content (decode-content s)])
(record-index (list (clean-up-index-string (content->string content)))
(if (= 1 (length content))
content
(list (make-element #f content)))
(record-index
(list (clean-up-index-string (content->string content)))
(if (= 1 (length content)) content (list (make-element #f content)))
key
content)))
@ -205,7 +205,7 @@
(define (commas l)
(if (or (null? l) (null? (cdr l)))
l
(cdr (apply append (map (lambda (i) (list ", " i)) l)))))
(cdr (append-map (lambda (i) (list ", " i)) l))))
(define (cadr-string-lists<? a b)
(let loop ([a (cadr a)] [b (cadr b)])
(cond [(null? b) #f]

View File

@ -33,16 +33,13 @@
[part-tag-decl ([tag tag?])])
(define (clean-up-index-string s)
;; Remove leading spaces or trailing, which might appear there due
;; to images or something else that gets dropped in string form.
;; Then collapse whitespace.
(regexp-replace* #px"\\s+"
(regexp-replace #rx"^ +"
(regexp-replace #rx" +$"
s
"")
"")
" "))
;; Collapse whitespace, and remove leading or trailing spaces, which
;; might appear there due to images or something else that gets
;; dropped in string form.
(let* ([s (regexp-replace* #px"\\s+" s " ")]
[s (regexp-replace* #rx"^ " s "")]
[s (regexp-replace* #rx" $" s "")])
s))
(define (decode-string s)
(let loop ([l '((#rx"---" mdash)
@ -102,8 +99,7 @@
(cons (make-index-element
#f null (car tags)
(list (clean-up-index-string
(regexp-replace
#px"^\\s+(?:(?:A|An|The)\\s)?"
(regexp-replace #px"^\\s+(?:(?:A|An|The)\\s)?"
(content->string title) "")))
(list (make-element #f title))
(make-part-index-desc))

View File

@ -872,7 +872,7 @@
(define/override (render-table t part ri need-inline?)
(define t-style (table-style t))
(define t-style-get (if (and (pair? t-style) (list? t-style))
(lambda (k) (assoc k (or t-style null)))
(lambda (k) (assoc k t-style))
(lambda (k) #f)))
(define index? (eq? 'index t-style))
(define (make-row flows style)

View File

@ -16,6 +16,3 @@
[(class-index-desc exported-index-desc) ()]
[(interface-index-desc exported-index-desc) ()]
[(mixin-index-desc exported-index-desc) ()])

View File

@ -303,7 +303,8 @@
(define (indexed-file . str)
(let* ([f (apply filepath str)]
[s (element->string f)])
(index* (list (clean-up-index-string (substring s 1 (sub1 (string-length s)))))
(index* (list (clean-up-index-string
(substring s 1 (sub1 (string-length s)))))
(list f)
f)))
(define (exec . str)