From 5060be624029af6afec8983f4d321883fc3e14c9 Mon Sep 17 00:00:00 2001 From: Tom Faulhaber Date: Thu, 29 Mar 2012 18:30:17 -0700 Subject: [PATCH] Added support for pretty-printing namespace declarations --- src/clj/clojure/pprint/dispatch.clj | 75 ++++++++++++++++++- test/clojure/test_clojure/pprint/test_pretty.clj | 90 ++++++++++++---------- 2 files changed, 124 insertions(+), 41 deletions(-) diff --git a/src/clj/clojure/pprint/dispatch.clj b/src/clj/clojure/pprint/dispatch.clj index 68d6d8a..68504aa 100644 --- a/src/clj/clojure/pprint/dispatch.clj +++ b/src/clj/clojure/pprint/dispatch.clj @@ -166,6 +166,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] diff --git a/test/clojure/test_clojure/pprint/test_pretty.clj b/test/clojure/test_clojure/pprint/test_pretty.clj index fb3bd34..d2f3f48 100644 --- a/test/clojure/test_clojure/pprint/test_pretty.clj +++ b/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" -- 1.7.5.4