mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-09-27 14:48:13 +00:00
Code Issues 1 Releases Wiki Activity

Windows fixes for jpm.

Browse Source
This commit is contained in:
Calvin Rose 2019-08-29 02:02:05 -04:00
parent 7e0586cb55
commit d4b49cd622
1 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
auxbin/jpm
View File

@ -203,6 +203,15 @@
(unless (zero? res) (unless (zero? res)
(error (string "command exited with status " res)))) (error (string "command exited with status " res))))
(defn- shell2
"Do a shell command, but don't assum 0 is the (only) passing exit code."
[pred & args]
(if (dyn :verbose)
(print ;(interpose " " args)))
(def res (os/execute args :p))
(unless (pred res)
(error (string "command exited with status " res))))
(defn rm (defn rm
"Remove a directory and all sub directories." "Remove a directory and all sub directories."
[path] [path]
@ -218,7 +227,11 @@
[src dest] [src dest]
(print "copying " src " to " dest "...") (print "copying " src " to " dest "...")
(if is-win (if is-win
(shell "xcopy" src dest "/y" "/e") (if (= (os/stat src :mode) :directory)
(let [dname (last (filter |(pos? (length $)) (string/split "/" src)))]
(shell2 |(< $ 9) "robocopy" "/MIR" "/COPY:DAT" "/NS" "/NS" "/NFL" "/NDL" "/NP" "/NJH" "/NJS"
src (string dest sep dname)))
(shell "xcopy" src dest "/y" "/e"))
(shell "cp" "-rf" src dest))) (shell "cp" "-rf" src dest)))
# #
@ -532,6 +545,7 @@ int main(int argc, const char **argv) {
(unless f (print manifest " does not exist") (break)) (unless f (print manifest " does not exist") (break))
(loop [line :iterate (:read f :line)] (loop [line :iterate (:read f :line)]
(def path ((string/split "\n" line) 0)) (def path ((string/split "\n" line) 0))
(def path ((string/split "\r" path) 0))
(print "removing " path) (print "removing " path)
(try (rm path) ([err] (try (rm path) ([err]
(unless (= err "No such file or directory") (unless (= err "No such file or directory")
@ -825,7 +839,7 @@ Flags are:
[] []
(local-rule "test")) (local-rule "test"))
(defn- uninstall (defn- uninstall-cmd
[&opt what] [&opt what]
(if what (if what
(uninstall what) (uninstall what)
@ -843,7 +857,7 @@ Flags are:
"help" help "help" help
"deps" deps "deps" deps
"clear-cache" clear-cache "clear-cache" clear-cache
"uninstall" uninstall}) "uninstall" uninstall-cmd})
(def- args (tuple/slice (dyn :args) 1)) (def- args (tuple/slice (dyn :args) 1))
(def- len (length args)) (def- len (length args))