diff --git a/sci b/sci index e4cfa161..96a54feb 160000 --- a/sci +++ b/sci @@ -1 +1 @@ -Subproject commit e4cfa161b06fa3cfe2c18342aaf8d7ffe2d5ae9d +Subproject commit 96a54feb9acb397a785d29a0307c8a6de2404c37 diff --git a/src/babashka/impl/pprint.clj b/src/babashka/impl/pprint.clj index e598c0ae..d1420cc4 100644 --- a/src/babashka/impl/pprint.clj +++ b/src/babashka/impl/pprint.clj @@ -3,7 +3,9 @@ (:require [clojure.pprint :as pprint] [sci.core :as sci])) -(defonce patch-option-table +(defonce patched? (volatile! false)) + +(when-not @patched? (alter-var-root #'pprint/write-option-table (fn [m] (zipmap (keys m) @@ -16,12 +18,21 @@ #(when-let [v (get t (key %))] [v (val %)]) m)))) -(alter-var-root #'pprint/table-ize (constantly new-table-ize)) +(when-not @patched? + (alter-var-root #'pprint/table-ize (constantly new-table-ize)) + (alter-meta! #'pprint/write-option-table dissoc :private) + (alter-meta! #'pprint/with-pretty-writer dissoc :private) + (alter-meta! #'pprint/pretty-writer? dissoc :private) + (alter-meta! #'pprint/make-pretty-writer dissoc :private) + (alter-meta! #'pprint/execute-format dissoc :private)) -(alter-meta! #'pprint/write-option-table dissoc :private) -(alter-meta! #'pprint/with-pretty-writer dissoc :private) -(alter-meta! #'pprint/pretty-writer? dissoc :private) -(alter-meta! #'pprint/make-pretty-writer dissoc :private) +(def pprint-ns (sci/create-ns 'clojure.pprint nil)) + +(def print-right-margin + (sci/new-dynamic-var '*print-right-margin* pprint/*print-right-margin* {:ns pprint-ns})) + +(def print-pprint-dispatch + (sci/new-dynamic-var '*print-pprint-dispatch* pprint/*print-pprint-dispatch* {:ns pprint-ns})) (def new-write (fn [object & kw-args] @@ -45,10 +56,8 @@ (if (nil? optval) (.toString ^java.io.StringWriter base-writer)))))))) -(alter-var-root #'pprint/write (constantly new-write)) - -(def pprint-ns (sci/create-ns 'clojure.pprint nil)) - +(when-not @patched? + (alter-var-root #'pprint/write (constantly new-write))) (defn print-table "Prints a collection of maps in a textual table. Prints table headings @@ -59,11 +68,19 @@ (binding [*out* @sci/out] (pprint/print-table ks rows)))) -(def print-right-margin - (sci/new-dynamic-var '*print-right-margin* pprint/*print-right-margin* {:ns pprint-ns})) - -(def print-pprint-dispatch - (sci/new-dynamic-var '*print-pprint-dispatch* pprint/*print-pprint-dispatch* {:ns pprint-ns})) +(defmacro formatter-out + "Makes a function which can directly run format-in. The function is + fn [& args] ... and returns nil. This version of the formatter macro is + designed to be used with *out* set to an appropriate Writer. In particular, + this is meant to be used as part of a pretty printer dispatch method. + format-in can be either a control string or a previously compiled format." + {:added "1.2"} + [format-in] + `(let [format-in# ~format-in + cf# (if (string? format-in#) (#'clojure.pprint/cached-compile format-in#) format-in#)] + (fn [& args#] + (let [navigator# (#'clojure.pprint/init-navigator args#)] + (#'clojure.pprint/execute-format cf# navigator#))))) (defn pprint "Pretty print object to the optional output writer. If the writer is not provided, @@ -72,22 +89,59 @@ (pprint s @sci/out)) ([s writer] (binding [pprint/*print-right-margin* @print-right-margin - #_#_pprint/*print-pprint-dispatch* @print-pprint-dispatch] + pprint/*print-pprint-dispatch* @print-pprint-dispatch] (pprint/pprint s writer)))) +(defn cl-format + "An implementation of a Common Lisp compatible format function. cl-format formats its +arguments to an output stream or string based on the format control string given. It +supports sophisticated formatting of structured data. +Writer is an instance of java.io.Writer, true to output to *out* or nil to output +to a string, format-in is the format control string and the remaining arguments +are the data to be formatted. +The format control string is a string to be output with embedded 'format directives' +describing how to format the various arguments passed in. +If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format +returns nil. +For example: + (let [results [46 38 22]] + (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" + (count results) results)) +Prints to *out*: + There are 3 results: 46, 38, 22 +Detailed documentation on format control strings is available in the \"Common Lisp the +Language, 2nd edition\", Chapter 22 (available online at: +http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) +and in the Common Lisp HyperSpec at +http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm +" + [& args] + ;; bind *out* to sci/out, so with-out-str works + (binding [*out* @sci/out] + (apply pprint/cl-format args))) + +(defn execute-format + "We need to bind sci/out to *out* so all calls to clojure.core/print are directed + to the writer bound to *out* by the cl-format logic." + [& args] + (sci/binding [sci/out *out*] + (apply #'pprint/execute-format args))) + (def pprint-namespace {'pp (sci/copy-var pprint/pp pprint-ns) 'pprint (sci/copy-var pprint pprint-ns) 'print-table (sci/copy-var print-table pprint-ns) '*print-right-margin* print-right-margin - 'cl-format (sci/copy-var pprint/cl-format pprint-ns) + 'cl-format (sci/copy-var cl-format pprint-ns) ;; we alter-var-root-ed write above, so this should copy the right function 'write (sci/copy-var pprint/write pprint-ns) 'simple-dispatch (sci/copy-var pprint/simple-dispatch pprint-ns) - ;; 'formatter-out (sci/copy-var pprint/formatter-out pprint-ns) - ;; 'cached-compile (sci/copy-var pprint/cached-compile pprint-ns) #_(sci/new-var 'cache-compile @#'pprint/cached-compile (meta @#'pprint/cached-compile)) - ;; 'init-navigator (sci/copy-var pprint/init-navigator pprint-ns) - ;; 'execute-format (sci/copy-var pprint/execute-format pprint-ns) - ;; 'with-pprint-dispatch (sci/copy-var pprint/with-pprint-dispatch pprint-ns) - ;; '*print-pprint-dispatch* print-pprint-dispatch + 'formatter-out (sci/copy-var formatter-out pprint-ns) + 'cached-compile (sci/copy-var pprint/cached-compile pprint-ns) #_(sci/new-var 'cache-compile @#'pprint/cached-compile (meta @#'pprint/cached-compile)) + 'init-navigator (sci/copy-var pprint/init-navigator pprint-ns) + 'execute-format (sci/copy-var execute-format pprint-ns) + 'with-pprint-dispatch (sci/copy-var pprint/with-pprint-dispatch pprint-ns) + '*print-pprint-dispatch* print-pprint-dispatch }) + +(vreset! patched? true) diff --git a/test/babashka/main_test.clj b/test/babashka/main_test.clj index 63e4da43..ead8de87 100644 --- a/test/babashka/main_test.clj +++ b/test/babashka/main_test.clj @@ -12,10 +12,11 @@ [sci.core :as sci])) (defn bb [input & args] - (edn/read-string - {:readers *data-readers* - :eof nil} - (apply test-utils/bb (when (some? input) (str input)) (map str args)))) + (test-utils/normalize + (edn/read-string + {:readers *data-readers* + :eof nil} + (apply test-utils/bb (when (some? input) (str input)) (map str args))))) (deftest parse-opts-test (is (= "1667" @@ -170,20 +171,18 @@ (defn foo [x y] (+ x y))" name)) (is (= "(defn foo [x y]\n (+ x y))\n" - (test-utils/normalize - (bb nil (format " + (bb nil (format " (load-file \"%s\") (require '[clojure.repl :refer [source]]) (with-out-str (source %s/foo))" - (test-utils/escape-file-paths (.getPath tmp)) - name)))))) + (test-utils/escape-file-paths (.getPath tmp)) + name))))) (testing "print source from file on classpath" (is (= "(defn foo [x y]\n (+ x y))\n" - (test-utils/normalize - (bb nil - "-cp" dir - "-e" (format "(require '[clojure.repl :refer [source]] '[%s])" name) - "-e" (format "(with-out-str (source %s/foo))" name)))))))) + (bb nil + "-cp" dir + "-e" (format "(require '[clojure.repl :refer [source]] '[%s])" name) + "-e" (format "(with-out-str (source %s/foo))" name))))))) (deftest eval-test (is (= "120\n" (test-utils/bb nil "(eval '(do (defn foo [x y] (+ x y)) @@ -452,17 +451,28 @@ (is (string? (bb nil "(let [sw (java.io.StringWriter.)] (clojure.pprint/pprint (range 10) sw) (str sw))")))) (testing "*print-right-margin*" (is (= "(0\n 1\n 2\n 3\n 4\n 5\n 6\n 7\n 8\n 9)\n" - (test-utils/normalize (bb nil " + (bb nil " (let [sw (java.io.StringWriter.)] (binding [clojure.pprint/*print-right-margin* 5] - (clojure.pprint/pprint (range 10) sw)) (str sw))")))) + (clojure.pprint/pprint (range 10) sw)) (str sw))"))) (is (= "(0 1 2 3 4 5 6 7 8 9)\n" - (test-utils/normalize (bb nil " + (bb nil " (let [sw (java.io.StringWriter.)] (binding [clojure.pprint/*print-right-margin* 50] - (clojure.pprint/pprint (range 10) sw)) (str sw))"))))) + (clojure.pprint/pprint (range 10) sw)) (str sw))")))) (testing "print-table writes to sci/out" - (is (str/includes? (test-utils/bb "(with-out-str (clojure.pprint/print-table [{:a 1} {:a 2}]))") "----")))) + (is (str/includes? (test-utils/bb "(with-out-str (clojure.pprint/print-table [{:a 1} {:a 2}]))") "----"))) + (testing "cl-format writes to sci/out" + (is (= "[1, 2, 3]" (bb nil "(with-out-str (clojure.pprint/cl-format true \"~<[~;~@{~w~^, ~:_~}~;]~:>\" [1,2,3]))")))) + (testing "formatter-out" + (is (= "[1, 2, 3]\n" + (bb nil (pr-str '(do (require '[clojure.pprint :as pprint]) + (def print-array (pprint/formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>")) + (pprint/with-pprint-dispatch + #(if (seqable? %) + (print-array %) + (print %)) + (with-out-str (pprint/pprint [1 2 3])))))))))) (deftest read-string-test (testing "namespaced keyword via alias"