suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

just skip a missing doc dir

Browse Source 
svn: r9070
This commit is contained in:
Eli Barzilay 2008-03-23 03:24:38 +00:00
parent e40121e879
commit 2a443f0baf
1 changed files with 38 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
collects/setup/unixstyle-install.ss
View File

@ -326,36 +326,45 @@
[(n) (error "Abort!")] [(n) (error "Abort!")]
[else (loop)])))))) [else (loop)]))))))
(define ((move/copy-tree move?) src dst*) (define ((move/copy-tree move?) src dst* #:missing [missing 'error])
(define dst (if (symbol? dst*) (dir: dst*) dst*)) (define dst (if (symbol? dst*) (dir: dst*) dst*))
(define src-exists?
(or (directory-exists? src) (file-exists? src) (link-exists? src)))
(printf "~aing ~a -> ~a\n" (if move? "Mov" "Copy") src dst) (printf "~aing ~a -> ~a\n" (if move? "Mov" "Copy") src dst)
(make-dir* (dirname dst)) (cond
(let loop ([src (path->string (simplify-path src #f))] [src-exists?
[dst (path->string (simplify-path dst #f))] (make-dir* (dirname dst))
[lvl (level-of src)]) ; see above (let loop ([src (path->string (simplify-path src #f))]
(let ([doit (let ([doit (if move? mv* cp*)]) (lambda () (doit src dst)))] [dst (path->string (simplify-path dst #f))]
[src-d? (directory-exists? src)] [lvl (level-of src)]) ; see above
[dst-l? (link-exists? dst)] (let ([doit (let ([doit (if move? mv* cp*)]) (lambda () (doit src dst)))]
[dst-d? (directory-exists? dst)] [src-d? (directory-exists? src)]
[dst-f? (file-exists? dst)]) [dst-l? (link-exists? dst)]
(unless (skip-filter src) [dst-d? (directory-exists? dst)]
(when (and src-d? (not lvl) (not dst-d?)) [dst-f? (file-exists? dst)])
(when (or dst-l? dst-f?) (ask-overwrite "file or link" dst)) (unless (skip-filter src)
(make-directory dst) (when (and src-d? (not lvl) (not dst-d?))
(register-change! 'md dst) (when (or dst-l? dst-f?) (ask-overwrite "file or link" dst))
(set! dst-d? #t) (set! dst-l? #f) (set! dst-f? #f)) (make-directory dst)
(cond [dst-l? (ask-overwrite "symlink" dst) (doit)] (register-change! 'md dst)
[dst-d? (if (and src-d? (or (not lvl) (< 0 lvl))) (set! dst-d? #t) (set! dst-l? #f) (set! dst-f? #f))
;; recurse only when source is dir, & not too deep (cond [dst-l? (ask-overwrite "symlink" dst) (doit)]
(for-each (lambda (name) [dst-d? (if (and src-d? (or (not lvl) (< 0 lvl)))
(loop (make-path src name) ;; recurse only when source is dir, & not too deep
(make-path dst name) (for-each (lambda (name)
(and lvl (sub1 lvl)))) (loop (make-path src name)
(ls src)) (make-path dst name)
(begin (ask-overwrite "dir" dst) (doit)))] (and lvl (sub1 lvl))))
[dst-f? (ask-overwrite "file" dst) (doit)] (ls src))
[else (doit)])))) (begin (ask-overwrite "dir" dst) (doit)))]
(when move? (remove-empty-dirs src))) [dst-f? (ask-overwrite "file" dst) (doit)]
[else (doit)]))))
(when move? (remove-empty-dirs src))]
[(eq? missing 'error)
(error (format " missing source path ~s, aborting..." src))]
[(eq? missing 'skip)
(printf " missing source path ~s, skipping...\n" src)]
[else (error 'move/copy-tree "internal error, unknown mode: ~e" missing)]))
;; -------------------------------------------------------------------------- ;; --------------------------------------------------------------------------
@ -368,7 +377,7 @@
(define binfiles (ls "bin")) ; see below (define binfiles (ls "bin")) ; see below
(do-tree "bin" 'bin) (do-tree "bin" 'bin)
(do-tree "collects" 'collects) (do-tree "collects" 'collects)
(do-tree "doc" 'doc) (do-tree "doc" 'doc #:missing 'skip) ; not included in mz distros
;; (do-tree ??? 'lib) ; shared stuff goes here ;; (do-tree ??? 'lib) ; shared stuff goes here
(do-tree "include" 'includeplt) (do-tree "include" 'includeplt)
(do-tree "lib" 'libplt) (do-tree "lib" 'libplt)