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

24
collects/scribble/basic.ss
View File

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

68
collects/scribble/xref.ss
View File

@ -85,37 +85,37 @@
(values tag (eq? (car tag) 'form))
(values #f #f))))])
(cond
[(identifier? id/binding)
(search id/binding)]
[(and (list? id/binding)
(= 6 (length id/binding)))
(search id/binding)]
[(and (list? id/binding)
(= 2 (length id/binding)))
(let loop ([src (car id/binding)])
(cond
[(path? src)
(if (complete-path? src)
[(identifier? id/binding)
(search id/binding)]
[(and (list? id/binding)
(= 6 (length id/binding)))
(search id/binding)]
[(and (list? id/binding)
(= 2 (length id/binding)))
(let loop ([src (car id/binding)])
(cond
[(path? src)
(if (complete-path? src)
(search (list src (cadr id/binding)))
(loop (path->complete-path src)))]
[(path-string? src)
(loop (path->complete-path src))]
[(resolved-module-path? src)
(let ([n (resolved-module-path-name src)])
(if (pair? n)
[(path-string? src)
(loop (path->complete-path src))]
[(resolved-module-path? src)
(let ([n (resolved-module-path-name src)])
(if (pair? n)
(loop n)
(search n)))]
[(module-path-index? src)
(loop (module-path-index-resolve src))]
[(module-path? src)
(loop (module-path-index-join src #f))]
[else
(raise-type-error 'xref-binding-definition->tag
"list starting with module path, resolved module path, module path index, path, or string"
src)]))]
[else (raise-type-error 'xref-binding-definition->tag
"identifier, 2-element list, or 6-element list"
id/binding)]))]))
[(module-path-index? src)
(loop (module-path-index-resolve src))]
[(module-path? src)
(loop (module-path-index-join src #f))]
[else
(raise-type-error 'xref-binding-definition->tag
"list starting with module path, resolved module path, module path index, path, or string"
src)]))]
[else (raise-type-error 'xref-binding-definition->tag
"identifier, 2-element list, or 6-element list"
id/binding)]))]))
(define (xref-binding->definition-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)))
`(index-entry ,tag)
#f)])
(cond
[v (make-entry (car v)
(cadr v)
(cadr tag)
(caddr v))]
[(and (pair? tag) (eq? 'form (car tag)))
;; Try again with 'def:
(xref-tag->index-entry xrefs (cons 'def (cdr tag)))]
[else #f])))
(cond [v (make-entry (car v) (cadr v) (cadr tag) (caddr v))]
[(and (pair? tag) (eq? 'form (car tag)))
;; Try again with 'def:
(xref-tag->index-entry xrefs (cons 'def (cdr tag)))]
[else #f])))