aboutsummaryrefslogtreecommitdiff
path: root/modules/command-line/src/main/clojure
diff options
context:
space:
mode:
authorStuart Sierra <mail@stuartsierra.com>2010-08-07 16:41:53 -0400
committerStuart Sierra <mail@stuartsierra.com>2010-08-07 16:41:53 -0400
commita6a92b9b3d2bfd9a56e1e5e9cfba706d1aeeaae5 (patch)
treef1f3da9887dc2dc557df3282b0bcbd4d701ec593 /modules/command-line/src/main/clojure
parente7930c85290f77815cdb00a60604feedfa2d0194 (diff)
Split all namespaces into sub-modules.
* Examples and tests have not been copied over. * Clojure test/compile phases are commented out in parent POM. * May require installing parent POM before full build.
Diffstat (limited to 'modules/command-line/src/main/clojure')
-rw-r--r--modules/command-line/src/main/clojure/clojure/contrib/command_line.clj121
1 files changed, 121 insertions, 0 deletions
diff --git a/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj b/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj
new file mode 100644
index 00000000..47ee7849
--- /dev/null
+++ b/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj
@@ -0,0 +1,121 @@
+; 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
+ (:use (clojure.contrib [string :only (join)])))
+
+(defn make-map [args cmdspec]
+ (let [{spec true [rest-sym] false} (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]] args
+ 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 (join " "
+ (for [n (range (count maxes))]
+ (str "%"
+ (when-not (zero? (maxes n))
+ (str (when (= (spec n) :l) "-") (maxes n)))
+ "s")))]
+ (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
+ (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)))))
+
+)