Added support for pretty-printing namespace declarations

Signed-off-by: Stuart Halloway <[email protected]>

Author: tomfaulhaber

src/clj/clojure/pprint/dispatch.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]

test/clojure/test_clojure/pprint/test_pretty.clj

@@ -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"