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

minor things

Browse Source 
svn: r8419

original commit: df0368e5ccc99f75b993eacc2a627c33dfa70d9f
This commit is contained in:
Eli Barzilay 2008-01-25 20:02:12 +00:00
parent 2dfa41a8f2
commit d2002d0a0d
3 changed files with 45 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/scribble/base-render.ss
View File

@ -115,7 +115,7 @@
(loop (cdr parts) (loop (cdr parts)
(if (unnumbered-part? s) pos (add1 pos)))))) (if (unnumbered-part? s) pos (add1 pos))))))
(hash-table-put! (collect-info-parts ci) (hash-table-put! (collect-info-parts ci)
d d
(make-collected-info (make-collected-info
number number
parent parent
@ -134,10 +134,7 @@
(case (car k) (case (car k)
[(part tech) [(part tech)
(if (string? (cadr k)) (if (string? (cadr k))
(list (car k) (list (car k) (string-append prefix ":" (cadr k)))
(string-append prefix
":"
(cadr k)))
k)] k)]
[(index-entry) [(index-entry)
(let ([v (convert-key prefix (cadr k))]) (let ([v (convert-key prefix (cadr k))])

24
collects/scribble/basic.ss
View File

@ -190,14 +190,13 @@
content))) content)))
(define (index-section #:title [title "Index"] #:tag [tag #f]) (define (index-section #:title [title "Index"] #:tag [tag #f])
(make-unnumbered-part (make-unnumbered-part #f
#f `((part ,(or tag "doc-index")))
`((part ,(or tag "doc-index"))) (list title)
(list title) 'index
'index null
null (make-flow (index-flow-elements))
(make-flow (index-flow-elements)) null))
null))
(define (index-flow-elements) (define (index-flow-elements)
(define (commas l) (define (commas l)
@ -210,7 +209,7 @@
[(null? a) #t] [(null? a) #t]
[(string-ci=? (car a) (car b)) [(string-ci=? (car a) (car b))
(or (loop (cdr a) (cdr b)) (or (loop (cdr a) (cdr b))
;; Try string<? ;; Try string<? so "Foo" still precedes "foo"
(string<? (car a) (car b)))] (string<? (car a) (car b)))]
[else (string-ci<? (car a) (car b))]))) [else (string-ci<? (car a) (car b))])))
(define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) (define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
@ -264,10 +263,9 @@
[else (loop (cdr i) alpha)]))])))))) [else (loop (cdr i) alpha)]))]))))))
(list (make-flow (list (make-paragraph (list 'nbsp))))) (list (make-flow (list (make-paragraph (list 'nbsp)))))
(map (lambda (i) (map (lambda (i)
(let* ([e (make-link-element (let* ([e (make-link-element "indexlink"
"indexlink" (commas (caddr i))
(commas (caddr i)) (car i))]
(car i))]
[letter (hash-table-get alpha-starts i #f)] [letter (hash-table-get alpha-starts i #f)]
[e (if letter [e (if letter
(make-element (make-element

68
collects/scribble/xref.ss
View File

@ -85,37 +85,37 @@
(values tag (eq? (car tag) 'form)) (values tag (eq? (car tag) 'form))
(values #f #f))))]) (values #f #f))))])
(cond (cond
[(identifier? id/binding) [(identifier? id/binding)
(search id/binding)] (search id/binding)]
[(and (list? id/binding) [(and (list? id/binding)
(= 6 (length id/binding))) (= 6 (length id/binding)))
(search id/binding)] (search id/binding)]
[(and (list? id/binding) [(and (list? id/binding)
(= 2 (length id/binding))) (= 2 (length id/binding)))
(let loop ([src (car id/binding)]) (let loop ([src (car id/binding)])
(cond (cond
[(path? src) [(path? src)
(if (complete-path? src) (if (complete-path? src)
(search (list src (cadr id/binding))) (search (list src (cadr id/binding)))
(loop (path->complete-path src)))] (loop (path->complete-path src)))]
[(path-string? src) [(path-string? src)
(loop (path->complete-path src))] (loop (path->complete-path src))]
[(resolved-module-path? src) [(resolved-module-path? src)
(let ([n (resolved-module-path-name src)]) (let ([n (resolved-module-path-name src)])
(if (pair? n) (if (pair? n)
(loop n) (loop n)
(search n)))] (search n)))]
[(module-path-index? src) [(module-path-index? src)
(loop (module-path-index-resolve src))] (loop (module-path-index-resolve src))]
[(module-path? src) [(module-path? src)
(loop (module-path-index-join src #f))] (loop (module-path-index-join src #f))]
[else [else
(raise-type-error 'xref-binding-definition->tag (raise-type-error 'xref-binding-definition->tag
"list starting with module path, resolved module path, module path index, path, or string" "list starting with module path, resolved module path, module path index, path, or string"
src)]))] src)]))]
[else (raise-type-error 'xref-binding-definition->tag [else (raise-type-error 'xref-binding-definition->tag
"identifier, 2-element list, or 6-element list" "identifier, 2-element list, or 6-element list"
id/binding)]))])) id/binding)]))]))
(define (xref-binding->definition-tag xrefs id/binding mode) (define (xref-binding->definition-tag xrefs id/binding mode)
(let-values ([(tag form?) (xref-binding-tag xrefs id/binding mode)]) (let-values ([(tag form?) (xref-binding-tag xrefs id/binding mode)])
@ -130,13 +130,9 @@
(let ([v (hash-table-get (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs))) (let ([v (hash-table-get (collect-info-ext-ht (resolve-info-ci (xrefs-ri xrefs)))
`(index-entry ,tag) `(index-entry ,tag)
#f)]) #f)])
(cond (cond [v (make-entry (car v) (cadr v) (cadr tag) (caddr v))]
[v (make-entry (car v) [(and (pair? tag) (eq? 'form (car tag)))
(cadr v) ;; Try again with 'def:
(cadr tag) (xref-tag->index-entry xrefs (cons 'def (cdr tag)))]
(caddr v))] [else #f])))
[(and (pair? tag) (eq? 'form (car tag)))
;; Try again with 'def:
(xref-tag->index-entry xrefs (cons 'def (cdr tag)))]
[else #f])))