reformat etc

svn: r9957

original commit: ce97fa58c2ac3e8a9e6c295ef7b9cb607d2ff9eb
This commit is contained in:
Eli Barzilay 2008-05-26 11:33:15 +00:00
parent f2d6ee7e3c
commit a6f9520273

View File

@ -22,7 +22,7 @@
(define literal (define literal
(let ([loc (xml:make-location 0 0 0)]) (let ([loc (xml:make-location 0 0 0)])
(lambda strings (xml:make-cdata loc loc (apply string-append strings))))) (lambda strings (xml:make-cdata loc loc (string-append* strings)))))
(define (ref-style path) (define (ref-style path)
`(link ([rel "stylesheet"] [type "text/css"] [href ,path] [title "default"]))) `(link ([rel "stylesheet"] [type "text/css"] [href ,path] [title "default"])))
(define (inlined-style . body) (define (inlined-style . body)
@ -343,72 +343,72 @@
(if p (if p
(loop p (if (reveal-subparts? d) mine d)) (loop p (if (reveal-subparts? d) mine d))
(values d mine))))) (values d mine)))))
(define (do-part pp)
(let ([p (car pp)] [show-number? (cdr pp)])
`(tr (td ([align "right"])
,@(if show-number?
(format-number
(collected-info-number (part-collected-info p ri))
'((tt nbsp)))
'("-" nbsp)))
(td (a ([href
,(let ([dest (resolve-get p ri (car (part-tags p)))])
(format "~a~a~a"
(from-root (relative->path (dest-path dest))
(get-dest-directory))
(if (dest-page? dest) "" "#")
(if (dest-page? dest)
""
(anchor-name (dest-anchor dest)))))]
[class ,(if (eq? p mine)
"tocviewselflink" "tocviewlink")])
,@(render-content (or (part-title-content p) '("???"))
d ri))))))
(define toc-content (define toc-content
(parameterize ([extra-breaking? #t]) (parameterize ([extra-breaking? #t])
(map (lambda (pp) (map do-part
(let ([p (car pp)]
[show-number? (cdr pp)])
`(tr
(td ([align "right"])
,@(if show-number?
(format-number (collected-info-number (part-collected-info p ri))
'((tt nbsp)))
'("-" nbsp)))
(td
(a ([href ,(let ([dest (resolve-get p ri (car (part-tags p)))])
(format "~a~a~a"
(from-root (relative->path (dest-path dest))
(get-dest-directory))
(if (dest-page? dest) "" "#")
(if (dest-page? dest)
""
(anchor-name (dest-anchor dest)))))]
[class ,(if (eq? p mine)
"tocviewselflink"
"tocviewlink")])
,@(render-content (or (part-title-content p) '("???"))
d ri))))))
(let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))]) (let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))])
(cond [(null? l) null] (cond [(null? l) null]
[(reveal-subparts? (caar l)) [(reveal-subparts? (caar l))
(cons (car l) (loop (append (map (lambda (v) (cons v #f)) (cons (car l)
(part-parts (caar l))) (loop (append (map (lambda (v) (cons v #f))
(cdr l))))] (part-parts (caar l)))
(cdr l))))]
[else (cons (car l) (loop (cdr l)))]))))) [else (cons (car l) (loop (cdr l)))])))))
`((div ([class "tocset"]) `((div ([class "tocset"])
,@(if (part-style? d 'no-toc) ,@(if (part-style? d 'no-toc)
null null
(let* ([content (render-content (let* ([content (render-content
(or (part-title-content top) '("???")) (or (part-title-content top) '("???"))
d ri)] d ri)]
[content (if (null? toc-content) [content (if (null? toc-content)
content content
`((a ([href "index.html"] [class "tocviewlink"]) `((a ([href "index.html"] [class "tocviewlink"])
,@content)))]) ,@content)))])
`((div ([class "tocview"]) `((div ([class "tocview"])
(div ([class "tocviewtitle"]) ,@content) (div ([class "tocviewtitle"]) ,@content)
(div nbsp) (div nbsp)
,@(if (null? toc-content) ,@(if (null? toc-content)
'() '()
(toc-wrap (toc-wrap
`(table ([class "tocviewlist"] [cellspacing "0"]) `(table ([class "tocviewlist"] [cellspacing "0"])
,@toc-content))))))) ,@toc-content)))))))
,@(render-onthispage-contents d ri top (if (part-style? d 'no-toc) ,@(render-onthispage-contents
"tocview" d ri top (if (part-style? d 'no-toc) "tocview" "tocsub"))
"tocsub"))
,@(parameterize ([extra-breaking? #t]) ,@(parameterize ([extra-breaking? #t])
(append-map (lambda (t) (append-map
(let loop ([t t]) (lambda (t)
(if (table? t) (let loop ([t t])
(render-table t d ri #f) (if (table? t)
(loop (delayed-block-blocks t ri))))) (render-table t d ri #f)
(filter (lambda (e) (loop (delayed-block-blocks t ri)))))
(let loop ([e e]) (filter (lambda (e)
(or (and (auxiliary-table? e) (let loop ([e e])
(pair? (table-flowss e))) (or (and (auxiliary-table? e)
(and (delayed-block? e) (pair? (table-flowss e)))
(loop (delayed-block-blocks e ri)))))) (and (delayed-block? e)
(flow-paragraphs (part-flow d)))))))) (loop (delayed-block-blocks e ri))))))
(flow-paragraphs (part-flow d))))))))
(define/public (get-onthispage-label) (define/public (get-onthispage-label)
null) null)
@ -420,68 +420,52 @@
(if (ormap (lambda (p) (part-whole-page? p ri)) (if (ormap (lambda (p) (part-whole-page? p ri))
(part-parts d)) (part-parts d))
null null
(let* ([nearly-top? (lambda (d) (nearly-top? d ri top))] (let ([nearly-top? (lambda (d) (nearly-top? d ri top))])
[ps ((if (nearly-top? d) values cdr) (define (flow-targets flow)
(let flatten ([d d]) (append-map block-targets (flow-paragraphs flow)))
(append* (define (block-targets e)
;; don't include the section if it's in the TOC (cond [(table? e) (table-targets e)]
(if (nearly-top? d) null (list d)) [(paragraph? e) (para-targets e)]
;; get internal targets: [(itemization? e)
(letrec ([flow-targets (append-map flow-targets (itemization-flows e))]
(lambda (flow) [(blockquote? e)
(apply append (map block-targets (flow-paragraphs flow))))] (append-map block-targets (blockquote-paragraphs e))]
[block-targets [(delayed-block? e) null]))
(lambda (e) (define (para-targets para)
(cond (let loop ([c (paragraph-content para)])
[(table? e) (table-targets e)] (define a (and (pair? c) (car c)))
[(paragraph? e) (para-targets e)] (cond
[(itemization? e) [(null? c) null]
(apply append (map flow-targets (itemization-flows e)))] [(toc-target-element? a) (cons a (loop (cdr c)))]
[(blockquote? e) [(toc-element? a) (cons a (loop (cdr c)))]
(apply append (map block-targets (blockquote-paragraphs e)))] [(element? a)
[(delayed-block? e) (append (loop (element-content a)) (loop (cdr c)))]
null]))] [(delayed-element? a)
[para-targets (loop (append (delayed-element-content a ri) (cdr c)))]
(lambda (para) [(part-relative-element? a)
(let loop ([c (paragraph-content para)]) (loop (append (part-relative-element-content a ri) (cdr c)))]
(define a (and (pair? c) (car c))) [else (loop (cdr c))])))
(cond (define (table-targets table)
[(null? c) null] (append-map
[(toc-target-element? a) (lambda (flows)
(cons a (loop (cdr c)))] (append-map (lambda (f) (if (eq? f 'cont) null (flow-targets f)))
[(toc-element? a) flows))
(cons a (loop (cdr c)))] (table-flowss table)))
[(element? a) (define ps
(append (loop (element-content a)) ((if (nearly-top? d) values cdr)
(loop (cdr c)))] (let flatten ([d d])
[(delayed-element? a) (append*
(loop (append (delayed-element-content a ri) ;; don't include the section if it's in the TOC
(cdr c)))] (if (nearly-top? d) null (list d))
[(part-relative-element? a) ;; get internal targets:
(loop (append (part-relative-element-content a ri) (append-map block-targets (flow-paragraphs (part-flow d)))
(cdr c)))] (map flatten (part-parts d))))))
[else (loop (cdr c))])))] (define any-parts? (ormap part? ps))
[table-targets
(lambda (table)
(append-map
(lambda (flows)
(append-map
(lambda (f)
(if (eq? f 'cont)
null
(flow-targets f)))
flows))
(table-flowss table)))])
(append-map block-targets
(flow-paragraphs (part-flow d))))
(map flatten (part-parts d)))))]
[any-parts? (ormap part? ps)])
(if (null? ps) (if (null? ps)
null null
`((div ([class ,box-class]) `((div ([class ,box-class])
,@(get-onthispage-label) ,@(get-onthispage-label)
(table ([class "tocsublist"] (table ([class "tocsublist"] [cellspacing "0"])
[cellspacing "0"])
,@(map (lambda (p) ,@(map (lambda (p)
`(tr `(tr
(td (td
@ -493,20 +477,29 @@
'((tt nbsp))))) '((tt nbsp)))))
'("")) '(""))
,@(if (toc-element? p) ,@(if (toc-element? p)
(render-content (toc-element-toc-content p) d ri) (render-content (toc-element-toc-content p)
d ri)
(parameterize ([current-no-links #t] (parameterize ([current-no-links #t]
[extra-breaking? #t]) [extra-breaking? #t])
`((a ([href ,(if (part? p) `((a ([href
(format "#~a" (anchor-name (tag-key (car (part-tags p)) ri))) ,(format
(format "#~a" (anchor-name (tag-key (target-element-tag p) ri))))] "#~a"
[class ,(if (part? p) (anchor-name
"tocsubseclink" (tag-key (if (part? p)
(if any-parts? (car (part-tags p))
"tocsubnonseclink" (target-element-tag p))
"tocsublink"))]) ri)))]
,@(if (part? p) [class
(render-content (or (part-title-content p) '("???")) d ri) ,(cond
(render-content (element-content p) d ri))))))))) [(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])])
,@(render-content
(if (part? p)
(or (part-title-content p)
'("???"))
(element-content p))
d ri))))))))
ps)))))))) ps))))))))
(define/public (render-one-part d ri fn number) (define/public (render-one-part d ri fn number)
@ -649,7 +642,8 @@
(define/public (render-version d ri) (define/public (render-version d ri)
`((div ([class "versionbox"]) `((div ([class "versionbox"])
,@(render-content ,@(render-content
(list (make-element "version" (list "Version: " (current-version)))) (list (make-element "version"
(list "Version: " (current-version))))
d d
ri)))) ri))))
@ -668,7 +662,8 @@
[else 'h5]) [else 'h5])
,@(format-number number '((tt nbsp))) ,@(format-number number '((tt nbsp)))
,@(map (lambda (t) ,@(map (lambda (t)
`(a ((name ,(format "~a" (anchor-name (tag-key t ri))))))) `(a ([name ,(format "~a" (anchor-name
(tag-key t ri)))])))
(part-tags d)) (part-tags d))
,@(if (part-title-content d) ,@(if (part-title-content d)
(render-content (part-title-content d) d ri) (render-content (part-title-content d) d ri)
@ -684,7 +679,7 @@
(define/private (render-flow* p part ri start-inline? special-last?) (define/private (render-flow* p part ri start-inline? special-last?)
;; Wrap each table with <p>, except for a trailing table ;; Wrap each table with <p>, except for a trailing table
;; when `special-last?' is #t ;; when `special-last?' is #t
(let loop ([f (flow-paragraphs p)][inline? start-inline?]) (let loop ([f (flow-paragraphs p)] [inline? start-inline?])
(cond (cond
[(null? f) null] [(null? f) null]
[(and (table? (car f)) [(and (table? (car f))
@ -706,29 +701,34 @@
(define/override (render-element e part ri) (define/override (render-element e part ri)
(cond (cond
[(hover-element? e) [(hover-element? e)
`((span ((title ,(hover-element-text e))) ,@(render-plain-element e part ri)))] `((span ([title ,(hover-element-text e)])
,@(render-plain-element e part ri)))]
[(target-element? e) [(target-element? e)
`((a ((name ,(format "~a" (anchor-name (tag-key (target-element-tag e) ri)))))) `((a ([name ,(format "~a" (anchor-name (tag-key (target-element-tag e)
ri)))]))
,@(render-plain-element e part ri))] ,@(render-plain-element e part ri))]
[(and (link-element? e) (not (current-no-links))) [(and (link-element? e) (not (current-no-links)))
(parameterize ([current-no-links #t]) (parameterize ([current-no-links #t])
(let-values ([(dest ext?) (resolve-get/ext? part ri (link-element-tag e))]) (let-values ([(dest ext?)
(resolve-get/ext? part ri (link-element-tag e))])
(if dest (if dest
`((a [(href ,(if (and ext? external-tag-path) `((a [(href
;; Redirected to search: ,(if (and ext? external-tag-path)
(format "~a;tag=~a" ;; Redirected to search:
external-tag-path (format "~a;tag=~a"
(base64-encode external-tag-path
(string->bytes/utf-8 (base64-encode
(format "~a" (serialize (link-element-tag e)))))) (string->bytes/utf-8
;; Normal link: (format "~a" (serialize
(format "~a~a~a" (link-element-tag e))))))
(from-root (relative->path (dest-path dest)) ;; Normal link:
(get-dest-directory)) (format "~a~a~a"
(if (dest-page? dest) "" "#") (from-root (relative->path (dest-path dest))
(if (dest-page? dest) (get-dest-directory))
"" (if (dest-page? dest) "" "#")
(anchor-name (dest-anchor dest)))))) (if (dest-page? dest)
""
(anchor-name (dest-anchor dest))))))
,@(if (string? (element-style e)) ,@(if (string? (element-style e))
`([class ,(element-style e)]) `([class ,(element-style e)])
null)] null)]
@ -747,156 +747,147 @@
[else (render-plain-element e part ri)])) [else (render-plain-element e part ri)]))
(define/private (render-plain-element e part ri) (define/private (render-plain-element e part ri)
(let ([style (and (element? e) (element-style e))]) (define style (and (element? e) (element-style e)))
(cond (cond
[(symbol? style) [(symbol? style)
(case style (case style
[(italic) `((i ,@(super render-element e part ri)))] [(italic) `((i ,@(super render-element e part ri)))]
[(bold) `((b ,@(super render-element e part ri)))] [(bold) `((b ,@(super render-element e part ri)))]
[(tt) `((span ([class "stt"]) ,@(super render-element e part ri)))] [(tt) `((span ([class "stt"]) ,@(super render-element e part ri)))]
[(no-break) `((span ([class "nobreak"]) ,@(super render-element e part ri)))] [(no-break) `((span ([class "nobreak"])
[(sf) `((b (font ([size "-1"][face "Helvetica"]) ,@(super render-element e part ri))))] ,@(super render-element e part ri)))]
[(subscript) `((sub ,@(super render-element e part ri)))] [(sf) `((b (font ([size "-1"] [face "Helvetica"])
[(superscript) `((sup ,@(super render-element e part ri)))] ,@(super render-element e part ri))))]
[(hspace) `((span ([class "hspace"]) [(subscript) `((sub ,@(super render-element e part ri)))]
,@(let ([str (content->string (element-content e))]) [(superscript) `((sup ,@(super render-element e part ri)))]
(map (lambda (c) 'nbsp) (string->list str)))))] [(hspace) `((span ([class "hspace"])
[(newline) `((br))] ,@(let ([str (content->string (element-content e))])
[else (error 'html-render "unrecognized style symbol: ~e" style)])] (map (lambda (c) 'nbsp) (string->list str)))))]
[(string? style) [(newline) `((br))]
`((span ([class ,style]) ,@(super render-element e part ri)))] [else (error 'html-render "unrecognized style symbol: ~e" style)])]
[(and (pair? style) [(string? style)
(or (eq? (car style) 'bg-color) `((span ([class ,style]) ,@(super render-element e part ri)))]
(eq? (car style) 'color))) [(and (pair? style) (memq (car style) '(color bg-color)))
(unless (and (list? style) (unless (and (list? style)
(or (and (= 4 (length style)) (or (and (= 4 (length style))
(andmap byte? (cdr style))) (andmap byte? (cdr style)))
(and (= 2 (length style)) (and (= 2 (length style))
(member (cadr style) (member (cadr style)
'("white" "black" "red" "green" "blue" '("white" "black" "red" "green" "blue"
"cyan" "magenta" "yellow"))))) "cyan" "magenta" "yellow")))))
(error 'render-font "bad color style: ~e" style)) (error 'render-font "bad color style: ~e" style))
`((font ([style ,(format "~acolor: ~a" `((font ([style
(if (eq? (car style) 'bg-color) ,(format "~acolor: ~a"
"background-" (if (eq? (car style) 'bg-color) "background-" "")
"") (if (= 2 (length style))
(if (= 2 (length style)) (cadr style)
(cadr style) (string-append*
(string-append* "#"
"#" (map (lambda (v)
(map (lambda (v) (let ([s (number->string v 16)])
(let ([s (format "0~x" v)]) (if (< v 16) (string-append "0" s) s)))
(substring s (- (string-length s) 2)))) (cdr style)))))])
(cdr style)))))]) ,@(super render-element e part ri)))]
,@(super render-element e part ri)))] [(target-url? style)
[(target-url? style) (if (current-no-links)
(if (current-no-links) (super render-element e part ri)
(super render-element e part ri) (parameterize ([current-no-links #t])
(parameterize ([current-no-links #t]) `((a ([href ,(let ([addr (target-url-addr style)])
`((a ([href ,(let ([addr (target-url-addr style)]) (if (path? addr)
(if (path? addr) (from-root addr (get-dest-directory))
(from-root addr (get-dest-directory)) addr))]
addr))] ,@(if (string? (target-url-style style))
,@(if (string? (target-url-style style)) `([class ,(target-url-style style)])
`([class ,(target-url-style style)]) null))
null)) ,@(super render-element e part ri)))))]
,@(super render-element e part ri)))))] [(url-anchor? style)
[(url-anchor? style) `((a ([name ,(url-anchor-name style)])
`((a ([name ,(url-anchor-name style)]) ,@(super render-element e part ri)))]
,@(super render-element e part ri)))] [(image-file? style)
[(image-file? style) (let* ([src (main-collects-relative->path (image-file-path style))]
(let* ([src (main-collects-relative->path (image-file-path style))] [scale (image-file-scale style)]
[scale (image-file-scale style)] [to-num
[sz (if (= 1.0 scale) (lambda (s)
null (number->string
;; Try to extract file size: (inexact->exact
(call-with-input-file* (floor (* scale (integer-bytes->integer s #f #t))))))]
src [sz (if (= 1.0 scale)
(lambda (in) null
(if (regexp-try-match #px#"^\211PNG.{12}" in) ;; Try to extract file size:
(let ([w (read-bytes 4 in)] (call-with-input-file*
[h (read-bytes 4 in)] src
[to-num (lambda (s) (lambda (in)
(number->string (if (regexp-try-match #px#"^\211PNG.{12}" in)
(inexact->exact `([width ,(to-num (read-bytes 4 in))]
(floor (* scale (integer-bytes->integer s #f #t))))))]) [height ,(to-num (read-bytes 4 in))])
`([width ,(to-num w)] null))))])
[height ,(to-num h)])) `((img ([src ,(let ([p (install-file src)])
null))))]) (if (path? p)
`((img ([src ,(let ([p (install-file src)]) (url->string (path->url (path->complete-path p)))
(if (path? p) p))])
(url->string (path->url (path->complete-path p))) ,@sz)))]
p))]) [else (super render-element e part ri)]))
,@sz)))]
[else (super render-element e part ri)])))
(define/override (render-table t part ri need-inline?) (define/override (render-table t part ri need-inline?)
(define index? (eq? 'index (table-style t))) (define t-style (table-style t))
(define t-style-get (if (and (pair? t-style) (list? t-style))
(lambda (k) (assoc k (or t-style null)))
(lambda (k) #f)))
(define index? (eq? 'index t-style))
(define (make-row flows style)
`(tr (,@(if style `([class ,style]) null))
,@(let loop ([ds flows]
[as (cdr (or (t-style-get 'alignment)
(cons #f (map (lambda (x) #f) flows))))]
[vas (cdr (or (t-style-get 'valignment)
(cons #f (map (lambda (x) #f) flows))))])
(cond
[(null? ds) null]
[(eq? (car ds) 'cont)
(loop (cdr ds) (cdr as) (cdr vas))]
[else
(let ([d (car ds)] [a (car as)] [va (car vas)])
(cons
`(td (,@(case a
[(#f) null]
[(right) '([align "right"])]
[(center) '([align "center"])]
[(left) '([align "left"])])
,@(case va
[(#f) null]
[(top) '((valign "top"))]
[(baseline) '((valign "baseline"))]
[(bottom) '((valign "bottom"))])
,@(if (and (pair? (cdr ds))
(eq? 'cont (cadr ds)))
`([colspan
,(number->string
(let loop ([n 2] [ds (cddr ds)])
(cond [(null? ds) n]
[(eq? 'cont (car ds))
(loop (+ n 1) (cdr ds))]
[else n])))])
null))
,@(render-flow d part ri #f))
(loop (cdr ds) (cdr as) (cdr vas))))]))))
`(,@(if index? `(,search-script ,search-field) '()) `(,@(if index? `(,search-script ,search-field) '())
(table ([cellspacing "0"] (table ([cellspacing "0"]
,@(if need-inline? ,@(if need-inline?
'([style "display: inline; vertical-align: top;"]) '([style "display: inline; vertical-align: top;"])
null) null)
,@(case (table-style t) ,@(case t-style
[(boxed) '([class "boxed"])] [(boxed) '([class "boxed"])]
[(centered) '([align "center"])] [(centered) '([align "center"])]
[(at-right) '([align "right"])] [(at-right) '([align "right"])]
[(at-left) '([align "left"])] [(at-left) '([align "left"])]
[else null]) [else null])
,@(let ([a (and (list? (table-style t)) ,@(let ([a (t-style-get 'style)])
(assoc 'style (table-style t)))]) (if (and a (string? (cadr a))) `([class ,(cadr a)]) null))
(if (and a (string? (cadr a))) ,@(if (string? t-style) `([class ,t-style]) null))
`([class ,(cadr a)]) ,@(map make-row
null)) (table-flowss t)
,@(if (string? (table-style t)) (cdr (or (t-style-get 'row-styles)
`([class ,(table-style t)]) (cons #f (map (lambda (x) #f) (table-flowss t)))))))))
null))
,@(map (lambda (flows style)
`(tr (,@(if style `([class ,style]) null))
,@(let loop ([ds flows]
[as (cdr (or (and (list? (table-style t))
(assoc 'alignment (or (table-style t) null)))
(cons #f (map (lambda (x) #f) flows))))]
[vas
(cdr (or (and (list? (table-style t))
(assoc 'valignment (or (table-style t) null)))
(cons #f (map (lambda (x) #f) flows))))])
(cond
[(null? ds) null]
[(eq? (car ds) 'cont)
(loop (cdr ds) (cdr as) (cdr vas))]
[else
(let ([d (car ds)]
[a (car as)]
[va (car vas)])
(cons
`(td (,@(case a
[(#f) null]
[(right) '([align "right"])]
[(center) '([align "center"])]
[(left) '([align "left"])])
,@(case va
[(#f) null]
[(top) '((valign "top"))]
[(baseline) '((valign "baseline"))]
[(bottom) '((valign "bottom"))])
,@(if (and (pair? (cdr ds))
(eq? 'cont (cadr ds)))
`([colspan
,(number->string
(let loop ([n 2]
[ds (cddr ds)])
(cond
[(null? ds) n]
[(eq? 'cont (car ds)) (loop (+ n 1) (cdr ds))]
[else n])))])
null))
,@(render-flow d part ri #f))
(loop (cdr ds) (cdr as) (cdr vas))))]))))
(table-flowss t)
(cdr (or (and (list? (table-style t))
(assoc 'row-styles (or (table-style t) null)))
(cons #f (map (lambda (x) #f) (table-flowss t)))))))))
(define/override (render-blockquote t part ri) (define/override (render-blockquote t part ri)
`((blockquote ,(if (string? (blockquote-style t)) `((blockquote ,(if (string? (blockquote-style t))
@ -962,7 +953,8 @@
(define/override (get-dest-directory) (define/override (get-dest-directory)
(or (and (current-subdirectory) (or (and (current-subdirectory)
(build-path (or (super get-dest-directory) (current-directory)) (current-subdirectory))) (build-path (or (super get-dest-directory) (current-directory))
(current-subdirectory)))
(super get-dest-directory))) (super get-dest-directory)))
(define/override (derive-filename d) (define/override (derive-filename d)