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

added a create? argument to get-dest-directory

Browse Source 
svn: r10105

original commit: 24d6e488ce92fb2adb6b73b28eeba8c9329ca19e
This commit is contained in:
Eli Barzilay 2008-06-03 01:47:31 +00:00
parent 13cda846d0
commit 320b104514
2 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -18,7 +18,10 @@
[refer-to-existing-files #f]
[root-path #f])
(define/public (get-dest-directory) dest-dir)
(define/public (get-dest-directory [create? #f])
(when (and dest-dir create? (not (directory-exists? dest-dir)))
(make-directory* dest-dir))
dest-dir)
(define/public (get-substitutions) null)
@ -402,7 +405,7 @@
(string->path fn)
fn)
(let ([src-dir (path-only fn)]
[dest-dir (get-dest-directory)]
[dest-dir (get-dest-directory #t)]
[fn (file-name-from-path fn)])
(let ([src-file (build-path (or src-dir (current-directory)) fn)]
[dest-file (build-path (or dest-dir (current-directory)) fn)])
@ -421,7 +424,6 @@
(and (equal? s d)
(or (eof-object? s) (loop)))))))))))
(when (file-exists? dest-file) (delete-file dest-file))
(make-directory* (path-only dest-file))
(copy-file src-file dest-file))
(path->string fn)))))

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

@ -998,11 +998,15 @@
(define/override (get-suffix) #"")
(define/override (get-dest-directory)
(define/override (get-dest-directory [create? #f])
(or (and (current-subdirectory)
(build-path (or (super get-dest-directory) (current-directory))
(current-subdirectory)))
(super get-dest-directory)))
(let ([d (build-path (or (super get-dest-directory)
(current-directory))
(current-subdirectory))])
(when (and create? (not (directory-exists? d)))
(make-directory* d))
d))
(super get-dest-directory create?)))
(define/override (derive-filename d)
(let ([fn (format "~a.html"