From 61b7ad1e50186544567f99f4750826227d7422a2 Mon Sep 17 00:00:00 2001 From: Stuart Sierra Date: Tue, 24 Aug 2010 17:45:54 -0400 Subject: Omit Clojure files from complete 'uberjar' --- modules/complete/pom.xml | 7 ++++--- modules/complete/src/main/assemblies/bin.xml | 17 +++++++++++++++++ 2 files changed, 21 insertions(+), 3 deletions(-) create mode 100644 modules/complete/src/main/assemblies/bin.xml diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index d0eedfe0..624d84fb 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -11,15 +11,16 @@ ../parent complete + pom maven-assembly-plugin 2.2-beta-5 - - jar-with-dependencies - + + src/main/assemblies/bin.xml + diff --git a/modules/complete/src/main/assemblies/bin.xml b/modules/complete/src/main/assemblies/bin.xml new file mode 100644 index 00000000..607ac863 --- /dev/null +++ b/modules/complete/src/main/assemblies/bin.xml @@ -0,0 +1,17 @@ + + bin + + jar + + false + + + true + + org.clojure:clojure + + + + \ No newline at end of file -- cgit v1.2.3-18-g5258 From 28689c48fa35c34023360aa2724b47ee1eb14e4e Mon Sep 17 00:00:00 2001 From: Stuart Sierra Date: Wed, 25 Aug 2010 12:39:44 -0400 Subject: Update links in README --- README.txt | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/README.txt b/README.txt index 2753e4b8..3353397f 100644 --- a/README.txt +++ b/README.txt @@ -1,20 +1,20 @@ = Clojure-contrib = -The user contributions library, clojure.contrib, is a collection of -namespaces each of which implements features that we believe may be -useful to a large part of the Clojure community. +The user contributions library, clojure-contrib, is a collection of +namespaces implementing features that may be useful to a large part of +the Clojure community. Clojure-contrib is open source under the Eclipse Public License and is copyrighted by Rich Hickey and the various contributors. Download releases from -http://code.google.com/p/clojure-contrib/downloads +http://clojure.org/downloads The official source repository for clojure-contrib is -http://github.com/richhickey/clojure-contrib +http://github.com/clojure/clojure-contrib Documentation and APIs are available at -http://richhickey.github.com/clojure-contrib/ +http://clojure.github.com/clojure-contrib/ Issues are maintained in the Assembla space at http://www.assembla.com/spaces/clojure-contrib @@ -24,8 +24,9 @@ http://groups.google.com/group/clojure and developer discussions are in the Clojure Dev Google group at http://groups.google.com/group/clojure-dev -Compiled JARs of development snapshots are available at -http://build.clojure.org/ +Compiled JARs of released versions are available in the Maven +repository http://build.clojure.org/releases and SNAPSHOT versions are +available at http://build.clojure.org/snapshots -- cgit v1.2.3-18-g5258 From 636381148b53424c0ea98f5983a2d1574451c6ee Mon Sep 17 00:00:00 2001 From: Matt Clark Date: Thu, 26 Aug 2010 21:28:34 -0300 Subject: Added :pre to functions instead of using custom assert-args macro in c.c.mock Cleaned up c.c.mock documentation Removed map? preconditions on mock functions which was causing tests to fail updated copyright notices for mock improved mock namespace description Fixed line endings which were erroneously CRLF instead of LF --- .../mock/src/main/clojure/clojure/contrib/mock.clj | 561 ++++++++++----------- .../clojure/clojure/contrib/mock/test_adapter.clj | 40 ++ .../clojure/clojure/contrib/mock/test_adapter.clj | 52 +- 3 files changed, 332 insertions(+), 321 deletions(-) create mode 100644 modules/mock/src/main/clojure/clojure/contrib/mock/test_adapter.clj diff --git a/modules/mock/src/main/clojure/clojure/contrib/mock.clj b/modules/mock/src/main/clojure/clojure/contrib/mock.clj index aaa36a8c..4953cd94 100644 --- a/modules/mock/src/main/clojure/clojure/contrib/mock.clj +++ b/modules/mock/src/main/clojure/clojure/contrib/mock.clj @@ -1,285 +1,276 @@ -;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure - -;; by Matt Clark - -;; Copyright (c) Matt Clark, 2009. 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). -;; 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. -;;------------------------------------------------------------------------------ - -(comment - ;; This is a simple function mocking library I accidentally wrote as a side - ;; effect of trying to write an opengl library in clojure. This is loosely - ;; based on various ruby and java mocking frameworks I have used in the past - ;; such as mockito, easymock, and whatever rspec uses. - ;; - ;; expect uses bindings to wrap the functions that are being tested and - ;; then validates the invocation count at the end. The expect macro is the - ;; main entry point and it is given a vector of binding pairs. - ;; The first of each pair names the dependent function you want to override, - ;; while the second is a hashmap containing the mock description, usually - ;; created via the simple helper methods described below. - ;; - ;; Usage: - ;; - ;; there are one or more dependent functions: - - (defn dep-fn1 [] "time consuming calculation in 3rd party library") - (defn dep-fn2 [x] "function with undesirable side effects while testing") - - ;; then we have the code under test that calls these other functions: - - (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2)) - - ;; to test this code, we simply surround it with an expect macro within - ;; the test: - - (expect [dep-fn1 (times 1) - dep-fn2 (times 1 (has-args [#(= "a" %)]))] - (my-code-under-test)) - - ;; When an expectation fails during execution of the function under test, - ;; an error condition function is called with the name of the function - ;; being mocked, the expected form and the actual value. These - ;; error functions can be overridden to allow easy integration into - ;; test frameworks such as test-is by reporting errors in the function - ;; overrides. - - ) ;; end comment - -(ns clojure.contrib.mock - ^{:author "Matt Clark", - :doc "function mocking/expectations for Clojure" } - (:use [clojure.contrib.seq :only (positions)] - [clojure.contrib.def :only (defmacro-)])) - - -;;------------------------------------------------------------------------------ -;; These are the error condition functions. Override them to integrate into -;; the test framework of your choice, or to simply customize error handling. - -(defn report-problem - {:dynamic true} - ([function expected actual] - (report-problem function expected actual "Expectation not met.")) - ([function expected actual message] - (prn (str message " Function name: " function - " expected: " expected " actual: " actual)))) - -(defn no-matching-function-signature - {:dynamic true} - [function expected actual] - (report-problem function expected actual - "No matching real function signature for given argument count.")) - -(defn unexpected-args - {:dynamic true} - [function expected actual i] - (report-problem function expected actual - (str "Argument " i " has an unexpected value for function."))) - -(defn incorrect-invocation-count - {:dynamic true} - [function expected actual] - (report-problem function expected actual "Unexpected invocation count.")) - - -;;------------------------------------------------------------------------------ -;; Internal Functions - ignore these - - -(defn- has-arg-count-match? - "Given the sequence of accepted argument vectors for a function, -returns true if at least one matches the given-count value." - [arg-lists given-count] - (some #(let [[ind] (positions #{'&} %)] - (if ind - (>= given-count ind) - (= (count %) given-count))) - arg-lists)) - - -(defn has-matching-signature? - "Calls no-matching-function-signature if no match is found for the given -function. If no argslist meta data is available for the function, it is -not called." - [fn-name args] - (let [arg-count (count args) - arg-lists (:arglists (meta (resolve fn-name)))] - (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count))) - (no-matching-function-signature fn-name arg-lists args)))) - - -(defn make-arg-checker - "Creates the argument verifying function for a replaced dependency within -the expectation bound scope. These functions take the additional argument -of the name of the replaced function, then the rest of their args. It is -designed to be called from the mock function generated in the first argument -of the mock info object created by make-mock." - [arg-preds arg-pred-forms] - (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)] - (fn [fn-name & args] - (every? true? - (map (fn [pred arg pred-form i] (if (pred arg) true - (unexpected-args fn-name pred-form arg i))) - sanitized-preds args arg-pred-forms (iterate inc 0)))))) - - -(defn make-count-checker - "creates the count checker that is invoked at the end of an expectation, after -the code under test has all been executed. The function returned takes the -name of the associated dependency and the invocation count as arguments." - [pred pred-form] - (let [pred-fn (if (integer? pred) #(= pred %) pred)] - (fn [fn-name v] (if (pred-fn v) true - (incorrect-invocation-count fn-name pred-form v))))) - -; Borrowed from clojure core. Remove if this ever becomes public there. -(defmacro- assert-args - [fnname & pairs] - `(do (when-not ~(first pairs) - (throw (IllegalArgumentException. - ~(str fnname " requires " (second pairs))))) - ~(let [more (nnext pairs)] - (when more - (list* `assert-args fnname more))))) - -(defn make-mock - "creates a vector containing the following information for the named function: -1. dependent function replacement - verifies signature, calls arg checker, -increases count, returns return value. -2. an atom containing the invocation count -3. the invocation count checker function -4. a symbol of the name of the function being replaced." - [fn-name expectation-hash] - (assert-args make-mock - (map? expectation-hash) "a map of expectations") - (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true)) - count-atom (atom 0) - ret-fn (or - (expectation-hash :calls) - (fn [& args] (expectation-hash :returns)))] - [(fn [& args] - (has-matching-signature? fn-name args) - (apply arg-checker fn-name args) - (swap! count-atom inc) - (apply ret-fn args)) - count-atom - (or (expectation-hash :times) (fn [fn-name v] true)) - fn-name])) - - -(defn validate-counts - "given the sequence of all mock data for the expectation, simply calls the -count checker for each dependency." - [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i))) - -(defn ^{:private true} make-bindings [expect-bindings mock-data-sym] - `[~@(interleave (map #(first %) (partition 2 expect-bindings)) - (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0)) - (range (quot (count expect-bindings) 2))))]) - - -;;------------------------------------------------------------------------------ -;; These are convenience functions to improve the readability and use of this -;; library. Useful in expressions such as: -;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc) - -(defn once [x] (= 1 x)) - -(defn never [x] (zero? x)) - -(defn more-than [x] #(< x %)) - -(defn less-than [x] #(> x %)) - -(defn between [x y] #(and (< x %) (> y %))) - - -;;------------------------------------------------------------------------------ -;; The following functions can be used to build up the expectation hash. - -(defn returns - "Creates or associates to an existing expectation hash the :returns key with -a value to be returned by the expectation after a successful invocation -matching its expected arguments (if applicable). -Usage: -(returns ret-value expectation-hash?)" - - ([val] (returns val {})) - ([val expectation-hash] (assoc expectation-hash :returns val))) - - -(defn calls - "Creates or associates to an existing expectation hash the :calls key with a -function that will be called with the given arguments. The return value from -this function will be returned returned by the expected function. If both this -and returns are specified, the return value of \"calls\" will have precedence. -Usage: -(calls some-fn expectation-hash?)" - - ([val] (calls val {})) - ([val expectation-hash] (assoc expectation-hash :calls val))) - - -(defmacro has-args - "Creates or associates to an existing expectation hash the :has-args key with -a value corresponding to a function that will either return true if its -argument expectations are met or throw an exception with the details of the -first failed argument it encounters. -Only specify as many predicates as you are interested in verifying. The rest -of the values are safely ignored. -Usage: -(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)" - - ([arg-pred-forms] `(has-args ~arg-pred-forms {})) - ([arg-pred-forms expect-hash-form] - (assert-args has-args - (vector? arg-pred-forms) "a vector of argument predicates") - `(assoc ~expect-hash-form :has-args - (make-arg-checker ~arg-pred-forms '~arg-pred-forms)))) - - -(defmacro times - "Creates or associates to an existing expectation hash the :times key with a -value corresponding to a predicate function which expects an integer value. -This function can either be specified as the first argument to times or can be -the result of calling times with an integer argument, in which case the -predicate will default to being an exact match. This predicate is called at -the end of an expect expression to validate that an expected dependency -function was called the expected number of times. -Usage: -(times n) -(times #(> n %)) -(times n expectation-hash)" - ([times-fn] `(times ~times-fn {})) - ([times-fn expectation-hash] - `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn)))) - - -;------------------------------------------------------------------------------- -; The main expect macro. -(defmacro expect - "Use expect to redirect calls to dependent functions that are made within the -code under test. Instead of calling the functions that would normally be used, -temporary stubs are used, which can verify function parameters and call counts. -Return values can also be specified as needed. -Usage: -(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))] - (function-under-test a b c))" - - [expect-bindings & body] - (assert-args expect - (vector? expect-bindings) "a vector of expectation bindings" - (even? (count expect-bindings)) - "an even number of forms in expectation bindings") - (let [mock-data (gensym "mock-data_")] - `(let [~mock-data (map (fn [args#] - (apply clojure.contrib.mock/make-mock args#)) - ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m)) - (partition 2 expect-bindings))))] - (binding ~(make-bindings expect-bindings mock-data) ~@body) - (clojure.contrib.mock/validate-counts ~mock-data) true))) +;;; clojure.contrib.mock.clj: mocking/expectation framework for Clojure + +;; by Matt Clark + +;; Copyright (c) Matt Clark, 2009, 2010. 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. +;;------------------------------------------------------------------------------ + +(comment + ;; Mock uses bindings to wrap the functions that are being tested and + ;; then validates the invocation count at the end. The expect macro is the + ;; main entry point and it is given a vector of binding pairs. + ;; The first of each pair names the dependent function you want to override + ;; while the second is a hashmap containing the mock description, usually + ;; created via the simple helper methods described below. + ;; + ;; Usage: + ;; + ;; there are one or more dependent functions: + + (defn dep-fn1 [] "time consuming calculation in 3rd party library") + (defn dep-fn2 [x] "function with undesirable side effects while testing") + + ;; then we have the code under test that calls these other functions: + + (defn my-code-under-test [] (dep-fn1) (dep-fn2 "a") (+ 2 2)) + + ;; to test this code, we simply surround it with an expect macro within + ;; the test: + + (expect [dep-fn1 (times 1) + dep-fn2 (times 1 (has-args [#(= "a" %)]))] + (my-code-under-test)) + + ;; When an expectation fails during execution of the function under test + ;; an error condition function is called with the name of the function + ;; being mocked, the expected form and the actual value. These + ;; error functions can be overridden to allow easy integration into + ;; test frameworks such as test-is by reporting errors in the function + ;; overrides. + + ) ;; end comment + +(ns clojure.contrib.mock + ^{:author "Matt Clark" + :doc "Mock is a function mocking utility inspired by the various ruby and +java mocking frameworks such as mockito, easymock, and rspec yet designed to +fit the functional style of clojure."} + (:use [clojure.contrib.seq :only (positions)])) + + +;;------------------------------------------------------------------------------ +;; These are the error condition functions. Override them to integrate into +;; the test framework of your choice, or to simply customize error handling. + +(defn report-problem + {:dynamic true} + ([function expected actual] + (report-problem function expected actual "Expectation not met.")) + ([function expected actual message] + (prn (str message " Function name: " function + " expected: " expected " actual: " actual)))) + +(defn no-matching-function-signature + {:dynamic true} + [function expected actual] + (report-problem function expected actual + "No matching real function signature for given argument count.")) + +(defn unexpected-args + {:dynamic true} + [function expected actual i] + (report-problem function expected actual + (str "Argument " i " has an unexpected value for function."))) + +(defn incorrect-invocation-count + {:dynamic true} + [function expected actual] + (report-problem function expected actual "Unexpected invocation count.")) + + +;;------------------------------------------------------------------------------ +;; Internal Functions - ignore these + + +(defn- has-arg-count-match? + "Given the sequence of accepted argument vectors for a function +returns true if at least one matches the given-count value." + [arg-lists given-count] + (some #(let [[ind] (positions #{'&} %)] + (if ind + (>= given-count ind) + (= (count %) given-count))) + arg-lists)) + + +(defn has-matching-signature? + "Calls no-matching-function-signature if no match is found for the given +function. If no argslist meta data is available for the function, it is +not called." + [fn-name args] + (let [arg-count (count args) + arg-lists (:arglists (meta (resolve fn-name)))] + (if (and arg-lists (not (has-arg-count-match? arg-lists arg-count))) + (no-matching-function-signature fn-name arg-lists args)))) + + +(defn make-arg-checker + "Creates the argument verifying function for a replaced dependency within +the expectation bound scope. These functions take the additional argument +of the name of the replaced function, then the rest of their args. It is +designed to be called from the mock function generated in the first argument +of the mock info object created by make-mock." + [arg-preds arg-pred-forms] + (let [sanitized-preds (map (fn [v] (if (fn? v) v #(= v %))) arg-preds)] + (fn [fn-name & args] + (every? true? + (map (fn [pred arg pred-form i] (if (pred arg) true + (unexpected-args fn-name + pred-form arg i))) + sanitized-preds args arg-pred-forms (iterate inc 0)))))) + + +(defn make-count-checker + "creates the count checker that is invoked at the end of an expectation, after +the code under test has all been executed. The function returned takes the +name of the associated dependency and the invocation count as arguments." + [pred pred-form] + (let [pred-fn (if (integer? pred) #(= pred %) pred)] + (fn [fn-name v] (if (pred-fn v) true + (incorrect-invocation-count fn-name pred-form v))))) + +(defn make-mock + "creates a vector containing the following information for the named function: +1. dependent function replacement - verifies signature, calls arg checker +increases count, returns return value. +2. an atom containing the invocation count +3. the invocation count checker function +4. a symbol of the name of the function being replaced." + [fn-name expectation-hash] + {:pre [(map? expectation-hash) + (symbol? fn-name)]} + (let [arg-checker (or (expectation-hash :has-args) (fn [& args] true)) + count-atom (atom 0) + ret-fn (or + (expectation-hash :calls) + (fn [& args] (expectation-hash :returns)))] + [(fn [& args] + (has-matching-signature? fn-name args) + (apply arg-checker fn-name args) + (swap! count-atom inc) + (apply ret-fn args)) + count-atom + (or (expectation-hash :times) (fn [fn-name v] true)) + fn-name])) + + +(defn validate-counts + "given the sequence of all mock data for the expectation, simply calls the +count checker for each dependency." + [mock-data] (doseq [[mfn i checker fn-name] mock-data] (checker fn-name @i))) + +(defn- make-bindings [expect-bindings mock-data-sym] + `[~@(interleave (map #(first %) (partition 2 expect-bindings)) + (map (fn [i] `(nth (nth ~mock-data-sym ~i) 0)) + (range (quot (count expect-bindings) 2))))]) + + +;;------------------------------------------------------------------------------ +;; These are convenience functions to improve the readability and use of this +;; library. Useful in expressions such as: +;; (expect [dep-fn1 (times (more-than 1) (returns 15)) etc) + +;; best used in the times function +(defn once [x] (= 1 x)) + +(defn never [x] (zero? x)) + +(defn more-than [x] #(< x %)) + +(defn less-than [x] #(> x %)) + +(defn between [x y] #(and (< x %) (> y %))) + +;;best used in the has-args function +(defn anything [x] true) + + +;;------------------------------------------------------------------------------ +;; The following functions can be used to build up the expectation hash. + +(defn returns + "Creates or associates to an existing expectation hash the :returns key with +a value to be returned by the expectation after a successful invocation +matching its expected arguments (if applicable). +Usage: +(returns ret-value expectation-hash?)" + + ([val] (returns val {})) + ([val expectation-hash] + (assoc expectation-hash :returns val))) + + +(defn calls + "Creates or associates to an existing expectation hash the :calls key with a +function that will be called with the given arguments. The return value from +this function will be returned by the expected function. If both this +and :returns are specified, the return value of :calls will have precedence. +Usage: +(calls some-fn expectation-hash?)" + + ([val] (calls val {})) + ([val expectation-hash] + {:pre [(fn? val)]} + (assoc expectation-hash :calls val))) + + +(defmacro has-args + "Creates or associates to an existing expectation hash the :has-args key with +a value corresponding to a function that will either return true if its +argument expectations are met or throw an exception with the details of the +first failed argument it encounters. +Only specify as many predicates as you are interested in verifying. The rest +of the values are safely ignored. +Usage: +(has-args [arg-pred-1 arg-pred-2 ... arg-pred-n] expectation-hash?)" + + ([arg-pred-forms] `(has-args ~arg-pred-forms {})) + ([arg-pred-forms expectation-hash] + {:pre [(vector? arg-pred-forms)]} + `(assoc ~expectation-hash :has-args + (make-arg-checker ~arg-pred-forms '~arg-pred-forms)))) + + +(defmacro times + "Creates or associates to an existing expectation hash the :times key with a +value corresponding to a predicate function which expects an integer value. +Also, an integer can be specified, in which case the times will only be an +exact match. The times check is called at the end of an expect expression to +validate that an expected dependency function was called the expected +number of times. +Usage: +(times n) +(times #(> n %)) +(times n expectation-hash)" + ([times-fn] `(times ~times-fn {})) + ([times-fn expectation-hash] + `(assoc ~expectation-hash :times (make-count-checker ~times-fn '~times-fn)))) + + +;------------------------------------------------------------------------------- +; The main expect macro. +(defmacro expect + "Use expect to redirect calls to dependent functions that are made within the +code under test. Instead of calling the functions that would normally be used +temporary stubs are used, which can verify function parameters and call counts. +Return values of overridden functions can also be specified as needed. +Usage: +(expect [dep-fn (has-args [arg-pred1] (times n (returns x)))] + (function-under-test a b c))" + + [expect-bindings & body] + {:pre [(vector? expect-bindings) + (even? (count expect-bindings))]} + (let [mock-data (gensym "mock-data_")] + `(let [~mock-data (map (fn [args#] + (apply clojure.contrib.mock/make-mock args#)) + ~(cons 'list (map (fn [[n m]] (vector (list 'quote n) m)) + (partition 2 expect-bindings))))] + (binding ~(make-bindings expect-bindings mock-data) ~@body) + (clojure.contrib.mock/validate-counts ~mock-data) true))) diff --git a/modules/mock/src/main/clojure/clojure/contrib/mock/test_adapter.clj b/modules/mock/src/main/clojure/clojure/contrib/mock/test_adapter.clj new file mode 100644 index 00000000..fc0c0c0b --- /dev/null +++ b/modules/mock/src/main/clojure/clojure/contrib/mock/test_adapter.clj @@ -0,0 +1,40 @@ +;;; test_adapter.clj: clojure.test adapter for mocking/expectation +;;; framework for Clojure + +;; by Matt Clark + +;; Copyright (c) Matt Clark, 2009, 2010. 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. + +(ns clojure.contrib.mock.test-adapter + #^{:author "Matt Clark", + :doc "an adapter namespace to enable clojure.contrib.mock to + report problems via clojure.test." } + (:require [clojure.contrib.mock :as mock]) + (:use clojure.test + clojure.contrib.ns-utils)) + +(immigrate 'clojure.contrib.mock) + +(defn report-problem + "This function is designed to be used in a binding macro to override +the report-problem function in clojure.contrib.mock. Instead of printing +the error to the console, the error is logged via clojure.test." + {:dynamic true} + [fn-name expected actual msg] + (report {:type :fail, + :message (str msg " Function name: " fn-name), + :expected expected, + :actual actual})) + + +(defmacro expect [& body] + "Use this macro instead of the standard c.c.mock expect macro to have +failures reported through clojure.test." + `(binding [mock/report-problem report-problem] + (mock/expect ~@body))) diff --git a/modules/mock/src/test/clojure/clojure/contrib/mock/test_adapter.clj b/modules/mock/src/test/clojure/clojure/contrib/mock/test_adapter.clj index 466cb537..5f21ce11 100644 --- a/modules/mock/src/test/clojure/clojure/contrib/mock/test_adapter.clj +++ b/modules/mock/src/test/clojure/clojure/contrib/mock/test_adapter.clj @@ -1,38 +1,18 @@ -;;; test_adapter.clj: clojure.test adapter for mocking/expectation framework for Clojure - -;; by Matt Clark - -;; Copyright (c) Matt Clark, 2009. 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). -;; 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. - -(ns clojure.contrib.mock.test-adapter - (:require [clojure.contrib.mock :as mock]) - (:use clojure.test - clojure.contrib.ns-utils)) - -(immigrate 'clojure.contrib.mock) - -(defn report-problem - "This function is designed to be used in a binding macro to override -the report-problem function in clojure.contrib.mock. Instead of printing -the error to the console, the error is logged via clojure.test." - {:dynamic true} - [fn-name expected actual msg] - (report {:type :fail, - :message (str msg " Function name: " fn-name), - :expected expected, - :actual actual})) - - -(defmacro expect [& body] - "Use this macro instead of the standard c.c.mock expect macro to have -failures reported through clojure.test." - `(binding [mock/report-problem report-problem] - (mock/expect ~@body))) - +(ns clojure.contrib.test-contrib.mock-test.test-adapter-test + (:use clojure.contrib.mock.test-adapter + [clojure.contrib.test-contrib.mock-test :only (assert-called)] + clojure.test)) + +(deftest test-report-problem-called + (def #^{:private true :dynamic true} fn1 (fn [x] "dummy code")) + (def #^{:private true :dynamic true} fn2 (fn [x y] "dummy code2")) + (let [under-test (fn [x] (fn1 x))] + (assert-called clojure.contrib.mock.test-adapter/report-problem + true (expect [fn1 (times 5)] (under-test "hi"))))) + +(deftest test-is-report-called + (assert-called clojure.test/report true + (clojure.contrib.mock.test-adapter/report-problem + 'fn-name 5 6 "fake problem"))) -- cgit v1.2.3-18-g5258 From a5e611beb358b518d86d7c4c9aef5261fee078b7 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Mon, 23 Aug 2010 21:33:59 +0200 Subject: gen-html-docs needs clojure.contrib.def Signed-off-by: Stuart Sierra --- modules/gen-html-docs/pom.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/modules/gen-html-docs/pom.xml b/modules/gen-html-docs/pom.xml index 96d4e8a4..d9561557 100644 --- a/modules/gen-html-docs/pom.xml +++ b/modules/gen-html-docs/pom.xml @@ -32,5 +32,10 @@ prxml 1.3.0-SNAPSHOT + + org.clojure.contrib + def + 1.3.0-SNAPSHOT + -- cgit v1.2.3-18-g5258 From 6321145ba58dc4773b8c866abecc49180dfe5309 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Mon, 23 Aug 2010 20:30:51 +0200 Subject: remove derecated clojure.contrib.apply-macro Signed-off-by: Stuart Sierra --- modules/apply-macro/pom.xml | 16 -------- .../main/clojure/clojure/contrib/apply_macro.clj | 45 ---------------------- modules/complete/pom.xml | 5 --- .../main/clojure/clojure/contrib/gen_html_docs.clj | 1 - pom.xml | 1 - 5 files changed, 68 deletions(-) delete mode 100644 modules/apply-macro/pom.xml delete mode 100644 modules/apply-macro/src/main/clojure/clojure/contrib/apply_macro.clj diff --git a/modules/apply-macro/pom.xml b/modules/apply-macro/pom.xml deleted file mode 100644 index 23048791..00000000 --- a/modules/apply-macro/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - apply-macro - - - \ No newline at end of file diff --git a/modules/apply-macro/src/main/clojure/clojure/contrib/apply_macro.clj b/modules/apply-macro/src/main/clojure/clojure/contrib/apply_macro.clj deleted file mode 100644 index 9df85407..00000000 --- a/modules/apply-macro/src/main/clojure/clojure/contrib/apply_macro.clj +++ /dev/null @@ -1,45 +0,0 @@ -;;; apply_macro.clj: make macros behave like functions - -;; by Stuart Sierra, http://stuartsierra.com/ -;; January 28, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - - -;; Don't use this. I mean it. It's evil. How evil? You can't -;; handle it, that's how evil it is. That's right. I did it so you -;; don't have to, ok? Look but don't touch. Use this lib and you'll -;; go blind. - -;; DEPRECATED in 1.2 with no replacement. - -(ns ^{:deprecated "1.2"} - clojure.contrib.apply-macro) - -;; Copied from clojure.core/spread, which is private. -(defn- spread - "Flatten final argument list as in apply." - [arglist] - (cond - (nil? arglist) nil - (nil? (rest arglist)) (seq (first arglist)) - :else (cons (first arglist) (spread (rest arglist))))) - -(defmacro apply-macro - "This is evil. Don't ever use it. It makes a macro behave like a - function. Seriously, how messed up is that? - - Evaluates all args, then uses them as arguments to the macro as with - apply. - - (def things [true true false]) - (apply-macro and things) - ;; Expands to: (and true true false)" - [macro & args] - (cons macro (spread (map eval args)))) diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 624d84fb..d1c4bb9c 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -45,11 +45,6 @@ agent-utils 1.3.0-SNAPSHOT - - org.clojure.contrib - apply-macro - 1.3.0-SNAPSHOT - org.clojure.contrib base64 diff --git a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj index 73166510..466c3fb4 100644 --- a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj +++ b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj @@ -475,7 +475,6 @@ emits the generated HTML to the path named by path." 'clojure.zip 'clojure.xml 'clojure.contrib.accumulators - 'clojure.contrib.apply-macro 'clojure.contrib.auto-agent 'clojure.contrib.combinatorics 'clojure.contrib.command-line diff --git a/pom.xml b/pom.xml index ad38a1fa..4a1696d1 100644 --- a/pom.xml +++ b/pom.xml @@ -24,7 +24,6 @@ modules/accumulators modules/agent-utils - modules/apply-macro modules/base64 modules/classpath modules/combinatorics -- cgit v1.2.3-18-g5258 From 5160b58ea1a79e37a5225aea75b0319e561e589b Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Mon, 23 Aug 2010 20:42:40 +0200 Subject: remove deprecated clojure.contrib.http-agent Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/http-agent/pom.xml | 26 -- .../main/clojure/clojure/contrib/http/agent.clj | 386 --------------------- pom.xml | 1 - 4 files changed, 418 deletions(-) delete mode 100644 modules/http-agent/pom.xml delete mode 100644 modules/http-agent/src/main/clojure/clojure/contrib/http/agent.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index d1c4bb9c..be2440dc 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -150,11 +150,6 @@ greatest-least 1.3.0-SNAPSHOT - - org.clojure.contrib - http-agent - 1.3.0-SNAPSHOT - org.clojure.contrib http-connection diff --git a/modules/http-agent/pom.xml b/modules/http-agent/pom.xml deleted file mode 100644 index 4de1a63c..00000000 --- a/modules/http-agent/pom.xml +++ /dev/null @@ -1,26 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - http-agent - - - org.clojure.contrib - http-connection - 1.3.0-SNAPSHOT - - - org.clojure.contrib - io - 1.3.0-SNAPSHOT - - - \ No newline at end of file diff --git a/modules/http-agent/src/main/clojure/clojure/contrib/http/agent.clj b/modules/http-agent/src/main/clojure/clojure/contrib/http/agent.clj deleted file mode 100644 index a42431f6..00000000 --- a/modules/http-agent/src/main/clojure/clojure/contrib/http/agent.clj +++ /dev/null @@ -1,386 +0,0 @@ -;;; http/agent.clj: agent-based asynchronous HTTP client - -;; by Stuart Sierra, http://stuartsierra.com/ -;; August 17, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - -;; DEPRECATED IN 1.2. Use direct Java bits, or take a look at -;; http://github.com/technomancy/clojure-http-client - -(ns ^{:deprecated "1.2" - :doc "Agent-based asynchronous HTTP client. - - This is a HTTP client library based on Java's HttpURLConnection - class and Clojure's Agent system. It allows you to make multiple - HTTP requests in parallel. - - Start an HTTP request with the 'http-agent' function, which - immediately returns a Clojure Agent. You will never deref this - agent; that is handled by the accessor functions. The agent will - execute the HTTP request on a separate thread. - - If you pass a :handler function to http-agent, that function will be - called as soon as the HTTP response body is ready. The handler - function is called with one argument, the HTTP agent itself. The - handler can read the response body by calling the 'stream' function - on the agent. - - The value returned by the handler function becomes part of the state - of the agent, and you can retrieve it with the 'result' function. - If you call 'result' before the HTTP request has finished, it will - block until the handler function returns. - - If you don't provide a handler function, the default handler will - buffer the entire response body in memory, which you can retrieve - with the 'bytes', 'string', or 'stream' functions. Like 'result', - these functions will block until the HTTP request is completed. - - If you want to check if an HTTP request is finished without - blocking, use the 'done?' function. - - A single GET request could be as simple as: - - (string (http-agent \"http://www.stuartsierra.com/\")) - - A simple POST might look like: - - (http-agent \"http...\" :method \"POST\" :body \"foo=1\") - - And you could write the response directly to a file like this: - - (require '[clojure.contrib.io :as d]) - - (http-agent \"http...\" - :handler (fn [agnt] - (with-open [w (d/writer \"/tmp/out\")] - (d/copy (stream agnt) w)))) -" - :author "Stuart Sierra" - } - - clojure.contrib.http.agent - (:refer-clojure :exclude [bytes]) - (:require [clojure.contrib.http.connection :as c] - [clojure.contrib.io :as duck]) - (:import (java.io InputStream ByteArrayOutputStream - ByteArrayInputStream) - (java.net HttpURLConnection))) - - -;;; PRIVATE - -(declare result stream) - -(defn- setup-http-connection - "Sets the instance method, redirect behavior, and request headers of - the HttpURLConnection." - [^HttpURLConnection conn options] - (when-let [t (:connect-timeout options)] - (.setConnectTimeout conn t)) - (when-let [t (:read-timeout options)] - (.setReadTimeout conn t)) - (.setRequestMethod conn (:method options)) - (.setInstanceFollowRedirects conn (:follow-redirects options)) - (doseq [[name value] (:headers options)] - (.setRequestProperty conn name value))) - -(defn- start-request - "Agent action that starts sending the HTTP request." - [state options] - (let [conn (::connection state)] - (setup-http-connection conn options) - (c/start-http-connection conn (:body options)) - (assoc state ::state ::started))) - -(defn- connection-success? [^HttpURLConnection conn] - "Returns true if the HttpURLConnection response code is in the 2xx - range." - (= 2 (quot (.getResponseCode conn) 100))) - -(defn- open-response - "Agent action that opens the response body stream on the HTTP - request; this will block until the response stream is available." ; - [state options] - (let [^HttpURLConnection conn (::connection state)] - (assoc state - ::response-stream (if (connection-success? conn) - (.getInputStream conn) - (.getErrorStream conn)) - ::state ::receiving))) - -(defn- handle-response - "Agent action that calls the provided handler function, with no - arguments, and sets the ::result key of the agent to the handler's - return value." - [state handler options] - (let [conn (::connection state)] - (assoc state - ::result (handler) - ::state ::finished))) - -(defn- disconnect - "Agent action that closes the response body stream and disconnects - the HttpURLConnection." - [state options] - (when (::response-stream state) - (.close ^InputStream (::response-stream state))) - (.disconnect ^HttpURLConnection (::connection state)) - (assoc state - ::response-stream nil - ::state ::disconnected)) - -(defn- status-in-range? - "Returns true if the response status of the HTTP agent begins with - digit, an Integer." - [digit http-agnt] - (= digit (quot (.getResponseCode - ^HttpURLConnection (::connection @http-agnt)) - 100))) - -(defn- ^ByteArrayOutputStream get-byte-buffer [http-agnt] - (let [buffer (result http-agnt)] - (if (instance? ByteArrayOutputStream buffer) - buffer - (throw (Exception. "Handler result was not a ByteArrayOutputStream"))))) - - -(defn buffer-bytes - "The default HTTP agent result handler; it collects the response - body in a java.io.ByteArrayOutputStream, which can later be - retrieved with the 'stream', 'string', and 'bytes' functions." - [http-agnt] - (let [output (ByteArrayOutputStream.)] - (duck/copy (or (stream http-agnt) "") output) - output)) - - -;;; CONSTRUCTOR - -(def *http-agent-defaults* - {:method "GET" - :headers {} - :body nil - :connect-timeout 0 - :read-timeout 0 - :follow-redirects true - :handler buffer-bytes}) - -(defn http-agent - "Creates (and immediately returns) an Agent representing an HTTP - request running in a new thread. - - options are key/value pairs: - - :method string - - The HTTP method name. Default is \"GET\". - - :headers h - - HTTP headers, as a Map or a sequence of pairs like - ([key1,value1], [key2,value2]) Default is nil. - - :body b - - HTTP request entity body, one of nil, String, byte[], InputStream, - Reader, or File. Default is nil. - - :connect-timeout int - - Timeout value, in milliseconds, when opening a connection to the - URL. Default is zero, meaning no timeout. - - :read-timeout int - - Timeout value, in milliseconds, when reading data from the - connection. Default is zero, meaning no timeout. - - :follow-redirects boolean - - If true, HTTP 3xx redirects will be followed automatically. Default - is true. - - :handler f - - Function to be called when the HTTP response body is ready. If you - do not provide a handler function, the default is to buffer the - entire response body in memory. - - The handler function will be called with the HTTP agent as its - argument, and can use the 'stream' function to read the response - body. The return value of this function will be stored in the state - of the agent and can be retrieved with the 'result' function. Any - exceptions thrown by this function will be added to the agent's - error queue (see agent-errors). The default function collects the - response stream in a memory buffer. - " - ([uri & options] - (let [opts (merge *http-agent-defaults* (apply array-map options))] - (let [a (agent {::connection (c/http-connection uri) - ::state ::created - ::uri uri - ::options opts})] - (send-off a start-request opts) - (send-off a open-response opts) - (send-off a handle-response (partial (:handler opts) a) opts) - (send-off a disconnect opts))))) - - -;;; RESPONSE BODY ACCESSORS - -(defn result - "Returns the value returned by the :handler function of the HTTP - agent; blocks until the HTTP request is completed. The default - handler function returns a ByteArrayOutputStream." - [http-agnt] - (await http-agnt) - (::result @http-agnt)) - -(defn stream - "Returns an InputStream of the HTTP response body. When called by - the handler function passed to http-agent, this is the raw - HttpURLConnection stream. - - If the default handler function was used, this function returns a - ByteArrayInputStream on the buffered response body." - [http-agnt] - (let [a @http-agnt] - (if (= (::state a) ::receiving) - (::response-stream a) - (ByteArrayInputStream. - (.toByteArray (get-byte-buffer http-agnt)))))) - -(defn bytes - "Returns a Java byte array of the content returned by the server; - nil if the content is not yet available." - [http-agnt] - (.toByteArray (get-byte-buffer http-agnt))) - -(defn string - "Returns the HTTP response body as a string, using the given - encoding. - - If no encoding is given, uses the encoding specified in the server - headers, or clojure.contrib.io/*default-encoding* if it is - not specified." - ([http-agnt] - (await http-agnt) ;; have to wait for Content-Encoding - (string http-agnt (or (.getContentEncoding - ^HttpURLConnection (::connection @http-agnt)) - duck/*default-encoding*))) - ([http-agnt ^String encoding] - (.toString (get-byte-buffer http-agnt) encoding))) - - -;;; REQUEST ACCESSORS - -(defn request-uri - "Returns the URI/URL requested by this HTTP agent, as a String." - [http-agnt] - (::uri @http-agnt)) - -(defn request-headers - "Returns the request headers specified for this HTTP agent." - [http-agnt] - (:headers (::options @http-agnt))) - -(defn method - "Returns the HTTP method name used by this HTTP agent, as a String." - [http-agnt] - (:method (::options @http-agnt))) - -(defn request-body - "Returns the HTTP request body given to this HTTP agent. - - Note: if the request body was an InputStream or a Reader, it will no - longer be usable." - [http-agnt] - (:body (::options @http-agnt))) - - -;;; RESPONSE ACCESSORS - -(defn done? - "Returns true if the HTTP request/response has completed." - [http-agnt] - (if (#{::finished ::disconnected} (::state @http-agnt)) - true false)) - -(defn status - "Returns the HTTP response status code (e.g. 200, 404) for this - request, as an Integer, or nil if the status has not yet been - received." - [http-agnt] - (when (done? http-agnt) - (.getResponseCode ^HttpURLConnection (::connection @http-agnt)))) - -(defn message - "Returns the HTTP response message (e.g. 'Not Found'), for this - request, or nil if the response has not yet been received." - [http-agnt] - (when (done? http-agnt) - (.getResponseMessage ^HttpURLConnection (::connection @http-agnt)))) - -(defn headers - "Returns a map of HTTP response headers. Header names are converted - to keywords in all lower-case Header values are strings. If a - header appears more than once, only the last value is returned." - [http-agnt] - (reduce (fn [m [^String k v]] - (assoc m (when k (keyword (.toLowerCase k))) (last v))) - {} (.getHeaderFields - ^HttpURLConnection (::connection @http-agnt)))) - -(defn headers-seq - "Returns the HTTP response headers in order as a sequence of - [String,String] pairs. The first 'header' name may be null for the - HTTP status line." - [http-agnt] - (let [^HttpURLConnection conn (::connection @http-agnt) - f (fn thisfn [^Integer i] - ;; Get value first because first key may be nil. - (when-let [value (.getHeaderField conn i)] - (cons [(.getHeaderFieldKey conn i) value] - (thisfn (inc i)))))] - (lazy-seq (f 0)))) - - -;;; RESPONSE STATUS CODE ACCESSORS - -(defn success? - "Returns true if the HTTP response code was in the 200-299 range." - [http-agnt] - (status-in-range? 2 http-agnt)) - -(defn redirect? - "Returns true if the HTTP response code was in the 300-399 range. - - Note: if the :follow-redirects option was true (the default), - redirects will be followed automatically and a the agent will never - return a 3xx response code." - [http-agnt] - (status-in-range? 3 http-agnt)) - -(defn client-error? - "Returns true if the HTTP response code was in the 400-499 range." - [http-agnt] - (status-in-range? 4 http-agnt)) - -(defn server-error? - "Returns true if the HTTP response code was in the 500-599 range." - [http-agnt] - (status-in-range? 5 http-agnt)) - -(defn error? - "Returns true if the HTTP response code was in the 400-499 range OR - the 500-599 range." - [http-agnt] - (or (client-error? http-agnt) - (server-error? http-agnt))) diff --git a/pom.xml b/pom.xml index 4a1696d1..1d725318 100644 --- a/pom.xml +++ b/pom.xml @@ -45,7 +45,6 @@ modules/generic modules/graph modules/greatest-least - modules/http-agent modules/http-connection modules/import-static modules/io -- cgit v1.2.3-18-g5258 From bf85deddc000469cb2f7af06c2a63d72c1894a00 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Mon, 23 Aug 2010 20:45:00 +0200 Subject: remove deprecated clojure.contrib.http-connection Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 -- modules/http-connection/pom.xml | 21 -------- .../clojure/clojure/contrib/http/connection.clj | 62 ---------------------- pom.xml | 1 - 4 files changed, 89 deletions(-) delete mode 100644 modules/http-connection/pom.xml delete mode 100644 modules/http-connection/src/main/clojure/clojure/contrib/http/connection.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index be2440dc..0ac8d3d1 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -150,11 +150,6 @@ greatest-least 1.3.0-SNAPSHOT - - org.clojure.contrib - http-connection - 1.3.0-SNAPSHOT - org.clojure.contrib import-static diff --git a/modules/http-connection/pom.xml b/modules/http-connection/pom.xml deleted file mode 100644 index 74aaa0b0..00000000 --- a/modules/http-connection/pom.xml +++ /dev/null @@ -1,21 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - http-connection - - - org.clojure.contrib - io - 1.3.0-SNAPSHOT - - - \ No newline at end of file diff --git a/modules/http-connection/src/main/clojure/clojure/contrib/http/connection.clj b/modules/http-connection/src/main/clojure/clojure/contrib/http/connection.clj deleted file mode 100644 index c6cf162a..00000000 --- a/modules/http-connection/src/main/clojure/clojure/contrib/http/connection.clj +++ /dev/null @@ -1,62 +0,0 @@ -;;; http/connection.clj: low-level HTTP client API around HttpURLConnection - -;; by Stuart Sierra, http://stuartsierra.com/ -;; June 8, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - -;; DEPRECATED IN 1.2. Use direct Java bits, or take a look at -;; http://github.com/technomancy/clojure-http-client - -(ns ^{:deprecated "1.2" - :doc "Low-level HTTP client API around HttpURLConnection"} - clojure.contrib.http.connection - (:require [clojure.contrib.io :as duck]) - (:import (java.net URI URL HttpURLConnection) - (java.io File InputStream Reader))) - -(defn http-connection - "Opens an HttpURLConnection at the URL, handled by as-url." - [url] - (.openConnection (duck/as-url url))) - -(defmulti - ^{:doc "Transmits a request entity body."} - send-request-entity (fn [conn entity] (type entity))) - -(defmethod send-request-entity duck/*byte-array-type* [^HttpURLConnection conn entity] - (.setFixedLengthStreamingMode conn (count entity)) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defmethod send-request-entity String [conn ^String entity] - (send-request-entity conn (.getBytes entity duck/*default-encoding*))) - -(defmethod send-request-entity File [^HttpURLConnection conn ^File entity] - (.setFixedLengthStreamingMode conn (.length entity)) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defmethod send-request-entity InputStream [^HttpURLConnection conn entity] - (.setChunkedStreamingMode conn -1) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defmethod send-request-entity Reader [^HttpURLConnection conn entity] - (.setChunkedStreamingMode conn -1) - (.connect conn) - (duck/copy entity (.getOutputStream conn))) - -(defn start-http-connection - ([^HttpURLConnection conn] (.connect conn)) - ([^HttpURLConnection conn request-entity-body] - (if request-entity-body - (do (.setDoOutput conn true) - (send-request-entity conn request-entity-body)) - (.connect conn)))) diff --git a/pom.xml b/pom.xml index 1d725318..de9be890 100644 --- a/pom.xml +++ b/pom.xml @@ -45,7 +45,6 @@ modules/generic modules/graph modules/greatest-least - modules/http-connection modules/import-static modules/io modules/jar -- cgit v1.2.3-18-g5258 From 1be54b2f9bd3c9f35385a015b14fc93337bffcac Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Mon, 23 Aug 2010 20:51:51 +0200 Subject: remove deprecated clojure.contrib.properties Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 -- modules/properties/pom.xml | 26 -------- .../main/clojure/clojure/contrib/properties.clj | 77 ---------------------- .../clojure/clojure/contrib/test_properties.clj | 63 ------------------ modules/sql/pom.xml | 5 -- .../main/clojure/clojure/contrib/sql/internal.clj | 19 +++++- pom.xml | 1 - 7 files changed, 17 insertions(+), 179 deletions(-) delete mode 100644 modules/properties/pom.xml delete mode 100644 modules/properties/src/main/clojure/clojure/contrib/properties.clj delete mode 100644 modules/properties/src/test/clojure/clojure/contrib/test_properties.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 0ac8d3d1..2c195bbe 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -270,11 +270,6 @@ profile 1.3.0-SNAPSHOT - - org.clojure.contrib - properties - 1.3.0-SNAPSHOT - org.clojure.contrib prxml diff --git a/modules/properties/pom.xml b/modules/properties/pom.xml deleted file mode 100644 index c0cbca7a..00000000 --- a/modules/properties/pom.xml +++ /dev/null @@ -1,26 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - properties - - - org.clojure.contrib - io - 1.3.0-SNAPSHOT - - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - - - \ No newline at end of file diff --git a/modules/properties/src/main/clojure/clojure/contrib/properties.clj b/modules/properties/src/main/clojure/clojure/contrib/properties.clj deleted file mode 100644 index 0e210206..00000000 --- a/modules/properties/src/main/clojure/clojure/contrib/properties.clj +++ /dev/null @@ -1,77 +0,0 @@ -; Copyright (c) Stuart Halloway & Contributors, April 2009. 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. - -;; DEPRECATED in 1.2. Moved to c.c.java-utils - -(ns ^{:deprecated "1.2"} - clojure.contrib.properties - (:use [clojure.contrib.string :only (as-str)] - [clojure.contrib.io :only (file)]) - (:import (java.util Properties) - (java.io FileInputStream FileOutputStream))) - -(defn get-system-property - "Get a system property." - ([stringable] - (System/getProperty (as-str stringable))) - ([stringable default] - (System/getProperty (as-str stringable) default))) - -(defn set-system-properties - "Set some system properties. Nil clears a property." - [settings] - (doseq [[name val] settings] - (if val - (System/setProperty (as-str name) (as-str val)) - (System/clearProperty (as-str name))))) - -(defmacro with-system-properties - "setting => property-name value - - Sets the system properties to the supplied values, executes the body, and - sets the properties back to their original values. Values of nil are - translated to a clearing of the property." - [settings & body] - `(let [settings# ~settings - current# (reduce (fn [coll# k#] - (assoc coll# k# (get-system-property k#))) - {} - (keys settings#))] - (set-system-properties settings#) - (try - ~@body - (finally - (set-system-properties current#))))) - - -; Not there is no corresponding props->map. Just destructure! -(defn ^Properties as-properties - "Convert any seq of pairs to a java.utils.Properties instance. - Uses as-str to convert both keys and values into strings." - {:tag Properties} - [m] - (let [p (Properties.)] - (doseq [[k v] m] - (.setProperty p (as-str k) (as-str v))) - p)) - -(defn read-properties - "Read properties from file-able." - [file-able] - (with-open [f (java.io.FileInputStream. (file file-able))] - (doto (Properties.) - (.load f)))) - -(defn write-properties - "Write properties to file-able." - {:tag Properties} - ([m file-able] (write-properties m file-able nil)) - ([m file-able comments] - (with-open [^FileOutputStream f (FileOutputStream. (file file-able))] - (doto (as-properties m) - (.store f ^String comments))))) diff --git a/modules/properties/src/test/clojure/clojure/contrib/test_properties.clj b/modules/properties/src/test/clojure/clojure/contrib/test_properties.clj deleted file mode 100644 index 65b1371f..00000000 --- a/modules/properties/src/test/clojure/clojure/contrib/test_properties.clj +++ /dev/null @@ -1,63 +0,0 @@ -(ns clojure.contrib.test-properties - (:refer-clojure :exclude (spit)) - (:use clojure.test clojure.contrib.properties - [clojure.contrib.io :only (spit)]) - (:import (java.util Properties) - (java.io File))) - -(deftest test-get-system-property - (testing "works the same with keywords, symbols, and strings" - (is (= (get-system-property "java.home") (get-system-property 'java.home))) - (is (= (get-system-property "java.home") (get-system-property :java.home)))) - (testing "treats second arg as default" - (is (= "default" (get-system-property "testing.test-system-property" "default")))) - (testing "returns nil for missing properties" - (is (nil? (get-system-property "testing.test-system-property"))))) - -(deftest test-set-system-properties - (testing "set and then unset a property using keywords" - (let [propname :clojure.contrib.java.test-set-system-properties] - (is (nil? (get-system-property propname))) - (set-system-properties {propname :foo}) - (is (= "foo") (get-system-property propname)) - (set-system-properties {propname nil}) - (is (nil? (get-system-property propname)))))) - -(deftest test-with-system-properties - (let [propname :clojure.contrib.java.test-with-system-properties] - (testing "sets a property only for the duration of a block" - (is (= "foo" - (with-system-properties {propname "foo"} - (get-system-property propname)))) - (is (nil? (get-system-property propname))))) - (testing "leaves other properties alone" - ; TODO: write this test better, using a properties -> map function - (let [propname :clojure.contrib.java.test-with-system-properties - propcount (count (System/getProperties))] - (with-system-properties {propname "foo"} - (is (= (inc propcount) (count (System/getProperties))))) - (is (= propcount (count (System/getProperties))))))) - -(deftest test-as-properties - (let [expected (doto (Properties.) - (.setProperty "a" "b") - (.setProperty "c" "d"))] - (testing "with a map" - (is (= expected - (as-properties {:a "b" :c "d"})))) - (testing "with a sequence of pairs" - (is (= expected - (as-properties [[:a :b] [:c :d]])))))) - -(deftest test-read-properties - (let [f (File/createTempFile "test" "properties")] - (spit f "a=b\nc=d") - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - -(deftest test-write-properties - (let [f (File/createTempFile "test" "properties")] - (write-properties [['a 'b] ['c 'd]] f) - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - diff --git a/modules/sql/pom.xml b/modules/sql/pom.xml index 998a5cad..c36f876f 100644 --- a/modules/sql/pom.xml +++ b/modules/sql/pom.xml @@ -27,11 +27,6 @@ except 1.3.0-SNAPSHOT - - org.clojure.contrib - properties - 1.3.0-SNAPSHOT - org.clojure.contrib seq diff --git a/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj b/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj index 59a05205..57d7050f 100644 --- a/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj +++ b/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj @@ -15,12 +15,11 @@ (:use (clojure.contrib [except :only (throwf throw-arg)] - [properties :only (as-properties)] [seq :only (indexed)])) (:import (clojure.lang RT) (java.sql BatchUpdateException DriverManager SQLException Statement) - (java.util Hashtable Map) + (java.util Hashtable Map Properties) (javax.naming InitialContext Name) (javax.sql DataSource))) @@ -48,6 +47,22 @@ ([val] (swap! (:rollback *db*) (fn [_] val)))) +(defn- as-str + [x] + (if (instance? clojure.lang.Named x) + (name x) + (str x))) + +(defn- ^Properties as-properties + "Convert any seq of pairs to a java.utils.Properties instance. + Uses as-str to convert both keys and values into strings." + {:tag Properties} + [m] + (let [p (Properties.)] + (doseq [[k v] m] + (.setProperty p (as-str k) (as-str v))) + p)) + (defn get-connection "Creates a connection to a database. db-spec is a map containing values for one of the following parameter sets: diff --git a/pom.xml b/pom.xml index de9be890..1a1e9e11 100644 --- a/pom.xml +++ b/pom.xml @@ -69,7 +69,6 @@ modules/priority-map modules/probabilities modules/profile - modules/properties modules/prxml modules/reflect modules/repl-ln -- cgit v1.2.3-18-g5258 From dee2466054cf2ff5a845bde70091fbd78b8c1a0e Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Mon, 23 Aug 2010 20:56:45 +0200 Subject: remove deprecated clojure.contrib.javadoc Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 --- modules/javadoc/pom.xml | 26 ----------- .../src/main/clojure/clojure/contrib/javadoc.clj | 4 -- .../clojure/clojure/contrib/javadoc/browse.clj | 51 ---------------------- .../clojure/clojure/contrib/javadoc/browse_ui.clj | 31 ------------- modules/repl-utils/pom.xml | 5 --- .../main/clojure/clojure/contrib/repl_utils.clj | 2 +- pom.xml | 1 - 8 files changed, 1 insertion(+), 124 deletions(-) delete mode 100644 modules/javadoc/pom.xml delete mode 100644 modules/javadoc/src/main/clojure/clojure/contrib/javadoc.clj delete mode 100644 modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse.clj delete mode 100644 modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 2c195bbe..3151d6be 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -170,11 +170,6 @@ java-utils 1.3.0-SNAPSHOT - - org.clojure.contrib - javadoc - 1.3.0-SNAPSHOT - org.clojure.contrib jmx diff --git a/modules/javadoc/pom.xml b/modules/javadoc/pom.xml deleted file mode 100644 index 4479bb97..00000000 --- a/modules/javadoc/pom.xml +++ /dev/null @@ -1,26 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - javadoc - - - org.clojure.contrib - shell - 1.3.0-SNAPSHOT - - - org.clojure.contrib - def - 1.3.0-SNAPSHOT - - - diff --git a/modules/javadoc/src/main/clojure/clojure/contrib/javadoc.clj b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc.clj deleted file mode 100644 index 7ac30a4e..00000000 --- a/modules/javadoc/src/main/clojure/clojure/contrib/javadoc.clj +++ /dev/null @@ -1,4 +0,0 @@ -(ns ^{:deprecated "1.2"} - clojure.contrib.javadoc) - -(throw (Exception. "clojure.contrib.javadoc/javadoc can now be found in clojure.java.javadoc")) diff --git a/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse.clj b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse.clj deleted file mode 100644 index a47fc0cd..00000000 --- a/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse.clj +++ /dev/null @@ -1,51 +0,0 @@ -;;; browse.clj -- start a web browser from Clojure - -; Copyright (c) Christophe Grand, December 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. - -(ns - ^{:author "Christophe Grand", - :deprecated "1.2" - :doc "Start a web browser from Clojure"} - clojure.contrib.javadoc.browse - (:require [clojure.contrib.shell :as sh]) - (:import (java.net URI))) - -(defn- macosx? [] - (-> "os.name" System/getProperty .toLowerCase - (.startsWith "mac os x"))) - -(def *open-url-script* (when (macosx?) "/usr/bin/open")) - -(defn open-url-in-browser - "Opens url (a string) in the default system web browser. May not - work on all platforms. Returns url on success, nil if not - supported." - [url] - (try - (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" - "isDesktopSupported" (to-array nil)) - (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" - "getDesktop" (to-array nil)) - (.browse (URI. url))) - url) - (catch ClassNotFoundException e - nil))) - -(defn open-url-in-swing - "Opens url (a string) in a Swing window." - [url] - ; the implementation of this function resides in another namespace to be loaded "on demand" - ; this fixes a bug on mac os x where requiring repl-utils turns the process into a GUI app - ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32 - (require 'clojure.contrib.javadoc.browse-ui) - ((find-var 'clojure.contrib.javadoc.browse-ui/open-url-in-swing) url)) - -(defn browse-url [url] - (or (open-url-in-browser url) (when *open-url-script* (sh/sh *open-url-script* (str url)) true) (open-url-in-swing url))) diff --git a/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj b/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj deleted file mode 100644 index 388c76d5..00000000 --- a/modules/javadoc/src/main/clojure/clojure/contrib/javadoc/browse_ui.clj +++ /dev/null @@ -1,31 +0,0 @@ -;;; browse_ui.clj -- starts a swing web browser :-( - -; Copyright (c) Christophe Grand, December 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. - -(ns ^{:deprecated "1.2"} - clojure.contrib.javadoc.browse-ui) - -(defn open-url-in-swing - "Opens url (a string) in a Swing window." - [url] - (let [htmlpane (javax.swing.JEditorPane. url)] - (.setEditable htmlpane false) - (.addHyperlinkListener htmlpane - (proxy [javax.swing.event.HyperlinkListener] [] - (hyperlinkUpdate [^javax.swing.event.HyperlinkEvent e] - (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED)) - (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e) - (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e)) - (.setPage htmlpane (.getURL e))))))) - (doto (javax.swing.JFrame.) - (.setContentPane (javax.swing.JScrollPane. htmlpane)) - (.setBounds 32 32 700 900) - (.show)))) - diff --git a/modules/repl-utils/pom.xml b/modules/repl-utils/pom.xml index 449d7677..1377caa2 100644 --- a/modules/repl-utils/pom.xml +++ b/modules/repl-utils/pom.xml @@ -12,11 +12,6 @@ repl-utils - - org.clojure.contrib - javadoc - 1.3.0-SNAPSHOT - org.clojure.contrib seq diff --git a/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj index fdb321a5..bc9787b5 100644 --- a/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj +++ b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj @@ -20,7 +20,7 @@ (clojure.lang RT Compiler Compiler$C)) (:require [clojure.contrib.string :as s]) (:use [clojure.contrib.seq :only (indexed)] - [clojure.contrib.javadoc.browse :only (browse-url)])) + [clojure.java.browse :only (browse-url)])) ;; ---------------------------------------------------------------------- ;; Examine Java classes diff --git a/pom.xml b/pom.xml index 1a1e9e11..f20e6c5f 100644 --- a/pom.xml +++ b/pom.xml @@ -49,7 +49,6 @@ modules/io modules/jar modules/java-utils - modules/javadoc modules/jmx modules/json modules/lazy-seqs -- cgit v1.2.3-18-g5258 From b356e2ee0bebfa99bf8fcc6da25c748ad9355adb Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Mon, 23 Aug 2010 20:59:39 +0200 Subject: remove deprecated clojure.contrib.test-is Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - .../mock/src/main/clojure/clojure/contrib/mock.clj | 2 +- modules/test-is/pom.xml | 16 --- .../src/main/clojure/clojure/contrib/test_is.clj | 119 --------------------- pom.xml | 1 - 5 files changed, 1 insertion(+), 142 deletions(-) delete mode 100644 modules/test-is/pom.xml delete mode 100644 modules/test-is/src/main/clojure/clojure/contrib/test_is.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 3151d6be..6fdbb64e 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -355,11 +355,6 @@ swing-utils 1.3.0-SNAPSHOT - - org.clojure.contrib - test-is - 1.3.0-SNAPSHOT - org.clojure.contrib trace diff --git a/modules/mock/src/main/clojure/clojure/contrib/mock.clj b/modules/mock/src/main/clojure/clojure/contrib/mock.clj index 4953cd94..6f923a5d 100644 --- a/modules/mock/src/main/clojure/clojure/contrib/mock.clj +++ b/modules/mock/src/main/clojure/clojure/contrib/mock.clj @@ -41,7 +41,7 @@ ;; an error condition function is called with the name of the function ;; being mocked, the expected form and the actual value. These ;; error functions can be overridden to allow easy integration into - ;; test frameworks such as test-is by reporting errors in the function + ;; test frameworks such as clojure.test by reporting errors in the function ;; overrides. ) ;; end comment diff --git a/modules/test-is/pom.xml b/modules/test-is/pom.xml deleted file mode 100644 index c0fb8a47..00000000 --- a/modules/test-is/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - test-is - - - \ No newline at end of file diff --git a/modules/test-is/src/main/clojure/clojure/contrib/test_is.clj b/modules/test-is/src/main/clojure/clojure/contrib/test_is.clj deleted file mode 100644 index a1b0d8f9..00000000 --- a/modules/test-is/src/main/clojure/clojure/contrib/test_is.clj +++ /dev/null @@ -1,119 +0,0 @@ -;;; test_is.clj: Compatibility layer for old clojure.contrib.test-is - -;; by Stuart Sierra, http://stuartsierra.com/ -;; August 28, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - -;; DEPRECATED in 1.2: Moved to clojure.test - -(ns ^{:deprecated "1.2" - :doc "Backwards-compatibility for clojure.contrib.test-is - - The clojure.contrib.test-is library moved from Contrib into the - Clojure distribution as clojure.test. - - This happened on or around clojure-contrib Git commit - 82cf0409d0fcb71be477ebfc4da18ee2128a2ad1 on June 25, 2009. - - This file makes the clojure.test interface available under the old - namespace clojure.contrib.test-is. - - This includes support for the old syntax of the 'are' macro. - - This was suggested by Howard Lewis Ship in ticket #26, - http://www.assembla.com/spaces/clojure-contrib/tickets/26" - :author "Stuart Sierra"} - clojure.contrib.test-is - (:require clojure.test - [clojure.walk :as walk])) - - -;;; COPY INTERNED VARS (EXCEPT are) FROM clojure.test - -(doseq [v (disj (set (vals (ns-interns 'clojure.test))) - #'clojure.test/are)] - (intern *ns* (with-meta (:name (meta v)) (meta v)) (var-get v))) - - -;;; REDEFINE OLD clojure.contrib.template - -(defn find-symbols - "Recursively finds all symbols in form." - [form] - (distinct (filter symbol? (tree-seq coll? seq form)))) - -(defn find-holes - "Recursively finds all symbols starting with _ in form." - [form] - (sort (distinct (filter #(.startsWith (name %) "_") - (find-symbols form))))) - -(defn find-pure-exprs - "Recursively finds all sub-expressions in form that do not contain - any symbols starting with _" - [form] - (filter #(and (list? %) - (empty? (find-holes %))) - (tree-seq seq? seq form))) - -(defn flatten-map - "Transforms a map into a vector like [key value key value]." - [m] - (reduce (fn [coll [k v]] (conj coll k v)) - [] m)) - -(defn template? - "Returns true if form is a valid template expression." - [form] - (if (seq (find-holes form)) true false)) - -(defn apply-template - "Replaces _1, _2, _3, etc. in expr with corresponding elements of - values. Returns the modified expression. For use in macros." - [expr values] - (when-not (template? expr) - (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) - (let [expr (walk/postwalk-replace {'_ '_1} expr) - holes (find-holes expr) - smap (zipmap holes values)] - (walk/prewalk-replace smap expr))) - -(defmacro do-template - "Repeatedly evaluates template expr (in a do block) using values in - args. args are grouped by the number of holes in the template. - Example: (do-template (check _1 _2) :a :b :c :d) - expands to (do (check :a :b) (check :c :d))" - [expr & args] - (when-not (template? expr) - (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) - (let [expr (walk/postwalk-replace {'_ '_1} expr) - argcount (count (find-holes expr))] - `(do ~@(map (fn [a] (apply-template expr a)) - (partition argcount args))))) - - - -;;; REDEFINE are MACRO TO MATCH OLD TEMPLATE BEHAVIOR - -(defmacro are - "Checks multiple assertions with a template expression. - See clojure.contrib.template/do-template for an explanation of - templates. - - Example: (are (= _1 _2) - 2 (+ 1 1) - 4 (* 2 2)) - Expands to: - (do (is (= 2 (+ 1 1))) - (is (= 4 (* 2 2)))) - - Note: This breaks some reporting features, such as line numbers." - [expr & args] - `(do-template (is ~expr) ~@args)) diff --git a/pom.xml b/pom.xml index f20e6c5f..b8f3ff3f 100644 --- a/pom.xml +++ b/pom.xml @@ -86,7 +86,6 @@ modules/string modules/strint modules/swing-utils - modules/test-is modules/trace modules/types modules/with-ns -- cgit v1.2.3-18-g5258 From 51e2efbe391e4a45fb6fcbc8b7954ed0b32e5f03 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Tue, 24 Aug 2010 20:20:55 +0200 Subject: removed c.c.shell and c.c.shell-out Both are deprecated in 1.2 and have been replaced by clojure.java.shell. Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 10 -- .../main/clojure/clojure/contrib/gen_html_docs.clj | 2 - modules/shell-out/pom.xml | 16 --- .../src/main/clojure/clojure/contrib/shell_out.clj | 149 --------------------- modules/shell/pom.xml | 16 --- .../src/main/clojure/clojure/contrib/shell.clj | 149 --------------------- .../test/clojure/clojure/contrib/test_shell.clj | 41 ------ pom.xml | 2 - 8 files changed, 385 deletions(-) delete mode 100644 modules/shell-out/pom.xml delete mode 100644 modules/shell-out/src/main/clojure/clojure/contrib/shell_out.clj delete mode 100644 modules/shell/pom.xml delete mode 100644 modules/shell/src/main/clojure/clojure/contrib/shell.clj delete mode 100644 modules/shell/src/test/clojure/clojure/contrib/test_shell.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 6fdbb64e..03f7df60 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -305,16 +305,6 @@ set 1.3.0-SNAPSHOT - - org.clojure.contrib - shell - 1.3.0-SNAPSHOT - - - org.clojure.contrib - shell-out - 1.3.0-SNAPSHOT - org.clojure.contrib singleton diff --git a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj index 466c3fb4..2e54aeee 100644 --- a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj +++ b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj @@ -509,7 +509,6 @@ emits the generated HTML to the path named by path." 'clojure.contrib.repl-utils 'clojure.contrib.seq 'clojure.contrib.server-socket - 'clojure.contrib.shell 'clojure.contrib.sql 'clojure.contrib.stream-utils 'clojure.contrib.string @@ -532,7 +531,6 @@ emits the generated HTML to the path named by path." 'clojure.contrib.test-clojure.printer 'clojure.contrib.test-clojure.reader 'clojure.contrib.test-clojure.sequences - 'clojure.contrib.test-contrib.shell 'clojure.contrib.test-contrib.string 'clojure.contrib.zip-filter.xml ])) diff --git a/modules/shell-out/pom.xml b/modules/shell-out/pom.xml deleted file mode 100644 index 219bb2b7..00000000 --- a/modules/shell-out/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - shell-out - - - \ No newline at end of file diff --git a/modules/shell-out/src/main/clojure/clojure/contrib/shell_out.clj b/modules/shell-out/src/main/clojure/clojure/contrib/shell_out.clj deleted file mode 100644 index 8fcd3680..00000000 --- a/modules/shell-out/src/main/clojure/clojure/contrib/shell_out.clj +++ /dev/null @@ -1,149 +0,0 @@ -; Copyright (c) Chris Houser, Jan 2009. 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. - -; :dir and :env options added by Stuart Halloway - -; Conveniently launch a sub-process providing to its stdin and -; collecting its stdout - -;; DEPRECATED in 1.2: Promoted to clojure.java.shell - -(ns - ^{:author "Chris Houser", - :deprecated "1.2" - :doc "Conveniently launch a sub-process providing to its stdin and -collecting its stdout"} - clojure.contrib.shell-out - (:import (java.io InputStreamReader OutputStreamWriter))) - -(def *sh-dir* nil) -(def *sh-env* nil) - -(defmacro with-sh-dir [dir & forms] - "Sets the directory for use with sh, see sh for details." - `(binding [*sh-dir* ~dir] - ~@forms)) - -(defmacro with-sh-env [env & forms] - "Sets the environment for use with sh, see sh for details." - `(binding [*sh-env* ~env] - ~@forms)) - -(defn- stream-seq - "Takes an InputStream and returns a lazy seq of integers from the stream." - [stream] - (take-while #(>= % 0) (repeatedly #(.read stream)))) - -(defn- aconcat - "Concatenates arrays of given type." - [type & xs] - (let [target (make-array type (apply + (map count xs)))] - (loop [i 0 idx 0] - (when-let [a (nth xs i nil)] - (System/arraycopy a 0 target idx (count a)) - (recur (inc i) (+ idx (count a))))) - target)) - -(defn- parse-args - "Takes a seq of 'sh' arguments and returns a map of option keywords - to option values." - [args] - (loop [[arg :as args] args opts {:cmd [] :out "UTF-8" :dir *sh-dir* :env *sh-env*}] - (if-not args - opts - (if (keyword? arg) - (recur (nnext args) (assoc opts arg (second args))) - (recur (next args) (update-in opts [:cmd] conj arg)))))) - -(defn- as-env-key [arg] - "Helper so that callers can use symbols, keywords, or strings - when building an environment map." - (cond - (symbol? arg) (name arg) - (keyword? arg) (name arg) - (string? arg) arg)) - -(defn- as-file [arg] - "Helper so that callers can pass a String for the :dir to sh." - (cond - (string? arg) (java.io.File. arg) - (nil? arg) nil - (instance? java.io.File arg) arg)) - -(defn- as-env-string [arg] - "Helper so that callers can pass a Clojure map for the :env to sh." - (cond - (nil? arg) nil - (map? arg) (into-array String (map (fn [[k v]] (str (as-env-key k) "=" v)) arg)) - true arg)) - - -(defn sh - "Passes the given strings to Runtime.exec() to launch a sub-process. - - Options are - - :in may be given followed by a String specifying text to be fed to the - sub-process's stdin. - :out option may be given followed by :bytes or a String. If a String - is given, it will be used as a character encoding name (for - example \"UTF-8\" or \"ISO-8859-1\") to convert the - sub-process's stdout to a String which is returned. - If :bytes is given, the sub-process's stdout will be stored in - a byte array and returned. Defaults to UTF-8. - :return-map - when followed by boolean true, sh returns a map of - :exit => sub-process's exit code - :out => sub-process's stdout (as byte[] or String) - :err => sub-process's stderr (as byte[] or String) - when not given or followed by false, sh returns a single - array or String of the sub-process's stdout followed by its - stderr - :env override the process env with a map (or the underlying Java - String[] if you are a masochist). - :dir override the process dir with a String or java.io.File. - - You can bind :env or :dir for multiple operations using with-sh-env - and with-sh-dir." - [& args] - (let [opts (parse-args args) - proc (.exec (Runtime/getRuntime) - (into-array (:cmd opts)) - (as-env-string (:env opts)) - (as-file (:dir opts)))] - (if (:in opts) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc))] - (.write osw (:in opts))) - (.close (.getOutputStream proc))) - (with-open [stdout (.getInputStream proc) - stderr (.getErrorStream proc)] - (let [[[out err] combine-fn] - (if (= (:out opts) :bytes) - [(for [strm [stdout stderr]] - (into-array Byte/TYPE (map byte (stream-seq strm)))) - #(aconcat Byte/TYPE %1 %2)] - [(for [strm [stdout stderr]] - (apply str (map char (stream-seq - (InputStreamReader. strm (:out opts)))))) - str]) - exit-code (.waitFor proc)] - (if (:return-map opts) - {:exit exit-code :out out :err err} - (combine-fn out err)))))) - -(comment - -(println (sh "ls" "-l")) -(println (sh "ls" "-l" "/no-such-thing")) -(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) -(println (sh "cat" :in "x\u25bax\n")) -(println (sh "echo" "x\u25bax")) -(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars -(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[] - -) diff --git a/modules/shell/pom.xml b/modules/shell/pom.xml deleted file mode 100644 index a74b677f..00000000 --- a/modules/shell/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - shell - - - \ No newline at end of file diff --git a/modules/shell/src/main/clojure/clojure/contrib/shell.clj b/modules/shell/src/main/clojure/clojure/contrib/shell.clj deleted file mode 100644 index 63467664..00000000 --- a/modules/shell/src/main/clojure/clojure/contrib/shell.clj +++ /dev/null @@ -1,149 +0,0 @@ -; Copyright (c) Chris Houser, Jan 2009. 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. - -; :dir and :env options added by Stuart Halloway - -; Conveniently launch a sub-process providing to its stdin and -; collecting its stdout - -;; DEPRECATED in 1.2: Promoted to clojure.java.shell - -(ns - ^{:author "Chris Houser", - :deprecated "1.2" - :doc "Conveniently launch a sub-process providing to its stdin and -collecting its stdout"} - clojure.contrib.shell - (:import (java.io InputStreamReader OutputStreamWriter))) - -(def *sh-dir* nil) -(def *sh-env* nil) - -(defmacro with-sh-dir [dir & forms] - "Sets the directory for use with sh, see sh for details." - `(binding [*sh-dir* ~dir] - ~@forms)) - -(defmacro with-sh-env [env & forms] - "Sets the environment for use with sh, see sh for details." - `(binding [*sh-env* ~env] - ~@forms)) - -(defn- stream-seq - "Takes an InputStream and returns a lazy seq of integers from the stream." - [stream] - (take-while #(>= % 0) (repeatedly #(.read stream)))) - -(defn- aconcat - "Concatenates arrays of given type." - [type & xs] - (let [target (make-array type (apply + (map count xs)))] - (loop [i 0 idx 0] - (when-let [a (nth xs i nil)] - (System/arraycopy a 0 target idx (count a)) - (recur (inc i) (+ idx (count a))))) - target)) - -(defn- parse-args - "Takes a seq of 'sh' arguments and returns a map of option keywords - to option values." - [args] - (loop [[arg :as args] args opts {:cmd [] :out "UTF-8" :dir *sh-dir* :env *sh-env*}] - (if-not args - opts - (if (keyword? arg) - (recur (nnext args) (assoc opts arg (second args))) - (recur (next args) (update-in opts [:cmd] conj arg)))))) - -(defn- as-env-key [arg] - "Helper so that callers can use symbols, keywords, or strings - when building an environment map." - (cond - (symbol? arg) (name arg) - (keyword? arg) (name arg) - (string? arg) arg)) - -(defn- as-file [arg] - "Helper so that callers can pass a String for the :dir to sh." - (cond - (string? arg) (java.io.File. arg) - (nil? arg) nil - (instance? java.io.File arg) arg)) - -(defn- as-env-string [arg] - "Helper so that callers can pass a Clojure map for the :env to sh." - (cond - (nil? arg) nil - (map? arg) (into-array String (map (fn [[k v]] (str (as-env-key k) "=" v)) arg)) - true arg)) - - -(defn sh - "Passes the given strings to Runtime.exec() to launch a sub-process. - - Options are - - :in may be given followed by a String specifying text to be fed to the - sub-process's stdin. - :out option may be given followed by :bytes or a String. If a String - is given, it will be used as a character encoding name (for - example \"UTF-8\" or \"ISO-8859-1\") to convert the - sub-process's stdout to a String which is returned. - If :bytes is given, the sub-process's stdout will be stored in - a byte array and returned. Defaults to UTF-8. - :return-map - when followed by boolean true, sh returns a map of - :exit => sub-process's exit code - :out => sub-process's stdout (as byte[] or String) - :err => sub-process's stderr (as byte[] or String) - when not given or followed by false, sh returns a single - array or String of the sub-process's stdout followed by its - stderr - :env override the process env with a map (or the underlying Java - String[] if you are a masochist). - :dir override the process dir with a String or java.io.File. - - You can bind :env or :dir for multiple operations using with-sh-env - and with-sh-dir." - [& args] - (let [opts (parse-args args) - proc (.exec (Runtime/getRuntime) - (into-array (:cmd opts)) - (as-env-string (:env opts)) - (as-file (:dir opts)))] - (if (:in opts) - (with-open [osw (OutputStreamWriter. (.getOutputStream proc))] - (.write osw (:in opts))) - (.close (.getOutputStream proc))) - (with-open [stdout (.getInputStream proc) - stderr (.getErrorStream proc)] - (let [[[out err] combine-fn] - (if (= (:out opts) :bytes) - [(for [strm [stdout stderr]] - (into-array Byte/TYPE (map byte (stream-seq strm)))) - #(aconcat Byte/TYPE %1 %2)] - [(for [strm [stdout stderr]] - (apply str (map char (stream-seq - (InputStreamReader. strm (:out opts)))))) - str]) - exit-code (.waitFor proc)] - (if (:return-map opts) - {:exit exit-code :out out :err err} - (combine-fn out err)))))) - -(comment - -(println (sh "ls" "-l")) -(println (sh "ls" "-l" "/no-such-thing")) -(println (sh "sed" "s/[aeiou]/oo/g" :in "hello there\n")) -(println (sh "cat" :in "x\u25bax\n")) -(println (sh "echo" "x\u25bax")) -(println (sh "echo" "x\u25bax" :out "ISO-8859-1")) ; reads 4 single-byte chars -(println (sh "cat" "myimage.png" :out :bytes)) ; reads binary file into bytes[] - -) diff --git a/modules/shell/src/test/clojure/clojure/contrib/test_shell.clj b/modules/shell/src/test/clojure/clojure/contrib/test_shell.clj deleted file mode 100644 index 120093e7..00000000 --- a/modules/shell/src/test/clojure/clojure/contrib/test_shell.clj +++ /dev/null @@ -1,41 +0,0 @@ -(ns clojure.contrib.test-shell - (:use clojure.test - clojure.contrib.shell) - (:import (java.io File))) - -; workaroung to access private parse-args. Better way? -(def parse-args ((ns-interns 'clojure.contrib.shell) 'parse-args)) -(def as-file ((ns-interns 'clojure.contrib.shell) 'as-file)) -(def as-env-string ((ns-interns 'clojure.contrib.shell) 'as-env-string)) - -(deftest test-parse-args - (are [x y] (= x y) - {:cmd [nil] :out "UTF-8" :dir nil :env nil} (parse-args []) - {:cmd ["ls"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls"]) - {:cmd ["ls" "-l"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls" "-l"]) - {:cmd ["ls"] :out "ISO-8859-1" :dir nil :env nil} (parse-args ["ls" :out "ISO-8859-1"]) -)) - -(deftest test-with-sh-dir - (are [x y] (= x y) - nil *sh-dir* - "foo" (with-sh-dir "foo" *sh-dir*))) - -(deftest test-with-sh-env - (are [x y] (= x y) - nil *sh-env* - {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*))) - -(deftest test-as-env-string - (are [x y] (= x y) - nil (as-env-string nil) - ["FOO=BAR"] (seq (as-env-string {"FOO" "BAR"})) - ["FOO_SYMBOL=BAR"] (seq (as-env-string {'FOO_SYMBOL "BAR"})) - ["FOO_KEYWORD=BAR"] (seq (as-env-string {:FOO_KEYWORD "BAR"})))) - - -(deftest test-as-file - (are [x y] (= x y) - (File. "foo") (as-file "foo") - nil (as-file nil) - (File. "bar") (as-file (File. "bar")))) \ No newline at end of file diff --git a/pom.xml b/pom.xml index b8f3ff3f..a704ce92 100644 --- a/pom.xml +++ b/pom.xml @@ -76,8 +76,6 @@ modules/seq-utils modules/server-socket modules/set - modules/shell - modules/shell-out modules/singleton modules/sql modules/str-utils -- cgit v1.2.3-18-g5258 From 2c6c9e3eca8039964b451be38cdf9d7044dd0b06 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Thu, 26 Aug 2010 21:38:13 +0200 Subject: remove deprecated clojure.contrib.io Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/gen-html-docs/pom.xml | 5 - .../main/clojure/clojure/contrib/gen_html_docs.clj | 6 +- modules/io/pom.xml | 16 - modules/io/src/main/clojure/clojure/contrib/io.clj | 564 --------------------- .../src/test/clojure/clojure/contrib/test_io.clj | 96 ---- .../clojure/clojure/contrib/monadic_io_streams.clj | 8 +- pom.xml | 1 - 8 files changed, 6 insertions(+), 695 deletions(-) delete mode 100644 modules/io/pom.xml delete mode 100644 modules/io/src/main/clojure/clojure/contrib/io.clj delete mode 100644 modules/io/src/test/clojure/clojure/contrib/test_io.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 03f7df60..9de805ac 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -155,11 +155,6 @@ import-static 1.3.0-SNAPSHOT - - org.clojure.contrib - io - 1.3.0-SNAPSHOT - org.clojure.contrib jar diff --git a/modules/gen-html-docs/pom.xml b/modules/gen-html-docs/pom.xml index d9561557..c04d6e84 100644 --- a/modules/gen-html-docs/pom.xml +++ b/modules/gen-html-docs/pom.xml @@ -12,11 +12,6 @@ gen-html-docs - - org.clojure.contrib - io - 1.3.0-SNAPSHOT - org.clojure.contrib string diff --git a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj index 2e54aeee..5046c163 100644 --- a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj +++ b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj @@ -46,8 +46,7 @@ :doc "Generates a single HTML page that contains the documentation for one or more Clojure libraries."} clojure.contrib.gen-html-docs - (:require [clojure.contrib.io :as io] - [clojure.contrib.string :as s]) + (:require [clojure.contrib.string :as s]) (:use [clojure.contrib repl-utils def prxml]) (:import [java.lang Exception] [java.util.regex Pattern])) @@ -458,7 +457,7 @@ libraries." "Calls generate-documentation on the libraries named by libs and emits the generated HTML to the path named by path." [path libs] - (io/spit path (generate-documentation libs))) + (spit path (generate-documentation libs))) (comment (generate-documentation-to-file @@ -481,7 +480,6 @@ emits the generated HTML to the path named by path." 'clojure.contrib.complex-numbers 'clojure.contrib.cond 'clojure.contrib.def - 'clojure.contrib.io 'clojure.contrib.enum 'clojure.contrib.error-kit 'clojure.contrib.except diff --git a/modules/io/pom.xml b/modules/io/pom.xml deleted file mode 100644 index f22d4494..00000000 --- a/modules/io/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - io - - - \ No newline at end of file diff --git a/modules/io/src/main/clojure/clojure/contrib/io.clj b/modules/io/src/main/clojure/clojure/contrib/io.clj deleted file mode 100644 index 4d793180..00000000 --- a/modules/io/src/main/clojure/clojure/contrib/io.clj +++ /dev/null @@ -1,564 +0,0 @@ -;;; io.clj -- duck-typed I/O streams for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; May 13, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - - -;; This file defines "duck-typed" I/O utility functions for Clojure. -;; The 'reader' and 'writer' functions will open and return an -;; instance of java.io.BufferedReader and java.io.BufferedWriter, -;; respectively, for a variety of argument types -- filenames as -;; strings, URLs, java.io.File's, etc. 'reader' even works on http -;; URLs. -;; -;; Note: this is not really "duck typing" as implemented in languages -;; like Ruby. A better name would have been "do-what-I-mean-streams" -;; or "just-give-me-a-stream", but ducks are funnier. - - -;; CHANGE LOG -;; -;; July 23, 2010: Most functions here are deprecated. Use -;; clojure.java.io -;; -;; May 13, 2009: added functions to open writers for appending -;; -;; May 3, 2009: renamed file to file-str, for compatibility with -;; clojure.contrib.java. reader/writer no longer use this -;; function. -;; -;; February 16, 2009: (lazy branch) fixed read-lines to work with lazy -;; Clojure. -;; -;; January 10, 2009: added *default-encoding*, so streams are always -;; opened as UTF-8. -;; -;; December 19, 2008: rewrote reader and writer as multimethods; added -;; slurp*, file, and read-lines -;; -;; April 8, 2008: first version - - - -(ns - ^{:author "Stuart Sierra", - :doc "This file defines polymorphic I/O utility functions for Clojure. - - The Streams protocol defines reader, writer, input-stream and - output-stream methods that return BufferedReader, BufferedWriter, - BufferedInputStream and BufferedOutputStream instances (respectively), - with default implementations extended to a variety of argument - types: URLs or filenames as strings, java.io.File's, Sockets, etc."} - clojure.contrib.io - (:refer-clojure :exclude (spit)) - (:import - (java.io Reader InputStream InputStreamReader PushbackReader - BufferedReader File OutputStream - OutputStreamWriter BufferedWriter Writer - FileInputStream FileOutputStream ByteArrayOutputStream - StringReader ByteArrayInputStream - BufferedInputStream BufferedOutputStream - CharArrayReader) - (java.net URI URL MalformedURLException Socket))) - - -(def - ^{:doc "Name of the default encoding to use when reading & writing. - Default is UTF-8." - :tag "java.lang.String"} - *default-encoding* "UTF-8") - -(def - ^{:doc "Size, in bytes or characters, of the buffer used when - copying streams."} - *buffer-size* 1024) - -(def - ^{:doc "Type object for a Java primitive byte array."} - *byte-array-type* (class (make-array Byte/TYPE 0))) - -(def - ^{:doc "Type object for a Java primitive char array."} - *char-array-type* (class (make-array Character/TYPE 0))) - - -(defn ^File file-str - "Concatenates args as strings and returns a java.io.File. Replaces - all / and \\ with File/separatorChar. Replaces ~ at the start of - the path with the user.home system property." - [& args] - (let [^String s (apply str args) - s (.replace s \\ File/separatorChar) - s (.replace s \/ File/separatorChar) - s (if (.startsWith s "~") - (str (System/getProperty "user.home") - File/separator (subs s 1)) - s)] - (File. s))) - -(def - ^{:doc "If true, writer, output-stream and spit will open files in append mode. - Defaults to false. Instead of binding this var directly, use append-writer, - append-output-stream or append-spit." - :tag "java.lang.Boolean"} - *append* false) - -(defn- assert-not-appending [] - (when *append* - (throw (Exception. "Cannot change an open stream to append mode.")))) - -;; @todo -- Both simple and elaborate methods for controlling buffering of -;; in the Streams protocol were implemented, considered, and postponed -;; see http://groups.google.com/group/clojure-dev/browse_frm/thread/3e39e9b3982f542b -(defprotocol Streams - (reader [x] - "Attempts to coerce its argument into an open java.io.Reader. - The default implementations of this protocol always return a - java.io.BufferedReader. - - Default implementations are provided for Reader, BufferedReader, - InputStream, File, URI, URL, Socket, byte arrays, character arrays, - and String. - - If argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. If this fails, a final attempt is made to resolve - the string as a resource on the CLASSPATH. - - Uses *default-encoding* as the text encoding. - - Should be used inside with-open to ensure the Reader is properly - closed.") - (writer [x] - "Attempts to coerce its argument into an open java.io.Writer. - The default implementations of this protocol always return a - java.io.BufferedWriter. - - Default implementations are provided for Writer, BufferedWriter, - OutputStream, File, URI, URL, Socket, and String. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the Writer is properly - closed.") - (input-stream [x] - "Attempts to coerce its argument into an open java.io.InputStream. - The default implementations of this protocol always return a - java.io.BufferedInputStream. - - Default implementations are defined for OutputStream, File, URI, URL, - Socket, byte array, and String arguments. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the InputStream is properly - closed.") - (output-stream [x] - "Attempts to coerce its argument into an open java.io.OutputStream. - The default implementations of this protocol always return a - java.io.BufferedOutputStream. - - Default implementations are defined for OutputStream, File, URI, URL, - Socket, and String arguments. - - If the argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the OutputStream is - properly closed.")) - -(def default-streams-impl - {:reader #(reader (input-stream %)) - :writer #(writer (output-stream %)) - :input-stream #(throw (Exception. (str "Cannot open <" (pr-str %) "> as an InputStream."))) - :output-stream #(throw (Exception. (str "Cannot open <" (pr-str %) "> as an OutputStream.")))}) - -(extend File - Streams - (assoc default-streams-impl - :input-stream #(input-stream (FileInputStream. ^File %)) - :output-stream #(let [stream (FileOutputStream. ^File % *append*)] - (binding [*append* false] - (output-stream stream))))) -(extend URL - Streams - (assoc default-streams-impl - :input-stream (fn [^URL x] - (input-stream (if (= "file" (.getProtocol x)) - (FileInputStream. (.getPath x)) - (.openStream x)))) - :output-stream (fn [^URL x] - (if (= "file" (.getProtocol x)) - (output-stream (File. (.getPath x))) - (throw (Exception. (str "Can not write to non-file URL <" x ">"))))))) -(extend URI - Streams - (assoc default-streams-impl - :input-stream #(input-stream (.toURL ^URI %)) - :output-stream #(output-stream (.toURL ^URI %)))) -(extend String - Streams - (assoc default-streams-impl - :input-stream #(try - (input-stream (URL. %)) - (catch MalformedURLException e - (input-stream (File. ^String %)))) - :output-stream #(try - (output-stream (URL. %)) - (catch MalformedURLException err - (output-stream (File. ^String %)))))) -(extend Socket - Streams - (assoc default-streams-impl - :input-stream #(.getInputStream ^Socket %) - :output-stream #(output-stream (.getOutputStream ^Socket %)))) -(extend *byte-array-type* - Streams - (assoc default-streams-impl :input-stream #(input-stream (ByteArrayInputStream. %)))) -(extend *char-array-type* - Streams - (assoc default-streams-impl :reader #(reader (CharArrayReader. %)))) -(extend Object - Streams - default-streams-impl) - -(extend Reader - Streams - (assoc default-streams-impl :reader #(BufferedReader. %))) -(extend BufferedReader - Streams - (assoc default-streams-impl :reader identity)) -(defn- inputstream->reader - [^InputStream is] - (reader (InputStreamReader. is *default-encoding*))) -(extend InputStream - Streams - (assoc default-streams-impl :input-stream #(BufferedInputStream. %) - :reader inputstream->reader)) -(extend BufferedInputStream - Streams - (assoc default-streams-impl - :input-stream identity - :reader inputstream->reader)) - -(extend Writer - Streams - (assoc default-streams-impl :writer #(do (assert-not-appending) - (BufferedWriter. %)))) -(extend BufferedWriter - Streams - (assoc default-streams-impl :writer #(do (assert-not-appending) %))) -(defn- outputstream->writer - [^OutputStream os] - (assert-not-appending) - (writer (OutputStreamWriter. os *default-encoding*))) -(extend OutputStream - Streams - (assoc default-streams-impl - :output-stream #(do (assert-not-appending) - (BufferedOutputStream. %)) - :writer outputstream->writer)) -(extend BufferedOutputStream - Streams - (assoc default-streams-impl - :output-stream #(do (assert-not-appending) %) - :writer outputstream->writer)) - -(defn append-output-stream - "Like output-stream but opens file for appending. Does not work on streams - that are already open." - {:deprecated "1.2"} - [x] - (binding [*append* true] - (output-stream x))) - -(defn append-writer - "Like writer but opens file for appending. Does not work on streams - that are already open." - {:deprecated "1.2"} - [x] - (binding [*append* true] - (writer x))) - -(defn write-lines - "Writes lines (a seq) to f, separated by newlines. f is opened with - writer, and automatically closed at the end of the sequence." - [f lines] - (with-open [^BufferedWriter writer (writer f)] - (loop [lines lines] - (when-let [line (first lines)] - (.write writer (str line)) - (.newLine writer) - (recur (rest lines)))))) - -(defn read-lines - "Like clojure.core/line-seq but opens f with reader. Automatically - closes the reader AFTER YOU CONSUME THE ENTIRE SEQUENCE." - [f] - (let [read-line (fn this [^BufferedReader rdr] - (lazy-seq - (if-let [line (.readLine rdr)] - (cons line (this rdr)) - (.close rdr))))] - (read-line (reader f)))) - -(defn ^String slurp* - "Like clojure.core/slurp but opens f with reader." - {:deprecated "1.2"} - [f] - (with-open [^BufferedReader r (reader f)] - (let [sb (StringBuilder.)] - (loop [c (.read r)] - (if (neg? c) - (str sb) - (do (.append sb (char c)) - (recur (.read r)))))))) - -(defn spit - "Opposite of slurp. Opens f with writer, writes content, then - closes f." - {:deprecated "1.2"} - [f content] - (with-open [^Writer w (writer f)] - (.write w content))) - -(defn append-spit - "Like spit but appends to file." - {:deprecated "1.2"} - [f content] - (with-open [^Writer w (append-writer f)] - (.write w content))) - -(defn pwd - "Returns current working directory as a String. (Like UNIX 'pwd'.) - Note: In Java, you cannot change the current working directory." - {:deprecated "1.2"} - [] - (System/getProperty "user.dir")) - -(defmacro with-out-writer - "Opens a writer on f, binds it to *out*, and evalutes body. - Anything printed within body will be written to f." - [f & body] - `(with-open [stream# (writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-out-append-writer - "Like with-out-writer but appends to file." - {:deprecated "1.2"} - [f & body] - `(with-open [stream# (append-writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-in-reader - "Opens a PushbackReader on f, binds it to *in*, and evaluates body." - [f & body] - `(with-open [stream# (PushbackReader. (reader ~f))] - (binding [*in* stream#] - ~@body))) - -(defmulti - ^{:deprecated "1.2" - :doc "Copies input to output. Returns nil. - Input may be an InputStream, Reader, File, byte[], or String. - Output may be an OutputStream, Writer, or File. - - Does not close any streams except those it opens itself - (on a File). - - Writing a File fails if the parent directory does not exist." - :arglists '([input output])} - copy - (fn [input output] [(type input) (type output)])) - -(defmethod copy [InputStream OutputStream] [^InputStream input ^OutputStream output] - (let [buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [InputStream Writer] [^InputStream input ^Writer output] - (let [^"[B" buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [chars (.toCharArray (String. buffer 0 size *default-encoding*))] - (do (.write output chars) - (recur)))))))) - -(defmethod copy [InputStream File] [^InputStream input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [Reader OutputStream] [^Reader input ^OutputStream output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [bytes (.getBytes (String. buffer 0 size) *default-encoding*)] - (do (.write output bytes) - (recur)))))))) - -(defmethod copy [Reader Writer] [^Reader input ^Writer output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [Reader File] [^Reader input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [File OutputStream] [^File input ^OutputStream output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File Writer] [^File input ^Writer output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File File] [^File input ^File output] - (with-open [in (FileInputStream. input) - out (FileOutputStream. output)] - (copy in out))) - -(defmethod copy [String OutputStream] [^String input ^OutputStream output] - (copy (StringReader. input) output)) - -(defmethod copy [String Writer] [^String input ^Writer output] - (copy (StringReader. input) output)) - -(defmethod copy [String File] [^String input ^File output] - (copy (StringReader. input) output)) - -(defmethod copy [*char-array-type* OutputStream] [input ^OutputStream output] - (copy (CharArrayReader. input) output)) - -(defmethod copy [*char-array-type* Writer] [input ^Writer output] - (copy (CharArrayReader. input) output)) - -(defmethod copy [*char-array-type* File] [input ^File output] - (copy (CharArrayReader. input) output)) - -(defmethod copy [*byte-array-type* OutputStream] [^"[B" input ^OutputStream output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* Writer] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* File] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - -(defn make-parents - "Creates all parent directories of file." - [^File file] - (.mkdirs (.getParentFile file))) - -(defmulti - ^{:doc "Converts argument into a Java byte array. Argument may be - a String, File, InputStream, or Reader. If the argument is already - a byte array, returns it." - :arglists '([arg])} - to-byte-array type) - -(defmethod to-byte-array *byte-array-type* [x] x) - -(defmethod to-byte-array String [^String x] - (.getBytes x *default-encoding*)) - -(defmethod to-byte-array File [^File x] - (with-open [input (FileInputStream. x) - buffer (ByteArrayOutputStream.)] - (copy input buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array InputStream [^InputStream x] - (let [buffer (ByteArrayOutputStream.)] - (copy x buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array Reader [^Reader x] - (.getBytes (slurp* x) *default-encoding*)) - -(defmulti relative-path-string - "Interpret a String or java.io.File as a relative path string. - Building block for clojure.contrib.java/file." - {:deprecated "1.2"} - class) - -(defmethod relative-path-string String [^String s] - (relative-path-string (File. s))) - -(defmethod relative-path-string File [^File f] - (if (.isAbsolute f) - (throw (IllegalArgumentException. (str f " is not a relative path"))) - (.getPath f))) - -(defmulti ^File as-file - "Interpret a String or a java.io.File as a File. Building block - for clojure.contrib.java/file, which you should prefer - in most cases." - {:deprecated "1.2"} - class) -(defmethod as-file String [^String s] (File. s)) -(defmethod as-file File [f] f) - -(defn ^File file - "Returns a java.io.File from string or file args." - {:deprecated "1.2"} - ([arg] - (as-file arg)) - ([parent child] - (File. ^File (as-file parent) ^String (relative-path-string child))) - ([parent child & more] - (reduce file (file parent child) more))) - -(defn delete-file - "Delete file f. Raise an exception if it fails unless silently is true." - [f & [silently]] - (or (.delete (file f)) - silently - (throw (java.io.IOException. (str "Couldn't delete " f))))) - -(defn delete-file-recursively - "Delete file f. If it's a directory, recursively delete all its contents. -Raise an exception if any deletion fails unless silently is true." - [f & [silently]] - (let [f (file f)] - (if (.isDirectory f) - (doseq [child (.listFiles f)] - (delete-file-recursively child silently))) - (delete-file f silently))) - -(defmulti - ^{:deprecated "1.2" - :doc "Coerces argument (URL, URI, or String) to a java.net.URL." - :arglists '([arg])} - as-url type) - -(defmethod as-url URL [x] x) - -(defmethod as-url URI [^URI x] (.toURL x)) - -(defmethod as-url String [^String x] (URL. x)) - -(defmethod as-url File [^File x] (.toURL x)) diff --git a/modules/io/src/test/clojure/clojure/contrib/test_io.clj b/modules/io/src/test/clojure/clojure/contrib/test_io.clj deleted file mode 100644 index 807fc394..00000000 --- a/modules/io/src/test/clojure/clojure/contrib/test_io.clj +++ /dev/null @@ -1,96 +0,0 @@ -(ns clojure.contrib.test-io - (:refer-clojure :exclude (spit)) - (:use clojure.test clojure.contrib.io) - (:import (java.io File FileInputStream BufferedInputStream) - (java.net URL URI))) - -(deftest file-str-backslash - (is (= (java.io.File. - (str "C:" java.io.File/separator - "Documents" java.io.File/separator - "file.txt")) - (file-str "C:\\Documents\\file.txt")))) - -(deftest test-as-file - (testing "strings" - (is (= (File. "foo") (as-file "foo")))) - (testing "Files" - (is (= (File. "bar") (as-file (File. "bar")))))) - -(deftest test-as-url - (are [result expr] (= result expr) - (URL. "http://foo") (as-url (URL. "http://foo")) - (URL. "http://foo") (as-url "http://foo") - (URL. "http://foo") (as-url (URI. "http://foo")) - (URL. "file:/foo") (as-url (File. "/foo")))) - -(deftest test-delete-file - (let [file (File/createTempFile "test" "deletion") - not-file (File. (str (java.util.UUID/randomUUID)))] - (delete-file (.getAbsolutePath file)) - (is (not (.exists file))) - (is (thrown? ArithmeticException (/ 1 0))) - (is (thrown? java.io.IOException (delete-file not-file))) - (is (delete-file not-file :silently)))) - -(deftest test-relative-path-string - (testing "strings" - (is (= "foo" (relative-path-string "foo")))) - (testing "absolute path strings are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string (str File/separator "baz"))))) - (testing "relative File paths" - (is (= "bar" (relative-path-string (File. "bar"))))) - (testing "absolute File paths are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string (File. (str File/separator "quux"))))))) - -(defn stream-should-have [stream expected-bytes msg] - (let [actual-bytes (byte-array (alength expected-bytes))] - (.read stream actual-bytes) - (is (= -1 (.read stream)) (str msg " : should be end of stream")) - (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match")))) - -(deftest test-input-stream - (let [file (File/createTempFile "test-input-stream" "txt") - bytes (.getBytes "foobar")] - (spit file "foobar") - (doseq [[expr msg] - [[file File] - [(FileInputStream. file) FileInputStream] - [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream] - [(.. file toURI) URI] - [(.. file toURI toURL) URL] - [(.. file toURI toURL toString) "URL as String"] - [(.. file toString) "File as String"]]] - (with-open [s (input-stream expr)] - (stream-should-have s bytes msg))))) - -(deftest test-streams-buffering - (let [data (.getBytes "")] - (is (instance? java.io.BufferedReader (reader data))) - (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.)))) - (is (instance? java.io.BufferedInputStream (input-stream data))) - (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.)))))) - -(deftest test-streams-defaults - (let [f (File/createTempFile "clojure.contrib" "test-reader-writer") - content "test\u2099ing"] - (try - (is (thrown? Exception (reader (Object.)))) - (is (thrown? Exception (writer (Object.)))) - - (are [write-to read-from] (= content (do - (spit write-to content) - (slurp* (or read-from write-to)))) - f nil - (.getAbsolutePath f) nil - (.toURL f) nil - (.toURI f) nil - (java.io.FileOutputStream. f) f - (java.io.OutputStreamWriter. (java.io.FileOutputStream. f) "UTF-8") f - f (java.io.FileInputStream. f) - f (java.io.InputStreamReader. (java.io.FileInputStream. f) "UTF-8")) - - (is (= content (slurp* (.getBytes content "UTF-8")))) - (is (= content (slurp* (.toCharArray content)))) - (finally - (.delete f))))) diff --git a/modules/monadic-io-streams/src/main/clojure/clojure/contrib/monadic_io_streams.clj b/modules/monadic-io-streams/src/main/clojure/clojure/contrib/monadic_io_streams.clj index 31ad0ac4..429ff85d 100644 --- a/modules/monadic-io-streams/src/main/clojure/clojure/contrib/monadic_io_streams.clj +++ b/modules/monadic-io-streams/src/main/clojure/clojure/contrib/monadic_io_streams.clj @@ -82,7 +82,7 @@ (defn with-reader "Create a reader from reader-spec, run the monadic I/O statement on it, and close the reader. reader-spec can be any object accepted - by clojure.contrib.io/reader." + by clojure.java.io/reader." [reader-spec statement] (with-open [r (reader reader-spec)] (first (statement (lock r))))) @@ -90,7 +90,7 @@ (defn with-writer "Create a writer from writer-spec, run the monadic I/O statement on it, and close the writer. writer-spec can be any object accepted - by clojure.contrib.io/writer." + by clojure.java.io/writer." [writer-spec statement] (with-open [w (writer writer-spec)] (first (statement (lock w))))) @@ -101,8 +101,8 @@ a binding-like vector in which each stream is specified by three element: a keyword by which the stream can be referred to, the stream mode (:read or :write), and a stream specification as - accepted by clojure.contrib.io/reader (mode :read) or - clojure.contrib.io/writer (mode :write). The statement + accepted by clojure.java.io/reader (mode :read) or + clojure.java.io/writer (mode :write). The statement is run on a state which is a map from keywords to corresponding streams. Single-stream monadic I/O statements must be wrapped with clojure.contrib.monads/with-state-field." diff --git a/pom.xml b/pom.xml index a704ce92..d572dfcd 100644 --- a/pom.xml +++ b/pom.xml @@ -46,7 +46,6 @@ modules/graph modules/greatest-least modules/import-static - modules/io modules/jar modules/java-utils modules/jmx -- cgit v1.2.3-18-g5258 From 6047457b6b1af0d307287daf49695f7249ecd749 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 10:38:36 +0200 Subject: remove deprecated clojure.contrib.str-utils Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/str-utils/pom.xml | 16 ---- .../src/main/clojure/clojure/contrib/str_utils.clj | 103 --------------------- pom.xml | 1 - 4 files changed, 125 deletions(-) delete mode 100644 modules/str-utils/pom.xml delete mode 100644 modules/str-utils/src/main/clojure/clojure/contrib/str_utils.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 9de805ac..bfa81296 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -310,11 +310,6 @@ sql 1.3.0-SNAPSHOT - - org.clojure.contrib - str-utils - 1.3.0-SNAPSHOT - org.clojure.contrib str-utils2 diff --git a/modules/str-utils/pom.xml b/modules/str-utils/pom.xml deleted file mode 100644 index 63ea53e5..00000000 --- a/modules/str-utils/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - str-utils - - - \ No newline at end of file diff --git a/modules/str-utils/src/main/clojure/clojure/contrib/str_utils.clj b/modules/str-utils/src/main/clojure/clojure/contrib/str_utils.clj deleted file mode 100644 index 2aee325a..00000000 --- a/modules/str-utils/src/main/clojure/clojure/contrib/str_utils.clj +++ /dev/null @@ -1,103 +0,0 @@ -;;; str_utils.clj -- string utilities for Clojure - -;; by Stuart Sierra -;; April 8, 2008 - -;; Copyright (c) Stuart Sierra, 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. - -;; DEPRECATED in 1.2: Promoted to clojure.java.string. Note that -;; many function names and semantics have changed - -(ns - ^{:author "Stuart Sierra", - :deprecated "1.2" - :doc "String utilities for Clojure"} - clojure.contrib.str-utils - (:import (java.util.regex Pattern))) - -(defn re-split - "Splits the string on instances of 'pattern'. Returns a sequence of - strings. Optional 'limit' argument is the maximum number of - splits. Like Perl's 'split'." - ([^Pattern pattern string] (seq (. pattern (split string)))) - ([^Pattern pattern string limit] (seq (. pattern (split string limit))))) - -(defn re-partition - "Splits the string into a lazy sequence of substrings, alternating - between substrings that match the patthern and the substrings - between the matches. The sequence always starts with the substring - before the first match, or an empty string if the beginning of the - string matches. - - For example: (re-partition #\"[a-z]+\" \"abc123def\") - - Returns: (\"\" \"abc\" \"123\" \"def\")" - [^Pattern re string] - (let [m (re-matcher re string)] - ((fn step [prevend] - (lazy-seq - (if (.find m) - (cons (.subSequence string prevend (.start m)) - (cons (re-groups m) - (step (+ (.start m) (count (.group m)))))) - (when (< prevend (.length string)) - (list (.subSequence string prevend (.length string))))))) - 0))) - -(defn re-gsub - "Replaces all instances of 'pattern' in 'string' with - 'replacement'. Like Ruby's 'String#gsub'. - - If (ifn? replacment) is true, the replacement is called with the - match. - " - [^java.util.regex.Pattern regex replacement ^String string] - (if (ifn? replacement) - (let [parts (vec (re-partition regex string))] - (apply str - (reduce (fn [parts match-idx] - (update-in parts [match-idx] replacement)) - parts (range 1 (count parts) 2)))) - (.. regex (matcher string) (replaceAll replacement)))) - -(defn re-sub - "Replaces the first instance of 'pattern' in 'string' with - 'replacement'. Like Ruby's 'String#sub'. - - If (ifn? replacement) is true, the replacement is called with - the match. - " - [^Pattern regex replacement ^String string] - (if (ifn? replacement) - (let [m (re-matcher regex string)] - (if (.find m) - (str (.subSequence string 0 (.start m)) - (replacement (re-groups m)) - (.subSequence string (.end m) (.length string))) - string)) - (.. regex (matcher string) (replaceFirst replacement)))) - - -(defn str-join - "Returns a string of all elements in 'sequence', separated by - 'separator'. Like Perl's 'join'." - [separator sequence] - (apply str (interpose separator sequence))) - - -(defn chop - "Removes the last character of string." - [s] - (subs s 0 (dec (count s)))) - -(defn chomp - "Removes all trailing newline \\n or return \\r characters from - string. Note: String.trim() is similar and faster." - [s] - (re-sub #"[\r\n]+$" "" s)) diff --git a/pom.xml b/pom.xml index d572dfcd..ea604d79 100644 --- a/pom.xml +++ b/pom.xml @@ -77,7 +77,6 @@ modules/set modules/singleton modules/sql - modules/str-utils modules/str-utils2 modules/stream-utils modules/string -- cgit v1.2.3-18-g5258 From 034d3d1703d139117b38fe6a10f552e23aa48b5c Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 11:10:12 +0200 Subject: remove deprecated clojure.contrib.str-utils2 Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/str-utils2/pom.xml | 16 - .../main/clojure/clojure/contrib/str_utils2.clj | 376 --------------------- pom.xml | 1 - 4 files changed, 398 deletions(-) delete mode 100644 modules/str-utils2/pom.xml delete mode 100644 modules/str-utils2/src/main/clojure/clojure/contrib/str_utils2.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index bfa81296..8b77d067 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -310,11 +310,6 @@ sql 1.3.0-SNAPSHOT - - org.clojure.contrib - str-utils2 - 1.3.0-SNAPSHOT - org.clojure.contrib stream-utils diff --git a/modules/str-utils2/pom.xml b/modules/str-utils2/pom.xml deleted file mode 100644 index 83bfd85c..00000000 --- a/modules/str-utils2/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - str-utils2 - - - \ No newline at end of file diff --git a/modules/str-utils2/src/main/clojure/clojure/contrib/str_utils2.clj b/modules/str-utils2/src/main/clojure/clojure/contrib/str_utils2.clj deleted file mode 100644 index 344666c0..00000000 --- a/modules/str-utils2/src/main/clojure/clojure/contrib/str_utils2.clj +++ /dev/null @@ -1,376 +0,0 @@ -;;; str_utils2.clj -- functional string utilities for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; August 19, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - -;; DEPRECATED in 1.2: Promoted to clojure.java.string. Note that -;; many function names and semantics have changed - -(ns ^{:author "Stuart Sierra" - :deprecated "1.2" - :doc "This is a library of string manipulation functions. It - is intented as a replacement for clojure.contrib.str-utils. - - You cannot (use 'clojure.contrib.str-utils2) because it defines - functions with the same names as functions in clojure.core. - Instead, do (require '[clojure.contrib.str-utils2 :as s]) - or something similar. - - Goals: - 1. Be functional - 2. String argument first, to work with -> - 3. Performance linear in string length - - Some ideas are borrowed from - http://github.com/francoisdevlin/devlinsf-clojure-utils/"} - clojure.contrib.str-utils2 - (:refer-clojure :exclude (take replace drop butlast partition - contains? get repeat reverse partial)) - (:import (java.util.regex Pattern))) - - -(defmacro dochars - "bindings => [name string] - - Repeatedly executes body, with name bound to each character in - string. Does NOT handle Unicode supplementary characters (above - U+FFFF)." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - ;; This seems to be the fastest way to iterate over characters. - `(let [^String s# ~(second bindings)] - (dotimes [i# (.length s#)] - (let [~(first bindings) (.charAt s# i#)] - ~@body)))) - - -(defmacro docodepoints - "bindings => [name string] - - Repeatedly executes body, with name bound to the integer code point - of each Unicode character in the string. Handles Unicode - supplementary characters (above U+FFFF) correctly." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - (let [character (first bindings) - string (second bindings)] - `(let [^String s# ~string - len# (.length s#)] - (loop [i# 0] - (when (< i# len#) - (let [~character (.charAt s# i#)] - (if (Character/isHighSurrogate ~character) - (let [~character (.codePointAt s# i#)] - ~@body - (recur (+ 2 i#))) - (let [~character (int ~character)] - ~@body - (recur (inc i#)))))))))) - -(defn codepoints - "Returns a sequence of integer Unicode code points in s. Handles - Unicode supplementary characters (above U+FFFF) correctly." - [^String s] - (let [len (.length s) - f (fn thisfn [^String s i] - (when (< i len) - (let [c (.charAt s i)] - (if (Character/isHighSurrogate c) - (cons (.codePointAt s i) (thisfn s (+ 2 i))) - (cons (int c) (thisfn s (inc i)))))))] - (lazy-seq (f s 0)))) - -(defn ^String escape - "Returns a new String by applying cmap (a function or a map) to each - character in s. If cmap returns nil, the original character is - added to the output unchanged." - [^String s cmap] - (let [buffer (StringBuilder. (.length s))] - (dochars [c s] - (if-let [r (cmap c)] - (.append buffer r) - (.append buffer c))) - (.toString buffer))) - -(defn blank? - "True if s is nil, empty, or contains only whitespace." - [^String s] - (every? (fn [^Character c] (Character/isWhitespace c)) s)) - -(defn ^String take - "Take first n characters from s, up to the length of s. - - Note the argument order is the opposite of clojure.core/take; this - is to keep the string as the first argument for use with ->" - [^String s n] - (if (< (count s) n) - s - (.substring s 0 n))) - -(defn ^String drop - "Drops first n characters from s. Returns an empty string if n is - greater than the length of s. - - Note the argument order is the opposite of clojure.core/drop; this - is to keep the string as the first argument for use with ->" - [^String s n] - (if (< (count s) n) - "" - (.substring s n))) - -(defn ^String butlast - "Returns s without the last n characters. Returns an empty string - if n is greater than the length of s. - - Note the argument order is the opposite of clojure.core/butlast; - this is to keep the string as the first argument for use with ->" - [^String s n] - (if (< (count s) n) - "" - (.substring s 0 (- (count s) n)))) - -(defn ^String tail - "Returns the last n characters of s." - [^String s n] - (if (< (count s) n) - s - (.substring s (- (count s) n)))) - -(defn ^String repeat - "Returns a new String containing s repeated n times." - [^String s n] - (apply str (clojure.core/repeat n s))) - -(defn ^String reverse - "Returns s with its characters reversed." - [^String s] - (.toString (.reverse (StringBuilder. s)))) - -(defmulti - ^{:doc "Replaces all instances of pattern in string with replacement. - - Allowed argument types for pattern and replacement are: - 1. String and String - 2. Character and Character - 3. regex Pattern and String - (Uses java.util.regex.Matcher.replaceAll) - 4. regex Pattern and function - (Calls function with re-groups of each match, uses return - value as replacement.)" - :arglists '([string pattern replacement]) - :tag String} - replace - (fn [^String string pattern replacement] - [(class pattern) (class replacement)])) - -(defmethod replace [String String] [^String s ^String a ^String b] - (.replace s a b)) - -(defmethod replace [Character Character] [^String s ^Character a ^Character b] - (.replace s a b)) - -(defmethod replace [Pattern String] [^String s re replacement] - (.replaceAll (re-matcher re s) replacement)) - -(defmethod replace [Pattern clojure.lang.IFn] [^String s re replacement] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer. (.length s))] - (loop [] - (if (.find m) - (do (.appendReplacement m buffer (replacement (re-groups m))) - (recur)) - (do (.appendTail m buffer) - (.toString buffer))))))) - -(defmulti - ^{:doc "Replaces the first instance of pattern in s with replacement. - - Allowed argument types for pattern and replacement are: - 1. String and String - 2. regex Pattern and String - (Uses java.util.regex.Matcher.replaceAll) - 3. regex Pattern and function -" - :arglists '([s pattern replacement]) - :tag String} - replace-first - (fn [s pattern replacement] - [(class pattern) (class replacement)])) - -(defmethod replace-first [String String] [^String s pattern replacement] - (.replaceFirst (re-matcher (Pattern/quote pattern) s) replacement)) - -(defmethod replace-first [Pattern String] [^String s re replacement] - (.replaceFirst (re-matcher re s) replacement)) - -(defmethod replace-first [Pattern clojure.lang.IFn] [^String s ^Pattern re f] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer.)] - (if (.find m) - (let [rep (f (re-groups m))] - (.appendReplacement m buffer rep) - (.appendTail m buffer) - (str buffer)))))) - -(defn partition - "Splits the string into a lazy sequence of substrings, alternating - between substrings that match the patthern and the substrings - between the matches. The sequence always starts with the substring - before the first match, or an empty string if the beginning of the - string matches. - - For example: (partition \"abc123def\" #\"[a-z]+\") - returns: (\"\" \"abc\" \"123\" \"def\")" - [^String s ^Pattern re] - (let [m (re-matcher re s)] - ((fn step [prevend] - (lazy-seq - (if (.find m) - (cons (.subSequence s prevend (.start m)) - (cons (re-groups m) - (step (+ (.start m) (count (.group m)))))) - (when (< prevend (.length s)) - (list (.subSequence s prevend (.length s))))))) - 0))) - -(defn ^String join - "Returns a string of all elements in coll, separated by - separator. Like Perl's join." - [^String separator coll] - (apply str (interpose separator coll))) - -(defn ^String chop - "Removes the last character of string, does nothing on a zero-length - string." - [^String s] - (let [size (count s)] - (if (zero? size) - s - (subs s 0 (dec (count s)))))) - -(defn ^String chomp - "Removes all trailing newline \\n or return \\r characters from - string. Note: String.trim() is similar and faster." - [^String s] - (replace s #"[\r\n]+$" "")) - -(defn title-case [^String s] - (throw (Exception. "title-case not implemeted yet"))) - -(defn ^String swap-case - "Changes upper case characters to lower case and vice-versa. - Handles Unicode supplementary characters correctly. Uses the - locale-sensitive String.toUpperCase() and String.toLowerCase() - methods." - [^String s] - (let [buffer (StringBuilder. (.length s)) - ;; array to make a String from one code point - ^"[I" array (make-array Integer/TYPE 1)] - (docodepoints [c s] - (aset-int array 0 c) - (if (Character/isLowerCase c) - ;; Character.toUpperCase is not locale-sensitive, but - ;; String.toUpperCase is; so we use a String. - (.append buffer (.toUpperCase (String. array 0 1))) - (.append buffer (.toLowerCase (String. array 0 1))))) - (.toString buffer))) - -(defn ^String capitalize - "Converts first character of the string to upper-case, all other - characters to lower-case." - [^String s] - (if (< (count s) 2) - (.toUpperCase s) - (str (.toUpperCase ^String (subs s 0 1)) - (.toLowerCase ^String (subs s 1))))) - -(defn ^String ltrim - "Removes whitespace from the left side of string." - [^String s] - (replace s #"^\s+" "")) - -(defn ^String rtrim - "Removes whitespace from the right side of string." - [^String s] - (replace s #"\s+$" "")) - -(defn split-lines - "Splits s on \\n or \\r\\n." - [^String s] - (seq (.split #"\r?\n" s))) - -;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0 -(defn ^String map-str - "Apply f to each element of coll, concatenate all results into a - String." - [f coll] - (apply str (map f coll))) - -;; borrowed from compojure.str-utils, by James Reeves, EPL 1.0 -(defn grep - "Filters elements of coll by a regular expression. The String - representation (with str) of each element is tested with re-find." - [re coll] - (filter (fn [x] (re-find re (str x))) coll)) - -(defn partial - "Like clojure.core/partial for functions that take their primary - argument first. - - Takes a function f and its arguments, NOT INCLUDING the first - argument. Returns a new function whose first argument will be the - first argument to f. - - Example: (str-utils2/partial str-utils2/take 2) - ;;=> (fn [s] (str-utils2/take s 2))" - [f & args] - (fn [s & more] (apply f s (concat args more)))) - - -;;; WRAPPERS - -;; The following functions are simple wrappers around java.lang.String -;; functions. They are included here for completeness, and for use -;; when mapping over a collection of strings. - -(defn ^String upper-case - "Converts string to all upper-case." - [^String s] - (.toUpperCase s)) - -(defn ^String lower-case - "Converts string to all lower-case." - [^String s] - (.toLowerCase s)) - -(defn split - "Splits string on a regular expression. Optional argument limit is - the maximum number of splits." - ([^String s ^Pattern re] (seq (.split re s))) - ([^String s ^Pattern re limit] (seq (.split re s limit)))) - -(defn ^String trim - "Removes whitespace from both ends of string." - [^String s] - (.trim s)) - -(defn ^String contains? - "True if s contains the substring." - [^String s substring] - (.contains s substring)) - -(defn ^String get - "Gets the i'th character in string." - [^String s i] - (.charAt s i)) - diff --git a/pom.xml b/pom.xml index ea604d79..b86e9610 100644 --- a/pom.xml +++ b/pom.xml @@ -77,7 +77,6 @@ modules/set modules/singleton modules/sql - modules/str-utils2 modules/stream-utils modules/string modules/strint -- cgit v1.2.3-18-g5258 From fe4ed311166677cd571d23774171af1d830f7fc5 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 11:22:22 +0200 Subject: remove deprecated clojure.contrib.string Since clojure.contrib.string is used by other submodules, some changes were required: - gen-html-docs and prxml needed changes because of functions were renamed or arguments reordered when promoted to clojure.string. - jmx, json, miglayout, prxml and sql gained a private one-argument implementation of as-str. - repl-utils gained a private copy of c.c.string/partition, named spartition. - repl-utils replaced a call to c.c.string/substring? with a call to the java String method '.contains' (with swapped argument order). Signed-off-by: Stuart Sierra --- modules/command-line/pom.xml | 5 - .../main/clojure/clojure/contrib/command_line.clj | 2 +- modules/complete/pom.xml | 5 - modules/gen-html-docs/pom.xml | 5 - .../main/clojure/clojure/contrib/gen_html_docs.clj | 16 +- modules/jmx/pom.xml | 5 - .../jmx/src/main/clojure/clojure/contrib/jmx.clj | 7 +- modules/json/pom.xml | 5 - .../json/src/main/clojure/clojure/contrib/json.clj | 9 +- modules/miglayout/pom.xml | 5 - .../clojure/clojure/contrib/miglayout/internal.clj | 9 +- modules/prxml/pom.xml | 5 - .../src/main/clojure/clojure/contrib/prxml.clj | 18 +- modules/repl-utils/pom.xml | 5 - .../main/clojure/clojure/contrib/repl_utils.clj | 33 +- modules/sql/pom.xml | 5 - .../sql/src/main/clojure/clojure/contrib/sql.clj | 10 +- modules/string/pom.xml | 16 - .../src/main/clojure/clojure/contrib/string.clj | 382 --------------------- .../test/clojure/clojure/contrib/test_string.clj | 124 ------- pom.xml | 1 - 21 files changed, 73 insertions(+), 599 deletions(-) delete mode 100644 modules/string/pom.xml delete mode 100644 modules/string/src/main/clojure/clojure/contrib/string.clj delete mode 100644 modules/string/src/test/clojure/clojure/contrib/test_string.clj diff --git a/modules/command-line/pom.xml b/modules/command-line/pom.xml index 8e2e01c9..224311a8 100644 --- a/modules/command-line/pom.xml +++ b/modules/command-line/pom.xml @@ -12,10 +12,5 @@ command-line - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - \ No newline at end of file diff --git a/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj b/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj index 47ee7849..6399c4fc 100644 --- a/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj +++ b/modules/command-line/src/main/clojure/clojure/contrib/command_line.clj @@ -12,7 +12,7 @@ ^{:author "Chris Houser", :doc "Process command-line arguments according to a given cmdspec"} clojure.contrib.command-line - (:use (clojure.contrib [string :only (join)]))) + (:use (clojure [string :only (join)]))) (defn make-map [args cmdspec] (let [{spec true [rest-sym] false} (group-by vector? cmdspec) diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 8b77d067..ea44dbc0 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -315,11 +315,6 @@ stream-utils 1.3.0-SNAPSHOT - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - org.clojure.contrib strint diff --git a/modules/gen-html-docs/pom.xml b/modules/gen-html-docs/pom.xml index c04d6e84..80cc2cd5 100644 --- a/modules/gen-html-docs/pom.xml +++ b/modules/gen-html-docs/pom.xml @@ -12,11 +12,6 @@ gen-html-docs - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - org.clojure.contrib repl-utils diff --git a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj index 5046c163..145c040b 100644 --- a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj +++ b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj @@ -46,7 +46,7 @@ :doc "Generates a single HTML page that contains the documentation for one or more Clojure libraries."} clojure.contrib.gen-html-docs - (:require [clojure.contrib.string :as s]) + (:require [clojure.string :as s]) (:use [clojure.contrib repl-utils def prxml]) (:import [java.lang Exception] [java.util.regex Pattern])) @@ -226,7 +226,7 @@ function toggle(targetid, linkid, textWhenOpen, textWhenClosed) (if (= 0 (count l)) [:span {:class "library-member-doc-whitespace"} " "] ; We need something here to make the blank line show up l)]) - (s/split #"\n" docs)) + (s/split docs #"\n")) "")) (defn- member-type @@ -270,7 +270,7 @@ function toggle(targetid, linkid, textWhenOpen, textWhenClosed) (defn- elide-to-one-line "Elides a string down to one line." [s] - (s/replace-re #"(\n.*)+" "..." s)) + (s/replace s #"(\n.*)+" "...")) (defn- elide-string "Returns a string that is at most the first limit characters of s" @@ -282,13 +282,9 @@ function toggle(targetid, linkid, textWhenOpen, textWhenClosed) (defn- doc-elided-src "Returns the src with the docs elided." [docs src] - (s/replace-re (re-pattern (str "\"" (Pattern/quote docs) "\"")) - (str "\"" - (elide-to-one-line docs) -;; (elide-string docs 10) -;; "..." - "\"") - src)) + (s/replace src + (re-pattern (str "\"" (Pattern/quote docs) "\"")) + (str "\"" (elide-to-one-line docs) "\""))) (defn- format-source [libid memberid v] (try diff --git a/modules/jmx/pom.xml b/modules/jmx/pom.xml index 70d24b3f..08094a48 100644 --- a/modules/jmx/pom.xml +++ b/modules/jmx/pom.xml @@ -17,10 +17,5 @@ def 1.3.0-SNAPSHOT - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - \ No newline at end of file diff --git a/modules/jmx/src/main/clojure/clojure/contrib/jmx.clj b/modules/jmx/src/main/clojure/clojure/contrib/jmx.clj index ca0232ed..c248cf0d 100644 --- a/modules/jmx/src/main/clojure/clojure/contrib/jmx.clj +++ b/modules/jmx/src/main/clojure/clojure/contrib/jmx.clj @@ -72,7 +72,6 @@ clojure.contrib.jmx (:refer-clojure :exclude [read]) (:use clojure.contrib.def - [clojure.contrib.string :only [as-str]] [clojure.stacktrace :only (root-cause)] [clojure.walk :only [postwalk]]) (:import [clojure.lang Associative] @@ -83,6 +82,12 @@ (defvar *connection* (ManagementFactory/getPlatformMBeanServer) "The connection to be used for JMX ops. Defaults to the local process.") +(defn- as-str + [x] + (if (instance? clojure.lang.Named x) + (name x) + (str x))) + (load "jmx/data") (load "jmx/client") (load "jmx/server") diff --git a/modules/json/pom.xml b/modules/json/pom.xml index 95f611ca..5cf987c4 100644 --- a/modules/json/pom.xml +++ b/modules/json/pom.xml @@ -17,10 +17,5 @@ pprint 1.3.0-SNAPSHOT - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - \ No newline at end of file diff --git a/modules/json/src/main/clojure/clojure/contrib/json.clj b/modules/json/src/main/clojure/clojure/contrib/json.clj index 69f6cc9d..457f33c9 100644 --- a/modules/json/src/main/clojure/clojure/contrib/json.clj +++ b/modules/json/src/main/clojure/clojure/contrib/json.clj @@ -17,8 +17,7 @@ To write JSON, use json-str, write-json, or write-json. To read JSON, use read-json."} clojure.contrib.json - (:use [clojure.contrib.pprint :only (write formatter-out)] - [clojure.contrib.string :only (as-str)]) + (:use [clojure.contrib.pprint :only (write formatter-out)]) (:import (java.io PrintWriter PushbackReader StringWriter StringReader Reader EOFException))) @@ -228,6 +227,12 @@ (.append sb \") (.print out (str sb)))) +(defn- as-str + [x] + (if (instance? clojure.lang.Named x) + (name x) + (str x))) + (defn- write-json-object [m ^PrintWriter out] (.print out \{) (loop [x m] diff --git a/modules/miglayout/pom.xml b/modules/miglayout/pom.xml index 22328c7e..b7e3b856 100644 --- a/modules/miglayout/pom.xml +++ b/modules/miglayout/pom.xml @@ -27,10 +27,5 @@ fcase 1.3.0-SNAPSHOT - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - \ No newline at end of file diff --git a/modules/miglayout/src/main/clojure/clojure/contrib/miglayout/internal.clj b/modules/miglayout/src/main/clojure/clojure/contrib/miglayout/internal.clj index f6e6431f..86cbac12 100644 --- a/modules/miglayout/src/main/clojure/clojure/contrib/miglayout/internal.clj +++ b/modules/miglayout/src/main/clojure/clojure/contrib/miglayout/internal.clj @@ -20,8 +20,7 @@ (:use (clojure.contrib [core :only (new-by-name)] [except :only (throwf)] - [fcase :only (fcase)] - [string :only (as-str)]))) + [fcase :only (fcase)]))) (def MigLayout "net.miginfocom.swing.MigLayout") (def LayoutCallback "net.miginfocom.layout.LayoutCallback") @@ -44,6 +43,12 @@ (throwf IllegalArgumentException "unrecognized constraint: %s (%s)" c (class c)))]) +(defn- as-str + [x] + (if (instance? clojure.lang.Named x) + (name x) + (str x))) + (defn format-constraints "Returns a string representing all the constraints for one keyword-item or component formatted for miglayout." diff --git a/modules/prxml/pom.xml b/modules/prxml/pom.xml index c3132665..b2b25fe8 100644 --- a/modules/prxml/pom.xml +++ b/modules/prxml/pom.xml @@ -12,10 +12,5 @@ prxml - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - \ No newline at end of file diff --git a/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj b/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj index 2c2ec761..a680c773 100644 --- a/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj +++ b/modules/prxml/src/main/clojure/clojure/contrib/prxml.clj @@ -27,7 +27,7 @@ :doc "Compact syntax for generating XML. See the documentation of \"prxml\" for details."} clojure.contrib.prxml - (:use [clojure.contrib.string :only (escape as-str)])) + (:use [clojure.string :only (escape)])) (def ^{:doc "If true, empty tags will have a space before the closing />"} @@ -43,11 +43,17 @@ for details."} (def ^{:private true} print-xml) ; forward declaration (defn- escape-xml [s] - (escape {\< "<" - \> ">" - \& "&" - \' "'" - \" """} s)) + (escape s {\< "<" + \> ">" + \& "&" + \' "'" + \" """})) + +(defn- as-str + [x] + (if (instance? clojure.lang.Named x) + (name x) + (str x))) (defn- prxml-attribute [name value] (print " ") diff --git a/modules/repl-utils/pom.xml b/modules/repl-utils/pom.xml index 1377caa2..cdcbbc83 100644 --- a/modules/repl-utils/pom.xml +++ b/modules/repl-utils/pom.xml @@ -17,10 +17,5 @@ seq 1.3.0-SNAPSHOT - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - \ No newline at end of file diff --git a/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj index bc9787b5..39195ea0 100644 --- a/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj +++ b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj @@ -18,23 +18,44 @@ (:import (java.io File LineNumberReader InputStreamReader PushbackReader) (java.lang.reflect Modifier Method Constructor) (clojure.lang RT Compiler Compiler$C)) - (:require [clojure.contrib.string :as s]) (:use [clojure.contrib.seq :only (indexed)] - [clojure.java.browse :only (browse-url)])) + [clojure.java.browse :only (browse-url)] + [clojure.string :only (join)])) ;; ---------------------------------------------------------------------- ;; Examine Java classes +(defn- spartition + "Splits the string into a lazy sequence of substrings, alternating + between substrings that match the patthern and the substrings + between the matches. The sequence always starts with the substring + before the first match, or an empty string if the beginning of the + string matches. + + For example: (spartition #\"[a-z]+\" \"abc123def\") + returns: (\"\" \"abc\" \"123\" \"def\")" + [^Pattern re ^String s] + (let [m (re-matcher re s)] + ((fn step [prevend] + (lazy-seq + (if (.find m) + (cons (.subSequence s prevend (.start m)) + (cons (re-groups m) + (step (+ (.start m) (count (.group m)))))) + (when (< prevend (.length s)) + (list (.subSequence s prevend (.length s))))))) + 0))) + (defn- sortable [t] (apply str (map (fn [[a b]] (str a (format "%04d" (Integer. b)))) - (partition 2 (concat (s/partition #"\d+" t) [0]))))) + (spartition 2 (concat (spartition #"\d+" t) [0]))))) (defn- param-str [m] - (str " (" (s/join + (str " (" (join "," (map (fn [[c i]] (if (> i 3) (str (.getSimpleName c) "*" i) - (s/join "," (replicate i (.getSimpleName c))))) + (join "," (replicate i (.getSimpleName c))))) (reduce (fn [pairs y] (let [[x i] (peek pairs)] (if (= x y) (conj (pop pairs) [y (inc i)]) @@ -138,7 +159,7 @@ str-or-pattern." [str-or-pattern] (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern) #(re-find str-or-pattern (str %)) - #(s/substring? (str str-or-pattern) (str %)))] + #(.contains (str %) (str str-or-pattern)))] (mapcat (fn [ns] (filter matches? (keys (ns-publics ns)))) (all-ns)))) diff --git a/modules/sql/pom.xml b/modules/sql/pom.xml index c36f876f..baf4ecab 100644 --- a/modules/sql/pom.xml +++ b/modules/sql/pom.xml @@ -17,11 +17,6 @@ def 1.3.0-SNAPSHOT - - org.clojure.contrib - string - 1.3.0-SNAPSHOT - org.clojure.contrib except diff --git a/modules/sql/src/main/clojure/clojure/contrib/sql.clj b/modules/sql/src/main/clojure/clojure/contrib/sql.clj index c6946078..5bc530af 100644 --- a/modules/sql/src/main/clojure/clojure/contrib/sql.clj +++ b/modules/sql/src/main/clojure/clojure/contrib/sql.clj @@ -21,9 +21,7 @@ :see-also [["http://github.com/richhickey/clojure-contrib/blob/master/src/test/clojure/clojure/contrib/test_sql.clj" "Example code"]]} clojure.contrib.sql - (:use (clojure.contrib - [def :only (defalias)] - [string :only (as-str)]) + (:use (clojure.contrib [def :only (defalias)]) clojure.contrib.sql.internal)) (defalias find-connection find-connection*) @@ -100,6 +98,12 @@ (transaction (seq (.executeBatch stmt))))) +(defn- as-str + [x] + (if (instance? clojure.lang.Named x) + (name x) + (str x))) + (defn create-table "Creates a table on the open database connection given a table name and specs. Each spec is either a column spec: a vector containing a column diff --git a/modules/string/pom.xml b/modules/string/pom.xml deleted file mode 100644 index 8978a33f..00000000 --- a/modules/string/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - string - - - \ No newline at end of file diff --git a/modules/string/src/main/clojure/clojure/contrib/string.clj b/modules/string/src/main/clojure/clojure/contrib/string.clj deleted file mode 100644 index 0042f710..00000000 --- a/modules/string/src/main/clojure/clojure/contrib/string.clj +++ /dev/null @@ -1,382 +0,0 @@ -;;; string.clj -- functional string utilities for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; January 26, 2010 - -;; Copyright (c) Stuart Sierra, 2010. 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. - -;; DEPRECATED in 1.2: Many functions have moved to clojure.string. - -(ns ^{:author "Stuart Sierra" - :doc "This is a library of string manipulation functions. It - is intented as a replacement for clojure.contrib.string. - - You cannot (use 'clojure.contrib.string) because it defines - functions with the same names as functions in clojure.core. - Instead, do (require '[clojure.contrib.string :as s]) - or something similar. - - Goals: - 1. Be functional - 2. Most significant argument LAST, to work with ->> - 3. At least O(n) performance for Strings of length n - - Some ideas are borrowed from - http://github.com/francoisdevlin/devlinsf-clojure-utils/"} - clojure.contrib.string - (:refer-clojure :exclude (take replace drop butlast partition - contains? get repeat reverse partial)) - (:import (java.util.regex Pattern))) - - -(defmacro dochars - "bindings => [name string] - - Repeatedly executes body, with name bound to each character in - string. Does NOT handle Unicode supplementary characters (above - U+FFFF)." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - ;; This seems to be the fastest way to iterate over characters. - `(let [^String s# ~(second bindings)] - (dotimes [i# (.length s#)] - (let [~(first bindings) (.charAt s# i#)] - ~@body)))) - - -(defmacro docodepoints - "bindings => [name string] - - Repeatedly executes body, with name bound to the integer code point - of each Unicode character in the string. Handles Unicode - supplementary characters (above U+FFFF) correctly." - [bindings & body] - (assert (vector bindings)) - (assert (= 2 (count bindings))) - (let [character (first bindings) - string (second bindings)] - `(let [^String s# ~string - len# (.length s#)] - (loop [i# 0] - (when (< i# len#) - (let [~character (.charAt s# i#)] - (if (Character/isHighSurrogate ~character) - (let [~character (.codePointAt s# i#)] - ~@body - (recur (+ 2 i#))) - (let [~character (int ~character)] - ~@body - (recur (inc i#)))))))))) - -(defn codepoints - "Returns a sequence of integer Unicode code points in s. Handles - Unicode supplementary characters (above U+FFFF) correctly." - [^String s] - (let [len (.length s) - f (fn thisfn [^String s i] - (when (< i len) - (let [c (.charAt s i)] - (if (Character/isHighSurrogate c) - (cons (.codePointAt s i) (thisfn s (+ 2 i))) - (cons (int c) (thisfn s (inc i)))))))] - (lazy-seq (f s 0)))) - -(defn ^String escape - "Returns a new String by applying cmap (a function or a map) to each - character in s. If cmap returns nil, the original character is - added to the output unchanged." - {:deprecated "1.2"} - [cmap ^String s] - (let [buffer (StringBuilder. (.length s))] - (dochars [c s] - (if-let [r (cmap c)] - (.append buffer r) - (.append buffer c))) - (.toString buffer))) - -(defn blank? - "True if s is nil, empty, or contains only whitespace." - {:deprecated "1.2"} - [^String s] - (every? (fn [^Character c] (Character/isWhitespace c)) s)) - -(defn ^String take - "Take first n characters from s, up to the length of s." - [n ^String s] - (if (< (count s) n) - s - (.substring s 0 n))) - -(defn ^String drop - "Drops first n characters from s. Returns an empty string if n is - greater than the length of s." - [n ^String s] - (if (< (count s) n) - "" - (.substring s n))) - -(defn ^String butlast - "Returns s without the last n characters. Returns an empty string - if n is greater than the length of s." - [n ^String s] - (if (< (count s) n) - "" - (.substring s 0 (- (count s) n)))) - -(defn ^String tail - "Returns the last n characters of s." - [n ^String s] - (if (< (count s) n) - s - (.substring s (- (count s) n)))) - -(defn ^String repeat - "Returns a new String containing s repeated n times." - [n ^String s] - (apply str (clojure.core/repeat n s))) - -(defn ^String reverse - "Returns s with its characters reversed." - {:deprecated "1.2"} - [^String s] - (.toString (.reverse (StringBuilder. s)))) - -(defn replace-str - "Replaces all instances of substring a with b in s." - {:deprecated "1.2"} - [^String a ^String b ^String s] - (.replace s a b)) - -(defn replace-char - "Replaces all instances of character a with character b in s." - {:deprecated "1.2"} - [^Character a ^Character b ^String s] - (.replace s a b)) - -(defn replace-re - "Replaces all matches of re with replacement in s." - {:deprecated "1.2"} - [re replacement ^String s] - (.replaceAll (re-matcher re s) replacement)) - -(defn replace-by - "Replaces all matches of re in s with the result of - (f (re-groups the-match))." - {:deprecated "1.2"} - [re f ^String s] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer. (.length s))] - (loop [] - (if (.find m) - (do (.appendReplacement m buffer (f (re-groups m))) - (recur)) - (do (.appendTail m buffer) - (.toString buffer))))))) - -(defn replace-first-str - "Replace first occurance of substring a with b in s." - {:deprecated "1.2"} - [^String a ^String b ^String s] - (.replaceFirst (re-matcher (Pattern/quote a) s) b)) - -(defn replace-first-re - "Replace first match of re in s." - {:deprecated "1.2"} - [^Pattern re ^String replacement ^String s] - (.replaceFirst (re-matcher re s) replacement)) - -(defn replace-first-by - "Replace first match of re in s with the result of - (f (re-groups the-match))." - {:deprecated "1.2"} - [^Pattern re f ^String s] - (let [m (re-matcher re s)] - (let [buffer (StringBuffer.)] - (if (.find m) - (let [rep (f (re-groups m))] - (.appendReplacement m buffer rep) - (.appendTail m buffer) - (str buffer)))))) - -(defn partition - "Splits the string into a lazy sequence of substrings, alternating - between substrings that match the patthern and the substrings - between the matches. The sequence always starts with the substring - before the first match, or an empty string if the beginning of the - string matches. - - For example: (partition #\"[a-z]+\" \"abc123def\") - returns: (\"\" \"abc\" \"123\" \"def\")" - [^Pattern re ^String s] - (let [m (re-matcher re s)] - ((fn step [prevend] - (lazy-seq - (if (.find m) - (cons (.subSequence s prevend (.start m)) - (cons (re-groups m) - (step (+ (.start m) (count (.group m)))))) - (when (< prevend (.length s)) - (list (.subSequence s prevend (.length s))))))) - 0))) - -(defn ^String join - "Returns a string of all elements in coll, separated by - separator. Like Perl's join." - {:deprecated "1.2"} - [^String separator coll] - (apply str (interpose separator coll))) - -(defn ^String chop - "Removes the last character of string, does nothing on a zero-length - string." - [^String s] - (let [size (count s)] - (if (zero? size) - s - (subs s 0 (dec (count s)))))) - -(defn ^String chomp - "Removes all trailing newline \\n or return \\r characters from - string. Note: String.trim() is similar and faster. - Deprecated in 1.2. Use clojure.string/trim-newline" - {:deprecated "1.2"} - [^String s] - (replace-re #"[\r\n]+$" "" s)) - -(defn ^String swap-case - "Changes upper case characters to lower case and vice-versa. - Handles Unicode supplementary characters correctly. Uses the - locale-sensitive String.toUpperCase() and String.toLowerCase() - methods." - [^String s] - (let [buffer (StringBuilder. (.length s)) - ;; array to make a String from one code point - ^"[I" array (make-array Integer/TYPE 1)] - (docodepoints [c s] - (aset-int array 0 c) - (if (Character/isLowerCase c) - ;; Character.toUpperCase is not locale-sensitive, but - ;; String.toUpperCase is; so we use a String. - (.append buffer (.toUpperCase (String. array 0 1))) - (.append buffer (.toLowerCase (String. array 0 1))))) - (.toString buffer))) - -(defn ^String capitalize - "Converts first character of the string to upper-case, all other - characters to lower-case." - {:deprecated "1.2"} - [^String s] - (if (< (count s) 2) - (.toUpperCase s) - (str (.toUpperCase ^String (subs s 0 1)) - (.toLowerCase ^String (subs s 1))))) - -(defn ^String ltrim - "Removes whitespace from the left side of string. - Deprecated in 1.2. Use clojure.string/triml." - {:deprecated "1.2"} - [^String s] - (replace-re #"^\s+" "" s)) - -(defn ^String rtrim - "Removes whitespace from the right side of string. - Deprecated in 1.2. Use clojure.string/trimr." - {:deprecated "1.2"} - [^String s] - (replace-re #"\s+$" "" s)) - -(defn split-lines - "Splits s on \\n or \\r\\n." - {:deprecated "1.2"} - [^String s] - (seq (.split #"\r?\n" s))) - -;; borrowed from compojure.string, by James Reeves, EPL 1.0 -(defn ^String map-str - "Apply f to each element of coll, concatenate all results into a - String." - [f coll] - (apply str (map f coll))) - -;; borrowed from compojure.string, by James Reeves, EPL 1.0 -(defn grep - "Filters elements of coll by a regular expression. The String - representation (with str) of each element is tested with re-find." - [re coll] - (filter (fn [x] (re-find re (str x))) coll)) - -(defn as-str - "Like clojure.core/str, but if an argument is a keyword or symbol, - its name will be used instead of its literal representation. - - Example: - (str :foo :bar) ;;=> \":foo:bar\" - (as-str :foo :bar) ;;=> \"foobar\" - - Note that this does not apply to keywords or symbols nested within - data structures; they will be rendered as with str. - - Example: - (str {:foo :bar}) ;;=> \"{:foo :bar}\" - (as-str {:foo :bar}) ;;=> \"{:foo :bar}\" " - ([] "") - ([x] (if (instance? clojure.lang.Named x) - (name x) - (str x))) - ([x & ys] - ((fn [^StringBuilder sb more] - (if more - (recur (. sb (append (as-str (first more)))) (next more)) - (str sb))) - (new StringBuilder ^String (as-str x)) ys))) - - -;;; WRAPPERS - -;; The following functions are simple wrappers around java.lang.String -;; functions. They are included here for completeness, and for use -;; when mapping over a collection of strings. - -(defn ^String upper-case - "Converts string to all upper-case." - {:deprecated "1.2"} - [^String s] - (.toUpperCase s)) - -(defn ^String lower-case - "Converts string to all lower-case." - {:deprecated "1.2"} - [^String s] - (.toLowerCase s)) - -(defn split - "Splits string on a regular expression. Optional argument limit is - the maximum number of splits." - {:deprecated "1.2"} - ([^Pattern re ^String s] (seq (.split re s))) - ([^Pattern re limit ^String s] (seq (.split re s limit)))) - -(defn ^String trim - "Removes whitespace from both ends of string." - {:deprecated "1.2"} - [^String s] - (.trim s)) - -(defn ^String substring? - "True if s contains the substring." - [substring ^String s] - (.contains s substring)) - -(defn ^String get - "Gets the i'th character in string." - {:deprecated "1.2"} - [^String s i] - (.charAt s i)) - diff --git a/modules/string/src/test/clojure/clojure/contrib/test_string.clj b/modules/string/src/test/clojure/clojure/contrib/test_string.clj deleted file mode 100644 index 98f03a78..00000000 --- a/modules/string/src/test/clojure/clojure/contrib/test_string.clj +++ /dev/null @@ -1,124 +0,0 @@ -(ns clojure.contrib.test-string - (:require [clojure.contrib.string :as s]) - (:use clojure.test)) - -(deftest t-codepoints - (is (= (list 102 111 111 65536 98 97 114) - (s/codepoints "foo\uD800\uDC00bar")) - "Handles Unicode supplementary characters")) - -(deftest t-escape - (is (= "<foo&bar>" - (s/escape {\& "&" \< "<" \> ">"} ""))) - (is (= " \\\"foo\\\" " - (s/escape {\" "\\\""} " \"foo\" " ))) - (is (= "faabor" (s/escape {\a \o, \o \a} "foobar")))) - -(deftest t-blank - (is (s/blank? nil)) - (is (s/blank? "")) - (is (s/blank? " ")) - (is (s/blank? " \t \n \r ")) - (is (not (s/blank? " foo ")))) - -(deftest t-take - (is (= "foo" (s/take 3 "foobar"))) - (is (= "foobar" (s/take 7 "foobar"))) - (is (= "" (s/take 0 "foo")))) - -(deftest t-drop - (is (= "bar" (s/drop 3 "foobar"))) - (is (= "" (s/drop 9 "foobar"))) - (is (= "foobar" (s/drop 0 "foobar")))) - -(deftest t-butlast - (is (= "foob" (s/butlast 2 "foobar"))) - (is (= "" (s/butlast 9 "foobar"))) - (is (= "foobar" (s/butlast 0 "foobar")))) - -(deftest t-tail - (is (= "ar" (s/tail 2 "foobar"))) - (is (= "foobar" (s/tail 9 "foobar"))) - (is (= "" (s/tail 0 "foobar")))) - -(deftest t-repeat - (is (= "foofoofoo" (s/repeat 3 "foo")))) - -(deftest t-reverse - (is (= "tab" (s/reverse "bat")))) - -(deftest t-replace - (is (= "faabar" (s/replace-char \o \a "foobar"))) - (is (= "barbarbar" (s/replace-str "foo" "bar" "foobarfoo"))) - (is (= "FOObarFOO" (s/replace-by #"foo" s/upper-case "foobarfoo")))) - -(deftest t-replace-first - (is (= "barbarfoo" (s/replace-first-re #"foo" "bar" "foobarfoo"))) - (is (= "FOObarfoo" (s/replace-first-by #"foo" s/upper-case "foobarfoo")))) - -(deftest t-partition - (is (= (list "" "abc" "123" "def") - (s/partition #"[a-z]+" "abc123def")))) - -(deftest t-join - (is (= "1,2,3" (s/join \, [1 2 3]))) - (is (= "" (s/join \, []))) - (is (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3])))) - -(deftest t-chop - (is (= "fo" (s/chop "foo"))) - (is (= "") (s/chop "f")) - (is (= "") (s/chop ""))) - -(deftest t-chomp - (is (= "foo" (s/chomp "foo\n"))) - (is (= "foo" (s/chomp "foo\r\n"))) - (is (= "foo" (s/chomp "foo"))) - (is (= "" (s/chomp "")))) - -(deftest t-swap-case - (is (= "fOO!bAR" (s/swap-case "Foo!Bar"))) - (is (= "" (s/swap-case "")))) - -(deftest t-capitalize - (is (= "Foobar" (s/capitalize "foobar"))) - (is (= "Foobar" (s/capitalize "FOOBAR")))) - -(deftest t-ltrim - (is (= "foo " (s/ltrim " foo "))) - (is (= "" (s/ltrim " ")))) - -(deftest t-rtrim - (is (= " foo" (s/rtrim " foo "))) - (is (= "" (s/rtrim " ")))) - -(deftest t-split-lines - (is (= (list "one" "two" "three") - (s/split-lines "one\ntwo\r\nthree"))) - (is (= (list "foo") (s/split-lines "foo")))) - -(deftest t-upper-case - (is (= "FOOBAR" (s/upper-case "Foobar")))) - -(deftest t-lower-case - (is (= "foobar" (s/lower-case "FooBar")))) - -(deftest t-trim - (is (= "foo" (s/trim " foo \r\n")))) - -(deftest t-substring - (is (s/substring? "foo" "foobar")) - (is (not (s/substring? "baz" "foobar")))) - -(deftest t-get - (is (= \o (s/get "foo" 1)))) - -(deftest t-as-str - (testing "keyword to string" - (is (= "foo") (s/as-str :foo))) - (testing "symbol to string" - (is (= "foo") (s/as-str 'foo))) - (testing "string to string" - (is (= "foo") (s/as-str "foo"))) - (testing "stringifying non-namish things" - (is (= "42") (s/as-str 42)))) diff --git a/pom.xml b/pom.xml index b86e9610..0a875049 100644 --- a/pom.xml +++ b/pom.xml @@ -78,7 +78,6 @@ modules/singleton modules/sql modules/stream-utils - modules/string modules/strint modules/swing-utils modules/trace -- cgit v1.2.3-18-g5258 From d6f519411d9d8f02ee1db134d288879ee23e00e4 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 17:15:08 +0200 Subject: removed deprecated clojure.contrib.duck-streams Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/duck-streams/pom.xml | 16 - .../main/clojure/clojure/contrib/duck_streams.clj | 418 --------------------- pom.xml | 1 - 4 files changed, 440 deletions(-) delete mode 100644 modules/duck-streams/pom.xml delete mode 100644 modules/duck-streams/src/main/clojure/clojure/contrib/duck_streams.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index ea44dbc0..2cd121cd 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -100,11 +100,6 @@ def 1.3.0-SNAPSHOT - - org.clojure.contrib - duck-streams - 1.3.0-SNAPSHOT - org.clojure.contrib error-kit diff --git a/modules/duck-streams/pom.xml b/modules/duck-streams/pom.xml deleted file mode 100644 index 4449a8a1..00000000 --- a/modules/duck-streams/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - duck-streams - - - \ No newline at end of file diff --git a/modules/duck-streams/src/main/clojure/clojure/contrib/duck_streams.clj b/modules/duck-streams/src/main/clojure/clojure/contrib/duck_streams.clj deleted file mode 100644 index 8164ffb2..00000000 --- a/modules/duck-streams/src/main/clojure/clojure/contrib/duck_streams.clj +++ /dev/null @@ -1,418 +0,0 @@ -;;; duck_streams.clj -- duck-typed I/O streams for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; May 13, 2009 - -;; Copyright (c) Stuart Sierra, 2009. 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. - - -;; This file defines "duck-typed" I/O utility functions for Clojure. -;; The 'reader' and 'writer' functions will open and return an -;; instance of java.io.BufferedReader and java.io.PrintWriter, -;; respectively, for a variety of argument types -- filenames as -;; strings, URLs, java.io.File's, etc. 'reader' even works on http -;; URLs. -;; -;; Note: this is not really "duck typing" as implemented in languages -;; like Ruby. A better name would have been "do-what-I-mean-streams" -;; or "just-give-me-a-stream", but ducks are funnier. - - -;; CHANGE LOG -;; -;; July 23, 2010: DEPRECATED in 1.2. Use clojure.java.io instead. -;; -;; May 13, 2009: added functions to open writers for appending -;; -;; May 3, 2009: renamed file to file-str, for compatibility with -;; clojure.contrib.java-utils. reader/writer no longer use this -;; function. -;; -;; February 16, 2009: (lazy branch) fixed read-lines to work with lazy -;; Clojure. -;; -;; January 10, 2009: added *default-encoding*, so streams are always -;; opened as UTF-8. -;; -;; December 19, 2008: rewrote reader and writer as multimethods; added -;; slurp*, file, and read-lines -;; -;; April 8, 2008: first version - -(ns - ^{:author "Stuart Sierra", - :deprecated "1.2" - :doc "This file defines \"duck-typed\" I/O utility functions for Clojure. - The 'reader' and 'writer' functions will open and return an - instance of java.io.BufferedReader and java.io.PrintWriter, - respectively, for a variety of argument types -- filenames as - strings, URLs, java.io.File's, etc. 'reader' even works on http - URLs. - - Note: this is not really \"duck typing\" as implemented in languages - like Ruby. A better name would have been \"do-what-I-mean-streams\" - or \"just-give-me-a-stream\", but ducks are funnier."} - clojure.contrib.duck-streams - (:refer-clojure :exclude (spit)) - (:import - (java.io Reader InputStream InputStreamReader PushbackReader - BufferedReader File PrintWriter OutputStream - OutputStreamWriter BufferedWriter Writer - FileInputStream FileOutputStream ByteArrayOutputStream - StringReader ByteArrayInputStream) - (java.net URI URL MalformedURLException Socket))) - - -(def - ^{:doc "Name of the default encoding to use when reading & writing. - Default is UTF-8." - :tag "java.lang.String"} - *default-encoding* "UTF-8") - -(def - ^{:doc "Size, in bytes or characters, of the buffer used when - copying streams."} - *buffer-size* 1024) - -(def - ^{:doc "Type object for a Java primitive byte array."} - *byte-array-type* (class (make-array Byte/TYPE 0))) - - -(defn ^File file-str - "Concatenates args as strings and returns a java.io.File. Replaces - all / and \\ with File/separatorChar. Replaces ~ at the start of - the path with the user.home system property." - [& args] - (let [^String s (apply str args) - s (.replaceAll (re-matcher #"[/\\]" s) File/separator) - s (if (.startsWith s "~") - (str (System/getProperty "user.home") - File/separator (subs s 1)) - s)] - (File. s))) - - -(defmulti ^{:tag BufferedReader - :doc "Attempts to coerce its argument into an open - java.io.BufferedReader. Argument may be an instance of Reader, - BufferedReader, InputStream, File, URI, URL, Socket, or String. - - If argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. Uses *default-encoding* as the text encoding. - - Should be used inside with-open to ensure the Reader is properly - closed." - :arglists '([x])} - reader class) - -(defmethod reader Reader [x] - (BufferedReader. x)) - -(defmethod reader InputStream [^InputStream x] - (BufferedReader. (InputStreamReader. x *default-encoding*))) - -(defmethod reader File [^File x] - (reader (FileInputStream. x))) - -(defmethod reader URL [^URL x] - (reader (if (= "file" (.getProtocol x)) - (FileInputStream. (.getPath x)) - (.openStream x)))) - -(defmethod reader URI [^URI x] - (reader (.toURL x))) - -(defmethod reader String [^String x] - (try (let [url (URL. x)] - (reader url)) - (catch MalformedURLException e - (reader (File. x))))) - -(defmethod reader Socket [^Socket x] - (reader (.getInputStream x))) - -(defmethod reader :default [x] - (throw (Exception. (str "Cannot open " (pr-str x) " as a reader.")))) - - -(def - ^{:doc "If true, writer and spit will open files in append mode. - Defaults to false. Use append-writer or append-spit." - :tag "java.lang.Boolean"} - *append-to-writer* false) - - -(defmulti ^{:tag PrintWriter - :doc "Attempts to coerce its argument into an open java.io.PrintWriter - wrapped around a java.io.BufferedWriter. Argument may be an - instance of Writer, PrintWriter, BufferedWriter, OutputStream, File, - URI, URL, Socket, or String. - - If argument is a String, it tries to resolve it first as a URI, then - as a local file name. URIs with a 'file' protocol are converted to - local file names. - - Should be used inside with-open to ensure the Writer is properly - closed." - :arglists '([x])} - writer class) - -(defn- assert-not-appending [] - (when *append-to-writer* - (throw (Exception. "Cannot change an open stream to append mode.")))) - -(defmethod writer PrintWriter [x] - (assert-not-appending) - x) - -(defmethod writer BufferedWriter [^BufferedWriter x] - (assert-not-appending) - (PrintWriter. x)) - -(defmethod writer Writer [x] - (assert-not-appending) - ;; Writer includes sub-classes such as FileWriter - (PrintWriter. (BufferedWriter. x))) - -(defmethod writer OutputStream [^OutputStream x] - (assert-not-appending) - (PrintWriter. - (BufferedWriter. - (OutputStreamWriter. x *default-encoding*)))) - -(defmethod writer File [^File x] - (let [stream (FileOutputStream. x *append-to-writer*)] - (binding [*append-to-writer* false] - (writer stream)))) - -(defmethod writer URL [^URL x] - (if (= "file" (.getProtocol x)) - (writer (File. (.getPath x))) - (throw (Exception. (str "Cannot write to non-file URL <" x ">"))))) - -(defmethod writer URI [^URI x] - (writer (.toURL x))) - -(defmethod writer String [^String x] - (try (let [url (URL. x)] - (writer url)) - (catch MalformedURLException err - (writer (File. x))))) - -(defmethod writer Socket [^Socket x] - (writer (.getOutputStream x))) - -(defmethod writer :default [x] - (throw (Exception. (str "Cannot open <" (pr-str x) "> as a writer.")))) - - -(defn append-writer - "Like writer but opens file for appending. Does not work on streams - that are already open." - [x] - (binding [*append-to-writer* true] - (writer x))) - - -(defn write-lines - "Writes lines (a seq) to f, separated by newlines. f is opened with - writer, and automatically closed at the end of the sequence." - [f lines] - (with-open [^PrintWriter writer (writer f)] - (loop [lines lines] - (when-let [line (first lines)] - (.write writer (str line)) - (.println writer) - (recur (rest lines)))))) - -(defn read-lines - "Like clojure.core/line-seq but opens f with reader. Automatically - closes the reader AFTER YOU CONSUME THE ENTIRE SEQUENCE." - [f] - (let [read-line (fn this [^BufferedReader rdr] - (lazy-seq - (if-let [line (.readLine rdr)] - (cons line (this rdr)) - (.close rdr))))] - (read-line (reader f)))) - -(defn ^String slurp* - "Like clojure.core/slurp but opens f with reader." - [f] - (with-open [^BufferedReader r (reader f)] - (let [sb (StringBuilder.)] - (loop [c (.read r)] - (if (neg? c) - (str sb) - (do (.append sb (char c)) - (recur (.read r)))))))) - -(defn spit - "Opposite of slurp. Opens f with writer, writes content, then - closes f." - [f content] - (with-open [^PrintWriter w (writer f)] - (.print w content))) - -(defn append-spit - "Like spit but appends to file." - [f content] - (with-open [^PrintWriter w (append-writer f)] - (.print w content))) - -(defn pwd - "Returns current working directory as a String. (Like UNIX 'pwd'.) - Note: In Java, you cannot change the current working directory." - [] - (System/getProperty "user.dir")) - - - -(defmacro with-out-writer - "Opens a writer on f, binds it to *out*, and evalutes body. - Anything printed within body will be written to f." - [f & body] - `(with-open [stream# (writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-out-append-writer - "Like with-out-writer but appends to file." - [f & body] - `(with-open [stream# (append-writer ~f)] - (binding [*out* stream#] - ~@body))) - -(defmacro with-in-reader - "Opens a PushbackReader on f, binds it to *in*, and evaluates body." - [f & body] - `(with-open [stream# (PushbackReader. (reader ~f))] - (binding [*in* stream#] - ~@body))) - -(defmulti - ^{:doc "Copies input to output. Returns nil. - Input may be an InputStream, Reader, File, byte[], or String. - Output may be an OutputStream, Writer, or File. - - Does not close any streams except those it opens itself - (on a File). - - Writing a File fails if the parent directory does not exist." - :arglists '([input output])} - copy - (fn [input output] [(type input) (type output)])) - -(defmethod copy [InputStream OutputStream] [^InputStream input ^OutputStream output] - (let [buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [InputStream Writer] [^InputStream input ^Writer output] - (let [^"[B" buffer (make-array Byte/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [chars (.toCharArray (String. buffer 0 size *default-encoding*))] - (do (.write output chars) - (recur)))))))) - -(defmethod copy [InputStream File] [^InputStream input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [Reader OutputStream] [^Reader input ^OutputStream output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (let [bytes (.getBytes (String. buffer 0 size) *default-encoding*)] - (do (.write output bytes) - (recur)))))))) - -(defmethod copy [Reader Writer] [^Reader input ^Writer output] - (let [^"[C" buffer (make-array Character/TYPE *buffer-size*)] - (loop [] - (let [size (.read input buffer)] - (when (pos? size) - (do (.write output buffer 0 size) - (recur))))))) - -(defmethod copy [Reader File] [^Reader input ^File output] - (with-open [out (FileOutputStream. output)] - (copy input out))) - -(defmethod copy [File OutputStream] [^File input ^OutputStream output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File Writer] [^File input ^Writer output] - (with-open [in (FileInputStream. input)] - (copy in output))) - -(defmethod copy [File File] [^File input ^File output] - (with-open [in (FileInputStream. input) - out (FileOutputStream. output)] - (copy in out))) - -(defmethod copy [String OutputStream] [^String input ^OutputStream output] - (copy (StringReader. input) output)) - -(defmethod copy [String Writer] [^String input ^Writer output] - (copy (StringReader. input) output)) - -(defmethod copy [String File] [^String input ^File output] - (copy (StringReader. input) output)) - -(defmethod copy [*byte-array-type* OutputStream] [^"[B" input ^OutputStream output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* Writer] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - -(defmethod copy [*byte-array-type* File] [^"[B" input ^Writer output] - (copy (ByteArrayInputStream. input) output)) - - -(defn make-parents - "Creates all parent directories of file." - [^File file] - (.mkdirs (.getParentFile file))) - -(defmulti - ^{:doc "Converts argument into a Java byte array. Argument may be - a String, File, InputStream, or Reader. If the argument is already - a byte array, returns it." - :arglists '([arg])} - to-byte-array type) - -(defmethod to-byte-array *byte-array-type* [x] x) - -(defmethod to-byte-array String [^String x] - (.getBytes x *default-encoding*)) - -(defmethod to-byte-array File [^File x] - (with-open [input (FileInputStream. x) - buffer (ByteArrayOutputStream.)] - (copy input buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array InputStream [^InputStream x] - (let [buffer (ByteArrayOutputStream.)] - (copy x buffer) - (.toByteArray buffer))) - -(defmethod to-byte-array Reader [^Reader x] - (.getBytes (slurp* x) *default-encoding*)) - diff --git a/pom.xml b/pom.xml index 0a875049..518a2868 100644 --- a/pom.xml +++ b/pom.xml @@ -35,7 +35,6 @@ modules/dataflow modules/datalog modules/def - modules/duck-streams modules/error-kit modules/except modules/fcase -- cgit v1.2.3-18-g5258 From cb832f62e793023af70e465d878ab0dea1250b5b Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 17:46:01 +0200 Subject: removed deprecated clojure.contrib.java-utils Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/java-utils/pom.xml | 16 -- .../main/clojure/clojure/contrib/java_utils.clj | 219 --------------------- pom.xml | 1 - 4 files changed, 241 deletions(-) delete mode 100644 modules/java-utils/pom.xml delete mode 100644 modules/java-utils/src/main/clojure/clojure/contrib/java_utils.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 2cd121cd..09d3247a 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -155,11 +155,6 @@ jar 1.3.0-SNAPSHOT - - org.clojure.contrib - java-utils - 1.3.0-SNAPSHOT - org.clojure.contrib jmx diff --git a/modules/java-utils/pom.xml b/modules/java-utils/pom.xml deleted file mode 100644 index 7c276109..00000000 --- a/modules/java-utils/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - java-utils - - - \ No newline at end of file diff --git a/modules/java-utils/src/main/clojure/clojure/contrib/java_utils.clj b/modules/java-utils/src/main/clojure/clojure/contrib/java_utils.clj deleted file mode 100644 index 65e84eda..00000000 --- a/modules/java-utils/src/main/clojure/clojure/contrib/java_utils.clj +++ /dev/null @@ -1,219 +0,0 @@ -; Copyright (c) Stuart Halloway & Contributors, April 2009. 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. - -;; -;; CHANGELOG -;; -;; Most functions deprecated in 1.2. Some already exist in c.c.io, and -;; some replaced by c.c.reflections - -(ns - ^{:author "Stuart Halloway, Stephen C. Gilardi, Shawn Hoover, Perry Trolard, Stuart Sierra", - :doc "A set of utilties for dealing with Java stuff like files and properties. - - Design goals: - - (1) Ease-of-use. These APIs should be convenient. Performance is secondary. - - (2) Duck typing. I hate having to think about the difference between - a string that names a file, and a File. Ditto for a ton of other - wrapper classes in the Java world (URL, InternetAddress). With these - APIs you should be able to think about domain equivalence, not type - equivalence. - - (3) No bossiness. I am not marking any of these functions as private - the docstrings will tell you the intended usage but do what works for you. - - Feedback welcome! - - If something in this module violates the principle of least surprise, please - let me (Stu) and the Clojure community know via the mailing list. - Contributors: - - Stuart Halloway - Stephen C. Gilardi - Shawn Hoover - Perry Trolard - Stuart Sierra -"} - clojure.contrib.java-utils - (:import [java.io File FileOutputStream] - [java.util Properties] - [java.net URI URL])) - -(defmulti relative-path-string - "Interpret a String or java.io.File as a relative path string. - Building block for clojure.contrib.java-utils/file." - {:deprecated "1.2"} - class) - -(defmethod relative-path-string String [^String s] - (relative-path-string (File. s))) - -(defmethod relative-path-string File [^File f] - (if (.isAbsolute f) - (throw (IllegalArgumentException. (str f " is not a relative path"))) - (.getPath f))) - -(defmulti ^File as-file - "Interpret a String or a java.io.File as a File. Building block - for clojure.contrib.java-utils/file, which you should prefer - in most cases." - {:deprecated "1.2"} - class) -(defmethod as-file String [^String s] (File. s)) -(defmethod as-file File [f] f) - -(defn ^File file - "Returns a java.io.File from string or file args." - {:deprecated "1.2"} - ([arg] - (as-file arg)) - ([parent child] - (File. ^File (as-file parent) ^String (relative-path-string child))) - ([parent child & more] - (reduce file (file parent child) more))) - -(defn as-str - "Like clojure.core/str, but if an argument is a keyword or symbol, - its name will be used instead of its literal representation. - - Example: - (str :foo :bar) ;;=> \":foo:bar\" - (as-str :foo :bar) ;;=> \"foobar\" - - Note that this does not apply to keywords or symbols nested within - data structures; they will be rendered as with str. - - Example: - (str {:foo :bar}) ;;=> \"{:foo :bar}\" - (as-str {:foo :bar}) ;;=> \"{:foo :bar}\" " - {:deprecated "1.2"} - ([] "") - ([x] (if (instance? clojure.lang.Named x) - (name x) - (str x))) - ([x & ys] - ((fn [^StringBuilder sb more] - (if more - (recur (. sb (append (as-str (first more)))) (next more)) - (str sb))) - (new StringBuilder ^String (as-str x)) ys))) - -(defn get-system-property - "Get a system property." - ([stringable] - (System/getProperty (as-str stringable))) - ([stringable default] - (System/getProperty (as-str stringable) default))) - -(defn set-system-properties - "Set some system properties. Nil clears a property." - [settings] - (doseq [[name val] settings] - (if val - (System/setProperty (as-str name) (as-str val)) - (System/clearProperty (as-str name))))) - -(defmacro with-system-properties - "setting => property-name value - - Sets the system properties to the supplied values, executes the body, and - sets the properties back to their original values. Values of nil are - translated to a clearing of the property." - [settings & body] - `(let [settings# ~settings - current# (reduce (fn [coll# k#] - (assoc coll# k# (get-system-property k#))) - {} - (keys settings#))] - (set-system-properties settings#) - (try - ~@body - (finally - (set-system-properties current#))))) - - -; Not there is no corresponding props->map. Just destructure! -(defn ^Properties as-properties - "Convert any seq of pairs to a java.utils.Properties instance. - Uses as-str to convert both keys and values into strings." - {:tag Properties} - [m] - (let [p (Properties.)] - (doseq [[k v] m] - (.setProperty p (as-str k) (as-str v))) - p)) - -(defn read-properties - "Read properties from file-able." - [file-able] - (with-open [f (java.io.FileInputStream. (file file-able))] - (doto (Properties.) - (.load f)))) - -(defn write-properties - "Write properties to file-able." - {:tag Properties} - ([m file-able] (write-properties m file-able nil)) - ([m file-able comments] - (with-open [^FileOutputStream f (FileOutputStream. (file file-able))] - (doto (as-properties m) - (.store f ^String comments))))) - -(defn delete-file - "Delete file f. Raise an exception if it fails unless silently is true." - {:deprecated "1.2"} - [f & [silently]] - (or (.delete (file f)) - silently - (throw (java.io.IOException. (str "Couldn't delete " f))))) - -(defn delete-file-recursively - "Delete file f. If it's a directory, recursively delete all its contents. -Raise an exception if any deletion fails unless silently is true." - {:deprecated "1.2"} - [f & [silently]] - (let [f (file f)] - (if (.isDirectory f) - (doseq [child (.listFiles f)] - (delete-file-recursively child silently))) - (delete-file f silently))) - -(defmulti - ^{:deprecated "1.2" - :doc "Coerces argument (URL, URI, or String) to a java.net.URL." - :arglists '([arg])} - as-url type) - -(defmethod as-url URL [x] x) - -(defmethod as-url URI [^URI x] (.toURL x)) - -(defmethod as-url String [^String x] (URL. x)) - -(defmethod as-url File [^File x] (.toURL x)) - -(defn wall-hack-method - "Calls a private or protected method. - params is a vector of class which correspond to the arguments to the method - obj is nil for static methods, the instance object otherwise - the method name is given as a symbol or a keyword (something Named)" - {:deprecated "1.2"} - [class-name method-name params obj & args] - (-> class-name (.getDeclaredMethod (name method-name) (into-array Class params)) - (doto (.setAccessible true)) - (.invoke obj (into-array Object args)))) - -(defn wall-hack-field - "Access to private or protected field." - {:deprecated "1.2"} - [class-name field-name obj] - (-> class-name (.getDeclaredField (name field-name)) - (doto (.setAccessible true)) - (.get obj))) diff --git a/pom.xml b/pom.xml index 518a2868..172a7209 100644 --- a/pom.xml +++ b/pom.xml @@ -46,7 +46,6 @@ modules/greatest-least modules/import-static modules/jar - modules/java-utils modules/jmx modules/json modules/lazy-seqs -- cgit v1.2.3-18-g5258 From 9a05c1c70a1070f5a631dfc81ed98d6c70b33a9d Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 18:17:22 +0200 Subject: removed deprecated clojure.contrib.pprint Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/json/pom.xml | 5 - .../json/src/main/clojure/clojure/contrib/json.clj | 2 +- modules/pprint/pom.xml | 14 - .../src/main/clojure/clojure/contrib/pprint.clj | 43 - .../clojure/clojure/contrib/pprint/cl_format.clj | 1844 -------------------- .../clojure/contrib/pprint/column_writer.clj | 80 - .../clojure/clojure/contrib/pprint/dispatch.clj | 447 ----- .../clojure/clojure/contrib/pprint/pprint_base.clj | 342 ---- .../clojure/contrib/pprint/pretty_writer.clj | 488 ------ .../clojure/clojure/contrib/pprint/utilities.clj | 104 -- .../clojure/contrib/pprint/test_cl_format.clj | 691 -------- .../clojure/clojure/contrib/pprint/test_helper.clj | 21 - .../clojure/clojure/contrib/pprint/test_pretty.clj | 127 -- pom.xml | 1 - 15 files changed, 1 insertion(+), 4213 deletions(-) delete mode 100644 modules/pprint/pom.xml delete mode 100644 modules/pprint/src/main/clojure/clojure/contrib/pprint.clj delete mode 100644 modules/pprint/src/main/clojure/clojure/contrib/pprint/cl_format.clj delete mode 100644 modules/pprint/src/main/clojure/clojure/contrib/pprint/column_writer.clj delete mode 100644 modules/pprint/src/main/clojure/clojure/contrib/pprint/dispatch.clj delete mode 100644 modules/pprint/src/main/clojure/clojure/contrib/pprint/pprint_base.clj delete mode 100644 modules/pprint/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj delete mode 100644 modules/pprint/src/main/clojure/clojure/contrib/pprint/utilities.clj delete mode 100644 modules/pprint/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj delete mode 100644 modules/pprint/src/test/clojure/clojure/contrib/pprint/test_helper.clj delete mode 100644 modules/pprint/src/test/clojure/clojure/contrib/pprint/test_pretty.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 09d3247a..0fdbea7d 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -230,11 +230,6 @@ ns-utils 1.3.0-SNAPSHOT - - org.clojure.contrib - pprint - 1.3.0-SNAPSHOT - org.clojure.contrib priority-map diff --git a/modules/json/pom.xml b/modules/json/pom.xml index 5cf987c4..445723e7 100644 --- a/modules/json/pom.xml +++ b/modules/json/pom.xml @@ -12,10 +12,5 @@ json - - org.clojure.contrib - pprint - 1.3.0-SNAPSHOT - \ No newline at end of file diff --git a/modules/json/src/main/clojure/clojure/contrib/json.clj b/modules/json/src/main/clojure/clojure/contrib/json.clj index 457f33c9..f8008f7e 100644 --- a/modules/json/src/main/clojure/clojure/contrib/json.clj +++ b/modules/json/src/main/clojure/clojure/contrib/json.clj @@ -17,7 +17,7 @@ To write JSON, use json-str, write-json, or write-json. To read JSON, use read-json."} clojure.contrib.json - (:use [clojure.contrib.pprint :only (write formatter-out)]) + (:use [clojure.pprint :only (write formatter-out)]) (:import (java.io PrintWriter PushbackReader StringWriter StringReader Reader EOFException))) diff --git a/modules/pprint/pom.xml b/modules/pprint/pom.xml deleted file mode 100644 index fd5e7526..00000000 --- a/modules/pprint/pom.xml +++ /dev/null @@ -1,14 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - pprint - \ No newline at end of file diff --git a/modules/pprint/src/main/clojure/clojure/contrib/pprint.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint.clj deleted file mode 100644 index 27c1be73..00000000 --- a/modules/pprint/src/main/clojure/clojure/contrib/pprint.clj +++ /dev/null @@ -1,43 +0,0 @@ -;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -;; Copyright (c) Tom Faulhaber, April 2009. 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. - -;; DEPRECATED in 1.2. Promoted to clojure.pprint - -(ns - ^{:author "Tom Faulhaber", - :deprecated "1.2" - :doc "This module comprises two elements: -1) A pretty printer for Clojure data structures, implemented in the - function \"pprint\" -2) A Common Lisp compatible format function, implemented as - \"cl-format\" because Clojure is using the name \"format\" - for its Java-based format function. - -See documentation for those functions for more information or complete -documentation on the the clojure-contrib web site on github. - -As of the 1.2 release, pprint has been moved to clojure.pprint. Please prefer -the clojure.pprint version for new code.", - } - clojure.contrib.pprint - (:use clojure.contrib.pprint.utilities) - (:use clojure.contrib.pprint.pretty-writer - clojure.contrib.pprint.column-writer)) - - -(load "pprint/pprint_base") -(load "pprint/cl_format") -(load "pprint/dispatch") - -nil diff --git a/modules/pprint/src/main/clojure/clojure/contrib/pprint/cl_format.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/cl_format.clj deleted file mode 100644 index 85f29b13..00000000 --- a/modules/pprint/src/main/clojure/clojure/contrib/pprint/cl_format.clj +++ /dev/null @@ -1,1844 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, 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. - -;; This module implements the Common Lisp compatible format function as documented -;; in "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) - -(in-ns 'clojure.contrib.pprint) - -;;; Forward references -(declare compile-format) -(declare execute-format) -(declare init-navigator) -;;; End forward references - -(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 -" - {:see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" - "Common Lisp the Language"] - ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm" - "Common Lisp HyperSpec"]]} - [writer format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format writer compiled-format navigator))) - -(def ^{:private true} *format-str* nil) - -(defn- format-error [message offset] - (let [full-message (str message \newline *format-str* \newline - (apply str (repeat offset \space)) "^" \newline)] - (throw (RuntimeException. full-message)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Argument navigators manage the argument list -;;; as the format statement moves through the list -;;; (possibly going forwards and backwards as it does so) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct ^{:private true} - arg-navigator :seq :rest :pos ) - -(defn init-navigator - "Create a new arg-navigator from the sequence with the position set to 0" - {:skip-wiki true} - [s] - (let [s (seq s)] - (struct arg-navigator s s 0))) - -;; TODO call format-error with offset -(defn- next-arg [ navigator ] - (let [ rst (:rest navigator) ] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - (throw (new Exception "Not enough arguments for format definition"))))) - -(defn- next-arg-or-nil [navigator] - (let [rst (:rest navigator)] - (if rst - [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))] - [nil navigator]))) - -;; Get an argument off the arg list and compile it if it's not already compiled -(defn- get-format-arg [navigator] - (let [[raw-format navigator] (next-arg navigator) - compiled-format (if (instance? String raw-format) - (compile-format raw-format) - raw-format)] - [compiled-format navigator])) - -(declare relative-reposition) - -(defn- absolute-reposition [navigator position] - (if (>= position (:pos navigator)) - (relative-reposition navigator (- (:pos navigator) position)) - (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position))) - -(defn- relative-reposition [navigator position] - (let [newpos (+ (:pos navigator) position)] - (if (neg? position) - (absolute-reposition navigator newpos) - (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos)))) - -(defstruct ^{:private true} - compiled-directive :func :def :params :offset) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; When looking at the parameter list, we may need to manipulate -;;; the argument list as well (for 'V' and '#' parameter types). -;;; We hide all of this behind a function, but clients need to -;;; manage changing arg navigator -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: validate parameters when they come from arg list -(defn- realize-parameter [[param [raw-val offset]] navigator] - (let [[real-param new-navigator] - (cond - (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary - [raw-val navigator] - - (= raw-val :parameter-from-args) - (next-arg navigator) - - (= raw-val :remaining-arg-count) - [(count (:rest navigator)) navigator] - - true - [raw-val navigator])] - [[param [real-param offset]] new-navigator])) - -(defn- realize-parameter-list [parameter-map navigator] - (let [[pairs new-navigator] - (map-passing-context realize-parameter navigator parameter-map)] - [(into {} pairs) new-navigator])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions that support individual directives -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Common handling code for ~A and ~S -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare opt-base-str) - -(def ^{:private true} - special-radix-markers {2 "#b" 8 "#o", 16 "#x"}) - -(defn- format-simple-number [n] - (cond - (integer? n) (if (= *print-base* 10) - (str n (if *print-radix* ".")) - (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* n))) - (ratio? n) (str - (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r"))) - (opt-base-str *print-base* (.numerator n)) - "/" - (opt-base-str *print-base* (.denominator n))) - :else nil)) - -(defn- format-ascii [print-func params arg-navigator offsets] - (let [ [arg arg-navigator] (next-arg arg-navigator) - ^String base-output (or (format-simple-number arg) (print-func arg)) - base-width (.length base-output) - min-width (+ base-width (:minpad params)) - width (if (>= min-width (:mincol params)) - min-width - (+ min-width - (* (+ (quot (- (:mincol params) min-width 1) - (:colinc params) ) - 1) - (:colinc params)))) - chars (apply str (repeat (- width base-width) (:padchar params)))] - (if (:at params) - (print (str chars base-output)) - (print (str base-output chars))) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the integer directives ~D, ~X, ~O, ~B and some -;;; of ~R -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- integral? - "returns true if a number is actually an integer (that is, has no fractional part)" - [x] - (cond - (integer? x) true - (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part - (float? x) (= x (Math/floor x)) - (ratio? x) (let [^clojure.lang.Ratio r x] - (= 0 (rem (.numerator r) (.denominator r)))) - :else false)) - -(defn- remainders - "Return the list of remainders (essentially the 'digits') of val in the given base" - [base val] - (reverse - (first - (consume #(if (pos? %) - [(rem % base) (quot % base)] - [nil nil]) - val)))) - -;;; TODO: xlated-val does not seem to be used here. -(defn- base-str - "Return val as a string in the given base" - [base val] - (if (zero? val) - "0" - (let [xlated-val (cond - (float? val) (bigdec val) - (ratio? val) (let [^clojure.lang.Ratio r val] - (/ (.numerator r) (.denominator r))) - :else val)] - (apply str - (map - #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) - (remainders base val)))))) - -(def ^{:private true} - java-base-formats {8 "%o", 10 "%d", 16 "%x"}) - -(defn- opt-base-str - "Return val as a string in the given base, using clojure.core/format if supported -for improved performance" - [base val] - (let [format-str (get java-base-formats base)] - (if (and format-str (integer? val) (-> val class .getName (.startsWith "java."))) - (clojure.core/format format-str val) - (base-str base val)))) - -(defn- group-by* [unit lis] - (reverse - (first - (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis))))) - -(defn- format-integer [base params arg-navigator offsets] - (let [[arg arg-navigator] (next-arg arg-navigator)] - (if (integral? arg) - (let [neg (neg? arg) - pos-arg (if neg (- arg) arg) - raw-str (opt-base-str base pos-arg) - group-str (if (:colon params) - (let [groups (map #(apply str %) (group-by* (:commainterval params) raw-str)) - commas (repeat (count groups) (:commachar params))] - (apply str (next (interleave commas groups)))) - raw-str) - ^String signed-str (cond - neg (str "-" group-str) - (:at params) (str "+" group-str) - true group-str) - padded-str (if (< (.length signed-str) (:mincol params)) - (str (apply str (repeat (- (:mincol params) (.length signed-str)) - (:padchar params))) - signed-str) - signed-str)] - (print padded-str)) - (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 - :padchar (:padchar params) :at true} - (init-navigator [arg]) nil)) - arg-navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for english formats (~R and ~:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - english-cardinal-units - ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine" - "ten" "eleven" "twelve" "thirteen" "fourteen" - "fifteen" "sixteen" "seventeen" "eighteen" "nineteen"]) - -(def ^{:private true} - english-ordinal-units - ["zeroth" "first" "second" "third" "fourth" "fifth" "sixth" "seventh" "eighth" "ninth" - "tenth" "eleventh" "twelfth" "thirteenth" "fourteenth" - "fifteenth" "sixteenth" "seventeenth" "eighteenth" "nineteenth"]) - -(def ^{:private true} - english-cardinal-tens - ["" "" "twenty" "thirty" "forty" "fifty" "sixty" "seventy" "eighty" "ninety"]) - -(def ^{:private true} - english-ordinal-tens - ["" "" "twentieth" "thirtieth" "fortieth" "fiftieth" - "sixtieth" "seventieth" "eightieth" "ninetieth"]) - -;; We use "short scale" for our units (see http://en.wikipedia.org/wiki/Long_and_short_scales) -;; Number names from http://www.jimloy.com/math/billion.htm -;; We follow the rules for writing numbers from the Blue Book -;; (http://www.grammarbook.com/numbers/numbers.asp) -(def ^{:private true} - english-scale-numbers - ["" "thousand" "million" "billion" "trillion" "quadrillion" "quintillion" - "sextillion" "septillion" "octillion" "nonillion" "decillion" - "undecillion" "duodecillion" "tredecillion" "quattuordecillion" - "quindecillion" "sexdecillion" "septendecillion" - "octodecillion" "novemdecillion" "vigintillion"]) - -(defn- format-simple-cardinal - "Convert a number less than 1000 to a cardinal english string" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-cardinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-cardinal-units unit-digit))))))))) - -(defn- add-english-scales - "Take a sequence of parts, add scale numbers (e.g., million) and combine into a string -offset is a factor of 10^3 to multiply by" - [parts offset] - (let [cnt (count parts)] - (loop [acc [] - pos (dec cnt) - this (first parts) - remainder (next parts)] - (if (nil? remainder) - (str (apply str (interpose ", " acc)) - (if (and (not (empty? this)) (not (empty? acc))) ", ") - this - (if (and (not (empty? this)) (pos? (+ pos offset))) - (str " " (nth english-scale-numbers (+ pos offset))))) - (recur - (if (empty? this) - acc - (conj acc (str this " " (nth english-scale-numbers (+ pos offset))))) - (dec pos) - (first remainder) - (next remainder)))))) - -(defn- format-cardinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zero") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal parts) - full-str (add-english-scales parts-strs 0)] - (print (str (if (neg? arg) "minus ") full-str))) - (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})))) - navigator)) - -(defn- format-simple-ordinal - "Convert a number less than 1000 to a ordinal english string -Note this should only be used for the last one in the sequence" - [num] - (let [hundreds (quot num 100) - tens (rem num 100)] - (str - (if (pos? hundreds) (str (nth english-cardinal-units hundreds) " hundred")) - (if (and (pos? hundreds) (pos? tens)) " ") - (if (pos? tens) - (if (< tens 20) - (nth english-ordinal-units tens) - (let [ten-digit (quot tens 10) - unit-digit (rem tens 10)] - (if (and (pos? ten-digit) (not (pos? unit-digit))) - (nth english-ordinal-tens ten-digit) - (str - (if (pos? ten-digit) (nth english-cardinal-tens ten-digit)) - (if (and (pos? ten-digit) (pos? unit-digit)) "-") - (if (pos? unit-digit) (nth english-ordinal-units unit-digit)))))) - (if (pos? hundreds) "th"))))) - -(defn- format-ordinal-english [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (= 0 arg) - (print "zeroth") - (let [abs-arg (if (neg? arg) (- arg) arg) ; some numbers are too big for Math/abs - parts (remainders 1000 abs-arg)] - (if (<= (count parts) (count english-scale-numbers)) - (let [parts-strs (map format-simple-cardinal (drop-last parts)) - head-str (add-english-scales parts-strs 1) - tail-str (format-simple-ordinal (last parts))] - (print (str (if (neg? arg) "minus ") - (cond - (and (not (empty? head-str)) (not (empty? tail-str))) - (str head-str ", " tail-str) - - (not (empty? head-str)) (str head-str "th") - :else tail-str)))) - (do (format-integer ;; for numbers > 10^63, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0}) - (let [low-two-digits (rem arg 100) - not-teens (or (< 11 low-two-digits) (> 19 low-two-digits)) - low-digit (rem low-two-digits 10)] - (print (cond - (and (== low-digit 1) not-teens) "st" - (and (== low-digit 2) not-teens) "nd" - (and (== low-digit 3) not-teens) "rd" - :else "th"))))))) - navigator)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for roman numeral formats (~@R and ~@:R) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - old-roman-table - [[ "I" "II" "III" "IIII" "V" "VI" "VII" "VIII" "VIIII"] - [ "X" "XX" "XXX" "XXXX" "L" "LX" "LXX" "LXXX" "LXXXX"] - [ "C" "CC" "CCC" "CCCC" "D" "DC" "DCC" "DCCC" "DCCCC"] - [ "M" "MM" "MMM"]]) - -(def ^{:private true} - new-roman-table - [[ "I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX"] - [ "X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC"] - [ "C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM"] - [ "M" "MM" "MMM"]]) - -(defn- format-roman - "Format a roman numeral using the specified look-up table" - [table params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (and (number? arg) (> arg 0) (< arg 4000)) - (let [digits (remainders 10 arg)] - (loop [acc [] - pos (dec (count digits)) - digits digits] - (if (empty? digits) - (print (apply str acc)) - (let [digit (first digits)] - (recur (if (= 0 digit) - acc - (conj acc (nth (nth table pos) (dec digit)))) - (dec pos) - (next digits)))))) - (format-integer ;; for anything <= 0 or > 3999, we fall back on ~D - 10 - { :mincol 0, :padchar \space, :commachar \, :commainterval 3, :colon true} - (init-navigator [arg]) - { :mincol 0, :padchar 0, :commachar 0 :commainterval 0})) - navigator)) - -(defn- format-old-roman [params navigator offsets] - (format-roman old-roman-table params navigator offsets)) - -(defn- format-new-roman [params navigator offsets] - (format-roman new-roman-table params navigator offsets)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for character formats (~C) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - special-chars { 8 "Backspace", 9 "Tab", 10 "Newline", 13 "Return", 32 "Space"}) - -(defn- pretty-character [params navigator offsets] - (let [[c navigator] (next-arg navigator) - as-int (int c) - base-char (bit-and as-int 127) - meta (bit-and as-int 128) - special (get special-chars base-char)] - (if (> meta 0) (print "Meta-")) - (print (cond - special special - (< base-char 32) (str "Control-" (char (+ base-char 64))) - (= base-char 127) "Control-?" - :else (char base-char))) - navigator)) - -(defn- readable-character [params navigator offsets] - (let [[c navigator] (next-arg navigator)] - (condp = (:char-format params) - \o (cl-format true "\\o~3,'0o" (int c)) - \u (cl-format true "\\u~4,'0x" (int c)) - nil (pr c)) - navigator)) - -(defn- plain-character [params navigator offsets] - (let [[char navigator] (next-arg navigator)] - (print char) - navigator)) - -;; Check to see if a result is an abort (~^) construct -;; TODO: move these funcs somewhere more appropriate -(defn- abort? [context] - (let [token (first context)] - (or (= :up-arrow token) (= :colon-up-arrow token)))) - -;; Handle the execution of "sub-clauses" in bracket constructions -(defn- execute-sub-format [format args base-args] - (second - (map-passing-context - (fn [element context] - (if (abort? context) - [nil context] ; just keep passing it along - (let [[params args] (realize-parameter-list (:params element) context) - [params offsets] (unzip-map params) - params (assoc params :base-args base-args)] - [nil (apply (:func element) [params args offsets])]))) - args - format))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for real number formats -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO - return exponent as int to eliminate double conversion -(defn- float-parts-base - "Produce string parts for the mantissa (normalized 1-9) and exponent" - [^Object f] - (let [^String s (.toLowerCase (.toString f)) - exploc (.indexOf s (int \e))] - (if (neg? exploc) - (let [dotloc (.indexOf s (int \.))] - (if (neg? dotloc) - [s (str (dec (count s)))] - [(str (subs s 0 dotloc) (subs s (inc dotloc))) (str (dec dotloc))])) - [(str (subs s 0 1) (subs s 2 exploc)) (subs s (inc exploc))]))) - - -(defn- float-parts - "Take care of leading and trailing zeros in decomposed floats" - [f] - (let [[m ^String e] (float-parts-base f) - m1 (rtrim m \0) - m2 (ltrim m1 \0) - delta (- (count m1) (count m2)) - ^String e (if (and (pos? (count e)) (= (nth e 0) \+)) (subs e 1) e)] - (if (empty? m2) - ["0" 0] - [m2 (- (Integer/valueOf e) delta)]))) - -(defn- round-str [m e d w] - (if (or d w) - (let [len (count m) - round-pos (if d (+ e d 1)) - round-pos (if (and w (< (inc e) (dec w)) - (or (nil? round-pos) (< (dec w) round-pos))) - (dec w) - round-pos) - [m1 e1 round-pos len] (if (= round-pos 0) - [(str "0" m) (inc e) 1 (inc len)] - [m e round-pos len])] - (if round-pos - (if (neg? round-pos) - ["0" 0 false] - (if (> len round-pos) - (let [round-char (nth m1 round-pos) - ^String result (subs m1 0 round-pos)] - (if (>= (int round-char) (int \5)) - (let [result-val (Integer/valueOf result) - leading-zeros (subs result 0 (min (prefix-count result \0) (- round-pos 1))) - round-up-result (str leading-zeros - (String/valueOf (+ result-val - (if (neg? result-val) -1 1)))) - expanded (> (count round-up-result) (count result))] - [round-up-result e1 expanded]) - [result e1 false])) - [m e false])) - [m e false])) - [m e false])) - -(defn- expand-fixed [m e d] - (let [m1 (if (neg? e) (str (apply str (repeat (dec (- e)) \0)) m) m) - len (count m1) - target-len (if d (+ e d 1) (inc e))] - (if (< len target-len) - (str m1 (apply str (repeat (- target-len len) \0))) - m1))) - -(defn- insert-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m e] - (if (neg? e) - (str "." m) - (let [loc (inc e)] - (str (subs m 0 loc) "." (subs m loc))))) - -(defn- get-fixed [m e d] - (insert-decimal (expand-fixed m e d) e)) - -(defn- insert-scaled-decimal - "Insert the decimal point at the right spot in the number to match an exponent" - [m k] - (if (neg? k) - (str "." m) - (str (subs m 0 k) "." (subs m k)))) - -;; the function to render ~F directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- fixed-float [params navigator offsets] - (let [w (:w params) - d (:d params) - [arg navigator] (next-arg navigator) - [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg]) - [mantissa exp] (float-parts abs) - scaled-exp (+ exp (:k params)) - add-sign (or (:at params) (neg? arg)) - append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp - d (if w (- w (if add-sign 1 0)))) - fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - prepend-zero (= (first fixed-repr) \.)] - (if w - (let [len (count fixed-repr) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (>= signed-len w))) - append-zero (and append-zero (not (>= signed-len w))) - full-len (if (or prepend-zero append-zero) - (inc signed-len) - signed-len)] - (if (and (> full-len w) (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str (repeat (- w full-len) (:padchar params))) - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0"))))) - (print (str - (if add-sign sign) - (if prepend-zero "0") - fixed-repr - (if append-zero "0")))) - navigator)) - - -;; the function to render ~E directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: define ~E representation for Infinity -(defn- exponential-float [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (loop [[mantissa exp] (float-parts (if (neg? arg) (- arg) arg))] - (let [w (:w params) - d (:d params) - e (:e params) - k (:k params) - expchar (or (:exponentchar params) \E) - add-sign (or (:at params) (neg? arg)) - prepend-zero (<= k 0) - ^Integer scaled-exp (- exp (dec k)) - scaled-exp-str (str (Math/abs scaled-exp)) - scaled-exp-str (str expchar (if (neg? scaled-exp) \- \+) - (if e (apply str - (repeat - (- e - (count scaled-exp-str)) - \0))) - scaled-exp-str) - exp-width (count scaled-exp-str) - base-mantissa-width (count mantissa) - scaled-mantissa (str (apply str (repeat (- k) \0)) - mantissa - (if d - (apply str - (repeat - (- d (dec base-mantissa-width) - (if (neg? k) (- k) 0)) \0)))) - w-mantissa (if w (- w exp-width)) - [rounded-mantissa _ incr-exp] (round-str - scaled-mantissa 0 - (cond - (= k 0) (dec d) - (pos? k) d - (neg? k) (dec d)) - (if w-mantissa - (- w-mantissa (if add-sign 1 0)))) - full-mantissa (insert-scaled-decimal rounded-mantissa k) - append-zero (and (= k (count rounded-mantissa)) (nil? d))] - (if (not incr-exp) - (if w - (let [len (+ (count full-mantissa) exp-width) - signed-len (if add-sign (inc len) len) - prepend-zero (and prepend-zero (not (= signed-len w))) - full-len (if prepend-zero (inc signed-len) signed-len) - append-zero (and append-zero (< full-len w))] - (if (and (or (> full-len w) (and e (> (- exp-width 2) e))) - (:overflowchar params)) - (print (apply str (repeat w (:overflowchar params)))) - (print (str - (apply str - (repeat - (- w full-len (if append-zero 1 0) ) - (:padchar params))) - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str)))) - (print (str - (if add-sign (if (neg? arg) \- \+)) - (if prepend-zero "0") - full-mantissa - (if append-zero "0") - scaled-exp-str))) - (recur [rounded-mantissa (inc exp)])))) - navigator)) - -;; the function to render ~G directives -;; This just figures out whether to pass the request off to ~F or ~E based -;; on the algorithm in CLtL. -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -;; TODO: refactor so that float-parts isn't called twice -(defn- general-float [params navigator offsets] - (let [[arg _] (next-arg navigator) - [mantissa exp] (float-parts (if (neg? arg) (- arg) arg)) - w (:w params) - d (:d params) - e (:e params) - n (if (= arg 0.0) 0 (inc exp)) - ee (if e (+ e 2) 4) - ww (if w (- w ee)) - d (if d d (max (count mantissa) (min n 7))) - dd (- d n)] - (if (<= 0 dd d) - (let [navigator (fixed-float {:w ww, :d dd, :k 0, - :overflowchar (:overflowchar params), - :padchar (:padchar params), :at (:at params)} - navigator offsets)] - (print (apply str (repeat ee \space))) - navigator) - (exponential-float params navigator offsets)))) - -;; the function to render ~$ directives -;; TODO: support rationals. Back off to ~D/~A is the appropriate cases -(defn- dollar-float [params navigator offsets] - (let [[^Double arg navigator] (next-arg navigator) - [mantissa exp] (float-parts (Math/abs arg)) - d (:d params) ; digits after the decimal - n (:n params) ; minimum digits before the decimal - w (:w params) ; minimum field width - add-sign (or (:at params) (neg? arg)) - [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil) - ^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d) - full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr) - full-len (+ (count full-repr) (if add-sign 1 0))] - (print (str - (if (and (:colon params) add-sign) (if (neg? arg) \- \+)) - (apply str (repeat (- w full-len) (:padchar params))) - (if (and (not (:colon params)) add-sign) (if (neg? arg) \- \+)) - full-repr)) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~[...~]' conditional construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; ~[...~] without any modifiers chooses one of the clauses based on the param or -;; next argument -;; TODO check arg is positive int -(defn- choice-conditional [params arg-navigator offsets] - (let [arg (:selector params) - [arg navigator] (if arg [arg arg-navigator] (next-arg arg-navigator)) - clauses (:clauses params) - clause (if (or (neg? arg) (>= arg (count clauses))) - (first (:else params)) - (nth clauses arg))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~:[...~] with the colon reads the next argument treating it as a truth value -(defn- boolean-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg - (second clauses) - (first clauses))] - (if clause - (execute-sub-format clause navigator (:base-args params)) - navigator))) - -;; ~@[...~] with the at sign executes the conditional if the next arg is not -;; nil/false without consuming the arg -(defn- check-arg-conditional [params arg-navigator offsets] - (let [[arg navigator] (next-arg arg-navigator) - clauses (:clauses params) - clause (if arg (first clauses))] - (if arg - (if clause - (execute-sub-format clause arg-navigator (:base-args params)) - arg-navigator) - navigator))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~{...~}' iteration construct in its -;;; different flavors -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;; ~{...~} without any modifiers uses the next argument as an argument list that -;; is consumed by all the iterations -(defn- iterate-sublist [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - [arg-list navigator] (next-arg navigator) - args (init-navigator arg-list)] - (loop [count 0 - args args - last-pos (num -1)] - (if (and (not max-count) (= (:pos args) last-pos) (> count 1)) - ;; TODO get the offset in here and call format exception - (throw (RuntimeException. "%{ construct not consuming any arguments: Infinite loop!"))) - (if (or (and (empty? (:rest args)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format clause args (:base-args params))] - (if (= :up-arrow (first iter-result)) - navigator - (recur (inc count) iter-result (:pos args)))))))) - -;; ~:{...~} with the colon treats the next argument as a list of sublists. Each of the -;; sublists is used as the arglist for a single iteration. -(defn- iterate-list-of-sublists [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - [arg-list navigator] (next-arg navigator)] - (loop [count 0 - arg-list arg-list] - (if (or (and (empty? arg-list) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format - clause - (init-navigator (first arg-list)) - (init-navigator (next arg-list)))] - (if (= :colon-up-arrow (first iter-result)) - navigator - (recur (inc count) (next arg-list)))))))) - -;; ~@{...~} with the at sign uses the main argument list as the arguments to the iterations -;; is consumed by all the iterations -(defn- iterate-main-list [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator])] - (loop [count 0 - navigator navigator - last-pos (num -1)] - (if (and (not max-count) (= (:pos navigator) last-pos) (> count 1)) - ;; TODO get the offset in here and call format exception - (throw (RuntimeException. "%@{ construct not consuming any arguments: Infinite loop!"))) - (if (or (and (empty? (:rest navigator)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [iter-result (execute-sub-format clause navigator (:base-args params))] - (if (= :up-arrow (first iter-result)) - (second iter-result) - (recur - (inc count) iter-result (:pos navigator)))))))) - -;; ~@:{...~} with both colon and at sign uses the main argument list as a set of sublists, one -;; of which is consumed with each iteration -(defn- iterate-main-sublists [params navigator offsets] - (let [max-count (:max-iterations params) - param-clause (first (:clauses params)) - [clause navigator] (if (empty? param-clause) - (get-format-arg navigator) - [param-clause navigator]) - ] - (loop [count 0 - navigator navigator] - (if (or (and (empty? (:rest navigator)) - (or (not (:colon (:right-params params))) (> count 0))) - (and max-count (>= count max-count))) - navigator - (let [[sublist navigator] (next-arg-or-nil navigator) - iter-result (execute-sub-format clause (init-navigator sublist) navigator)] - (if (= :colon-up-arrow (first iter-result)) - navigator - (recur (inc count) navigator))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The '~< directive has two completely different meanings -;;; in the '~<...~>' form it does justification, but with -;;; ~<...~:>' it represents the logical block operation of the -;;; pretty printer. -;;; -;;; Unfortunately, the current architecture decides what function -;;; to call at form parsing time before the sub-clauses have been -;;; folded, so it is left to run-time to make the decision. -;;; -;;; TODO: make it possible to make these decisions at compile-time. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare format-logical-block) -(declare justify-clauses) - -(defn- logical-block-or-justify [params navigator offsets] - (if (:colon (:right-params params)) - (format-logical-block params navigator offsets) - (justify-clauses params navigator offsets))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for the '~<...~>' justification directive -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- render-clauses [clauses navigator base-navigator] - (loop [clauses clauses - acc [] - navigator navigator] - (if (empty? clauses) - [acc navigator] - (let [clause (first clauses) - [iter-result result-str] (binding [*out* (java.io.StringWriter.)] - [(execute-sub-format clause navigator base-navigator) - (.toString *out*)])] - (if (= :up-arrow (first iter-result)) - [acc (second iter-result)] - (recur (next clauses) (conj acc result-str) iter-result)))))) - -;; TODO support for ~:; constructions -(defn- justify-clauses [params navigator offsets] - (let [[[eol-str] new-navigator] (when-let [else (:else params)] - (render-clauses else navigator (:base-args params))) - navigator (or new-navigator navigator) - [else-params new-navigator] (when-let [p (:else-params params)] - (realize-parameter-list p navigator)) - navigator (or new-navigator navigator) - min-remaining (or (first (:min-remaining else-params)) 0) - max-columns (or (first (:max-columns else-params)) - (get-max-column *out*)) - clauses (:clauses params) - [strs navigator] (render-clauses clauses navigator (:base-args params)) - slots (max 1 - (+ (dec (count strs)) (if (:colon params) 1 0) (if (:at params) 1 0))) - chars (reduce + (map count strs)) - mincol (:mincol params) - minpad (:minpad params) - colinc (:colinc params) - minout (+ chars (* slots minpad)) - result-columns (if (<= minout mincol) - mincol - (+ mincol (* colinc - (+ 1 (quot (- minout mincol 1) colinc))))) - total-pad (- result-columns chars) - pad (max minpad (quot total-pad slots)) - extra-pad (- total-pad (* pad slots)) - pad-str (apply str (repeat pad (:padchar params)))] - (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) - max-columns)) - (print eol-str)) - (loop [slots slots - extra-pad extra-pad - strs strs - pad-only (or (:colon params) - (and (= (count strs) 1) (not (:at params))))] - (if (seq strs) - (do - (print (str (if (not pad-only) (first strs)) - (if (or pad-only (next strs) (:at params)) pad-str) - (if (pos? extra-pad) (:padchar params)))) - (recur - (dec slots) - (dec extra-pad) - (if pad-only strs (next strs)) - false)))) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for case modification with ~(...~). -;;; We do this by wrapping the underlying writer with -;;; a special writer to do the appropriate modification. This -;;; allows us to support arbitrary-sized output and sources -;;; that may block. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- downcase-writer - "Returns a proxy that wraps writer, converting all characters to lower case" - [^java.io.Writer writer] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer (.toLowerCase s))) - - Integer - (let [c ^Character x] - (.write writer (int (Character/toLowerCase (char c)))))))))) - -(defn- upcase-writer - "Returns a proxy that wraps writer, converting all characters to upper case" - [^java.io.Writer writer] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer (.toUpperCase s))) - - Integer - (let [c ^Character x] - (.write writer (int (Character/toUpperCase (char c)))))))))) - -(defn- capitalize-string - "Capitalizes the words in a string. If first? is false, don't capitalize the - first character of the string even if it's a letter." - [s first?] - (let [^Character f (first s) - s (if (and first? f (Character/isLetter f)) - (str (Character/toUpperCase f) (subs s 1)) - s)] - (apply str - (first - (consume - (fn [s] - (if (empty? s) - [nil nil] - (let [m (re-matcher #"\W\w" s) - match (re-find m) - offset (and match (inc (.start m)))] - (if offset - [(str (subs s 0 offset) - (Character/toUpperCase ^Character (nth s offset))) - (subs s (inc offset))] - [s nil])))) - s))))) - -(defn- capitalize-word-writer - "Returns a proxy that wraps writer, captializing all words" - [^java.io.Writer writer] - (let [last-was-whitespace? (ref true)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write - ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s ^String x] - (.write writer - ^String (capitalize-string (.toLowerCase s) @last-was-whitespace?)) - (dosync - (ref-set last-was-whitespace? - (Character/isWhitespace - ^Character (nth s (dec (count s))))))) - - Integer - (let [c (char x)] - (let [mod-c (if @last-was-whitespace? (Character/toUpperCase ^Character (char x)) c)] - (.write writer (int mod-c)) - (dosync (ref-set last-was-whitespace? (Character/isWhitespace ^Character (char x)))))))))))) - -(defn- init-cap-writer - "Returns a proxy that wraps writer, capitalizing the first word" - [^java.io.Writer writer] - (let [capped (ref false)] - (proxy [java.io.Writer] [] - (close [] (.close writer)) - (flush [] (.flush writer)) - (write ([^chars cbuf ^Integer off ^Integer len] - (.write writer cbuf off len)) - ([x] - (condp = (class x) - String - (let [s (.toLowerCase ^String x)] - (if (not @capped) - (let [m (re-matcher #"\S" s) - match (re-find m) - offset (and match (.start m))] - (if offset - (do (.write writer - (str (subs s 0 offset) - (Character/toUpperCase ^Character (nth s offset)) - (.toLowerCase ^String (subs s (inc offset))))) - (dosync (ref-set capped true))) - (.write writer s))) - (.write writer (.toLowerCase s)))) - - Integer - (let [c ^Character (char x)] - (if (and (not @capped) (Character/isLetter c)) - (do - (dosync (ref-set capped true)) - (.write writer (int (Character/toUpperCase c)))) - (.write writer (int (Character/toLowerCase c))))))))))) - -(defn- modify-case [make-writer params navigator offsets] - (let [clause (first (:clauses params))] - (binding [*out* (make-writer *out*)] - (execute-sub-format clause navigator (:base-args params))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; If necessary, wrap the writer in a PrettyWriter object -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn get-pretty-writer [writer] - (if (pretty-writer? writer) - writer - (pretty-writer writer *print-right-margin* *print-miser-width*))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for column-aware operations ~&, ~T -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: make an automatic newline for non-ColumnWriters -(defn fresh-line - "Make a newline if the Writer is not already at the beginning of the line. -N.B. Only works on ColumnWriters right now." - [] - (if (not (= 0 (get-column (:base @@*out*)))) - (prn))) - -(defn- absolute-tabulation [params navigator offsets] - (let [colnum (:colnum params) - colinc (:colinc params) - current (get-column (:base @@*out*)) - space-count (cond - (< current colnum) (- colnum current) - (= colinc 0) 0 - :else (- colinc (rem (- current colnum) colinc)))] - (print (apply str (repeat space-count \space)))) - navigator) - -(defn- relative-tabulation [params navigator offsets] - (let [colrel (:colnum params) - colinc (:colinc params) - start-col (+ colrel (get-column (:base @@*out*))) - offset (if (pos? colinc) (rem start-col colinc) 0) - space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))] - (print (apply str (repeat space-count \space)))) - navigator) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for accessing the pretty printer from a format -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: support ~@; per-line-prefix separator -;; TODO: get the whole format wrapped so we can start the lb at any column -(defn- format-logical-block [params navigator offsets] - (let [clauses (:clauses params) - clause-count (count clauses) - prefix (cond - (> clause-count 1) (:string (:params (first (first clauses)))) - (:colon params) "(") - body (nth clauses (if (> clause-count 1) 1 0)) - suffix (cond - (> clause-count 2) (:string (:params (first (nth clauses 2)))) - (:colon params) ")") - [arg navigator] (next-arg navigator)] - (pprint-logical-block :prefix prefix :suffix suffix - (execute-sub-format - body - (init-navigator arg) - (:base-args params))) - navigator)) - -(defn- set-indent [params navigator offsets] - (let [relative-to (if (:colon params) :current :block)] - (pprint-indent relative-to (:n params)) - navigator)) - -;;; TODO: support ~:T section options for ~T - -(defn- conditional-newline [params navigator offsets] - (let [kind (if (:colon params) - (if (:at params) :mandatory :fill) - (if (:at params) :miser :linear))] - (pprint-newline kind) - navigator)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The table of directives we support, each with its params, -;;; properties, and the compilation function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; We start with a couple of helpers -(defn- process-directive-table-element [ [ char params flags bracket-info & generator-fn ] ] - [char, - {:directive char, - :params `(array-map ~@params), - :flags flags, - :bracket-info bracket-info, - :generator-fn (concat '(fn [ params offset]) generator-fn) }]) - -(defmacro ^{:private true} - defdirectives - [ & directives ] - `(def ^{:private true} - directive-table (hash-map ~@(mapcat process-directive-table-element directives)))) - -(defdirectives - (\A - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii print-str %1 %2 %3)) - - (\S - [ :mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character] ] - #{ :at :colon :both} {} - #(format-ascii pr-str %1 %2 %3)) - - (\D - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 10 %1 %2 %3)) - - (\B - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 2 %1 %2 %3)) - - (\O - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 8 %1 %2 %3)) - - (\X - [ :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - #(format-integer 16 %1 %2 %3)) - - (\R - [:base [nil Integer] :mincol [0 Integer] :padchar [\space Character] :commachar [\, Character] - :commainterval [ 3 Integer]] - #{ :at :colon :both } {} - (do - (cond ; ~R is overloaded with bizareness - (first (:base params)) #(format-integer (:base %1) %1 %2 %3) - (and (:at params) (:colon params)) #(format-old-roman %1 %2 %3) - (:at params) #(format-new-roman %1 %2 %3) - (:colon params) #(format-ordinal-english %1 %2 %3) - true #(format-cardinal-english %1 %2 %3)))) - - (\P - [ ] - #{ :at :colon :both } {} - (fn [params navigator offsets] - (let [navigator (if (:colon params) (relative-reposition navigator -1) navigator) - strs (if (:at params) ["y" "ies"] ["" "s"]) - [arg navigator] (next-arg navigator)] - (print (if (= arg 1) (first strs) (second strs))) - navigator))) - - (\C - [:char-format [nil Character]] - #{ :at :colon :both } {} - (cond - (:colon params) pretty-character - (:at params) readable-character - :else plain-character)) - - (\F - [ :w [nil Integer] :d [nil Integer] :k [0 Integer] :overflowchar [nil Character] - :padchar [\space Character] ] - #{ :at } {} - fixed-float) - - (\E - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - exponential-float) - - (\G - [ :w [nil Integer] :d [nil Integer] :e [nil Integer] :k [1 Integer] - :overflowchar [nil Character] :padchar [\space Character] - :exponentchar [nil Character] ] - #{ :at } {} - general-float) - - (\$ - [ :d [2 Integer] :n [1 Integer] :w [0 Integer] :padchar [\space Character]] - #{ :at :colon :both} {} - dollar-float) - - (\% - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (prn)) - arg-navigator)) - - (\& - [ :count [1 Integer] ] - #{ :pretty } {} - (fn [params arg-navigator offsets] - (let [cnt (:count params)] - (if (pos? cnt) (fresh-line)) - (dotimes [i (dec cnt)] - (prn))) - arg-navigator)) - - (\| - [ :count [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (dotimes [i (:count params)] - (print \formfeed)) - arg-navigator)) - - (\~ - [ :n [1 Integer] ] - #{ } {} - (fn [params arg-navigator offsets] - (let [n (:n params)] - (print (apply str (repeat n \~))) - arg-navigator))) - - (\newline ;; Whitespace supression is handled in the compilation loop - [ ] - #{:colon :at} {} - (fn [params arg-navigator offsets] - (if (:at params) - (prn)) - arg-navigator)) - - (\T - [ :colnum [1 Integer] :colinc [1 Integer] ] - #{ :at :pretty } {} - (if (:at params) - #(relative-tabulation %1 %2 %3) - #(absolute-tabulation %1 %2 %3))) - - (\* - [ :n [1 Integer] ] - #{ :colon :at } {} - (fn [params navigator offsets] - (let [n (:n params)] - (if (:at params) - (absolute-reposition navigator n) - (relative-reposition navigator (if (:colon params) (- n) n))) - ))) - - (\? - [ ] - #{ :at } {} - (if (:at params) - (fn [params navigator offsets] ; args from main arg list - (let [[subformat navigator] (get-format-arg navigator)] - (execute-sub-format subformat navigator (:base-args params)))) - (fn [params navigator offsets] ; args from sub-list - (let [[subformat navigator] (get-format-arg navigator) - [subargs navigator] (next-arg navigator) - sub-navigator (init-navigator subargs)] - (execute-sub-format subformat sub-navigator (:base-args params)) - navigator)))) - - - (\( - [ ] - #{ :colon :at :both} { :right \), :allows-separator nil, :else nil } - (let [mod-case-writer (cond - (and (:at params) (:colon params)) - upcase-writer - - (:colon params) - capitalize-word-writer - - (:at params) - init-cap-writer - - :else - downcase-writer)] - #(modify-case mod-case-writer %1 %2 %3))) - - (\) [] #{} {} nil) - - (\[ - [ :selector [nil Integer] ] - #{ :colon :at } { :right \], :allows-separator true, :else :last } - (cond - (:colon params) - boolean-conditional - - (:at params) - check-arg-conditional - - true - choice-conditional)) - - (\; [:min-remaining [nil Integer] :max-columns [nil Integer]] - #{ :colon } { :separator true } nil) - - (\] [] #{} {} nil) - - (\{ - [ :max-iterations [nil Integer] ] - #{ :colon :at :both} { :right \}, :allows-separator false } - (cond - (and (:at params) (:colon params)) - iterate-main-sublists - - (:colon params) - iterate-list-of-sublists - - (:at params) - iterate-main-list - - true - iterate-sublist)) - - - (\} [] #{:colon} {} nil) - - (\< - [:mincol [0 Integer] :colinc [1 Integer] :minpad [0 Integer] :padchar [\space Character]] - #{:colon :at :both :pretty} { :right \>, :allows-separator true, :else :first } - logical-block-or-justify) - - (\> [] #{:colon} {} nil) - - ;; TODO: detect errors in cases where colon not allowed - (\^ [:arg1 [nil Integer] :arg2 [nil Integer] :arg3 [nil Integer]] - #{:colon} {} - (fn [params navigator offsets] - (let [arg1 (:arg1 params) - arg2 (:arg2 params) - arg3 (:arg3 params) - exit (if (:colon params) :colon-up-arrow :up-arrow)] - (cond - (and arg1 arg2 arg3) - (if (<= arg1 arg2 arg3) [exit navigator] navigator) - - (and arg1 arg2) - (if (= arg1 arg2) [exit navigator] navigator) - - arg1 - (if (= arg1 0) [exit navigator] navigator) - - true ; TODO: handle looking up the arglist stack for info - (if (if (:colon params) - (empty? (:rest (:base-args params))) - (empty? (:rest navigator))) - [exit navigator] navigator))))) - - (\W - [] - #{:at :colon :both} {} - (if (or (:at params) (:colon params)) - (let [bindings (concat - (if (:at params) [:level nil :length nil] []) - (if (:colon params) [:pretty true] []))] - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (apply write arg bindings) - [:up-arrow navigator] - navigator)))) - (fn [params navigator offsets] - (let [[arg navigator] (next-arg navigator)] - (if (write-out arg) - [:up-arrow navigator] - navigator))))) - - (\_ - [] - #{:at :colon :both} {} - conditional-newline) - - (\I - [:n [0 Integer]] - #{:colon} {} - set-indent) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Code to manage the parameters and flags associated with each -;;; directive in the format string. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{:private true} - param-pattern #"^([vV]|#|('.)|([+-]?\d+)|(?=,))") -(def ^{:private true} - special-params #{ :parameter-from-args :remaining-arg-count }) - -(defn- extract-param [[s offset saw-comma]] - (let [m (re-matcher param-pattern s) - param (re-find m)] - (if param - (let [token-str (first (re-groups m)) - remainder (subs s (.end m)) - new-offset (+ offset (.end m))] - (if (not (= \, (nth remainder 0))) - [ [token-str offset] [remainder new-offset false]] - [ [token-str offset] [(subs remainder 1) (inc new-offset) true]])) - (if saw-comma - (format-error "Badly formed parameters in format directive" offset) - [ nil [s offset]])))) - - -(defn- extract-params [s offset] - (consume extract-param [s offset false])) - -(defn- translate-param - "Translate the string representation of a param to the internalized - representation" - [[^String p offset]] - [(cond - (= (.length p) 0) nil - (and (= (.length p) 1) (contains? #{\v \V} (nth p 0))) :parameter-from-args - (and (= (.length p) 1) (= \# (nth p 0))) :remaining-arg-count - (and (= (.length p) 2) (= \' (nth p 0))) (nth p 1) - true (new Integer p)) - offset]) - -(def ^{:private true} - flag-defs { \: :colon, \@ :at }) - -(defn- extract-flags [s offset] - (consume - (fn [[s offset flags]] - (if (empty? s) - [nil [s offset flags]] - (let [flag (get flag-defs (first s))] - (if flag - (if (contains? flags flag) - (format-error - (str "Flag \"" (first s) "\" appears more than once in a directive") - offset) - [true [(subs s 1) (inc offset) (assoc flags flag [true offset])]]) - [nil [s offset flags]])))) - [s offset {}])) - -(defn- check-flags [def flags] - (let [allowed (:flags def)] - (if (and (not (:at allowed)) (:at flags)) - (format-error (str "\"@\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:at flags) 1))) - (if (and (not (:colon allowed)) (:colon flags)) - (format-error (str "\":\" is an illegal flag for format directive \"" (:directive def) "\"") - (nth (:colon flags) 1))) - (if (and (not (:both allowed)) (:at flags) (:colon flags)) - (format-error (str "Cannot combine \"@\" and \":\" flags for format directive \"" - (:directive def) "\"") - (min (nth (:colon flags) 1) (nth (:at flags) 1)))))) - -(defn- map-params - "Takes a directive definition and the list of actual parameters and -a map of flags and returns a map of the parameters and flags with defaults -filled in. We check to make sure that there are the right types and number -of parameters as well." - [def params flags offset] - (check-flags def flags) - (if (> (count params) (count (:params def))) - (format-error - (cl-format - nil - "Too many parameters for directive \"~C\": ~D~:* ~[were~;was~:;were~] specified but only ~D~:* ~[are~;is~:;are~] allowed" - (:directive def) (count params) (count (:params def))) - (second (first params)))) - (doall - (map #(let [val (first %1)] - (if (not (or (nil? val) (contains? special-params val) - (instance? (second (second %2)) val))) - (format-error (str "Parameter " (name (first %2)) - " has bad type in directive \"" (:directive def) "\": " - (class val)) - (second %1))) ) - params (:params def))) - - (merge ; create the result map - (into (array-map) ; start with the default values, make sure the order is right - (reverse (for [[name [default]] (:params def)] [name [default offset]]))) - (reduce #(apply assoc %1 %2) {} (filter #(first (nth % 1)) (zipmap (keys (:params def)) params))) ; add the specified parameters, filtering out nils - flags)) ; and finally add the flags - -(defn- compile-directive [s offset] - (let [[raw-params [rest offset]] (extract-params s offset) - [_ [rest offset flags]] (extract-flags rest offset) - directive (first rest) - def (get directive-table (Character/toUpperCase ^Character directive)) - params (if def (map-params def (map translate-param raw-params) flags offset))] - (if (not directive) - (format-error "Format string ended in the middle of a directive" offset)) - (if (not def) - (format-error (str "Directive \"" directive "\" is undefined") offset)) - [(struct compiled-directive ((:generator-fn def) params offset) def params offset) - (let [remainder (subs rest 1) - offset (inc offset) - trim? (and (= \newline (:directive def)) - (not (:colon params))) - trim-count (if trim? (prefix-count remainder [\space \tab]) 0) - remainder (subs remainder trim-count) - offset (+ offset trim-count)] - [remainder offset])])) - -(defn- compile-raw-string [s offset] - (struct compiled-directive (fn [_ a _] (print s) a) nil { :string s } offset)) - -(defn- right-bracket [this] (:right (:bracket-info (:def this)))) -(defn- separator? [this] (:separator (:bracket-info (:def this)))) -(defn- else-separator? [this] - (and (:separator (:bracket-info (:def this))) - (:colon (:params this)))) - - -(declare collect-clauses) - -(defn- process-bracket [this remainder] - (let [[subex remainder] (collect-clauses (:bracket-info (:def this)) - (:offset this) remainder)] - [(struct compiled-directive - (:func this) (:def this) - (merge (:params this) (tuple-map subex (:offset this))) - (:offset this)) - remainder])) - -(defn- process-clause [bracket-info offset remainder] - (consume - (fn [remainder] - (if (empty? remainder) - (format-error "No closing bracket found." offset) - (let [this (first remainder) - remainder (next remainder)] - (cond - (right-bracket this) - (process-bracket this remainder) - - (= (:right bracket-info) (:directive (:def this))) - [ nil [:right-bracket (:params this) nil remainder]] - - (else-separator? this) - [nil [:else nil (:params this) remainder]] - - (separator? this) - [nil [:separator nil nil remainder]] ;; TODO: check to make sure that there are no params on ~; - - true - [this remainder])))) - remainder)) - -(defn- collect-clauses [bracket-info offset remainder] - (second - (consume - (fn [[clause-map saw-else remainder]] - (let [[clause [type right-params else-params remainder]] - (process-clause bracket-info offset remainder)] - (cond - (= type :right-bracket) - [nil [(merge-with concat clause-map - {(if saw-else :else :clauses) [clause] - :right-params right-params}) - remainder]] - - (= type :else) - (cond - (:else clause-map) - (format-error "Two else clauses (\"~:;\") inside bracket construction." offset) - - (not (:else bracket-info)) - (format-error "An else clause (\"~:;\") is in a bracket type that doesn't support it." - offset) - - (and (= :first (:else bracket-info)) (seq (:clauses clause-map))) - (format-error - "The else clause (\"~:;\") is only allowed in the first position for this directive." - offset) - - true ; if the ~:; is in the last position, the else clause - ; is next, this was a regular clause - (if (= :first (:else bracket-info)) - [true [(merge-with concat clause-map { :else [clause] :else-params else-params}) - false remainder]] - [true [(merge-with concat clause-map { :clauses [clause] }) - true remainder]])) - - (= type :separator) - (cond - saw-else - (format-error "A plain clause (with \"~;\") follows an else clause (\"~:;\") inside bracket construction." offset) - - (not (:allows-separator bracket-info)) - (format-error "A separator (\"~;\") is in a bracket type that doesn't support it." - offset) - - true - [true [(merge-with concat clause-map { :clauses [clause] }) - false remainder]])))) - [{ :clauses [] } false remainder]))) - -(defn- process-nesting - "Take a linearly compiled format and process the bracket directives to give it - the appropriate tree structure" - [format] - (first - (consume - (fn [remainder] - (let [this (first remainder) - remainder (next remainder) - bracket (:bracket-info (:def this))] - (if (:right bracket) - (process-bracket this remainder) - [this remainder]))) - format))) - -(defn compile-format - "Compiles format-str into a compiled format which can be used as an argument -to cl-format just like a plain format string. Use this function for improved -performance when you're using the same format string repeatedly" - [ format-str ] -; (prlabel compiling format-str) - (binding [*format-str* format-str] - (process-nesting - (first - (consume - (fn [[^String s offset]] - (if (empty? s) - [nil s] - (let [tilde (.indexOf s (int \~))] - (cond - (neg? tilde) [(compile-raw-string s offset) ["" (+ offset (.length s))]] - (zero? tilde) (compile-directive (subs s 1) (inc offset)) - true - [(compile-raw-string (subs s 0 tilde) offset) [(subs s tilde) (+ tilde offset)]])))) - [format-str 0]))))) - -(defn- needs-pretty - "determine whether a given compiled format has any directives that depend on the -column number or pretty printing" - [format] - (loop [format format] - (if (empty? format) - false - (if (or (:pretty (:flags (:def (first format)))) - (some needs-pretty (first (:clauses (:params (first format))))) - (some needs-pretty (first (:else (:params (first format)))))) - true - (recur (next format)))))) - -(defn execute-format - "Executes the format with the arguments. This should never be used directly, but is public -because the formatter macro uses it." - {:skip-wiki true} - ([stream format args] - (let [^java.io.Writer real-stream (cond - (not stream) (java.io.StringWriter.) - (true? stream) *out* - :else stream) - ^java.io.Writer wrapped-stream (if (and (needs-pretty format) - (not (pretty-writer? real-stream))) - (get-pretty-writer real-stream) - real-stream)] - (binding [*out* wrapped-stream] - (try - (execute-format format args) - (finally - (if-not (identical? real-stream wrapped-stream) - (.flush wrapped-stream)))) - (if (not stream) (.toString real-stream))))) - ([format args] - (map-passing-context - (fn [element context] - (if (abort? context) - [nil context] - (let [[params args] (realize-parameter-list - (:params element) context) - [params offsets] (unzip-map params) - params (assoc params :base-args args)] - [nil (apply (:func element) [params args offsets])]))) - args - format))) - - -(defmacro formatter - "Makes a function which can directly run format-in. The function is -fn [stream & args] ... and returns nil unless the stream is nil (meaning -output to a string) in which case it returns the resulting string. - -format-in can be either a control string or a previously compiled format." - [format-in] - (let [cf (gensym "compiled-format")] - `(let [format-in# ~format-in] - (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#)) - (fn [stream# & args#] - (let [navigator# (init-navigator args#)] - (execute-format stream# ~cf navigator#))))))) - -(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." - [format-in] - (let [cf (gensym "compiled-format")] - `(let [format-in# ~format-in] - (do (defonce ~cf (if (string? format-in#) (compile-format format-in#) format-in#)) - (fn [& args#] - (let [navigator# (init-navigator args#)] - (execute-format ~cf navigator#))))))) diff --git a/modules/pprint/src/main/clojure/clojure/contrib/pprint/column_writer.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/column_writer.clj deleted file mode 100644 index 32e62931..00000000 --- a/modules/pprint/src/main/clojure/clojure/contrib/pprint/column_writer.clj +++ /dev/null @@ -1,80 +0,0 @@ -;;; column_writer.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 -;; Revised to use proxy instead of gen-class April 2010 - -; Copyright (c) Tom Faulhaber, 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. - -;; This module implements a column-aware wrapper around an instance of java.io.Writer - -(ns clojure.contrib.pprint.column-writer - (:import - [clojure.lang IDeref] - [java.io Writer])) - -(def *default-page-width* 72) - -(defn- get-field [^Writer this sym] - (sym @@this)) - -(defn- set-field [^Writer this sym new-val] - (alter @this assoc sym new-val)) - -(defn get-column [this] - (get-field this :cur)) - -(defn get-line [this] - (get-field this :line)) - -(defn get-max-column [this] - (get-field this :max)) - -(defn set-max-column [this new-max] - (dosync (set-field this :max new-max)) - nil) - -(defn get-writer [this] - (get-field this :base)) - -(defn- write-char [^Writer this ^Integer c] - (dosync (if (= c (int \newline)) - (do - (set-field this :cur 0) - (set-field this :line (inc (get-field this :line)))) - (set-field this :cur (inc (get-field this :cur))))) - (.write ^Writer (get-field this :base) c)) - -(defn column-writer - ([writer] (column-writer writer *default-page-width*)) - ([writer max-columns] - (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})] - (proxy [Writer IDeref] [] - (deref [] fields) - (write - ([^chars cbuf ^Integer off ^Integer len] - (let [^Writer writer (get-field this :base)] - (.write writer cbuf off len))) - ([x] - (condp = (class x) - String - (let [^String s x - nl (.lastIndexOf s (int \newline))] - (dosync (if (neg? nl) - (set-field this :cur (+ (get-field this :cur) (count s))) - (do - (set-field this :cur (- (count s) nl 1)) - (set-field this :line (+ (get-field this :line) - (count (filter #(= % \newline) s))))))) - (.write ^Writer (get-field this :base) s)) - - Integer - (write-char this x) - Long - (write-char this x)))))))) diff --git a/modules/pprint/src/main/clojure/clojure/contrib/pprint/dispatch.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/dispatch.clj deleted file mode 100644 index 2d742964..00000000 --- a/modules/pprint/src/main/clojure/clojure/contrib/pprint/dispatch.clj +++ /dev/null @@ -1,447 +0,0 @@ -;; dispatch.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Feb 2009. 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. - -;; This module implements the default dispatch tables for pretty printing code and -;; data. - -(in-ns 'clojure.contrib.pprint) - -(defn use-method - "Installs a function as a new method of multimethod associated with dispatch-value. " - [multifn dispatch-val func] - (. multifn addMethod dispatch-val func)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Implementations of specific dispatch table entries -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Handle forms that can be "back-translated" to reader macros -;;; Not all reader macros can be dealt with this way or at all. -;;; Macros that we can't deal with at all are: -;;; ; - The comment character is aborbed by the reader and never is part of the form -;;; ` - Is fully processed at read time into a lisp expression (which will contain concats -;;; and regular quotes). -;;; ~@ - Also fully eaten by the processing of ` and can't be used outside. -;;; , - is whitespace and is lost (like all other whitespace). Formats can generate commas -;;; where they deem them useful to help readability. -;;; ^ - Adding metadata completely disappears at read time and the data appears to be -;;; completely lost. -;;; -;;; Most other syntax stuff is dealt with directly by the formats (like (), [], {}, and #{}) -;;; or directly by printing the objects using Clojure's built-in print functions (like -;;; :keyword, \char, or ""). The notable exception is #() which is special-cased. - -(def reader-macros - {'quote "'", 'clojure.core/deref "@", - 'var "#'", 'clojure.core/unquote "~"}) - -(defn pprint-reader-macro [alis] - (let [^String macro-char (reader-macros (first alis))] - (when (and macro-char (= 2 (count alis))) - (.write ^java.io.Writer *out* macro-char) - (write-out (second alis)) - true))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Dispatch for the basic data types when interpreted -;; as data (as opposed to code). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; TODO: inline these formatter statements into funcs so that we -;;; are a little easier on the stack. (Or, do "real" compilation, a -;;; la Common Lisp) - -;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>")) -(defn pprint-simple-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -(defn pprint-list [alis] - (if-not (pprint-reader-macro alis) - (pprint-simple-list alis))) - -;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>")) -(defn pprint-vector [avec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [aseq (seq avec)] - (when aseq - (write-out (first aseq)) - (when (next aseq) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def pprint-array (formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>")) - -;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>")) -(defn pprint-map [amap] - (pprint-logical-block :prefix "{" :suffix "}" - (loop [aseq (seq amap)] - (when aseq - (pprint-logical-block - (write-out (ffirst aseq)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (write-out (fnext (first aseq)))) - (when (next aseq) - (.write ^java.io.Writer *out* ", ") - (pprint-newline :linear) - (recur (next aseq))))))) - -(def pprint-set (formatter-out "~<#{~;~@{~w~^ ~:_~}~;}~:>")) -(defn pprint-ref [ref] - (pprint-logical-block :prefix "#" - (write-out @ref))) -(defn pprint-atom [ref] - (pprint-logical-block :prefix "#" - (write-out @ref))) -(defn pprint-agent [ref] - (pprint-logical-block :prefix "#" - (write-out @ref))) - -(defn pprint-simple-default [obj] - (cond - (.isArray (class obj)) (pprint-array obj) - (and *print-suppress-namespaces* (symbol? obj)) (print (name obj)) - :else (pr obj))) - - -(defmulti - *simple-dispatch* - "The pretty print dispatch function for simple data structure format." - {:arglists '[[object]]} - class) - -(use-method *simple-dispatch* clojure.lang.ISeq pprint-list) -(use-method *simple-dispatch* clojure.lang.IPersistentVector pprint-vector) -(use-method *simple-dispatch* clojure.lang.IPersistentMap pprint-map) -(use-method *simple-dispatch* clojure.lang.IPersistentSet pprint-set) -(use-method *simple-dispatch* clojure.lang.Ref pprint-ref) -(use-method *simple-dispatch* clojure.lang.Atom pprint-atom) -(use-method *simple-dispatch* clojure.lang.Agent pprint-agent) -(use-method *simple-dispatch* nil pr) -(use-method *simple-dispatch* :default pprint-simple-default) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Dispatch for the code table -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare pprint-simple-code-list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a simple def (sans metadata, since the reader -;;; won't give it to us now). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def pprint-hold-first (formatter-out "~:<~w~^ ~@_~w~^ ~_~@{~w~^ ~_~}~:>")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like a defn or defmacro -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Format the params and body of a defn with a single arity -(defn- single-defn [alis has-doc-str?] - (if (seq alis) - (do - (if has-doc-str? - ((formatter-out " ~_")) - ((formatter-out " ~@_"))) - ((formatter-out "~{~w~^ ~_~}") alis)))) - -;;; Format the param and body sublists of a defn with multiple arities -(defn- multi-defn [alis has-doc-str?] - (if (seq alis) - ((formatter-out " ~_~{~w~^ ~_~}") alis))) - -;;; TODO: figure out how to support capturing metadata in defns (we might need a -;;; special reader) -(defn pprint-defn [alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block :prefix "(" :suffix ")" - ((formatter-out "~w ~1I~@_~w") defn-sym defn-name) - (if doc-str - ((formatter-out " ~_~w") doc-str)) - (if attr-map - ((formatter-out " ~_~w") attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list alis))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something with a binding form -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn pprint-binding-form [binding-vec] - (pprint-logical-block :prefix "[" :suffix "]" - (loop [binding binding-vec] - (when (seq binding) - (pprint-logical-block binding - (write-out (first binding)) - (when (next binding) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second binding)))) - (when (next (rest binding)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest binding)))))))) - -(defn pprint-let [alis] - (let [base-sym (first alis)] - (pprint-logical-block :prefix "(" :suffix ")" - (if (and (next alis) (vector? (second alis))) - (do - ((formatter-out "~w ~1I~@_") base-sym) - (pprint-binding-form (second alis)) - ((formatter-out " ~_~{~w~^ ~_~}") (next (rest alis)))) - (pprint-simple-code-list alis))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format something that looks like "if" -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def pprint-if (formatter-out "~:<~1I~w~^ ~@_~w~@{ ~_~w~}~:>")) - -(defn pprint-cond [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (loop [alis (next alis)] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))))) - -(defn pprint-condp [alis] - (if (> (count alis) 3) - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (apply (formatter-out "~w ~@_~w ~@_~w ~_") alis) - (loop [alis (seq (drop 3 alis))] - (when alis - (pprint-logical-block alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :miser) - (write-out (second alis)))) - (when (next (rest alis)) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next (rest alis))))))) - (pprint-simple-code-list alis))) - -;;; The map of symbols that are defined in an enclosing #() anonymous function -(def *symbol-map* {}) - -(defn pprint-anon-func [alis] - (let [args (second alis) - nlis (first (rest (rest alis)))] - (if (vector? args) - (binding [*symbol-map* (if (= 1 (count args)) - {(first args) "%"} - (into {} - (map - #(vector %1 (str \% %2)) - args - (range 1 (inc (count args))))))] - ((formatter-out "~<#(~;~@{~w~^ ~_~}~;)~:>") nlis)) - (pprint-simple-code-list alis)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The master definitions for formatting lists in code (that is, (fn args...) or -;;; special forms). -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; This is the equivalent of (formatter-out "~:<~1I~@{~w~^ ~_~}~:>"), but is -;;; easier on the stack. - -(defn pprint-simple-code-list [alis] - (pprint-logical-block :prefix "(" :suffix ")" - (pprint-indent :block 1) - (loop [alis (seq alis)] - (when alis - (write-out (first alis)) - (when (next alis) - (.write ^java.io.Writer *out* " ") - (pprint-newline :linear) - (recur (next alis))))))) - -;;; Take a map with symbols as keys and add versions with no namespace. -;;; That is, if ns/sym->val is in the map, add sym->val to the result. -(defn two-forms [amap] - (into {} - (mapcat - identity - (for [x amap] - [x [(symbol (name (first x))) (second x)]])))) - -(defn add-core-ns [amap] - (let [core "clojure.core"] - (into {} - (map #(let [[s f] %] - (if (not (or (namespace s) (special-symbol? s))) - [(symbol core (name s)) f] - %)) - amap)))) - -(def *code-table* - (two-forms - (add-core-ns - {'def pprint-hold-first, 'defonce pprint-hold-first, - 'defn pprint-defn, 'defn- pprint-defn, 'defmacro pprint-defn, 'fn pprint-defn, - 'let pprint-let, 'loop pprint-let, 'binding pprint-let, - 'with-local-vars pprint-let, 'with-open pprint-let, 'when-let pprint-let, - 'if-let pprint-let, 'doseq pprint-let, 'dotimes pprint-let, - 'when-first pprint-let, - 'if pprint-if, 'if-not pprint-if, 'when pprint-if, 'when-not pprint-if, - 'cond pprint-cond, 'condp pprint-condp, - 'fn* pprint-anon-func, - '. pprint-hold-first, '.. pprint-hold-first, '-> pprint-hold-first, - 'locking pprint-hold-first, 'struct pprint-hold-first, - 'struct-map pprint-hold-first, - }))) - -(defn pprint-code-list [alis] - (if-not (pprint-reader-macro alis) - (if-let [special-form (*code-table* (first alis))] - (special-form alis) - (pprint-simple-code-list alis)))) - -(defn pprint-code-symbol [sym] - (if-let [arg-num (sym *symbol-map*)] - (print arg-num) - (if *print-suppress-namespaces* - (print (name sym)) - (pr sym)))) - -(defmulti - *code-dispatch* - "The pretty print dispatch function for pretty printing Clojure code." - {:arglists '[[object]]} - class) - -(use-method *code-dispatch* clojure.lang.ISeq pprint-code-list) -(use-method *code-dispatch* clojure.lang.Symbol pprint-code-symbol) - -;; The following are all exact copies of *simple-dispatch* -(use-method *code-dispatch* clojure.lang.IPersistentVector pprint-vector) -(use-method *code-dispatch* clojure.lang.IPersistentMap pprint-map) -(use-method *code-dispatch* clojure.lang.IPersistentSet pprint-set) -(use-method *code-dispatch* clojure.lang.Ref pprint-ref) -(use-method *code-dispatch* clojure.lang.Atom pprint-atom) -(use-method *code-dispatch* clojure.lang.Agent pprint-agent) -(use-method *code-dispatch* nil pr) -(use-method *code-dispatch* :default pprint-simple-default) - -(set-pprint-dispatch *simple-dispatch*) - - -;;; For testing -(comment - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn cl-format - "An implementation of a Common Lisp compatible format function" - [stream format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator))))) - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn cl-format - [stream format-in & args] - (let [compiled-format (if (string? format-in) (compile-format format-in) format-in) - navigator (init-navigator args)] - (execute-format stream compiled-format navigator))))) - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn- -write - ([this x] - (condp = (class x) - String - (let [s0 (write-initial-lines this x) - s (.replaceFirst s0 "\\s+$" "") - white-space (.substring s0 (count s)) - mode (getf :mode)] - (if (= mode :writing) - (dosync - (write-white-space this) - (.col_write this s) - (setf :trailing-white-space white-space)) - (add-to-buffer this (make-buffer-blob s white-space)))) - - Integer - (let [c ^Character x] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (.col_write this x)) - (if (= c (int \newline)) - (write-initial-lines this "\n") - (add-to-buffer this (make-buffer-blob (str (char c)) nil)))))))))) - -(with-pprint-dispatch *code-dispatch* - (pprint - '(defn pprint-defn [writer alis] - (if (next alis) - (let [[defn-sym defn-name & stuff] alis - [doc-str stuff] (if (string? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff]) - [attr-map stuff] (if (map? (first stuff)) - [(first stuff) (next stuff)] - [nil stuff])] - (pprint-logical-block writer :prefix "(" :suffix ")" - (cl-format true "~w ~1I~@_~w" defn-sym defn-name) - (if doc-str - (cl-format true " ~_~w" doc-str)) - (if attr-map - (cl-format true " ~_~w" attr-map)) - ;; Note: the multi-defn case will work OK for malformed defns too - (cond - (vector? (first stuff)) (single-defn stuff (or doc-str attr-map)) - :else (multi-defn stuff (or doc-str attr-map))))) - (pprint-simple-code-list writer alis))))) -) -nil - diff --git a/modules/pprint/src/main/clojure/clojure/contrib/pprint/pprint_base.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/pprint_base.clj deleted file mode 100644 index 05d05390..00000000 --- a/modules/pprint/src/main/clojure/clojure/contrib/pprint/pprint_base.clj +++ /dev/null @@ -1,342 +0,0 @@ -;;; pprint_base.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Jan 2009. 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. - -;; This module implements the generic pretty print functions and special variables - -(in-ns 'clojure.contrib.pprint) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Variables that control the pretty printer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; -;;; *print-length*, *print-level* and *print-dup* are defined in clojure.core -;;; TODO: use *print-dup* here (or is it supplanted by other variables?) -;;; TODO: make dispatch items like "(let..." get counted in *print-length* -;;; constructs - - -(def - ^{ :doc "Bind to true if you want write to use pretty printing"} - *print-pretty* true) - -(defonce ; If folks have added stuff here, don't overwrite - ^{ :doc "The pretty print dispatch function. Use with-pprint-dispatch or set-pprint-dispatch -to modify."} - *print-pprint-dispatch* nil) - -(def - ^{ :doc "Pretty printing will try to avoid anything going beyond this column. -Set it to nil to have pprint let the line be arbitrarily long. This will ignore all -non-mandatory newlines."} - *print-right-margin* 72) - -(def - ^{ :doc "The column at which to enter miser style. Depending on the dispatch table, -miser style add newlines in more places to try to keep lines short allowing for further -levels of nesting."} - *print-miser-width* 40) - -;;; TODO implement output limiting -(def - ^{ :doc "Maximum number of lines to print in a pretty print instance (N.B. This is not yet used)"} - *print-lines* nil) - -;;; TODO: implement circle and shared -(def - ^{ :doc "Mark circular structures (N.B. This is not yet used)"} - *print-circle* nil) - -;;; TODO: should we just use *print-dup* here? -(def - ^{ :doc "Mark repeated structures rather than repeat them (N.B. This is not yet used)"} - *print-shared* nil) - -(def - ^{ :doc "Don't print namespaces with symbols. This is particularly useful when -pretty printing the results of macro expansions"} - *print-suppress-namespaces* nil) - -;;; TODO: support print-base and print-radix in cl-format -;;; TODO: support print-base and print-radix in rationals -(def - ^{ :doc "Print a radix specifier in front of integers and rationals. If *print-base* is 2, 8, -or 16, then the radix specifier used is #b, #o, or #x, respectively. Otherwise the -radix specifier is in the form #XXr where XX is the decimal value of *print-base* "} - *print-radix* nil) - -(def - ^{ :doc "The base to use for printing integers and rationals."} - *print-base* 10) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Internal variables that keep track of where we are in the -;; structure -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^{ :private true } *current-level* 0) - -(def ^{ :private true } *current-length* nil) - -;; TODO: add variables for length, lines. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support for the write function -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare format-simple-number) - -(def ^{:private true} orig-pr pr) - -(defn- pr-with-base [x] - (if-let [s (format-simple-number x)] - (print s) - (orig-pr x))) - -(def ^{:private true} write-option-table - {;:array *print-array* - :base 'clojure.contrib.pprint/*print-base*, - ;;:case *print-case*, - :circle 'clojure.contrib.pprint/*print-circle*, - ;;:escape *print-escape*, - ;;:gensym *print-gensym*, - :length 'clojure.core/*print-length*, - :level 'clojure.core/*print-level*, - :lines 'clojure.contrib.pprint/*print-lines*, - :miser-width 'clojure.contrib.pprint/*print-miser-width*, - :dispatch 'clojure.contrib.pprint/*print-pprint-dispatch*, - :pretty 'clojure.contrib.pprint/*print-pretty*, - :radix 'clojure.contrib.pprint/*print-radix*, - :readably 'clojure.core/*print-readably*, - :right-margin 'clojure.contrib.pprint/*print-right-margin*, - :suppress-namespaces 'clojure.contrib.pprint/*print-suppress-namespaces*}) - - -(defmacro ^{:private true} binding-map [amap & body] - (let [] - `(do - (. clojure.lang.Var (pushThreadBindings ~amap)) - (try - ~@body - (finally - (. clojure.lang.Var (popThreadBindings))))))) - -(defn- table-ize [t m] - (apply hash-map (mapcat - #(when-let [v (get t (key %))] [(find-var v) (val %)]) - m))) - -(defn- pretty-writer? - "Return true iff x is a PrettyWriter" - [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x))) - -(defn- make-pretty-writer - "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width" - [base-writer right-margin miser-width] - (pretty-writer base-writer right-margin miser-width)) - -(defmacro ^{:private true} with-pretty-writer [base-writer & body] - `(let [base-writer# ~base-writer - new-writer# (not (pretty-writer? base-writer#))] - (binding [*out* (if new-writer# - (make-pretty-writer base-writer# *print-right-margin* *print-miser-width*) - base-writer#)] - ~@body - (.flush *out*)))) - - -;;;TODO: if pretty print is not set, don't use pr but rather something that respects *print-base*, etc. -(defn write-out - "Write an object to *out* subject to the current bindings of the printer control -variables. Use the kw-args argument to override individual variables for this call (and -any recursive calls). - -*out* must be a PrettyWriter if pretty printing is enabled. This is the responsibility -of the caller. - -This method is primarily intended for use by pretty print dispatch functions that -already know that the pretty printer will have set up their environment appropriately. -Normal library clients should use the standard \"write\" interface. " - [object] - (let [length-reached (and - *current-length* - *print-length* - (>= *current-length* *print-length*))] - (if-not *print-pretty* - (pr object) - (if length-reached - (print "...") - (do - (if *current-length* (set! *current-length* (inc *current-length*))) - (*print-pprint-dispatch* object)))) - length-reached)) - -(defn write - "Write an object subject to the current bindings of the printer control variables. -Use the kw-args argument to override individual variables for this call (and any -recursive calls). Returns the string result if :stream is nil or nil otherwise. - -The following keyword arguments can be passed with values: - Keyword Meaning Default value - :stream Writer for output or nil true (indicates *out*) - :base Base to use for writing rationals Current value of *print-base* - :circle* If true, mark circular structures Current value of *print-circle* - :length Maximum elements to show in sublists Current value of *print-length* - :level Maximum depth Current value of *print-level* - :lines* Maximum lines of output Current value of *print-lines* - :miser-width Width to enter miser mode Current value of *print-miser-width* - :dispatch The pretty print dispatch function Current value of *print-pprint-dispatch* - :pretty If true, do pretty printing Current value of *print-pretty* - :radix If true, prepend a radix specifier Current value of *print-radix* - :readably* If true, print readably Current value of *print-readably* - :right-margin The column for the right margin Current value of *print-right-margin* - :suppress-namespaces If true, no namespaces in symbols Current value of *print-suppress-namespaces* - - * = not yet supported -" - [object & kw-args] - (let [options (merge {:stream true} (apply hash-map kw-args))] - (binding-map (table-ize write-option-table options) - (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) - (let [optval (if (contains? options :stream) - (:stream options) - true) - base-writer (condp = optval - nil (java.io.StringWriter.) - true *out* - optval)] - (if *print-pretty* - (with-pretty-writer base-writer - (write-out object)) - (binding [*out* base-writer] - (pr object))) - (if (nil? optval) - (.toString ^java.io.StringWriter base-writer))))))) - - -(defn pprint - "Pretty print object to the optional output writer. If the writer is not provided, -print the object to the currently bound value of *out*." - ([object] (pprint object *out*)) - ([object writer] - (with-pretty-writer writer - (binding [*print-pretty* true] - (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) - (write-out object))) - (if (not (= 0 (get-column *out*))) - (.write *out* (int \newline)))))) - -(defmacro pp - "A convenience macro that pretty prints the last thing output. This is -exactly equivalent to (pprint *1)." - [] `(pprint *1)) - -(defn set-pprint-dispatch - "Set the pretty print dispatch function to a function matching (fn [obj] ...) -where obj is the object to pretty print. That function will be called with *out* set -to a pretty printing writer to which it should do its printing. - -For example functions, see *simple-dispatch* and *code-dispatch* in -clojure.contrib.pprint.dispatch.clj." - [function] - (let [old-meta (meta #'*print-pprint-dispatch*)] - (alter-var-root #'*print-pprint-dispatch* (constantly function)) - (alter-meta! #'*print-pprint-dispatch* (constantly old-meta))) - nil) - -(defmacro with-pprint-dispatch - "Execute body with the pretty print dispatch function bound to function." - [function & body] - `(binding [*print-pprint-dispatch* ~function] - ~@body)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Support for the functional interface to the pretty printer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- parse-lb-options [opts body] - (loop [body body - acc []] - (if (opts (first body)) - (recur (drop 2 body) (concat acc (take 2 body))) - [(apply hash-map acc) body]))) - -(defn- check-enumerated-arg [arg choices] - (if-not (choices arg) - (throw - (IllegalArgumentException. - ;; TODO clean up choices string - (str "Bad argument: " arg ". It must be one of " choices))))) - -(defn level-exceeded [] - (and *print-level* (>= *current-level* *print-level*))) - -(defmacro pprint-logical-block - "Execute the body as a pretty printing logical block with output to *out* which -must be a pretty printing writer. When used from pprint or cl-format, this can be -assumed. - -Before the body, the caller can optionally specify options: :prefix, :per-line-prefix, -and :suffix." - {:arglists '[[options* body]]} - [& args] - (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)] - `(do (if (level-exceeded) - (.write ^java.io.Writer *out* "#") - (binding [*current-level* (inc *current-level*) - *current-length* 0] - (start-block *out* - ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options)) - ~@body - (end-block *out*))) - nil))) - -(defn pprint-newline - "Print a conditional newline to a pretty printing stream. kind specifies if the -newline is :linear, :miser, :fill, or :mandatory. - -Output is sent to *out* which must be a pretty printing writer." - [kind] - (check-enumerated-arg kind #{:linear :miser :fill :mandatory}) - (nl *out* kind)) - -(defn pprint-indent - "Create an indent at this point in the pretty printing stream. This defines how -following lines are indented. relative-to can be either :block or :current depending -whether the indent should be computed relative to the start of the logical block or -the current column position. n is an offset. - -Output is sent to *out* which must be a pretty printing writer." - [relative-to n] - (check-enumerated-arg relative-to #{:block :current}) - (indent *out* relative-to n)) - -;; TODO a real implementation for pprint-tab -(defn pprint-tab - "Tab at this point in the pretty printing stream. kind specifies whether the tab -is :line, :section, :line-relative, or :section-relative. - -Colnum and colinc specify the target column and the increment to move the target -forward if the output is already past the original target. - -Output is sent to *out* which must be a pretty printing writer. - -THIS FUNCTION IS NOT YET IMPLEMENTED." - [kind colnum colinc] - (check-enumerated-arg kind #{:line :section :line-relative :section-relative}) - (throw (UnsupportedOperationException. "pprint-tab is not yet implemented"))) - - -nil diff --git a/modules/pprint/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj deleted file mode 100644 index dfea976a..00000000 --- a/modules/pprint/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj +++ /dev/null @@ -1,488 +0,0 @@ -;;; pretty_writer.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 -;; Revised to use proxy instead of gen-class April 2010 - -; Copyright (c) Tom Faulhaber, Jan 2009. 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. - -;; This module implements a wrapper around a java.io.Writer which implements the -;; core of the XP algorithm. - -(ns clojure.contrib.pprint.pretty-writer - (:refer-clojure :exclude (deftype)) - (:use clojure.contrib.pprint.utilities) - (:use [clojure.contrib.pprint.column-writer - :only (column-writer get-column get-max-column)]) - (:import - [clojure.lang IDeref] - [java.io Writer])) - -;; TODO: Support for tab directives - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Forward declarations -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare get-miser-width) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Macros to simplify dealing with types and classes. These are -;;; really utilities, but I'm experimenting with them here. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro ^{:private true} - getf - "Get the value of the field a named by the argument (which should be a keyword)." - [sym] - `(~sym @@~'this)) - -(defmacro ^{:private true} - setf [sym new-val] - "Set the value of the field SYM to NEW-VAL" - `(alter @~'this assoc ~sym ~new-val)) - -(defmacro ^{:private true} - deftype [type-name & fields] - (let [name-str (name type-name)] - `(do - (defstruct ~type-name :type-tag ~@fields) - (defn- ~(symbol (str "make-" name-str)) - [& vals#] (apply struct ~type-name ~(keyword name-str) vals#)) - (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The data structures used by pretty-writer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defstruct ^{:private true} logical-block - :parent :section :start-col :indent - :done-nl :intra-block-nl - :prefix :per-line-prefix :suffix - :logical-block-callback) - -(defn ancestor? [parent child] - (loop [child (:parent child)] - (cond - (nil? child) false - (identical? parent child) true - :else (recur (:parent child))))) - -(defstruct ^{:private true} section :parent) - -(defn buffer-length [l] - (let [l (seq l)] - (if l - (- (:end-pos (last l)) (:start-pos (first l))) - 0))) - -; A blob of characters (aka a string) -(deftype buffer-blob :data :trailing-white-space :start-pos :end-pos) - -; A newline -(deftype nl-t :type :logical-block :start-pos :end-pos) - -(deftype start-block-t :logical-block :start-pos :end-pos) - -(deftype end-block-t :logical-block :start-pos :end-pos) - -(deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Functions to write tokens in the output buffer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(declare emit-nl) - -(defmulti write-token #(:type-tag %2)) -(defmethod write-token :start-block-t [^Writer this token] - (when-let [cb (getf :logical-block-callback)] (cb :start)) - (let [lb (:logical-block token)] - (dosync - (when-let [^String prefix (:prefix lb)] - (.write (getf :base) prefix)) - (let [col (get-column (getf :base))] - (ref-set (:start-col lb) col) - (ref-set (:indent lb) col))))) - -(defmethod write-token :end-block-t [^Writer this token] - (when-let [cb (getf :logical-block-callback)] (cb :end)) - (when-let [^String suffix (:suffix (:logical-block token))] - (.write (getf :base) suffix))) - -(defmethod write-token :indent-t [^Writer this token] - (let [lb (:logical-block token)] - (ref-set (:indent lb) - (+ (:offset token) - (condp = (:relative-to token) - :block @(:start-col lb) - :current (get-column (getf :base))))))) - -(defmethod write-token :buffer-blob [^Writer this token] - (.write (getf :base) ^String (:data token))) - -(defmethod write-token :nl-t [^Writer this token] -; (prlabel wt @(:done-nl (:logical-block token))) -; (prlabel wt (:type token) (= (:type token) :mandatory)) - (if (or (= (:type token) :mandatory) - (and (not (= (:type token) :fill)) - @(:done-nl (:logical-block token)))) - (emit-nl this token) - (if-let [^String tws (getf :trailing-white-space)] - (.write (getf :base) tws))) - (dosync (setf :trailing-white-space nil))) - -(defn- write-tokens [^Writer this tokens force-trailing-whitespace] - (doseq [token tokens] - (if-not (= (:type-tag token) :nl-t) - (if-let [^String tws (getf :trailing-white-space)] - (.write (getf :base) tws))) - (write-token this token) - (setf :trailing-white-space (:trailing-white-space token))) - (let [^String tws (getf :trailing-white-space)] - (when (and force-trailing-whitespace tws) - (.write (getf :base) tws) - (setf :trailing-white-space nil)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; emit-nl? method defs for each type of new line. This makes -;;; the decision about whether to print this type of new line. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn- tokens-fit? [^Writer this tokens] -;;; (prlabel tf? (get-column (getf :base) (buffer-length tokens)) - (let [maxcol (get-max-column (getf :base))] - (or - (nil? maxcol) - (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol)))) - -(defn- linear-nl? [this lb section] -; (prlabel lnl? @(:done-nl lb) (tokens-fit? this section)) - (or @(:done-nl lb) - (not (tokens-fit? this section)))) - -(defn- miser-nl? [^Writer this lb section] - (let [miser-width (get-miser-width this) - maxcol (get-max-column (getf :base))] - (and miser-width maxcol - (>= @(:start-col lb) (- maxcol miser-width)) - (linear-nl? this lb section)))) - -(defmulti emit-nl? (fn [t _ _ _] (:type t))) - -(defmethod emit-nl? :linear [newl this section _] - (let [lb (:logical-block newl)] - (linear-nl? this lb section))) - -(defmethod emit-nl? :miser [newl this section _] - (let [lb (:logical-block newl)] - (miser-nl? this lb section))) - -(defmethod emit-nl? :fill [newl this section subsection] - (let [lb (:logical-block newl)] - (or @(:intra-block-nl lb) - (not (tokens-fit? this subsection)) - (miser-nl? this lb section)))) - -(defmethod emit-nl? :mandatory [_ _ _ _] - true) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Various support functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn- get-section [buffer] - (let [nl (first buffer) - lb (:logical-block nl) - section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb))) - (next buffer)))] - [section (seq (drop (inc (count section)) buffer))])) - -(defn- get-sub-section [buffer] - (let [nl (first buffer) - lb (:logical-block nl) - section (seq (take-while #(let [nl-lb (:logical-block %)] - (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb))))) - (next buffer)))] - section)) - -(defn- update-nl-state [lb] - (dosync - (ref-set (:intra-block-nl lb) false) - (ref-set (:done-nl lb) true) - (loop [lb (:parent lb)] - (if lb - (do (ref-set (:done-nl lb) true) - (ref-set (:intra-block-nl lb) true) - (recur (:parent lb))))))) - -(defn emit-nl [^Writer this nl] - (.write (getf :base) (int \newline)) - (dosync (setf :trailing-white-space nil)) - (let [lb (:logical-block nl) - ^String prefix (:per-line-prefix lb)] - (if prefix - (.write (getf :base) prefix)) - (let [^String istr (apply str (repeat (- @(:indent lb) (count prefix)) - \space))] - (.write (getf :base) istr)) - (update-nl-state lb))) - -(defn- split-at-newline [tokens] - (let [pre (seq (take-while #(not (nl-t? %)) tokens))] - [pre (seq (drop (count pre) tokens))])) - -;;; Methods for showing token strings for debugging - -(defmulti tok :type-tag) -(defmethod tok :nl-t [token] - (:type token)) -(defmethod tok :buffer-blob [token] - (str \" (:data token) (:trailing-white-space token) \")) -(defmethod tok :default [token] - (:type-tag token)) -(defn toks [toks] (map tok toks)) - -;;; write-token-string is called when the set of tokens in the buffer -;;; is longer than the available space on the line - -(defn- write-token-string [this tokens] - (let [[a b] (split-at-newline tokens)] -;; (prlabel wts (toks a) (toks b)) - (if a (write-tokens this a false)) - (if b - (let [[section remainder] (get-section b) - newl (first b)] -;; (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) - (let [do-nl (emit-nl? newl this section (get-sub-section b)) - result (if do-nl - (do -;; (prlabel emit-nl (:type newl)) - (emit-nl this newl) - (next b)) - b) - long-section (not (tokens-fit? this result)) - result (if long-section - (let [rem2 (write-token-string this section)] -;;; (prlabel recurse (toks rem2)) - (if (= rem2 section) - (do ; If that didn't produce any output, it has no nls - ; so we'll force it - (write-tokens this section false) - remainder) - (into [] (concat rem2 remainder)))) - result) -;; ff (prlabel wts (toks result)) - ] - result))))) - -(defn- write-line [^Writer this] - (dosync - (loop [buffer (getf :buffer)] -;; (prlabel wl1 (toks buffer)) - (setf :buffer (into [] buffer)) - (if (not (tokens-fit? this buffer)) - (let [new-buffer (write-token-string this buffer)] -;; (prlabel wl new-buffer) - (if-not (identical? buffer new-buffer) - (recur new-buffer))))))) - -;;; Add a buffer token to the buffer and see if it's time to start -;;; writing -(defn- add-to-buffer [^Writer this token] -; (prlabel a2b token) - (dosync - (setf :buffer (conj (getf :buffer) token)) - (if (not (tokens-fit? this (getf :buffer))) - (write-line this)))) - -;;; Write all the tokens that have been buffered -(defn- write-buffered-output [^Writer this] - (write-line this) - (if-let [buf (getf :buffer)] - (do - (write-tokens this buf true) - (setf :buffer [])))) - -;;; If there are newlines in the string, print the lines up until the last newline, -;;; making the appropriate adjustments. Return the remainder of the string -(defn- write-initial-lines - [^Writer this ^String s] - (let [lines (.split s "\n" -1)] - (if (= (count lines) 1) - s - (dosync - (let [^String prefix (:per-line-prefix (first (getf :logical-blocks))) - ^String l (first lines)] - (if (= :buffering (getf :mode)) - (let [oldpos (getf :pos) - newpos (+ oldpos (count l))] - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob l nil oldpos newpos)) - (write-buffered-output this)) - (.write (getf :base) l)) - (.write (getf :base) (int \newline)) - (doseq [^String l (next (butlast lines))] - (.write (getf :base) l) - (.write (getf :base) (int \newline)) - (if prefix - (.write (getf :base) prefix))) - (setf :buffering :writing) - (last lines)))))) - - -(defn write-white-space [^Writer this] - (if-let [^String tws (getf :trailing-white-space)] - (dosync - (.write (getf :base) tws) - (setf :trailing-white-space nil)))) - -(defn- write-char [^Writer this ^Integer c] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (.write (getf :base) c)) - (if (= c \newline) - (write-initial-lines this "\n") - (let [oldpos (getf :pos) - newpos (inc oldpos)] - (dosync - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Initialize the pretty-writer instance -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defn pretty-writer [writer max-columns miser-width] - (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false)) - fields (ref {:pretty-writer true - :base (column-writer writer max-columns) - :logical-blocks lb - :sections nil - :mode :writing - :buffer [] - :buffer-block lb - :buffer-level 1 - :miser-width miser-width - :trailing-white-space nil - :pos 0})] - (proxy [Writer IDeref] [] - (deref [] fields) - - (write - ([x] - ;; (prlabel write x (getf :mode)) - (condp = (class x) - String - (let [^String s0 (write-initial-lines this x) - ^String s (.replaceFirst s0 "\\s+$" "") - white-space (.substring s0 (count s)) - mode (getf :mode)] - (dosync - (if (= mode :writing) - (do - (write-white-space this) - (.write (getf :base) s) - (setf :trailing-white-space white-space)) - (let [oldpos (getf :pos) - newpos (+ oldpos (count s0))] - (setf :pos newpos) - (add-to-buffer this (make-buffer-blob s white-space oldpos newpos)))))) - - Integer - (write-char this x) - Long - (write-char this x)))) - - (flush [] - (if (= (getf :mode) :buffering) - (dosync - (write-tokens this (getf :buffer) true) - (setf :buffer [])) - (write-white-space this))) - - (close [] - (.flush this))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Methods for pretty-writer -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn start-block - [^Writer this - ^String prefix ^String per-line-prefix ^String suffix] - (dosync - (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0) - (ref false) (ref false) - prefix per-line-prefix suffix)] - (setf :logical-blocks lb) - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (when-let [cb (getf :logical-block-callback)] (cb :start)) - (if prefix - (.write (getf :base) prefix)) - (let [col (get-column (getf :base))] - (ref-set (:start-col lb) col) - (ref-set (:indent lb) col))) - (let [oldpos (getf :pos) - newpos (+ oldpos (if prefix (count prefix) 0))] - (setf :pos newpos) - (add-to-buffer this (make-start-block-t lb oldpos newpos))))))) - -(defn end-block [^Writer this] - (dosync - (let [lb (getf :logical-blocks) - ^String suffix (:suffix lb)] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (if suffix - (.write (getf :base) suffix)) - (when-let [cb (getf :logical-block-callback)] (cb :end))) - (let [oldpos (getf :pos) - newpos (+ oldpos (if suffix (count suffix) 0))] - (setf :pos newpos) - (add-to-buffer this (make-end-block-t lb oldpos newpos)))) - (setf :logical-blocks (:parent lb))))) - -(defn nl [^Writer this type] - (dosync - (setf :mode :buffering) - (let [pos (getf :pos)] - (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos))))) - -(defn indent [^Writer this relative-to offset] - (dosync - (let [lb (getf :logical-blocks)] - (if (= (getf :mode) :writing) - (do - (write-white-space this) - (ref-set (:indent lb) - (+ offset (condp = relative-to - :block @(:start-col lb) - :current (get-column (getf :base)))))) - (let [pos (getf :pos)] - (add-to-buffer this (make-indent-t lb relative-to offset pos pos))))))) - -(defn get-miser-width [^Writer this] - (getf :miser-width)) - -(defn set-miser-width [^Writer this new-miser-width] - (dosync (setf :miser-width new-miser-width))) - -(defn set-logical-block-callback [^Writer this f] - (dosync (setf :logical-block-callback f))) diff --git a/modules/pprint/src/main/clojure/clojure/contrib/pprint/utilities.clj b/modules/pprint/src/main/clojure/clojure/contrib/pprint/utilities.clj deleted file mode 100644 index 128c66e5..00000000 --- a/modules/pprint/src/main/clojure/clojure/contrib/pprint/utilities.clj +++ /dev/null @@ -1,104 +0,0 @@ -;;; utilities.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Jan 2009. 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. - -;; This module implements some utility function used in formatting and pretty -;; printing. The functions here could go in a more general purpose library, -;; perhaps. - -(ns clojure.contrib.pprint.utilities) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Helper functions for digesting formats in the various -;;; phases of their lives. -;;; These functions are actually pretty general. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn map-passing-context [func initial-context lis] - (loop [context initial-context - lis lis - acc []] - (if (empty? lis) - [acc context] - (let [this (first lis) - remainder (next lis) - [result new-context] (apply func [this context])] - (recur new-context remainder (conj acc result)))))) - -(defn consume [func initial-context] - (loop [context initial-context - acc []] - (let [[result new-context] (apply func [context])] - (if (not result) - [acc new-context] - (recur new-context (conj acc result)))))) - -(defn consume-while [func initial-context] - (loop [context initial-context - acc []] - (let [[result continue new-context] (apply func [context])] - (if (not continue) - [acc context] - (recur new-context (conj acc result)))))) - -(defn unzip-map [m] - "Take a map that has pairs in the value slots and produce a pair of maps, - the first having all the first elements of the pairs and the second all - the second elements of the pairs" - [(into {} (for [[k [v1 v2]] m] [k v1])) - (into {} (for [[k [v1 v2]] m] [k v2]))]) - -(defn tuple-map [m v1] - "For all the values, v, in the map, replace them with [v v1]" - (into {} (for [[k v] m] [k [v v1]]))) - -(defn rtrim [s c] - "Trim all instances of c from the end of sequence s" - (let [len (count s)] - (if (and (pos? len) (= (nth s (dec (count s))) c)) - (loop [n (dec len)] - (cond - (neg? n) "" - (not (= (nth s n) c)) (subs s 0 (inc n)) - true (recur (dec n)))) - s))) - -(defn ltrim [s c] - "Trim all instances of c from the beginning of sequence s" - (let [len (count s)] - (if (and (pos? len) (= (nth s 0) c)) - (loop [n 0] - (if (or (= n len) (not (= (nth s n) c))) - (subs s n) - (recur (inc n)))) - s))) - -(defn prefix-count [aseq val] - "Return the number of times that val occurs at the start of sequence aseq, -if val is a seq itself, count the number of times any element of val occurs at the -beginning of aseq" - (let [test (if (coll? val) (set val) #{val})] - (loop [pos 0] - (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) - pos - (recur (inc pos)))))) - -(defn prerr [& args] - "Println to *err*" - (binding [*out* *err*] - (apply println args))) - -(defmacro prlabel [prefix arg & more-args] - "Print args to *err* in name = value format" - `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) - (cons arg (seq more-args)))))) - diff --git a/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj deleted file mode 100644 index 4022e5e3..00000000 --- a/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj +++ /dev/null @@ -1,691 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, 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. - -;; This test set tests the basic cl-format functionality - -(ns clojure.contrib.pprint.test-cl-format - (:refer-clojure :exclude [format]) - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.pprint.test-helper - clojure.contrib.pprint)) - -(def format cl-format) - -;; TODO tests for ~A, ~D, etc. -;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding - -(simple-tests d-tests - (cl-format nil "~D" 0) "0" - (cl-format nil "~D" 2e6) "2000000" - (cl-format nil "~D" 2000000) "2000000" - (cl-format nil "~:D" 2000000) "2,000,000" - (cl-format nil "~D" 1/2) "1/2" - (cl-format nil "~D" 'fred) "fred" -) - -(simple-tests base-tests - (cl-format nil "~{~2r~^ ~}~%" (range 10)) - "0 1 10 11 100 101 110 111 1000 1001\n" - (with-out-str - (dotimes [i 35] - (binding [*print-base* (+ i 2)] ;print the decimal number 40 - (write 40) ;in each base from 2 to 36 - (if (zero? (mod i 10)) (prn) (cl-format true " "))))) - "101000 -1111 220 130 104 55 50 44 40 37 34 -31 2c 2a 28 26 24 22 20 1j 1i -1h 1g 1f 1e 1d 1c 1b 1a 19 18 -17 16 15 14 " - (with-out-str - (doseq [pb [2 3 8 10 16]] - (binding [*print-radix* true ;print the integer 10 and - *print-base* pb] ;the ratio 1/10 in bases 2, - (cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16 - "#b1010 #b1/1010 -#3r101 #3r1/101 -#o12 #o1/12 -10. #10r1/10 -#xa #x1/a -") - - - -(simple-tests cardinal-tests - (cl-format nil "~R" 0) "zero" - (cl-format nil "~R" 4) "four" - (cl-format nil "~R" 15) "fifteen" - (cl-format nil "~R" -15) "minus fifteen" - (cl-format nil "~R" 25) "twenty-five" - (cl-format nil "~R" 20) "twenty" - (cl-format nil "~R" 200) "two hundred" - (cl-format nil "~R" 203) "two hundred three" - - (cl-format nil "~R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R = ~:*~:D" 44000032) - "forty-four million, thirty-two = 44,000,032" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - - (cl-format nil "~R = ~:*~:D" 2e6) - "two million = 2,000,000" - - (cl-format nil "~R = ~:*~:D" 200000200000) - "two hundred billion, two hundred thousand = 200,000,200,000") - -(simple-tests ordinal-tests - (cl-format nil "~:R" 0) "zeroth" - (cl-format nil "~:R" 4) "fourth" - (cl-format nil "~:R" 15) "fifteenth" - (cl-format nil "~:R" -15) "minus fifteenth" - (cl-format nil "~:R" 25) "twenty-fifth" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 203) "two hundred third" - - (cl-format nil "~:R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R = ~:*~:D" 44000032) - "forty-four million, thirty-second = 44,000,032" - - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471" - (cl-format nil "~:R = ~:*~:D" 2e6) - "two millionth = 2,000,000") - -(simple-tests ordinal1-tests - (cl-format nil "~:R" 1) "first" - (cl-format nil "~:R" 11) "eleventh" - (cl-format nil "~:R" 21) "twenty-first" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 220) "two hundred twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 999) "nine hundred ninety-ninth" - ) - -(simple-tests roman-tests - (cl-format nil "~@R" 3) "III" - (cl-format nil "~@R" 4) "IV" - (cl-format nil "~@R" 9) "IX" - (cl-format nil "~@R" 29) "XXIX" - (cl-format nil "~@R" 429) "CDXXIX" - (cl-format nil "~@:R" 429) "CCCCXXVIIII" - (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII" - (cl-format nil "~@R" 3429) "MMMCDXXIX" - (cl-format nil "~@R" 3479) "MMMCDLXXIX" - (cl-format nil "~@R" 3409) "MMMCDIX" - (cl-format nil "~@R" 300) "CCC" - (cl-format nil "~@R ~D" 300 20) "CCC 20" - (cl-format nil "~@R" 5000) "5,000" - (cl-format nil "~@R ~D" 5000 20) "5,000 20" - (cl-format nil "~@R" "the quick") "the quick") - -(simple-tests c-tests - (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~@C~%" \m) "\\m\n" - (cl-format nil "~@C~%" (char 222)) "\\Þ\n" - (cl-format nil "~@C~%" (char 8)) "\\backspace\n" - (cl-format nil "~@C~%" (char 3)) "\\\n") - -(simple-tests e-tests - (cl-format nil "*~E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*" - (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*" - (cl-format nil "*~5E*" 0.0) "*0.E+0*" - (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*" - (cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*" - (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*" - ) - -(simple-tests $-tests - (cl-format nil "~$" 22.3) "22.30" - (cl-format nil "~$" 22.375) "22.38" - (cl-format nil "~3,5$" 22.375) "00022.375" - (cl-format nil "~3,5,8$" 22.375) "00022.375" - (cl-format nil "~3,5,10$" 22.375) " 00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375" - (cl-format nil "~3,,14@:$" 0.375) "+ 0.375" - (cl-format nil "~1,1$" -12.0) "-12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1@$" 12.0) "+12.0" - (cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0" - (cl-format nil "~1,1,8,' @$" 12.0) " +12.0" - (cl-format nil "~1,1,8,' :$" 12.0) " 12.0" - (cl-format nil "~1,1,8,' $" 12.0) " 12.0" - (cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' @$" -12.0) " -12.0" - (cl-format nil "~1,1,8,' :$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' $" -12.0) " -12.0" - (cl-format nil "~1,1$" 0.001) "0.0" - (cl-format nil "~2,1$" 0.001) "0.00" - (cl-format nil "~1,1,6$" 0.001) " 0.0" - (cl-format nil "~1,1,6$" 0.0015) " 0.0" - (cl-format nil "~2,1,6$" 0.005) " 0.01" - (cl-format nil "~2,1,6$" 0.01) " 0.01" - (cl-format nil "~$" 0.099) "0.10" - (cl-format nil "~1$" 0.099) "0.1" - (cl-format nil "~1$" 0.1) "0.1" - (cl-format nil "~1$" 0.99) "1.0" - (cl-format nil "~1$" -0.99) "-1.0") - -(simple-tests f-tests - (cl-format nil "~,1f" -12.0) "-12.0" - (cl-format nil "~,0f" 9.4) "9." - (cl-format nil "~,0f" 9.5) "10." - (cl-format nil "~,0f" -0.99) "-1." - (cl-format nil "~,1f" -0.99) "-1.0" - (cl-format nil "~,2f" -0.99) "-0.99" - (cl-format nil "~,3f" -0.99) "-0.990" - (cl-format nil "~,0f" 0.99) "1." - (cl-format nil "~,1f" 0.99) "1.0" - (cl-format nil "~,2f" 0.99) "0.99" - (cl-format nil "~,3f" 0.99) "0.990" - (cl-format nil "~f" -1) "-1.0" - (cl-format nil "~2f" -1) "-1." - (cl-format nil "~3f" -1) "-1." - (cl-format nil "~4f" -1) "-1.0" - (cl-format nil "~8f" -1) " -1.0" - (cl-format nil "~1,1f" 0.1) ".1") - -(simple-tests ampersand-tests - (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown elephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10) - "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n") - -(simple-tests t-tests - (cl-format nil "~@{~&~A~8,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" -) - -(simple-tests paren-tests - (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here" - (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here" - (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT" - (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!" - ;; Test cases from CLtL 18.3 - string-upcase, et al. - (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" - (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" - (cl-format nil "~:(~A~)" " hello ") " Hello " - (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") - "Occluded Casements Forestall Inadvertent Defenestration" - (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" - (cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!" - (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c" -) - -(simple-tests square-bracket-tests - ;; Tests for format without modifiers - (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n" - - ;; Tests for format with a colon - (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n" - - ;; Tests for format with an at sign - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n" - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17) - "We had 15 wins (out of 17 tries).\n" - - ;; Format tests with directives - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7) - "Max 15: Blue team 7.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12) - "Max 15: Red team 12.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" - 15, -1, "(system failure)") - "Max 15: No team (system failure).\n" - - ;; Nested format tests - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, true) - "Max 15: Blue team 7 (complete success).\n" - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, false) - "Max 15: Blue team 7.\n" - - ;; Test the selector as part of the argument - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].") - "The answer is nothing." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4) - "The answer is 4." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22) - "The answer is 7 out of 22." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4) - "The answer is something crazy." -) - -(simple-tests curly-brace-plain-tests - ;; Iteration from sublist - (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - - -(simple-tests curly-brace-colon-tests - ;; Iteration from list of sublists - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - -(simple-tests curly-brace-at-tests - ;; Iteration from main list - (cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -(simple-tests curly-brace-colon-at-tests - ;; Iteration from sublists on the main arg list - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -;; TODO tests for ~^ in ~[ constructs and other brackets -;; TODO test ~:^ generates an error when used improperly -;; TODO test ~:^ works in ~@:{...~} -(let [aseq '(a quick brown fox jumped over the lazy dog) - lseq (mapcat identity (for [x aseq] [x (.length (name x))]))] - (simple-tests up-tests - (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog" - (cl-format nil "~{~a~0^, ~}" aseq) "a" - (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over" - (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox" - (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox" -)) - -(simple-tests angle-bracket-tests - (cl-format nil "~") "foobarbaz" - (cl-format nil "~20") "foo bar baz" - (cl-format nil "~,,2") "foo bar baz" - (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz" - (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz " - (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz " - (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar" - (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo " - (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo" -) - -(simple-tests angle-bracket-max-column-tests - (cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s"))) - "\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n" -(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s")))) - -(defn list-to-table [aseq column-width] - (let [stream (get-pretty-writer (java.io.StringWriter.))] - (binding [*out* stream] - (doseq [row aseq] - (doseq [col row] - (cl-format true "~4D~7,vT" col column-width)) - (prn))) - (.flush stream) - (.toString (:base @@(:base @@stream))))) - -(simple-tests column-writer-test - (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8) - " 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following tests are the various examples from the format -;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn expt [base pow] (reduce * (repeat pow base))) - -(let [x 5, y "elephant", n 3] - (simple-tests cltl-intro-tests - (format nil "foo") "foo" - (format nil "The answer is ~D." x) "The answer is 5." - (format nil "The answer is ~3D." x) "The answer is 5." - (format nil "The answer is ~3,'0D." x) "The answer is 005." - (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007." - (format nil "Look at the ~A!" y) "Look at the elephant!" - (format nil "Type ~:C to ~A." (char 4) "delete all your files") - "Type Control-D to delete all your files." - (format nil "~D item~:P found." n) "3 items found." - (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here." - (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here." - (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies.")) - -(simple-tests cltl-B-tests - ;; CLtL didn't have the colons here, but the spec requires them - (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" - (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - ;; This one was a nice idea, but nothing in the spec supports it working this way - ;; (and SBCL doesn't work this way either) - ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110") - ) - -(simple-tests cltl-P-tests - (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" - (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" - (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins") - -(defn foo [x] - (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" - x x x x x x)) - -(simple-tests cltl-F-tests - (foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" - (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" - (foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0" - (foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0" - (foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006") - -(defn foo-e [x] - (format nil - "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-E-tests - (foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one - (foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0" - (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" - (foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3" -; In Clojure, this is identical to the above -; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3" - (foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13" - (foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120" -; Clojure doesn't support real numbers this large -; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200" -) - -(simple-tests cltl-E-scale-tests - (map - (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" - (- k 5) 3.14159)) ;Prints 13 lines - (range 13)) - '("Scale factor -5: | 0.000003E+06|" - "Scale factor -4: | 0.000031E+05|" - "Scale factor -3: | 0.000314E+04|" - "Scale factor -2: | 0.003142E+03|" - "Scale factor -1: | 0.031416E+02|" - "Scale factor 0: | 0.314159E+01|" - "Scale factor 1: | 3.141590E+00|" - "Scale factor 2: | 31.41590E-01|" - "Scale factor 3: | 314.1590E-02|" - "Scale factor 4: | 3141.590E-03|" - "Scale factor 5: | 31415.90E-04|" - "Scale factor 6: | 314159.0E-05|" - "Scale factor 7: | 3141590.E-06|")) - -(defn foo-g [x] - (format nil - "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-G-tests - (foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2" - (foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 " - (foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 " - (foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. " - (foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2" - (foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3" -; In Clojure, this is identical to the above -; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3" - (foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12" - (foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120" -; Clojure doesn't support real numbers this large -; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200" -) - -(defn type-clash-error [fun nargs argnum right-type wrong-type] - (format nil ;; CLtL has this format string slightly wrong - "~&Function ~S requires its ~:[~:R ~;~*~]~ - argument to be of type ~S,~%but it was called ~ - with an argument of type ~S.~%" - fun (= nargs 1) argnum right-type wrong-type)) - -(simple-tests cltl-Newline-tests - (type-clash-error 'aref nil 2 'integer 'vector) -"Function aref requires its second argument to be of type integer, -but it was called with an argument of type vector.\n" - (type-clash-error 'car 1 1 'list 'short-float) -"Function car requires its argument to be of type list, -but it was called with an argument of type short-float.\n") - -(simple-tests cltl-?-tests - (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) " 7" - (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) " 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) " 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) " 14") - -(defn f [n] (format nil "~@(~R~) error~:P detected." n)) - -(simple-tests cltl-paren-tests - (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" - (f 0) "Zero errors detected." - (f 1) "One error detected." - (f 23) "Twenty-three errors detected.") - -(let [*print-level* nil *print-length* 5] - (simple-tests cltl-bracket-tests - (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" - *print-level* *print-length*) - " print length = 5")) - -(let [foo "Items:~#[ none~; ~S~; ~S and ~S~ - ~:;~@{~#[~; and~] ~ - ~S~^,~}~]."] - (simple-tests cltl-bracket1-tests - (format nil foo) "Items: none." - (format nil foo 'foo) "Items: foo." - (format nil foo 'foo 'bar) "Items: foo and bar." - (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." - (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux.")) - -(simple-tests cltl-curly-bracket-tests - (format nil - "The winners are:~{ ~S~}." - '(fred harry jill)) - "The winners are: fred harry jill." - - (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) - "Pairs: ." - - (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) - "Pairs: ." - - (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) - "Pairs: ." - - (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) - "Pairs: .") - -(simple-tests cltl-angle-bracket-tests - (format nil "~10") "foo bar" - (format nil "~10:") " foo bar" - (format nil "~10:@") " foo bar " - (format nil "~10") " foobar" - (format nil "~10:") " foobar" - (format nil "~10@") "foobar " - (format nil "~10:@") " foobar ") - -(let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P." - tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here - - (simple-tests cltl-up-tests - (format nil donestr) "Done." - (format nil donestr 3) "Done. 3 warnings." - (format nil donestr 1 5) "Done. 1 warning. 5 errors." - (format nil tellstr 23) "Twenty-three." - (format nil tellstr nil "losers") "Losers." - (format nil tellstr 23 "losers") "Twenty-three losers." - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) - " foo" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) - "foo bar" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) - "foo bar baz")) - -(simple-tests cltl-up-x3j13-tests - (format nil - "~:{/~S~^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger/ice .../french ..." - (format nil - "~:{/~S~:^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger .../ice .../french" - - (format nil - "~:{/~S~#:^ ...~}" ;; This is wrong in CLtL - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger") - diff --git a/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_helper.clj b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_helper.clj deleted file mode 100644 index 9a36bbbe..00000000 --- a/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_helper.clj +++ /dev/null @@ -1,21 +0,0 @@ -;;; helper.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, April 2009. 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. - -;; This is just a macro to make my tests a little cleaner - -(ns clojure.contrib.pprint.test-helper - (:use [clojure.test :only (deftest are run-tests)])) - -(defmacro simple-tests [name & test-pairs] - `(deftest ~name (are [x y] (= x y) ~@test-pairs))) - diff --git a/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_pretty.clj b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_pretty.clj deleted file mode 100644 index f5de6f1e..00000000 --- a/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_pretty.clj +++ /dev/null @@ -1,127 +0,0 @@ -;;; pretty.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Feb 2009. 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. - -(ns clojure.contrib.pprint.test-pretty - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.pprint.test-helper - clojure.contrib.pprint)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Unit tests for the pretty printer -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(simple-tests xp-fill-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 38 - *print-miser-width* nil] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 22] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n") - -(simple-tests xp-miser-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 9] - (cl-format nil "~:" '(first second third))) - "(LIST\n first\n second\n third)" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 8] - (cl-format nil "~:" '(first second third))) - "(LIST first second third)") - -(simple-tests mandatory-fill-test - (cl-format nil - "
~%~~%
~%" - [ "hello" "gooodbye" ]) - "
-Usage: *hello*
-       *gooodbye*
-
-") - -(simple-tests prefix-suffix-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 10] - (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third))) - "{LIST\n first\n second\n third}") - -(simple-tests pprint-test - (binding [*print-pprint-dispatch* *simple-dispatch*] - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn - foo - [x y] - (let - [result (* x y)] - (if - (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (with-pprint-dispatch *code-dispatch* - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 15] - (write '(fn (cons (car x) (cdr y))) :stream nil)) - "(fn\n (cons\n (car x)\n (cdr y)))" - - (with-pprint-dispatch *code-dispatch* - (binding [*print-right-margin* 52] - (write - '(add-to-buffer this (make-buffer-blob (str (char c)) nil)) - :stream nil))) - "(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))" - ) - - - -(simple-tests pprint-reader-macro-test - (with-pprint-dispatch *code-dispatch* - (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])") - :stream nil)) - "(map #(first %) [[1 2 3] [4 5 6] [7]])" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "@@(ref (ref 1))") - :stream nil)) - "@@(ref (ref 1))" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "'foo") - :stream nil)) - "'foo" -) diff --git a/pom.xml b/pom.xml index 172a7209..69141fc0 100644 --- a/pom.xml +++ b/pom.xml @@ -61,7 +61,6 @@ modules/monadic-io-streams modules/monads modules/ns-utils - modules/pprint modules/priority-map modules/probabilities modules/profile -- cgit v1.2.3-18-g5258 From 67e85be147095c87a3cec82a64455974f29c7fd7 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 19:00:22 +0200 Subject: removed deprecated source, get-source, apropos from clojure.contrib.repl-utils. available in clojure.repl as source, source-fn, and apropos, respectively. Signed-off-by: Stuart Sierra --- modules/gen-html-docs/pom.xml | 5 --- .../main/clojure/clojure/contrib/gen_html_docs.clj | 5 ++- .../main/clojure/clojure/contrib/repl_utils.clj | 49 ---------------------- .../clojure/clojure/contrib/test_repl_utils.clj | 20 --------- 4 files changed, 3 insertions(+), 76 deletions(-) delete mode 100644 modules/repl-utils/src/test/clojure/clojure/contrib/test_repl_utils.clj diff --git a/modules/gen-html-docs/pom.xml b/modules/gen-html-docs/pom.xml index 80cc2cd5..98895b6d 100644 --- a/modules/gen-html-docs/pom.xml +++ b/modules/gen-html-docs/pom.xml @@ -12,11 +12,6 @@ gen-html-docs - - org.clojure.contrib - repl-utils - 1.3.0-SNAPSHOT - org.clojure.contrib prxml diff --git a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj index 145c040b..e2ad61dd 100644 --- a/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj +++ b/modules/gen-html-docs/src/main/clojure/clojure/contrib/gen_html_docs.clj @@ -47,7 +47,8 @@ one or more Clojure libraries."} clojure.contrib.gen-html-docs (:require [clojure.string :as s]) - (:use [clojure.contrib repl-utils def prxml]) + (:use [clojure [repl :only [source-fn]]]) + (:use [clojure.contrib def prxml]) (:import [java.lang Exception] [java.util.regex Pattern])) @@ -290,7 +291,7 @@ function toggle(targetid, linkid, textWhenOpen, textWhenClosed) (try (let [docs (:doc (meta v)) src (if-let [ns (find-ns libid)] - (get-source (symbol-for ns memberid)))] + (source-fn (symbol-for ns memberid)))] (if (and src docs) (doc-elided-src docs src) src)) diff --git a/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj index 39195ea0..e9bdb669 100644 --- a/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj +++ b/modules/repl-utils/src/main/clojure/clojure/contrib/repl_utils.clj @@ -115,55 +115,6 @@ (when (pred m) (printf "[%2d] %s\n" i (:text m))))))))) -;; ---------------------------------------------------------------------- -;; Examine Clojure functions (Vars, really) - -(defn get-source - "Returns a string of the source code for the given symbol, if it can - find it. This requires that the symbol resolve to a Var defined in - a namespace for which the .clj is in the classpath. Returns nil if - it can't find the source. For most REPL usage, 'source' is more - convenient. - - Example: (get-source 'filter)" - {:deprecated "1.2"} - [x] - (when-let [v (resolve x)] - (when-let [filepath (:file (meta v))] - (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)] - (with-open [rdr (LineNumberReader. (InputStreamReader. strm))] - (dotimes [_ (dec (:line (meta v)))] (.readLine rdr)) - (let [text (StringBuilder.) - pbr (proxy [PushbackReader] [rdr] - (read [] (let [i (proxy-super read)] - (.append text (char i)) - i)))] - (read (PushbackReader. pbr)) - (str text))))))) - -(defmacro source - "Prints the source code for the given symbol, if it can find it. - This requires that the symbol resolve to a Var defined in a - namespace for which the .clj is in the classpath. - - Example: (source filter)" - {:deprecated "1.2"} - [n] - `(println (or (get-source '~n) (str "Source not found")))) - -(defn apropos - "Given a regular expression or stringable thing, return a seq of -all definitions in all currently-loaded namespaces that match the -str-or-pattern." - {:deprecated "1.2"} - [str-or-pattern] - (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern) - #(re-find str-or-pattern (str %)) - #(.contains (str %) (str str-or-pattern)))] - (mapcat (fn [ns] - (filter matches? (keys (ns-publics ns)))) - (all-ns)))) - ;; ---------------------------------------------------------------------- ;; Handle Ctrl-C keystrokes diff --git a/modules/repl-utils/src/test/clojure/clojure/contrib/test_repl_utils.clj b/modules/repl-utils/src/test/clojure/clojure/contrib/test_repl_utils.clj deleted file mode 100644 index 6fa12ed7..00000000 --- a/modules/repl-utils/src/test/clojure/clojure/contrib/test_repl_utils.clj +++ /dev/null @@ -1,20 +0,0 @@ -(ns clojure.contrib.test-repl-utils - (:use clojure.test - clojure.contrib.repl-utils)) - -(deftest test-apropos - (testing "with a regular expression" - (is (= '[defmacro] (apropos #"^defmacro$"))) - (is (some '#{defmacro} (apropos #"def.acr."))) - (is (= [] (apropos #"nothing-has-this-name")))) - - - (testing "with a string" - (is (some '#{defmacro} (apropos "defmacro"))) - (is (some '#{defmacro} (apropos "efmac"))) - (is (= [] (apropos "nothing-has-this-name")))) - - (testing "with a symbol" - (is (some '#{defmacro} (apropos 'defmacro))) - (is (some '#{defmacro} (apropos 'efmac))) - (is (= [] (apropos 'nothing-has-this-name))))) -- cgit v1.2.3-18-g5258 From 906397b9928bec67c6ab66c923a5cb5cbd4c4566 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 19:11:03 +0200 Subject: removed deprecated clojure.contrib.seq-utils Signed-off-by: Stuart Sierra --- modules/complete/pom.xml | 5 - modules/seq-utils/pom.xml | 16 -- .../src/main/clojure/clojure/contrib/seq_utils.clj | 244 --------------------- pom.xml | 1 - 4 files changed, 266 deletions(-) delete mode 100644 modules/seq-utils/pom.xml delete mode 100644 modules/seq-utils/src/main/clojure/clojure/contrib/seq_utils.clj diff --git a/modules/complete/pom.xml b/modules/complete/pom.xml index 0fdbea7d..fb6cd1c1 100644 --- a/modules/complete/pom.xml +++ b/modules/complete/pom.xml @@ -270,11 +270,6 @@ seq 1.3.0-SNAPSHOT - - org.clojure.contrib - seq-utils - 1.3.0-SNAPSHOT - org.clojure.contrib server-socket diff --git a/modules/seq-utils/pom.xml b/modules/seq-utils/pom.xml deleted file mode 100644 index 5c796881..00000000 --- a/modules/seq-utils/pom.xml +++ /dev/null @@ -1,16 +0,0 @@ - - - 4.0.0 - - org.clojure.contrib - parent - 1.3.0-SNAPSHOT - ../parent - - seq-utils - - - \ No newline at end of file diff --git a/modules/seq-utils/src/main/clojure/clojure/contrib/seq_utils.clj b/modules/seq-utils/src/main/clojure/clojure/contrib/seq_utils.clj deleted file mode 100644 index 399a2ca2..00000000 --- a/modules/seq-utils/src/main/clojure/clojure/contrib/seq_utils.clj +++ /dev/null @@ -1,244 +0,0 @@ -;;; seq_utils.clj -- Sequence utilities for Clojure - -;; by Stuart Sierra, http://stuartsierra.com/ -;; last updated March 2, 2009 - -;; Copyright (c) Stuart Sierra, 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. - - -;; Change Log -;; -;; DEPRECATED in 1.2. Some functions promoted to clojure.core and some -;; moved to c.c.seq -;; -;; January 10, 2009 (Stuart Sierra): -;; -;; * BREAKING CHANGE: "includes?" now takes collection as first -;; argument. This is more consistent with Clojure collection -;; functions; see discussion at http://groups.google.com/group/clojure/browse_thread/thread/8b2c8dc96b39ddd7/a8866d34b601ff43 -;; - -(ns - ^{:author "Stuart Sierra (and others)", - :deprecated "1.2" - :doc "Sequence utilities for Clojure"} - clojure.contrib.seq-utils - (:import (java.util.concurrent LinkedBlockingQueue TimeUnit) - (java.lang.ref WeakReference)) - (:refer-clojure :exclude [frequencies shuffle partition-by reductions partition-all group-by flatten])) - - -;; 'flatten' written by Rich Hickey, -;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b -(defn flatten - "DEPRECATED. Prefer clojure.core version. - Takes any nested combination of sequential things (lists, vectors, - etc.) and returns their contents as a single, flat sequence. - (flatten nil) returns nil." - {:deprecated "1.2"} - [x] - (filter (complement sequential?) - (rest (tree-seq sequential? seq x)))) - -(defn separate - "Returns a vector: - [ (filter f s), (filter (complement f) s) ]" - [f s] - [(filter f s) (filter (complement f) s)]) - -(defn indexed - "Returns a lazy sequence of [index, item] pairs, where items come - from 's' and indexes count up from zero. - - (indexed '(a b c d)) => ([0 a] [1 b] [2 c] [3 d])" - [s] - (map vector (iterate inc 0) s)) - -;; group-by written by Rich Hickey; -;; see http://paste.lisp.org/display/64190 -(defn group-by - "DEPRECATED. Prefer clojure.core version. - Returns a sorted map of the elements of coll keyed by the result of - f on each element. The value at each key will be a vector of the - corresponding elements, in the order they appeared in coll." - {:deprecated "1.2"} - [f coll] - (reduce - (fn [ret x] - (let [k (f x)] - (assoc ret k (conj (get ret k []) x)))) - (sorted-map) coll)) - -;; partition-by originally written by Rich Hickey; -;; modified by Stuart Sierra -(defn partition-by - "DEPRECATED. Prefer clojure.core version. - Applies f to each value in coll, splitting it each time f returns - a new value. Returns a lazy seq of lazy seqs." - {:deprecated "1.2"} - [f coll] - (when-let [s (seq coll)] - (let [fst (first s) - fv (f fst) - run (cons fst (take-while #(= fv (f %)) (rest s)))] - (lazy-seq - (cons run (partition-by f (drop (count run) s))))))) - -(defn frequencies - "DEPRECATED. Prefer clojure.core version. - Returns a map from distinct items in coll to the number of times - they appear." - {:deprecated "1.2"} - [coll] - (reduce (fn [counts x] - (assoc counts x (inc (get counts x 0)))) - {} coll)) - -;; recursive sequence helpers by Christophe Grand -;; see http://clj-me.blogspot.com/2009/01/recursive-seqs.html -(defmacro rec-seq - "Similar to lazy-seq but binds the resulting seq to the supplied - binding-name, allowing for recursive expressions." - [binding-name & body] - `(let [s# (atom nil)] - (reset! s# (lazy-seq (let [~binding-name @s#] ~@body))))) - -(defmacro rec-cat - "Similar to lazy-cat but binds the resulting sequence to the supplied - binding-name, allowing for recursive expressions." - [binding-name & exprs] - `(rec-seq ~binding-name (lazy-cat ~@exprs))) - - -;; reductions by Chris Houser -;; see http://groups.google.com/group/clojure/browse_thread/thread/3edf6e82617e18e0/58d9e319ad92aa5f?#58d9e319ad92aa5f -(defn reductions - "DEPRECATED. Prefer clojure.core version. - Returns a lazy seq of the intermediate values of the reduction (as - per reduce) of coll by f, starting with init." - {:deprecated "1.2"} - ([f coll] - (if (seq coll) - (rec-seq self (cons (first coll) (map f self (rest coll)))) - (cons (f) nil))) - ([f init coll] - (rec-seq self (cons init (map f self coll))))) - -(defn rotations - "Returns a lazy seq of all rotations of a seq" - [x] - (if (seq x) - (map - (fn [n _] - (lazy-cat (drop n x) (take n x))) - (iterate inc 0) x) - (list nil))) - -(defn partition-all - "DEPRECATED. Prefer clojure.core version. - Returns a lazy sequence of lists like clojure.core/partition, but may - include lists with fewer than n items at the end." - {:deprecated "1.2"} - ([n coll] - (partition-all n n coll)) - ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (cons (take n s) (partition-all n step (drop step s))))))) - -(defn shuffle - "DEPRECATED. Prefer clojure.core version. - Return a random permutation of coll" - {:deprecated "1.2"} - [coll] - (let [l (java.util.ArrayList. coll)] - (java.util.Collections/shuffle l) - (seq l))) - -(defn rand-elt - "DEPRECATED. Prefer clojure.core/rand-nth. - Return a random element of this seq" - {:deprecated "1.2"} - [s] - (nth s (rand-int (count s)))) - - -;; seq-on written by Konrad Hinsen -(defmulti seq-on - "Returns a seq on the object s. Works like the built-in seq but as - a multimethod that can have implementations for new classes and types." - {:arglists '([s])} - type) - -(defmethod seq-on :default - [s] - (seq s)) - - -(defn find-first - "Returns the first item of coll for which (pred item) returns logical true. - Consumes sequences up to the first match, will consume the entire sequence - and return nil if no match is found." - [pred coll] - (first (filter pred coll))) - -; based on work related to Rich Hickey's seque. -; blame Chouser for anything broken or ugly. -(defn fill-queue - "filler-func will be called in another thread with a single arg - 'fill'. filler-func may call fill repeatedly with one arg each - time which will be pushed onto a queue, blocking if needed until - this is possible. fill-queue will return a lazy seq of the values - filler-func has pushed onto the queue, blocking if needed until each - next element becomes available. filler-func's return value is ignored." - ([filler-func & optseq] - (let [opts (apply array-map optseq) - apoll (:alive-poll opts 1) - q (LinkedBlockingQueue. (:queue-size opts 1)) - NIL (Object.) ;nil sentinel since LBQ doesn't support nils - weak-target (Object.) - alive? (WeakReference. weak-target) - fill (fn fill [x] - (if (.get alive?) - (if (.offer q (if (nil? x) NIL x) apoll TimeUnit/SECONDS) - x - (recur x)) - (throw (Exception. "abandoned")))) - f (future - (try - (filler-func fill) - (finally - (.put q q))) ;q itself is eos sentinel - nil)] ; set future's value to nil - ((fn drain [] - weak-target ; force closing over this object - (lazy-seq - (let [x (.take q)] - (if (identical? x q) - @f ;will be nil, touch just to propagate errors - (cons (if (identical? x NIL) nil x) - (drain)))))))))) - -(defn positions - "Returns a lazy sequence containing the positions at which pred - is true for items in coll." - [pred coll] - (for [[idx elt] (indexed coll) :when (pred elt)] idx)) - -(defn includes? - "Returns true if coll contains something equal (with =) to x, - in linear time. Deprecated. Prefer 'contains?' for key testing, - or 'some' for ad hoc linear searches." - {:deprecated "1.2"} - [coll x] - (boolean (some (fn [y] (= y x)) coll))) - - - - diff --git a/pom.xml b/pom.xml index 69141fc0..b983bf95 100644 --- a/pom.xml +++ b/pom.xml @@ -69,7 +69,6 @@ modules/repl-ln modules/repl-utils modules/seq - modules/seq-utils modules/server-socket modules/set modules/singleton -- cgit v1.2.3-18-g5258 From 95353ce63392ee9e7df44c9082320bdc42401f76 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 19:17:27 +0200 Subject: removed 9 deprecated functions from clojure.contrib.repl-utils Promoted to clojure.core: - flatten - group-by - partition-by - frequencies - reductions - partition-all - shuffle - rand-elt (clojure.core/rand-nth) Not promoted to clojure.core: - includes? prefer 'contains?' for key testing, or 'some' for ad hoc linear searches. Signed-off-by: Stuart Sierra --- .../seq/src/main/clojure/clojure/contrib/seq.clj | 104 --------------------- .../src/test/clojure/clojure/contrib/test_seq.clj | 92 ------------------ 2 files changed, 196 deletions(-) diff --git a/modules/seq/src/main/clojure/clojure/contrib/seq.clj b/modules/seq/src/main/clojure/clojure/contrib/seq.clj index 1bbd2110..bc130c34 100644 --- a/modules/seq/src/main/clojure/clojure/contrib/seq.clj +++ b/modules/seq/src/main/clojure/clojure/contrib/seq.clj @@ -30,18 +30,6 @@ (:refer-clojure :exclude [frequencies shuffle partition-by reductions partition-all group-by flatten])) -;; 'flatten' written by Rich Hickey, -;; see http://groups.google.com/group/clojure/msg/385098fabfcaad9b -(defn flatten - "DEPRECATED. Prefer clojure.core version. - Takes any nested combination of sequential things (lists, vectors, - etc.) and returns their contents as a single, flat sequence. - (flatten nil) returns nil." - {:deprecated "1.2"} - [x] - (filter (complement sequential?) - (rest (tree-seq sequential? seq x)))) - (defn separate "Returns a vector: [ (filter f s), (filter (complement f) s) ]" @@ -56,46 +44,6 @@ [s] (map vector (iterate inc 0) s)) -;; group-by written by Rich Hickey; -;; see http://paste.lisp.org/display/64190 -(defn group-by - "DEPRECATED. Prefer clojure.core version. - Returns a sorted map of the elements of coll keyed by the result of - f on each element. The value at each key will be a vector of the - corresponding elements, in the order they appeared in coll." - {:deprecated "1.2"} - [f coll] - (reduce - (fn [ret x] - (let [k (f x)] - (assoc ret k (conj (get ret k []) x)))) - (sorted-map) coll)) - -;; partition-by originally written by Rich Hickey; -;; modified by Stuart Sierra -(defn partition-by - "DEPRECATED. Prefer clojure.core version. - Applies f to each value in coll, splitting it each time f returns - a new value. Returns a lazy seq of lazy seqs." - {:deprecated "1.2"} - [f coll] - (when-let [s (seq coll)] - (let [fst (first s) - fv (f fst) - run (cons fst (take-while #(= fv (f %)) (rest s)))] - (lazy-seq - (cons run (partition-by f (drop (count run) s))))))) - -(defn frequencies - "DEPRECATED. Prefer clojure.core version. - Returns a map from distinct items in coll to the number of times - they appear." - {:deprecated "1.2"} - [coll] - (reduce (fn [counts x] - (assoc counts x (inc (get counts x 0)))) - {} coll)) - ;; recursive sequence helpers by Christophe Grand ;; see http://clj-me.blogspot.com/2009/01/recursive-seqs.html (defmacro rec-seq @@ -112,20 +60,6 @@ `(rec-seq ~binding-name (lazy-cat ~@exprs))) -;; reductions by Chris Houser -;; see http://groups.google.com/group/clojure/browse_thread/thread/3edf6e82617e18e0/58d9e319ad92aa5f?#58d9e319ad92aa5f -(defn reductions - "DEPRECATED. Prefer clojure.core version. - Returns a lazy seq of the intermediate values of the reduction (as - per reduce) of coll by f, starting with init." - {:deprecated "1.2"} - ([f coll] - (if (seq coll) - (rec-seq self (cons (first coll) (map f self (rest coll)))) - (cons (f) nil))) - ([f init coll] - (rec-seq self (cons init (map f self coll))))) - (defn rotations "Returns a lazy seq of all rotations of a seq" [x] @@ -136,34 +70,6 @@ (iterate inc 0) x) (list nil))) -(defn partition-all - "DEPRECATED. Prefer clojure.core version. - Returns a lazy sequence of lists like clojure.core/partition, but may - include lists with fewer than n items at the end." - {:deprecated "1.2"} - ([n coll] - (partition-all n n coll)) - ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (cons (take n s) (partition-all n step (drop step s))))))) - -(defn shuffle - "DEPRECATED. Prefer clojure.core version. - Return a random permutation of coll" - {:deprecated "1.2"} - [coll] - (let [l (java.util.ArrayList. coll)] - (java.util.Collections/shuffle l) - (seq l))) - -(defn rand-elt - "DEPRECATED. Prefer clojure.core/rand-nth. - Return a random element of this seq" - {:deprecated "1.2"} - [s] - (nth s (rand-int (count s)))) - ;; seq-on written by Konrad Hinsen (defmulti seq-on "Returns a seq on the object s. Works like the built-in seq but as @@ -226,13 +132,3 @@ [pred coll] (for [[idx elt] (indexed coll) :when (pred elt)] idx)) -(defn includes? - "Returns true if coll contains something equal (with =) to x, - in linear time. Deprecated. Prefer 'contains?' for key testing, - or 'some' for ad hoc linear searches." - {:deprecated "1.2"} - [coll x] - (boolean (some (fn [y] (= y x)) coll))) - - - diff --git a/modules/seq/src/test/clojure/clojure/contrib/test_seq.clj b/modules/seq/src/test/clojure/clojure/contrib/test_seq.clj index eacd9b73..082d19fa 100644 --- a/modules/seq/src/test/clojure/clojure/contrib/test_seq.clj +++ b/modules/seq/src/test/clojure/clojure/contrib/test_seq.clj @@ -9,44 +9,6 @@ () :d [:a :b :c] [0 2] #{:d} [:d :a :d :a])) -;Upon further inspection, flatten behaves... wierd. -;These tests are what passes on August 7, 2009 -(deftest test-flatten-present - (are [expected nested-val] (= (seq/flatten nested-val) expected) - ;simple literals - [] nil - [] 1 - [] 'test - [] :keyword - [] 1/2 - [] #"[\r\n]" - [] true - [] false - ;vectors - [1 2 3 4 5] [[1 2] [3 4 [5]]] - [1 2 3 4 5] [1 2 3 4 5] - [#{1 2} 3 4 5] [#{1 2} 3 4 5] - ;sets - [] #{} - [] #{#{1 2} 3 4 5} - [] #{1 2 3 4 5} - [] #{#{1 2} 3 4 5} - ;lists - [] '() - [1 2 3 4 5] `(1 2 3 4 5) - ;maps - [] {:a 1 :b 2} - [:a 1 :b 2] (seq {:a 1 :b 2}) - [] {[:a :b] 1 :c 2} - [:a :b 1 :c 2] (seq {[:a :b] 1 :c 2}) - [:a 1 2 :b 3] (seq {:a [1 2] :b 3}) - ;Strings - [] "12345" - [\1 \2 \3 \4 \5] (seq "12345") - ;fns - [] count - [count even? odd?] [count even? odd?])) - (deftest test-separate (are [test-seq] (= (seq/separate even? test-seq) [[2 4] [1 3 5]]) [1 2 3 4 5] @@ -60,33 +22,6 @@ [[0 :a] [1 :b] [2 :c] [3 :d]] '(:a :b :c :d) [[0 \1] [1 \2] [2 \3] [3 \4]] "1234")) -(deftest test-group-by - (is (= (seq/group-by even? [1 2 3 4 5]) - {false [1 3 5], true [2 4]}))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-partition-by - (are [test-seq] (= (seq/partition-by (comp even? count) test-seq) - [["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]]) - ["a" "bb" "cccc" "dd" "eee" "f" "" "hh"] - '("a" "bb" "cccc" "dd" "eee" "f" "" "hh")) - (is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm") - [[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]]))) - -(deftest test-frequencies - (are [expected test-seq] (= (seq/frequencies test-seq) expected) - {\p 2, \s 4, \i 4, \m 1} "mississippi" - {1 4 2 2 3 1} [1 1 1 1 2 2 3] - {1 4 2 2 3 1} '(1 1 1 1 2 2 3))) - -;Note - this does not make sense for maps and sets, because order is expected -;This is a key differnce between reductions and reduce. -(deftest test-reductions - (is (= (seq/reductions + [1 2 3 4 5]) - [1 3 6 10 15])) - (is (= (reductions + 10 [1 2 3 4 5]) - [10 11 13 16 20 25]))) - ;Note - this does not make sense for maps and sets, because order is expected (deftest test-rotations (is (= (seq/rotations [1 2 3 4]) @@ -95,34 +30,7 @@ [3 4 1 2] [4 1 2 3]]))) -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-partition-all - (is (= (seq/partition-all 4 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [5 6 7 8] [9]])) - (is (= (seq/partition-all 4 2 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]]))) - -;Thanks to Andy Fingerhut for the idea of testing invariants -(deftest test-shuffle-invariants - (is (= (count (seq/shuffle [1 2 3 4])) 4)) - (let [shuffled-seq (seq/shuffle [1 2 3 4])] - (is (every? #{1 2 3 4} shuffled-seq)))) - -;Thanks to Andy Fingerhut for the idea of testing invariants -(deftest test-rand-elt-invariants - (let [elt (seq/rand-elt [:a :b :c :d])] - (is (#{:a :b :c :d} elt)))) - ;Note - this does not make sense for maps and sets, because order is expected (deftest test-find-first (is (= (seq/find-first even? [1 2 3 4 5]) 2)) (is (= (seq/find-first even? '(1 2 3 4 5)) 2))) - -(deftest test-includes - (are [coll k] (false? (seq/includes? coll k)) - [1 2 3] 0 - [] nil - [:a :b] :c) - (are [coll k] (true? (seq/includes? coll k)) - [1 2 3] 1 - [:a :b] :b)) -- cgit v1.2.3-18-g5258 From 0f94c13af8becfa9eab18652572bab62fcb4c002 Mon Sep 17 00:00:00 2001 From: Ben Smith-Mannschott Date: Sat, 28 Aug 2010 20:16:32 +0200 Subject: removed deprecated subset?, superset? from clojure.contrib.set Both functions have been promoted to clojure.set. Signed-off-by: Stuart Sierra --- modules/datalog/pom.xml | 5 ----- .../main/clojure/clojure/contrib/datalog/literals.clj | 3 +-- .../src/main/clojure/clojure/contrib/datalog/rules.clj | 3 +-- .../clojure/contrib/datalog/tests/test_softstrat.clj | 2 +- modules/set/src/main/clojure/clojure/contrib/set.clj | 16 ---------------- 5 files changed, 3 insertions(+), 26 deletions(-) diff --git a/modules/datalog/pom.xml b/modules/datalog/pom.xml index 90d5fbf7..8de72c0d 100644 --- a/modules/datalog/pom.xml +++ b/modules/datalog/pom.xml @@ -27,11 +27,6 @@ def 1.3.0-SNAPSHOT - - org.clojure.contrib - set - 1.3.0-SNAPSHOT - org.clojure.contrib graph diff --git a/modules/datalog/src/main/clojure/clojure/contrib/datalog/literals.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/literals.clj index 37e5d8c9..b9a093d4 100644 --- a/modules/datalog/src/main/clojure/clojure/contrib/datalog/literals.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/literals.clj @@ -17,8 +17,7 @@ (ns clojure.contrib.datalog.literals (:use clojure.contrib.datalog.util) (:use clojure.contrib.datalog.database) - (:use [clojure.set :only (intersection)]) - (:use [clojure.contrib.set :only (subset?)])) + (:use [clojure.set :only (intersection subset?)])) ;;; Type Definitions diff --git a/modules/datalog/src/main/clojure/clojure/contrib/datalog/rules.clj b/modules/datalog/src/main/clojure/clojure/contrib/datalog/rules.clj index 9cb667e5..fd910a2a 100644 --- a/modules/datalog/src/main/clojure/clojure/contrib/datalog/rules.clj +++ b/modules/datalog/src/main/clojure/clojure/contrib/datalog/rules.clj @@ -18,8 +18,7 @@ (:use clojure.contrib.datalog.util) (:use clojure.contrib.datalog.literals clojure.contrib.datalog.database) - (:use [clojure.set :only (union intersection difference)]) - (:use [clojure.contrib.set :only (subset?)]) + (:use [clojure.set :only (union intersection difference subset?)]) (:use [clojure.contrib.except :only (throwf)]) (:import java.io.Writer)) diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj index a33d8c96..06e6acc4 100644 --- a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj @@ -19,7 +19,7 @@ clojure.contrib.datalog.magic clojure.contrib.datalog.rules clojure.contrib.datalog.database) - (:use [clojure.contrib.set :only (subset?)])) + (:use [clojure.set :only (subset?)])) diff --git a/modules/set/src/main/clojure/clojure/contrib/set.clj b/modules/set/src/main/clojure/clojure/contrib/set.clj index 4c831a6c..fefdba0d 100644 --- a/modules/set/src/main/clojure/clojure/contrib/set.clj +++ b/modules/set/src/main/clojure/clojure/contrib/set.clj @@ -21,22 +21,6 @@ :doc "Clojure functions for operating on sets (supplemental to clojure.set)"} clojure.contrib.set) -(defn subset? - "Is set1 a subset of set2?" - {:deprecated "1.2"} - [set1 set2] - {:tag Boolean} - (and (<= (count set1) (count set2)) - (every? set2 set1))) - -(defn superset? - "Is set1 a superset of set2?" - {:deprecated "1.2"} - [set1 set2] - {:tag Boolean} - (and (>= (count set1) (count set2)) - (every? set1 set2))) - (defn proper-subset? "Is s1 a proper subset of s2?" [set1 set2] -- cgit v1.2.3-18-g5258 From da0795c6d520c3c9ff02dea839c094f20198a094 Mon Sep 17 00:00:00 2001 From: Stuart Sierra Date: Fri, 3 Sep 2010 11:33:54 -0400 Subject: Inhibit all AOT-compilation in parent module --- modules/parent/pom.xml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/modules/parent/pom.xml b/modules/parent/pom.xml index cfa74855..4306df80 100644 --- a/modules/parent/pom.xml +++ b/modules/parent/pom.xml @@ -6,7 +6,7 @@ http://maven.apache.org/maven-v4_0_0.xsd"> 4.0.0 - 1.2.0 + [1.0.0,2.0.0) UTF-8 org.clojure.contrib @@ -41,8 +41,11 @@ clojure-maven-plugin 1.3.3 + true - !clojure\.contrib\.javadoc + + !.* -- cgit v1.2.3-18-g5258 From 40bc0152becf1eac728adc388e1a6a89671a0dba Mon Sep 17 00:00:00 2001 From: Stuart Sierra Date: Fri, 3 Sep 2010 11:34:16 -0400 Subject: Add AOT-compilation for modules that gen-class --- modules/condition/pom.xml | 13 +++++++++++++ modules/fnmap/pom.xml | 13 +++++++++++++ modules/jmx/pom.xml | 13 +++++++++++++ modules/repl-ln/pom.xml | 13 +++++++++++++ 4 files changed, 52 insertions(+) diff --git a/modules/condition/pom.xml b/modules/condition/pom.xml index 53113fc7..2bdd2daf 100644 --- a/modules/condition/pom.xml +++ b/modules/condition/pom.xml @@ -23,4 +23,17 @@ 1.3.0-SNAPSHOT + + + + com.theoryinpractise + clojure-maven-plugin + + + clojure\.contrib\.condition\.Condition + + + + + \ No newline at end of file diff --git a/modules/fnmap/pom.xml b/modules/fnmap/pom.xml index 7785e3e5..ec919aaf 100644 --- a/modules/fnmap/pom.xml +++ b/modules/fnmap/pom.xml @@ -11,4 +11,17 @@ ../parent fnmap + + + + com.theoryinpractise + clojure-maven-plugin + + + clojure\.contrib\.fnmap\.PersistentFnMap + + + + + \ No newline at end of file diff --git a/modules/jmx/pom.xml b/modules/jmx/pom.xml index 08094a48..8011a7e2 100644 --- a/modules/jmx/pom.xml +++ b/modules/jmx/pom.xml @@ -18,4 +18,17 @@ 1.3.0-SNAPSHOT + + + + com.theoryinpractise + clojure-maven-plugin + + + clojure\.contrib\.jmx\.Bean + + + + + \ No newline at end of file diff --git a/modules/repl-ln/pom.xml b/modules/repl-ln/pom.xml index 7fb0aad3..88d7b720 100644 --- a/modules/repl-ln/pom.xml +++ b/modules/repl-ln/pom.xml @@ -18,4 +18,17 @@ 1.3.0-SNAPSHOT + + + + com.theoryinpractise + clojure-maven-plugin + + + clojure\.contrib\.repl-ln + + + + + \ No newline at end of file -- cgit v1.2.3-18-g5258 From 1921e118d4a27c75084d0bece364e982ebe189b8 Mon Sep 17 00:00:00 2001 From: Stuart Sierra Date: Fri, 3 Sep 2010 15:04:46 -0400 Subject: AOT-compiled modules depend specifically on Clojure 1.2.0 --- modules/condition/pom.xml | 6 ++++++ modules/fnmap/pom.xml | 8 ++++++++ modules/jmx/pom.xml | 6 ++++++ modules/repl-ln/pom.xml | 6 ++++++ 4 files changed, 26 insertions(+) diff --git a/modules/condition/pom.xml b/modules/condition/pom.xml index 2bdd2daf..0e2062c4 100644 --- a/modules/condition/pom.xml +++ b/modules/condition/pom.xml @@ -12,6 +12,12 @@ condition + + + org.clojure + clojure + 1.2.0 + org.clojure.contrib def diff --git a/modules/fnmap/pom.xml b/modules/fnmap/pom.xml index ec919aaf..77e2270f 100644 --- a/modules/fnmap/pom.xml +++ b/modules/fnmap/pom.xml @@ -11,6 +11,14 @@ ../parent fnmap + + + + org.clojure + clojure + 1.2.0 + + diff --git a/modules/jmx/pom.xml b/modules/jmx/pom.xml index 8011a7e2..b91b6909 100644 --- a/modules/jmx/pom.xml +++ b/modules/jmx/pom.xml @@ -12,6 +12,12 @@ jmx + + + org.clojure + clojure + 1.2.0 + org.clojure.contrib def diff --git a/modules/repl-ln/pom.xml b/modules/repl-ln/pom.xml index 88d7b720..61493d00 100644 --- a/modules/repl-ln/pom.xml +++ b/modules/repl-ln/pom.xml @@ -12,6 +12,12 @@ repl-ln + + + org.clojure + clojure + 1.2.0 + org.clojure.contrib def -- cgit v1.2.3-18-g5258