Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 121 lines (110 sloc) 4.895 kb
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
; 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)))))

)
Something went wrong with that request. Please try again.