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

make HTML rednering work when a `part' has not tags

Browse Source 
original commit: 2d87d48ebdb831fafc398a603c2582bb87ce8592
This commit is contained in:
Matthew Flatt 2012-03-25 19:22:37 -06:00
parent 219c78cc7b
commit 70332eb7ce
3 changed files with 26 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/scribble/html-render.rkt
View File

@ -191,6 +191,12 @@
(define search-box (make-search-box "../")) (define search-box (make-search-box "../"))
(define top-search-box (make-search-box "")) (define top-search-box (make-search-box ""))
(define (part-tags/nonempty p)
(define l (part-tags p))
(if (null? l)
(list `(part "???"))
l))
;; ---------------------------------------- ;; ----------------------------------------
;; main mixin ;; main mixin
@ -267,8 +273,8 @@
fns)) fns))
(define/public (part-whole-page? p ri) (define/public (part-whole-page? p ri)
(let ([dest (resolve-get p ri (car (part-tags p)))]) (let ([dest (resolve-get p ri (car (part-tags/nonempty p)))])
(dest-page? dest))) (and dest (dest-page? dest))))
(define/public (current-part-whole-page? d) (define/public (current-part-whole-page? d)
(eq? d (current-top-part))) (eq? d (current-top-part)))
@ -375,6 +381,7 @@
null) null)
(define/private (dest->url dest) (define/private (dest->url dest)
(if dest
(format "~a~a~a" (format "~a~a~a"
(let ([p (relative->path (dest-path dest))]) (let ([p (relative->path (dest-path dest))])
(if (equal? p (current-output-file)) (if (equal? p (current-output-file))
@ -383,7 +390,8 @@
(if (dest-page? dest) "" "#") (if (dest-page? dest) "" "#")
(if (dest-page? dest) (if (dest-page? dest)
"" ""
(anchor-name (dest-anchor dest))))) (anchor-name (dest-anchor dest))))
"???"))
(define/public (render-toc-view d ri) (define/public (render-toc-view d ri)
(define has-sub-parts? (define has-sub-parts?
@ -401,7 +409,7 @@
(define top (car toc-chain)) (define top (car toc-chain))
(define (toc-item->title+num t show-mine?) (define (toc-item->title+num t show-mine?)
(values (values
`((a ([href ,(dest->url (resolve-get t ri (car (part-tags t))))] `((a ([href ,(dest->url (resolve-get t ri (car (part-tags/nonempty t))))]
[class ,(if (or (eq? t d) (and show-mine? (memq t toc-chain))) [class ,(if (or (eq? t d) (and show-mine? (memq t toc-chain)))
"tocviewselflink" "tocviewselflink"
"tocviewlink")] "tocviewlink")]
@ -586,7 +594,7 @@
(anchor-name (anchor-name
(add-tag-prefixes (add-tag-prefixes
(tag-key (if (part? p) (tag-key (if (part? p)
(car (part-tags p)) (car (part-tags/nonempty p))
(target-element-tag p)) (target-element-tag p))
ri) ri)
prefixes)))] prefixes)))]
@ -755,7 +763,7 @@
(define-values (url title) (define-values (url title)
(cond [(part? x) (cond [(part? x)
(values (values
(dest->url (resolve-get x ri (car (part-tags x)))) (dest->url (resolve-get x ri (car (part-tags/nonempty x))))
(string-append (string-append
"\"" "\""
(content->string (content->string
@ -805,7 +813,7 @@
;; sep-element ;; sep-element
;; (if (or (not index) (eq? d index)) ;; (if (or (not index) (eq? d index))
;; (make-element "nonavigation" index-content) ;; (make-element "nonavigation" index-content)
;; (make-link-element #f index-content (car (part-tags index)))) ;; (make-link-element #f index-content (car (part-tags/nonempty index))))
))) )))
(define navright (define navright
(if (not (or parent up-path next)) (if (not (or parent up-path next))
@ -1429,7 +1437,7 @@
"[^-a-zA-Z0-9_=]" "[^-a-zA-Z0-9_=]"
(string-append (string-append
(append-part-prefixes d ci ri) (append-part-prefixes d ci ri)
(let ([s (cadr (car (part-tags d)))]) (let ([s (cadr (car (part-tags/nonempty d)))])
(cond [(string? s) s] (cond [(string? s) s]
[(part-title-content d) [(part-title-content d)
(content->string (part-title-content d))] (content->string (part-title-content d))]

3
collects/scribblings/scribble/core.scrbl
View File

@ -308,7 +308,8 @@ The @racket[tag-prefix] field determines the optional @techlink{tag
prefix} for the part. prefix} for the part.
The @racket[tags] indicates a list of @techlink{tags} that each link The @racket[tags] indicates a list of @techlink{tags} that each link
to the section. to the section. Normally, @racket[tags] should be a non-empty list, so
that hyperlinks can target the section.
The @racket[title-content] field holds the part's title, if any. The @racket[title-content] field holds the part's title, if any.

0
src/mac/cw/MrStarter.r
View File