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

r5rs and srfi docs and bindings

Browse Source 
svn: r9336

original commit: 28a3f3f0e72da7a8810cd59f7238d7ccac647371
This commit is contained in:
Matthew Flatt 2008-04-16 20:52:39 +00:00
parent d0ba333047
commit f81149c127
5 changed files with 94 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -111,10 +111,16 @@
(unless (null? parts) (unless (null? parts)
(let ([s (car parts)]) (let ([s (car parts)])
(collect-part s d p-ci (collect-part s d p-ci
(cons (if (unnumbered-part? s) #f pos) (cons (if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
#f
pos)
number)) number))
(loop (cdr parts) (loop (cdr parts)
(if (unnumbered-part? s) pos (add1 pos)))))) (if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
pos
(add1 pos))))))
(let ([prefix (part-tag-prefix d)]) (let ([prefix (part-tag-prefix d)])
(for ([(k v) (collect-info-ht p-ci)]) (for ([(k v) (collect-info-ht p-ci)])
(when (cadr k) (when (cadr k)

53
collects/scribble/html-render.ss
View File

@ -9,6 +9,7 @@
setup/main-collects setup/main-collects
mzlib/list mzlib/list
net/url net/url
scheme/serialize
(prefix-in xml: xml/xml) (prefix-in xml: xml/xml)
(for-syntax scheme/base)) (for-syntax scheme/base))
(provide render-mixin (provide render-mixin
@ -49,23 +50,27 @@
;; (i.e., the ones that are not allowed as-in in URI ;; (i.e., the ones that are not allowed as-in in URI
;; codecs) by using "~" followed by a hex encoding. ;; codecs) by using "~" followed by a hex encoding.
(define (anchor-name v) (define (anchor-name v)
(let loop ([s (format "~a" v)]) (if (literal-anchor? v)
(cond (literal-anchor-string v)
[(regexp-match-positions #rx"[A-Z.]" s) (let loop ([s (format "~a" v)])
=> (lambda (m) (cond
(string-append [(regexp-match-positions #rx"[A-Z.]" s)
(loop (substring s 0 (caar m))) => (lambda (m)
"." (string-append
(substring s (caar m) (cdar m)) (loop (substring s 0 (caar m)))
(loop (substring s (cdar m)))))] "."
[(regexp-match-positions #rx"[^-a-zA-Z0-9_!*'().]" s) (substring s (caar m) (cdar m))
=> (lambda (m) (loop (substring s (cdar m)))))]
(string-append [(regexp-match-positions #rx"[^-a-zA-Z0-9_!*'().]" s)
(substring s 0 (caar m)) => (lambda (m)
"~" (string-append
(format "~x" (char->integer (string-ref s (caar m)))) (substring s 0 (caar m))
(loop (substring s (cdar m)))))] "~"
[else s]))) (format "~x" (char->integer (string-ref s (caar m))))
(loop (substring s (cdar m)))))]
[else s]))))
(define-serializable-struct literal-anchor (string))
(define literal (define literal
(let ([loc (xml:make-location 0 0 0)]) (let ([loc (xml:make-location 0 0 0)])
@ -229,10 +234,18 @@
(let ([key (generate-tag (target-element-tag i) ci)]) (let ([key (generate-tag (target-element-tag i) ci)])
(collect-put! ci (collect-put! ci
key key
(vector (path->relative (current-output-file)) (vector (path->relative (let ([p (current-output-file)])
#f (if (redirect-target-element? i)
(let-values ([(base name dir?) (split-path p)])
(build-path
base
(redirect-target-element-alt-path i)))
p)))
#f
(page-target-element? i) (page-target-element? i)
key)))) (if (redirect-target-element? i)
(make-literal-anchor (redirect-target-element-alt-anchor i))
key)))))
(define (dest-path dest) (define (dest-path dest)
(if (vector? dest) ; temporary (if (vector? dest) ; temporary

3
collects/scribble/latex-render.ss
View File

@ -68,7 +68,8 @@
(if no-number? (if no-number?
"*" "*"
"")) ""))
(when (not (part-style? d 'hidden)) (when (not (or (part-style? d 'hidden)
no-number?))
(printf "[") (printf "[")
(parameterize ([disable-images #t]) (parameterize ([disable-images #t])
(render-content (part-title-content d) d ri)) (render-content (part-title-content d) d ri))

49
collects/scribble/manual.ss
View File

@ -437,6 +437,55 @@
(lambda () (car content)) (lambda () (car content))
(lambda () (car content)))))) (lambda () (car content))))))
(define (make-binding-redirect-elements mod-path redirects)
(let ([taglet (path->main-collects-relative
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join mod-path #f))))])
(make-element
#f
(map
(lambda (redirect)
(let ([id (car redirect)]
[form? (cadr redirect)]
[path (caddr redirect)]
[anchor (cadddr redirect)])
(let ([make-one
(lambda (kind)
(make-redirect-target-element
#f
null
(list kind (list taglet id))
path
anchor))])
(make-element
#f
(list (make-one (if form? 'form 'def))
(make-one 'dep)
(make-index-element #f
null
(list (if form? 'form 'def)
(list taglet id))
(list (symbol->string id))
(list
(make-element
"schemesymbol"
(list
(make-element
(if form?
"schemesyntaxlink"
"schemevaluelink")
(list (symbol->string id))))))
((if form?
make-form-index-desc
make-procedure-index-desc)
id
(list mod-path))))))))
redirects))))
(provide make-binding-redirect-elements)
(define current-signature (make-parameter #f)) (define current-signature (make-parameter #f))
(define-syntax-rule (sigelem sig elem) (define-syntax-rule (sigelem sig elem)

2
collects/scribble/struct.ss
View File

@ -159,6 +159,8 @@
[(target-element element) ([tag tag?])] [(target-element element) ([tag tag?])]
[(toc-target-element target-element) ()] [(toc-target-element target-element) ()]
[(page-target-element target-element) ()] [(page-target-element target-element) ()]
[(redirect-target-element target-element) ([alt-path path-string?]
[alt-anchor string?])]
[(link-element element) ([tag tag?])] [(link-element element) ([tag tag?])]
[(index-element element) ([tag tag?] [(index-element element) ([tag tag?]
[plain-seq (listof string?)] [plain-seq (listof string?)]