rlm@10: ;   Copyright (c) Chris Houser, Nov-Dec 2008. All rights reserved.
rlm@10: ;   The use and distribution terms for this software are covered by the
rlm@10: ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10: ;   which can be found in the file epl-v10.html at the root of this distribution.
rlm@10: ;   By using this software in any fashion, you are agreeing to be bound by
rlm@10: ;   the terms of this license.
rlm@10: ;   You must not remove this notice, or any other, from this software.
rlm@10: 
rlm@10: ; Process command-line arguments according to a given cmdspec
rlm@10: 
rlm@10: (ns 
rlm@10:     ^{:author "Chris Houser", 
rlm@10:        :doc "Process command-line arguments according to a given cmdspec"}
rlm@10:     clojure.contrib.command-line
rlm@10:     (:use     (clojure.contrib [string :only (join)])))
rlm@10: 
rlm@10: (defn make-map [args cmdspec]
rlm@10:   (let [{spec true [rest-sym] false} (group-by vector? cmdspec)
rlm@10:         rest-str (str rest-sym)
rlm@10:         key-data (into {} (for [[syms [_ default]] (map #(split-with symbol? %)
rlm@10:                                                         (conj spec '[help? h?]))
rlm@10:                                 sym syms]
rlm@10:                             [(re-find #"^.*[^?]" (str sym))
rlm@10:                              {:sym (str (first syms)) :default default}]))
rlm@10:         defaults (into {} (for [[_ {:keys [default sym]}] key-data
rlm@10:                                 :when default]
rlm@10:                             [sym default]))]
rlm@10:     (loop [[argkey & [argval :as r]] args
rlm@10:            cmdmap (assoc defaults :cmdspec cmdspec rest-str [])]
rlm@10:       (if argkey
rlm@10:         (let [[_ & [keybase]] (re-find #"^--?(.*)" argkey)]
rlm@10:           (cond
rlm@10:             (= keybase nil) (recur r (update-in cmdmap [rest-str] conj argkey))
rlm@10:             (= keybase "")  (update-in cmdmap [rest-str] #(apply conj % r))
rlm@10:             :else (if-let [found (key-data keybase)]
rlm@10:                     (if (= \? (last (:sym found)))
rlm@10:                       (recur r (assoc cmdmap (:sym found) true))
rlm@10:                       (recur (next r) (assoc cmdmap (:sym found)
rlm@10:                                              (if (or (nil? r) (= \- (ffirst r)))
rlm@10:                                                (:default found)
rlm@10:                                                (first r)))))
rlm@10:                     (throw (Exception. (str "Unknown option " argkey))))))
rlm@10:         cmdmap))))
rlm@10: 
rlm@10: (defn- align
rlm@10:    "Align strings given as vectors of columns, with first vector
rlm@10:    specifying right or left alignment (:r or :l) for each column."
rlm@10:    [spec & rows]
rlm@10:    (let [maxes (vec (for [n (range (count (first rows)))]
rlm@10:                         (apply max (map (comp count #(nth % n)) rows))))
rlm@10:          fmt (join " " 
rlm@10:                   (for [n (range (count maxes))] 
rlm@10:                      (str "%" 
rlm@10:                         (when-not (zero? (maxes n))
rlm@10:                            (str (when (= (spec n) :l) "-") (maxes n))) 
rlm@10:                           "s")))]
rlm@10:       (join "\n"
rlm@10:          (for [row rows]
rlm@10:             (apply format fmt row)))))
rlm@10: 
rlm@10: (defn- rmv-q
rlm@10:    "Remove ?"
rlm@10:    [^String s]
rlm@10:    (if (.endsWith s "?")
rlm@10:       (.substring s 0 (dec (count s)))
rlm@10:       s))
rlm@10: 
rlm@10: (defn print-help [desc cmdmap]
rlm@10:   (println desc)
rlm@10:   (println "Options")
rlm@10:   (println 
rlm@10:      (apply align [:l :l :l] 
rlm@10:         (for [spec (:cmdspec cmdmap) :when (vector? spec)]
rlm@10:             (let [[argnames [text default]] (split-with symbol? spec)
rlm@10:                   [_ opt q] (re-find #"^(.*[^?])(\??)$"
rlm@10:                                  (str (first argnames)))
rlm@10:                   argnames  (map (comp rmv-q str) argnames)
rlm@10:                   argnames
rlm@10:                         (join ", "
rlm@10:                           (for [arg argnames]
rlm@10:                             (if (= 1 (count arg))
rlm@10:                               (str "-" arg)
rlm@10:                               (str "--" arg))))]
rlm@10:                [(str "  " argnames (when (= "" q) " <arg>") " ")
rlm@10:                 text 
rlm@10:                 (if-not default
rlm@10:                   ""
rlm@10:                   (str " [default " default "]"))])))))
rlm@10: 
rlm@10: (defmacro with-command-line 
rlm@10:   "Bind locals to command-line args."
rlm@10:   [args desc cmdspec & body]
rlm@10:   (let [locals (vec (for [spec cmdspec]
rlm@10:                       (if (vector? spec)
rlm@10:                         (first spec)
rlm@10:                         spec)))]
rlm@10:     `(let [{:strs ~locals :as cmdmap#} (make-map ~args '~cmdspec)]
rlm@10:        (if (cmdmap# "help?")
rlm@10:          (print-help ~desc cmdmap#)
rlm@10:          (do ~@body)))))
rlm@10: 
rlm@10: (comment
rlm@10: 
rlm@10: ; example of usage:
rlm@10: 
rlm@10: (with-command-line *command-line-args*
rlm@10:   "tojs -- Compile ClojureScript to JavaScript"
rlm@10:   [[simple? s? "Runs some simple built-in tests"]
rlm@10:    [serve      "Starts a repl server on the given port" 8081]
rlm@10:    [mkboot?    "Generates a boot.js file"]
rlm@10:    [verbose? v? "Includes extra fn names and comments in js"]
rlm@10:    filenames]
rlm@10:   (binding [*debug-fn-names* verbose? *debug-comments* verbose?]
rlm@10:     (cond
rlm@10:       simple? (simple-tests)
rlm@10:       serve   (start-server (Integer/parseInt serve))
rlm@10:       mkboot? (mkboot)
rlm@10:       :else   (doseq [filename filenames]
rlm@10:                  (filetojs filename)))))
rlm@10: 
rlm@10: )