diff --git a/src/marginalia/core.clj b/src/marginalia/core.clj index 25b66188e..235c0703e 100644 --- a/src/marginalia/core.clj +++ b/src/marginalia/core.clj @@ -36,7 +36,7 @@ [clojure.string :as str]) (:use [marginalia [html :only (uberdoc-html index-html single-page-html)] - [parser :only (parse-file parse-ns)]] + [parser :only (parse-file parse-ns *lift-inline-comments*)]] [clojure.tools [cli :only (cli)]])) @@ -256,7 +256,8 @@ If no source files are found, complain with a usage message." [args & [project]] - (let [[{:keys [dir file name version desc deps css js multi leiningen exclude]} files help] + (let [[{:keys [dir file name version desc deps css js multi + leiningen exclude lift-inline-comments]} files help] (cli args ["-d" "--dir" "Directory into which the documentation will be written" :default "./docs"] ["-f" "--file" "File into which the documentation will be written" :default "uberdoc.html"] @@ -272,14 +273,16 @@ ["-m" "--multi" "Generate each namespace documentation as a separate file" :flag true] ["-l" "--leiningen" "Generate the documentation for a Leiningen project file."] ["-e" "--exclude" "Exclude source file(s) from the document generation process ;;... - If not given will be taken from project.clj"]) + If not given will be taken from project.clj"] + ["-L" "--lift-inline-comments" "Lift ;; inline comments to the top of the enclosing form. + They will be treated as if they preceded the enclosing form." :flag true]) sources (distinct (format-sources (seq files))) sources (if leiningen (cons leiningen sources) sources)] (if-not sources (do (println "Wrong number of arguments passed to Marginalia.") (println help)) - (binding [*docs* dir] + (binding [*docs* dir *lift-inline-comments* lift-inline-comments] (let [project-clj (or project (when (.exists (io/file "project.clj")) (parse-project-file))) diff --git a/src/marginalia/parser.clj b/src/marginalia/parser.clj index faf6b63e5..7a37299b2 100644 --- a/src/marginalia/parser.clj +++ b/src/marginalia/parser.clj @@ -21,12 +21,12 @@ ;; Extracted from clojure.contrib.reflect (defn call-method "Calls a private or protected method. - + params is a vector of classes which correspond to the arguments to the method e - + obj is nil for static methods, the instance object otherwise. - + The method-name is given a symbol or a keyword (something Named)." [klass method-name params obj & args] (-> klass (.getDeclaredMethod (name method-name) @@ -44,6 +44,7 @@ (def ^{:dynamic true} *comments* nil) (def ^{:dynamic true} *comments-enabled* nil) +(def ^{:dynamic true} *lift-inline-comments* nil) (defn comments-enabled? [] @@ -158,6 +159,9 @@ (recur (.read rdr)) :else (.unread rdr c)))) +(declare adjacent?) +(declare merge-comments) + (defn parse* [reader] (take-while #(not= :_eof (:form %)) @@ -181,8 +185,27 @@ (throw e))))) end (.getLineNumber reader) code {:form form :start start :end end} - comments @top-level-comments] + ;; We optionally lift inline comments to the top of the form. + ;; This monstrosity ensures that each consecutive group of inline + ;; comments is treated as a mergable block, but with a fake + ;; blank comment between non-adjacent inline comments. When merged + ;; and converted to markdown, this will produce a paragraph for + ;; each separate block of inline comments. + paragraph-comment {:form (Comment. ";;")} ; start/end added below + inline-comments (when *lift-inline-comments* + (->> @sub-level-comments + (reduce (fn [cs c] + (if-let [t (peek cs)] + (if (adjacent? t c) + (conj cs c) + (conj cs paragraph-comment c)) + (conj cs c))) + []) + (into [paragraph-comment]) + (mapv #(assoc % :start start :end (dec start))))) + comments (concat @top-level-comments inline-comments)] (swap! top-level-comments (constantly [])) + (swap! sub-level-comments (constantly [])) (if (empty? comments) [code] (vec (concat comments [code]))))))))) @@ -297,7 +320,7 @@ (defn- literal-form? [form] (or (string? form) (number? form) (keyword? form) (symbol? form) (char? form) (true? form) (false? form) (instance? java.util.regex.Pattern form))) - + (defmethod dispatch-form :default [form raw nspace-sym] (cond (literal-form? form)