Permalink
Browse files

Added support for pretty-printing namespace declarations

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>
  • Loading branch information...
1 parent 75352eb commit 4ca0f7ea17888ba7ed56d2fde0bc2d6397e8e1c0 @tomfaulhaber tomfaulhaber committed with stuarthalloway Mar 30, 2012
Showing with 124 additions and 41 deletions.
  1. +74 −1 src/clj/clojure/pprint/dispatch.clj
  2. +50 −40 test/clojure/test_clojure/pprint/test_pretty.clj
@@ -165,6 +165,79 @@
(declare pprint-simple-code-list)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Format the namespace ("ns") macro. This is quite complicated because of all the
+;;; different forms supported and because programmers can choose lists or vectors
+;;; in various places.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- brackets
+ "Figure out which kind of brackets to use"
+ [form]
+ (if (vector? form)
+ ["[" "]"]
+ ["(" ")"]))
+
+(defn- pprint-ns-reference
+ "Pretty print a single reference (import, use, etc.) from a namespace decl"
+ [reference]
+ (if (sequential? reference)
+ (let [[start end] (brackets reference)
+ [keyw & args] reference]
+ (pprint-logical-block :prefix start :suffix end
+ ((formatter-out "~w~:i") keyw)
+ (loop [args args]
+ (when (seq args)
+ ((formatter-out " "))
+ (let [arg (first args)]
+ (if (sequential? arg)
+ (let [[start end] (brackets arg)]
+ (pprint-logical-block :prefix start :suffix end
+ (if (and (= (count arg) 3) (keyword? (second arg)))
+ (let [[ns kw lis] arg]
+ ((formatter-out "~w ~w ") ns kw)
+ (if (sequential? lis)
+ ((formatter-out (if (vector? lis)
+ "~<[~;~@{~w~^ ~:_~}~;]~:>"
+ "~<(~;~@{~w~^ ~:_~}~;)~:>"))
+ lis)
+ (write-out lis)))
+ (apply (formatter-out "~w ~:i~@{~w~^ ~:_~}") arg)))
+ (when (next args)
+ ((formatter-out "~_"))))
+ (do
+ (write-out arg)
+ (when (next args)
+ ((formatter-out "~:_"))))))
+ (recur (next args))))))
+ (write-out reference)))
+
+(defn- pprint-ns
+ "The pretty print dispatch chunk for the ns macro"
+ [alis]
+ (if (next alis)
+ (let [[ns-sym ns-name & stuff] alis
+ [doc-str stuff] (if (string? (first stuff))
+ [(first stuff) (next stuff)]
+ [nil stuff])
+ [attr-map references] (if (map? (first stuff))
+ [(first stuff) (next stuff)]
+ [nil stuff])]
+ (pprint-logical-block :prefix "(" :suffix ")"
+ ((formatter-out "~w ~1I~@_~w") ns-sym ns-name)
+ (when (or doc-str attr-map (seq references))
+ ((formatter-out "~@:_")))
+ (when doc-str
+ (cl-format true "\"~a\"~:[~;~:@_~]" doc-str (or attr-map (seq references))))
+ (when attr-map
+ ((formatter-out "~w~:[~;~:@_~]") attr-map (seq references)))
+ (loop [references references]
+ (pprint-ns-reference (first references))
+ (when-let [references (next references)]
+ (pprint-newline :linear)
+ (recur references)))))
+ (write-out alis)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Format something that looks like a simple def (sans metadata, since the reader
;;; won't give it to us now).
@@ -356,7 +429,7 @@
'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,
+ 'struct-map pprint-hold-first, 'ns pprint-ns
})))
(defn- pprint-code-list [alis]
@@ -124,49 +124,27 @@ Usage: *hello*
"'foo"
)
-(simple-tests code-block-tests
- (with-out-str
- (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))))))
- "(defn cl-format
+(defmacro code-block
+ "Read a string then print it with code-dispatch and succeed if it comes out the same"
+ [test-name & blocks]
+ `(simple-tests ~test-name
+ ~@(apply concat
+ (for [block blocks]
+ `[(with-out-str
+ (with-pprint-dispatch code-dispatch
+ (pprint (read-string ~block))))
+ (str ~block "\n")]))))
+
+(code-block code-block-tests
+ "(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-out-str
- (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))))))
+ (execute-format stream compiled-format navigator)))"
+
"(defn pprint-defn [writer alis]
(if (next alis)
(let [[defn-sym defn-name & stuff] alis
@@ -190,9 +168,41 @@ Usage: *hello*
stuff
(or doc-str attr-map))
:else (multi-defn stuff (or doc-str attr-map)))))
- (pprint-simple-code-list writer alis)))
-")
-
+ (pprint-simple-code-list writer alis)))")
+
+(code-block ns-macro-test
+ "(ns slam.hound.stitch
+ (:use [slam.hound.prettify :only [prettify]]))"
+
+ "(ns slam.hound.prettify
+ \"Format a namespace declaration using pretty print with custom dispatch.\"
+ (:use [clojure.pprint :only [cl-format code-dispatch formatter-out
+ pprint pprint-logical-block
+ pprint-newline with-pprint-dispatch
+ write-out]]))"
+
+ "(ns autodoc.build-html
+ \"This is the namespace that builds the HTML pages themselves.
+It is implemented with a number of custom enlive templates.\"
+ {:skip-wiki true, :author \"Tom Faulhaber\"}
+ (:refer-clojure :exclude [empty complement])
+ (:import [java.util.jar JarFile]
+ [java.io File FileWriter BufferedWriter StringReader
+ BufferedInputStream BufferedOutputStream
+ ByteArrayOutputStream FileReader FileInputStream]
+ [java.util.regex Pattern])
+ (:require [clojure.string :as str])
+ (:use [net.cgrand.enlive-html :exclude (deftemplate)]
+ [clojure.java.io :only (as-file file writer)]
+ [clojure.java.shell :only (sh)]
+ [clojure.pprint :only (pprint cl-format pprint-ident
+ pprint-logical-block set-pprint-dispatch
+ get-pretty-writer fresh-line)]
+ [clojure.data.json :only (pprint-json)]
+ [autodoc.collect-info :only (contrib-info)]
+ [autodoc.params :only (params expand-classpath)])
+ (:use clojure.set clojure.java.io clojure.data clojure.java.browse
+ clojure.inspector clojure.zip clojure.stacktrace))")
(defn tst-pprint
"A helper function to pprint to a string with a restricted right margin"

0 comments on commit 4ca0f7e

Please sign in to comment.