blob: 8a179c1da37b78f656439aa918d58fe3d993f975 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
; Copyright (c) Chris Houser, Nov-Dec 2008. All rights reserved.
; The use and distribution terms for this software are covered by the
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
; which can be found in the file epl-v10.html at the root of this distribution.
; By using this software in any fashion, you are agreeing to be bound by
; the terms of this license.
; You must not remove this notice, or any other, from this software.
; Process command-line arguments according to a given cmdspec
(ns
#^{:author "Chris Houser",
:doc "Process command-line arguments according to a given cmdspec"}
clojure.contrib.command-line
(:require (clojure.contrib [seq-utils :as su]))
(:use (clojure.contrib [str-utils :only (str-join)])))
(defn make-map [args cmdspec]
(let [{spec true [rest-sym] false} (su/group-by vector? cmdspec)
rest-str (str rest-sym)
key-data (into {} (for [[syms [_ default]] (map #(split-with symbol? %)
(conj spec '[help? h?]))
sym syms]
[(re-find #"^.*[^?]" (str sym))
{:sym (str (first syms)) :default default}]))
defaults (into {} (for [[_ {:keys [default sym]}] key-data
:when default]
[sym default]))]
(loop [[argkey & [argval :as r]] (if (seq args) args ["--help"])
cmdmap (assoc defaults :cmdspec cmdspec rest-str [])]
(if argkey
(let [[_ & [keybase]] (re-find #"^--?(.*)" argkey)]
(cond
(= keybase nil) (recur r (update-in cmdmap [rest-str] conj argkey))
(= keybase "") (update-in cmdmap [rest-str] #(apply conj % r))
:else (if-let [found (key-data keybase)]
(if (= \? (last (:sym found)))
(recur r (assoc cmdmap (:sym found) true))
(recur (next r) (assoc cmdmap (:sym found)
(if (or (nil? r) (= \- (ffirst r)))
(:default found)
(first r)))))
(throw (Exception. (str "Unknown option " argkey))))))
cmdmap))))
(defn- align
"Align strings given as vectors of columns, with first vector
specifying right or left alignment (:r or :l) for each column."
[spec & rows]
(let [maxes (vec (for [n (range (count (first rows)))]
(apply max (map (comp count #(nth % n)) rows))))
fmt (str-join " "
(for [n (range (count maxes))]
(str "%"
(when-not (zero? (maxes n))
(str (when (= (spec n) :l) "-") (maxes n)))
"s")))]
(str-join "\n"
(for [row rows]
(apply format fmt row)))))
(defn- rmv-q
"Remove ?"
[#^String s]
(if (.endsWith s "?")
(.substring s 0 (dec (count s)))
s))
(defn print-help [desc cmdmap]
(println desc)
(println "Options")
(println
(apply align [:l :l :l]
(for [spec (:cmdspec cmdmap) :when (vector? spec)]
(let [[argnames [text default]] (split-with symbol? spec)
[_ opt q] (re-find #"^(.*[^?])(\??)$"
(str (first argnames)))
argnames (map (comp rmv-q str) argnames)
argnames
(str-join ", "
(for [arg argnames]
(if (= 1 (count arg))
(str "-" arg)
(str "--" arg))))]
[(str " " argnames (when (= "" q) " <arg>") " ")
text
(if-not default
""
(str " [default " default "]"))])))))
(defmacro with-command-line
"Bind locals to command-line args."
[args desc cmdspec & body]
(let [locals (vec (for [spec cmdspec]
(if (vector? spec)
(first spec)
spec)))]
`(let [{:strs ~locals :as cmdmap#} (make-map ~args '~cmdspec)]
(if (cmdmap# "help?")
(print-help ~desc cmdmap#)
(do ~@body)))))
(comment
; example of usage:
(with-command-line *command-line-args*
"tojs -- Compile ClojureScript to JavaScript"
[[simple? s? "Runs some simple built-in tests"]
[serve "Starts a repl server on the given port" 8081]
[mkboot? "Generates a boot.js file"]
[verbose? v? "Includes extra fn names and comments in js"]
filenames]
(binding [*debug-fn-names* verbose? *debug-comments* verbose?]
(cond
simple? (simple-tests)
serve (start-server (Integer/parseInt serve))
mkboot? (mkboot)
:else (doseq [filename filenames]
(filetojs filename)))))
)
|
