Mercurial > lasercutter

     1 ;   Copyright (c) Rich Hickey. 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 (in-ns 'clojure.core)

    10 

    11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; printing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    12 

    13 (import '(java.io Writer))

    14 

    15 (def

    16  ^{:doc "*print-length* controls how many items of each collection the

    17   printer will print. If it is bound to logical false, there is no

    18   limit. Otherwise, it must be bound to an integer indicating the maximum

    19   number of items of each collection to print. If a collection contains

    20   more items, the printer will print items up to the limit followed by

    21   '...' to represent the remaining items. The root binding is nil

    22   indicating no limit."

    23    :added "1.0"}

    24  *print-length* nil)

    25 

    26 (def

    27  ^{:doc "*print-level* controls how many levels deep the printer will

    28   print nested objects. If it is bound to logical false, there is no

    29   limit. Otherwise, it must be bound to an integer indicating the maximum

    30   level to print. Each argument to print is at level 0; if an argument is a

    31   collection, its items are at level 1; and so on. If an object is a

    32   collection and is at a level greater than or equal to the value bound to

    33   *print-level*, the printer prints '#' to represent it. The root binding

    34   is nil indicating no limit."

    35    :added "1.0"}

    36 *print-level* nil)

    37 

    38 (defn- print-sequential [^String begin, print-one, ^String sep, ^String end, sequence, ^Writer w]

    39   (binding [*print-level* (and (not *print-dup*) *print-level* (dec *print-level*))]

    40     (if (and *print-level* (neg? *print-level*))

    41       (.write w "#")

    42       (do

    43         (.write w begin)

    44         (when-let [xs (seq sequence)]

    45           (if (and (not *print-dup*) *print-length*)

    46             (loop [[x & xs] xs

    47                    print-length *print-length*]

    48               (if (zero? print-length)

    49                 (.write w "...")

    50                 (do

    51                   (print-one x w)

    52                   (when xs

    53                     (.write w sep)

    54                     (recur xs (dec print-length))))))

    55             (loop [[x & xs] xs]

    56               (print-one x w)

    57               (when xs

    58                 (.write w sep)

    59                 (recur xs)))))

    60         (.write w end)))))

    61 

    62 (defn- print-meta [o, ^Writer w]

    63   (when-let [m (meta o)]

    64     (when (and (pos? (count m))

    65                (or *print-dup*

    66                    (and *print-meta* *print-readably*)))

    67       (.write w "^")

    68       (if (and (= (count m) 1) (:tag m))

    69           (pr-on (:tag m) w)

    70           (pr-on m w))

    71       (.write w " "))))

    72 

    73 (defmethod print-method :default [o, ^Writer w]

    74   (print-method (vary-meta o #(dissoc % :type)) w))

    75 

    76 (defmethod print-method nil [o, ^Writer w]

    77   (.write w "nil"))

    78 

    79 (defmethod print-dup nil [o w] (print-method o w))

    80 

    81 (defn print-ctor [o print-args ^Writer w]

    82   (.write w "#=(")

    83   (.write w (.getName ^Class (class o)))

    84   (.write w ". ")

    85   (print-args o w)

    86   (.write w ")"))

    87 

    88 (defmethod print-method Object [o, ^Writer w]

    89   (.write w "#<")

    90   (.write w (.getSimpleName (class o)))

    91   (.write w " ")

    92   (.write w (str o))

    93   (.write w ">"))

    94 

    95 (defmethod print-method clojure.lang.Keyword [o, ^Writer w]

    96   (.write w (str o)))

    97 

    98 (defmethod print-dup clojure.lang.Keyword [o w] (print-method o w))

    99 

   100 (defmethod print-method Number [o, ^Writer w]

   101   (.write w (str o)))

   102 

   103 (defmethod print-dup Number [o, ^Writer w]

   104   (print-ctor o

   105               (fn [o w]

   106                   (print-dup (str o) w))

   107               w))

   108 

   109 (defmethod print-dup clojure.lang.Fn [o, ^Writer w]

   110   (print-ctor o (fn [o w]) w))

   111 

   112 (prefer-method print-dup clojure.lang.IPersistentCollection clojure.lang.Fn)

   113 (prefer-method print-dup java.util.Map clojure.lang.Fn)

   114 (prefer-method print-dup java.util.Collection clojure.lang.Fn)

   115 

   116 (defmethod print-method Boolean [o, ^Writer w]

   117   (.write w (str o)))

   118 

   119 (defmethod print-dup Boolean [o w] (print-method o w))

   120 

   121 (defn print-simple [o, ^Writer w]

   122   (print-meta o w)

   123   (.write w (str o)))

   124 

   125 (defmethod print-method clojure.lang.Symbol [o, ^Writer w]

   126   (print-simple o w))

   127 

   128 (defmethod print-dup clojure.lang.Symbol [o w] (print-method o w))

   129 

   130 (defmethod print-method clojure.lang.Var [o, ^Writer w]

   131   (print-simple o w))

   132 

   133 (defmethod print-dup clojure.lang.Var [^clojure.lang.Var o, ^Writer w]

   134   (.write w (str "#=(var " (.name (.ns o)) "/" (.sym o) ")")))

   135 

   136 (defmethod print-method clojure.lang.ISeq [o, ^Writer w]

   137   (print-meta o w)

   138   (print-sequential "(" pr-on " " ")" o w))

   139 

   140 (defmethod print-dup clojure.lang.ISeq [o w] (print-method o w))

   141 (defmethod print-dup clojure.lang.IPersistentList [o w] (print-method o w))

   142 (prefer-method print-method clojure.lang.ISeq clojure.lang.IPersistentCollection)

   143 (prefer-method print-dup clojure.lang.ISeq clojure.lang.IPersistentCollection)

   144 (prefer-method print-method clojure.lang.ISeq java.util.Collection)

   145 (prefer-method print-dup clojure.lang.ISeq java.util.Collection)

   146 

   147 

   148 

   149 (defmethod print-dup java.util.Collection [o, ^Writer w]

   150  (print-ctor o #(print-sequential "[" print-dup " " "]" %1 %2) w))

   151 

   152 (defmethod print-dup clojure.lang.IPersistentCollection [o, ^Writer w]

   153   (print-meta o w)

   154   (.write w "#=(")

   155   (.write w (.getName ^Class (class o)))

   156   (.write w "/create ")

   157   (print-sequential "[" print-dup " " "]" o w)

   158   (.write w ")"))

   159 

   160 (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Collection)

   161 

   162 (def ^{:tag String 

   163        :doc "Returns escape string for char or nil if none"

   164        :added "1.0"}

   165   char-escape-string

   166     {\newline "\\n"

   167      \tab  "\\t"

   168      \return "\\r"

   169      \" "\\\""

   170      \\  "\\\\"

   171      \formfeed "\\f"

   172      \backspace "\\b"})

   173 

   174 (defmethod print-method String [^String s, ^Writer w]

   175   (if (or *print-dup* *print-readably*)

   176     (do (.append w \")

   177       (dotimes [n (count s)]

   178         (let [c (.charAt s n)

   179               e (char-escape-string c)]

   180           (if e (.write w e) (.append w c))))

   181       (.append w \"))

   182     (.write w s))

   183   nil)

   184 

   185 (defmethod print-dup String [s w] (print-method s w))

   186 

   187 (defmethod print-method clojure.lang.IPersistentVector [v, ^Writer w]

   188   (print-meta v w)

   189   (print-sequential "[" pr-on " " "]" v w))

   190 

   191 (defn- print-map [m print-one w]

   192   (print-sequential 

   193    "{"

   194    (fn [e  ^Writer w] 

   195      (do (print-one (key e) w) (.append w \space) (print-one (val e) w)))

   196    ", "

   197    "}"

   198    (seq m) w))

   199 

   200 (defmethod print-method clojure.lang.IPersistentMap [m, ^Writer w]

   201   (print-meta m w)

   202   (print-map m pr-on w))

   203 

   204 (defmethod print-dup java.util.Map [m, ^Writer w]

   205   (print-ctor m #(print-map (seq %1) print-dup %2) w))

   206 

   207 (defmethod print-dup clojure.lang.IPersistentMap [m, ^Writer w]

   208   (print-meta m w)

   209   (.write w "#=(")

   210   (.write w (.getName (class m)))

   211   (.write w "/create ")

   212   (print-map m print-dup w)

   213   (.write w ")"))

   214 

   215 (prefer-method print-dup clojure.lang.IPersistentCollection java.util.Map)

   216 

   217 (defmethod print-method clojure.lang.IPersistentSet [s, ^Writer w]

   218   (print-meta s w)

   219   (print-sequential "#{" pr-on " " "}" (seq s) w))

   220 

   221 (def ^{:tag String 

   222        :doc "Returns name string for char or nil if none"

   223        :added "1.0"} 

   224  char-name-string

   225    {\newline "newline"

   226     \tab "tab"

   227     \space "space"

   228     \backspace "backspace"

   229     \formfeed "formfeed"

   230     \return "return"})

   231 

   232 (defmethod print-method java.lang.Character [^Character c, ^Writer w]

   233   (if (or *print-dup* *print-readably*)

   234     (do (.append w \\)

   235         (let [n (char-name-string c)]

   236           (if n (.write w n) (.append w c))))

   237     (.append w c))

   238   nil)

   239 

   240 (defmethod print-dup java.lang.Character [c w] (print-method c w))

   241 (defmethod print-dup java.lang.Integer [o w] (print-method o w))

   242 (defmethod print-dup java.lang.Double [o w] (print-method o w))

   243 (defmethod print-dup clojure.lang.Ratio [o w] (print-method o w))

   244 (defmethod print-dup java.math.BigDecimal [o w] (print-method o w))

   245 (defmethod print-dup clojure.lang.PersistentHashMap [o w] (print-method o w))

   246 (defmethod print-dup clojure.lang.PersistentHashSet [o w] (print-method o w))

   247 (defmethod print-dup clojure.lang.PersistentVector [o w] (print-method o w))

   248 (defmethod print-dup clojure.lang.LazilyPersistentVector [o w] (print-method o w))

   249 

   250 (def primitives-classnames

   251   {Float/TYPE "Float/TYPE"

   252    Integer/TYPE "Integer/TYPE"

   253    Long/TYPE "Long/TYPE"

   254    Boolean/TYPE "Boolean/TYPE"

   255    Character/TYPE "Character/TYPE"

   256    Double/TYPE "Double/TYPE"

   257    Byte/TYPE "Byte/TYPE"

   258    Short/TYPE "Short/TYPE"})

   259 

   260 (defmethod print-method Class [^Class c, ^Writer w]

   261   (.write w (.getName c)))

   262 

   263 (defmethod print-dup Class [^Class c, ^Writer w]

   264   (cond

   265     (.isPrimitive c) (do

   266                        (.write w "#=(identity ")

   267                        (.write w ^String (primitives-classnames c))

   268                        (.write w ")"))

   269     (.isArray c) (do

   270                    (.write w "#=(java.lang.Class/forName \"")

   271                    (.write w (.getName c))

   272                    (.write w "\")"))

   273     :else (do

   274             (.write w "#=")

   275             (.write w (.getName c)))))

   276 

   277 (defmethod print-method java.math.BigDecimal [b, ^Writer w]

   278   (.write w (str b))

   279   (.write w "M"))

   280 

   281 (defmethod print-method java.util.regex.Pattern [p ^Writer w]

   282   (.write w "#\"")

   283   (loop [[^Character c & r :as s] (seq (.pattern ^java.util.regex.Pattern p))

   284          qmode false]

   285     (when s

   286       (cond

   287         (= c \\) (let [[^Character c2 & r2] r]

   288                    (.append w \\)

   289                    (.append w c2)

   290                    (if qmode

   291                       (recur r2 (not= c2 \E))

   292                       (recur r2 (= c2 \Q))))

   293         (= c \") (do

   294                    (if qmode

   295                      (.write w "\\E\\\"\\Q")

   296                      (.write w "\\\""))

   297                    (recur r qmode))

   298         :else    (do

   299                    (.append w c)

   300                    (recur r qmode)))))

   301   (.append w \"))

   302 

   303 (defmethod print-dup java.util.regex.Pattern [p ^Writer w] (print-method p w))

   304 

   305 (defmethod print-dup clojure.lang.Namespace [^clojure.lang.Namespace n ^Writer w]

   306   (.write w "#=(find-ns ")

   307   (print-dup (.name n) w)

   308   (.write w ")"))

   309 

   310 (defmethod print-method clojure.lang.IDeref [o ^Writer w]

   311   (print-sequential (format "#<%s@%x%s: "

   312                             (.getSimpleName (class o))

   313                             (System/identityHashCode o)

   314                             (if (and (instance? clojure.lang.Agent o)

   315                                      (agent-error o))

   316                               " FAILED"

   317                               ""))

   318                     pr-on, "", ">", (list (if (and (future? o) (not (future-done? o))) :pending @o)), w))

   319 

   320 (def ^{:private true} print-initialized true)
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children