suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

minor code improvements

Browse Source 
svn: r8417

original commit: 7126fdce72db0dc7a11b8db91cc37e678fd1ca8c
This commit is contained in:
Eli Barzilay 2008-01-25 16:32:33 +00:00
parent c63cd9a943
commit a65ca82cc5
1 changed files with 87 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

172
collects/scribble/basic.ss
View File

@ -89,12 +89,9 @@
(define (itemize . items) (define (itemize . items)
(let ([items (filter (lambda (v) (not (whitespace? v))) items)]) (let ([items (filter (lambda (v) (not (whitespace? v))) items)])
(for-each (lambda (v) (for ([v items])
(unless (an-item? v) (unless (an-item? v)
(error 'itemize (error 'itemize "expected an item, found something else: ~e" v)))
"expected an item, found something else: ~e"
v)))
items)
(make-itemization (map an-item-flow items)))) (make-itemization (map an-item-flow items))))
(define-struct an-item (flow)) (define-struct an-item (flow))
@ -203,95 +200,80 @@
null)) null))
(define (index-flow-elements) (define (index-flow-elements)
(list (make-delayed-flow-element (define (commas l)
(lambda (renderer sec ri) (if (or (null? l) (null? (cdr l)))
(let ([l null]) l
(hash-table-for-each (cdr (apply append (map (lambda (i) (list ", " i)) l)))))
(let ([parent (collected-info-parent (define (cadr-string-lists<? a b)
(part-collected-info sec ri))]) (let loop ([a (cadr a)] [b (cadr b)])
(if parent (cond [(null? a) #t]
(collected-info-info [(null? b) #f]
(part-collected-info [(string-ci=? (car a) (car b)) (loop (cdr a) (cdr b))]
parent [else (string-ci<? (car a) (car b))])))
ri)) (define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(collect-info-ext-ht (resolve-info-ci ri)))) (define contents
(lambda (k v) (make-delayed-flow-element
(when (and (pair? k) (lambda (renderer sec ri)
(eq? 'index-entry (car k))) (define l null)
(set! l (cons (cons (cadr k) v) l))))) (define alpha-starts (make-hash-table))
(let ([l (sort (hash-table-for-each
l (let ([parent (collected-info-parent (part-collected-info sec ri))])
(lambda (a b) (if parent
(let loop ([a (cadr a)][b (cadr b)]) (collected-info-info (part-collected-info parent ri))
(cond (collect-info-ext-ht (resolve-info-ci ri))))
[(null? a) #t] (lambda (k v)
[(null? b) #f] (when (and (pair? k) (eq? 'index-entry (car k)))
[(string-ci=? (car a) (car b)) (set! l (cons (cons (cadr k) v) l)))))
(loop (cdr a) (cdr b))] (set! l (sort l cadr-string-lists<?))
[else (make-table
(string-ci<? (car a) (car b))]))))] 'index
[commas (lambda (l) (list*
(if (or (null? l) (list
(null? (cdr l))) (make-flow
l (list
(cdr (apply append (map (lambda (i) (make-paragraph
(list ", " i)) (let loop ([i l] [alpha alpha])
l)))))] (define (add-letter letter l)
[alpha-starts (make-hash-table)]) (list* (make-element "nonavigation" (list (string letter)))
(make-table " " l))
'index (cond [(null? alpha) null]
(list* [(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]
(list [else
(make-flow (let* ([strs (cadr (car i))]
(list [letter (if (or (null? strs)
(make-paragraph (string=? "" (car strs)))
(let ([add-letter #f
(lambda (letter l) (string-ref (car strs) 0))])
(list* (make-element "nonavigation" (cond
(list (string letter))) [(not letter) (loop (cdr i) alpha)]
" " [(char-ci>? letter (car alpha))
l))]) (add-letter (car alpha) (loop i (cdr alpha)))]
(let loop ([i l] [(char-ci=? letter (car alpha))
[alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]) (hash-table-put! alpha-starts (car i) letter)
(cond (list*
[(null? alpha) null] (make-element
[(null? i) (add-letter (car alpha) (make-target-url
(loop i (cdr alpha)))] (format "#alpha:~a" (char-upcase letter))
[else (let* ([strs (cadr (car i))] #f)
[letter (if (or (null? strs) (list (string (car alpha))))
(string=? "" (car strs))) " "
#f (loop (cdr i) (cdr alpha)))]
(string-ref (car strs) 0))]) [else (loop (cdr i) alpha)]))]))))))
(cond (list (make-flow (list (make-paragraph (list 'nbsp)))))
[(not letter) (loop (cdr i) alpha)] (map (lambda (i)
[(char-ci>? letter (car alpha)) (let* ([e (make-link-element
(add-letter (car alpha) "indexlink"
(loop i (cdr alpha)))] (commas (caddr i))
[(char-ci=? letter (car alpha)) (car i))]
(hash-table-put! alpha-starts (car i) letter) [letter (hash-table-get alpha-starts i #f)]
(list* (make-element (make-target-url [e (if letter
(format "#alpha:~a" letter) (make-element
#f) (make-url-anchor (format "alpha:~a" letter))
(list (string (car alpha)))) (list e))
" " e)])
(loop (cdr i) (cdr alpha)))] (list (make-flow (list (make-paragraph (list e)))))))
[else (loop (cdr i) alpha)]))]))))))) l))))))
(list (make-flow (list (make-paragraph (list 'nbsp))))) (list contents))
(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)))))))))
;; ---------------------------------------- ;; ----------------------------------------