Mercurial > lasercutter

     1 ;   Copyright (c) Chris Houser, Nov-Dec 2008. All rights reserved.

     2 ;   The use and distribution terms for this software are covered by the

     3 ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     4 ;   which can be found in the file epl-v10.html at the root of this distribution.

     5 ;   By using this software in any fashion, you are agreeing to be bound by

     6 ;   the terms of this license.

     7 ;   You must not remove this notice, or any other, from this software.

     8 

     9 ; Process command-line arguments according to a given cmdspec

    10 

    11 (ns 

    12     ^{:author "Chris Houser", 

    13        :doc "Process command-line arguments according to a given cmdspec"}

    14     clojure.contrib.command-line

    15     (:use     (clojure.contrib [string :only (join)])))

    16 

    17 (defn make-map [args cmdspec]

    18   (let [{spec true [rest-sym] false} (group-by vector? cmdspec)

    19         rest-str (str rest-sym)

    20         key-data (into {} (for [[syms [_ default]] (map #(split-with symbol? %)

    21                                                         (conj spec '[help? h?]))

    22                                 sym syms]

    23                             [(re-find #"^.*[^?]" (str sym))

    24                              {:sym (str (first syms)) :default default}]))

    25         defaults (into {} (for [[_ {:keys [default sym]}] key-data

    26                                 :when default]

    27                             [sym default]))]

    28     (loop [[argkey & [argval :as r]] args

    29            cmdmap (assoc defaults :cmdspec cmdspec rest-str [])]

    30       (if argkey

    31         (let [[_ & [keybase]] (re-find #"^--?(.*)" argkey)]

    32           (cond

    33             (= keybase nil) (recur r (update-in cmdmap [rest-str] conj argkey))

    34             (= keybase "")  (update-in cmdmap [rest-str] #(apply conj % r))

    35             :else (if-let [found (key-data keybase)]

    36                     (if (= \? (last (:sym found)))

    37                       (recur r (assoc cmdmap (:sym found) true))

    38                       (recur (next r) (assoc cmdmap (:sym found)

    39                                              (if (or (nil? r) (= \- (ffirst r)))

    40                                                (:default found)

    41                                                (first r)))))

    42                     (throw (Exception. (str "Unknown option " argkey))))))

    43         cmdmap))))

    44 

    45 (defn- align

    46    "Align strings given as vectors of columns, with first vector

    47    specifying right or left alignment (:r or :l) for each column."

    48    [spec & rows]

    49    (let [maxes (vec (for [n (range (count (first rows)))]

    50                         (apply max (map (comp count #(nth % n)) rows))))

    51          fmt (join " " 

    52                   (for [n (range (count maxes))] 

    53                      (str "%" 

    54                         (when-not (zero? (maxes n))

    55                            (str (when (= (spec n) :l) "-") (maxes n))) 

    56                           "s")))]

    57       (join "\n"

    58          (for [row rows]

    59             (apply format fmt row)))))

    60 

    61 (defn- rmv-q

    62    "Remove ?"

    63    [^String s]

    64    (if (.endsWith s "?")

    65       (.substring s 0 (dec (count s)))

    66       s))

    67 

    68 (defn print-help [desc cmdmap]

    69   (println desc)

    70   (println "Options")

    71   (println 

    72      (apply align [:l :l :l] 

    73         (for [spec (:cmdspec cmdmap) :when (vector? spec)]

    74             (let [[argnames [text default]] (split-with symbol? spec)

    75                   [_ opt q] (re-find #"^(.*[^?])(\??)$"

    76                                  (str (first argnames)))

    77                   argnames  (map (comp rmv-q str) argnames)

    78                   argnames

    79                         (join ", "

    80                           (for [arg argnames]

    81                             (if (= 1 (count arg))

    82                               (str "-" arg)

    83                               (str "--" arg))))]

    84                [(str "  " argnames (when (= "" q) " <arg>") " ")

    85                 text 

    86                 (if-not default

    87                   ""

    88                   (str " [default " default "]"))])))))

    89 

    90 (defmacro with-command-line 

    91   "Bind locals to command-line args."

    92   [args desc cmdspec & body]

    93   (let [locals (vec (for [spec cmdspec]

    94                       (if (vector? spec)

    95                         (first spec)

    96                         spec)))]

    97     `(let [{:strs ~locals :as cmdmap#} (make-map ~args '~cmdspec)]

    98        (if (cmdmap# "help?")

    99          (print-help ~desc cmdmap#)

   100          (do ~@body)))))

   101 

   102 (comment

   103 

   104 ; example of usage:

   105 

   106 (with-command-line *command-line-args*

   107   "tojs -- Compile ClojureScript to JavaScript"

   108   [[simple? s? "Runs some simple built-in tests"]

   109    [serve      "Starts a repl server on the given port" 8081]

   110    [mkboot?    "Generates a boot.js file"]

   111    [verbose? v? "Includes extra fn names and comments in js"]

   112    filenames]

   113   (binding [*debug-fn-names* verbose? *debug-comments* verbose?]

   114     (cond

   115       simple? (simple-tests)

   116       serve   (start-server (Integer/parseInt serve))

   117       mkboot? (mkboot)

   118       :else   (doseq [filename filenames]

   119                  (filetojs filename)))))

   120 

   121 )
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children