Merge branch 'master' into more_marginalia

This merges Fogus's changes Jan 7 - Jan 25 into goodmike's banch for
  additional comments.
Conflicts:
	src/marginalia/core.clj

README.md

@@ -4,10 +4,7 @@ Marginalia
 
 Marginalia is a source documentation too that parses Clojure code and outputs an side-by-side source view with appropriate comments and docstrings aligned.  
 
-To get a quick look at what marginalia output looks like:
+To get a quick look at what marginalia output looks like, then [visit the official site](http://fogus.me/fun/marginalia/).
-
-1. `git clone https://github.com/fogus/marginalia.git`
-2. `open ./marginalia/example-output/uberdoc.html` (or [look here](http://fogus.me/fun/marginalia/))
 
 Usage
 -----
@@ -59,7 +56,6 @@ TODO
 ----
 * paragraph anchors
 * options for non-uber-docs
-* new docstring/comment reader
 * Maven generation support
 * POM parsing
 

project.clj

@@ -1,18 +1,18 @@
-(defproject marginalia "0.3.2"
+(defproject marginalia "0.5.0-alpha"
   :description "lightweight literate programming for clojure -- inspired by [docco](http://jashkenas.github.com/docco/)"
   :main marginalia.core
+  :eval-in-leiningen true
   :dependencies
   [[org.clojure/clojure "1.2.0"]
-   [org.clojars.nakkaya/markdownj "1.0.2b4"]
+   [hiccup "0.3.0"]
-   [hiccup "0.3.0"]]
+   [org.markdownj/markdownj "0.3.0-1.0.2b4"]]
   :dev-dependencies
   [[lein-clojars "0.5.0-SNAPSHOT"]
    [jline "0.9.94"]
    [swank-clojure "1.2.1"]
    ;;Needed for testing lein plugin
    [hiccup "0.3.0"]
-   [org.clojars.nakkaya/markdownj "1.0.2b4"]
+   [org.markdownj/markdownj "0.3.0-1.0.2b4"]]
-   [marginalia "0.3.2"]]
   ;;Needed for testing cake plugin
   :tasks [marginalia.tasks]
   ;;Needed for testing Latex equation formatting. You must download

src/leiningen/marg.clj

@@ -1,27 +1,15 @@
 (ns leiningen.marg
-  "# Leiningen plugin for running marginalia against your project.
+  "Run Marginalia against your project source files."
-
+  (:use [leiningen.compile :only [eval-in-project]]
-   ## Usage
+        marginalia.core))
-
-   1. Add `[marginalia \"<current version number>\"]` to your project.clj's `:dev-dependencies` section.
-   2. run `lein marg` from your project's root directory. "
-  (:use [marginalia.core]))
 
 (defn marg [project & args]
-  (run-marginalia args))
+  (eval-in-project project
-
+    `(marginalia.core/run-marginalia (list ~@args))
-;; You can pass a file, directory, multiple files and/or directories to marginalia like so:
+    nil
-;;
+    nil
-;;     $ lein marg  # runs marginalia on all the cljs found in your ./src dir.
+    '(require 'marginalia.core)))
-;;     $ lein marg ./path/to/files  # runs marginalia on all cljs found in ./path/to/files
-;;     $ lein marg ./path/to/file.clj  # runs marginalia on ./path/to/file.clj only.
-;;     $ lein marg ./path/to/one.clj ./path/to/another.clj
-;;     $ lein marg ./path/to/dir ./path/to/some/random.clj
-;;
-;; This allows you to control the order in which sections appear in the generated
-;; documentation.  For example, in marginalia's docs, the leiningen.marg namespace
-;; forced to the bottom of the namespace ordering by using this command:
-;;
-;;     $ lein marg ./src/marginalia ./src/leiningen
-
 
+(.setMeta #'marg
+          (assoc (.meta #'marg)
+            :doc (with-out-str (run-marginalia (list "-h")))))

src/marginalia/core.clj

@@ -1,18 +1,51 @@
+;; ## A new way to think about programs
+;;
+;; What if your code and its documentation were one and the same?
+;;
+;; Much of the philosophy guiding literate programming is the realization of the answer to this question.
+;; However, if literate programming stands as a comprehensive programming methodology at one of end of the
+;; spectrum and no documentation stands as its antithesis, then Marginalia falls somewhere between. That is,
+;; you should always aim for comprehensive documentation, but the shortest path to a useful subset is the
+;; commented source code itself.
+;;
+;; ## The art of Marginalia
+;;
+;; If you’re fervently writing code that is heavily documented, then using Marginalia for your Clojure projects
+;; is as simple as running it on your codebase. However, if you’re unaccustomed to documenting your source, then
+;; the guidelines herein will help you make the most out of Marginalia for true-power documentation.
+;;
+;; Following the guidelines will work to make your code not only easier to follow – it will make it better.
+;; The very process of using Marginalia will help to crystalize your understanding of problem and its solution(s).
+;;
+;; The quality of the prose in your documentation will often reflect the quality of the code itself thus highlighting
+;; problem areas. The elimination of problem areas will solidify your code and its accompanying prose. Marginalia
+;; provides a virtuous circle spiraling inward toward maximal code quality.
+;;
+;; ## The one true way
+;;
+;; 1. Start by running Marginalia against your code
+;; 2. Cringe at the sad state of your code commentary
+;; 3. Add docstrings and code comments as appropriate
+;; 4. Generate the documentation again
+;; 5. Read the resulting documentation
+;; 6. Make changes to code and documentation so that the “dialog” flows sensibly
+;; 7. Repeat from step #4 until complete
+;;
 (ns marginalia.core
-  "**Core** provides all of the functionality around parsing clojure source files
-   into an easily consumable format."
   (:require [clojure.java.io :as io]
             [clojure.string  :as str])
-  (:use [marginalia.html :only (uberdoc-html)]
+  (:use [marginalia
-        [clojure.contrib.find-namespaces :only (read-file-ns-decl)])
+         [html :only (uberdoc-html)]
+         [parser :only (parse-file)]]
+        [clojure.contrib
+         [find-namespaces :only (read-file-ns-decl)]
+         [command-line :only (print-help with-command-line)]])
   (:gen-class))
 
 
-(def *test* "./src/cljojo/core.clj")
+(def ^{:dynamic true} *test* "src/marginalia/core.clj")
-(def *docs* "docs")
+(def ^{:dynamic true} *docs* "./docs")
-(def *comment* #"^\s*;;\s?")
+(def ^{:dynamic true} *comment* #"^\s*;;\s?")
-(def *divider-text* "\n;;DIVIDER\n")
-(def *divider-html* #"\n*<span class=\"c[1]?\">;;DIVIDER</span>\n*")
 
 ;; ## File System Utilities
 
@@ -53,13 +86,11 @@
 ;; ## Project Info Parsing
 ;; Marginalia will parse info out of your project.clj to display in
 ;; the generated html file's header.
-;;
-;; ![TODO](http://images.fogus.me/badges/todo.png "POM") add pom.xml support.
 
 
-(defn parse-project-form
+(defn parse-project-file
-  "Pulls apart the seq of project information and assembles it into a map of
+  "Parses a project.clj file and returns a map in the following form
-   the following form
+
        {:name 
         :version
         :dependencies
@@ -91,14 +122,6 @@
 
 ;; ## Source File Analysis
 
-;; Marginalia will parse your code to extract doc strings for display in the
-;; generated html file.
-(defn parse [src]
-  (for [line (line-seq src)]
-    (if (re-find *comment* line)
-      {:docs-text (str (str/replace line *comment* ""))}
-      {:code-text (str line)})))
-
 
 (defn end-of-block? [cur-group groups lines]
   (let [line (first lines)
@@ -111,9 +134,15 @@
 
 (defn merge-line [line m]
   (cond
-   (:docstring-text line) (assoc m :docs (conj (get m :docs []) line))
+   (:docstring-text line) (assoc m
-   (:code-text line) (assoc m :codes (conj (get m :codes []) line))
+                            :docs
-   (:docs-text line) (assoc m :docs (conj (get m :docs []) line))))
+                            (conj (get m :docs []) line))
+   (:code-text line)      (assoc m
+                            :codes
+                            (conj (get m :codes []) line))
+   (:docs-text line)      (assoc m
+                            :docs
+                            (conj (get m :docs []) line))))
 
 (defn group-lines [doc-lines]
   (loop [cur-group {}
@@ -127,96 +156,12 @@
 
      :else (recur (merge-line (first lines) cur-group) groups (rest lines)))))
 
-;; Hacktastic, these ad-hoc checks should be replaced with something
-;; more robust.
-(defn docstring-line? [line sections]
-  (let [l (last sections)
-        last-code-text (get l :code-text "")]
-    (try
-      (or
-       ;; Last line contain defn &&
-       ;; last line not contain what looks like a param vector &&
-       ;; current line start with a quote 
-       (and (re-find #"\(defn" last-code-text)
-            (not (re-find #"\[.*\]" last-code-text))
-            (re-find #"^\"" (str/trim (str line))))
-       ;; Is the last line's code-text a deftask, and does the
-       ;; current line start with a quote?
-       (and (re-find #"^\(deftask" (str/trim last-code-text))
-            (re-find #"^\"" (str/trim (str line))))
-       ;; Is the last line's code-text the start of a ns
-       ;; decl, and does the current line start with a quote?
-       (and (re-find #"^\(ns" last-code-text)
-            (re-find #"^\"" (str/trim (str line))))
-       ;; Is the last line's code-text the start of a defprotocol,
-       ;; and does the current line start with a quote?
-       (and (re-find #"^\(defprotocol" last-code-text)
-            (re-find #"^\"" (str/trim (str line))))
-       ;; Is the last line's code-text the start of a defmulti,
-       ;; and does the current line start with a quote?
-       (and (re-find #"^\(defmulti" last-code-text)
-            (re-find #"^\"" (str/trim (str line))))
-       ;; Is the last line's code-text the start of a defmethod,
-       ;; and does the current line start with a quote?
-       (and (re-find #"^\(defmethod" last-code-text)
-            (re-find #"^\"" (str/trim (str line))))       
-       ;; Is the last line's code-text the start of a defmacro,
-       ;; and does the current line start with a quote?
-       (and (re-find #"^\(defmacro" last-code-text)
-            (re-find #"^\"" (str/trim (str line))))
-       ;; Is the prev line a docstring, prev line not end with a quote,
-       ;; and the current line empty?
-       (and (:docstring-text l)
-            (not (re-find #"\"$" (str/trim (:docstring-text l)))))
-       ;; Is the prev line a docstring, the prev line not end with a quote,
-       ;; and the current line not an empty string?
-       (and (:docstring-text l)
-            (not (re-find #"[^\\]\"$" (str/trim (:docstring-text l))))
-            (= "" (str/trim (str line)))))
-      (catch Exception e nil))))
-
-
-(defn parse [src]
-  (loop [[line & more] (line-seq src) cnum 1 dnum 0 sections []]
-    (if line
-      (if (re-find *comment* line)
-        (recur more
-               cnum
-               (inc dnum)
-               (conj sections {:docs-text (str (str/replace line *comment* "")) :line (+ cnum dnum)}))
-        (recur more
-               (inc cnum)
-               0
-               (if (docstring-line? (str line) sections)
-                 (conj sections {:docstring-text (str line) :line cnum})
-                 (conj sections {:code-text (str line) :line cnum}))))
-      sections)))
-
-
-;; How is this handled?
-;; I wonder?
-;; No idea ne
-(defn gen-doc! [path]
-  (println "Generating documentation for " path)
-  (with-open [src (io/reader (io/file path))]
-    (doseq [section (parse src)]
-      ;; and this?
-      (println section))))
-
-(defn gen-doc! [path]
-  (with-open [src (io/reader (io/file path))]
-    (parse src)))
-
-(re-find *comment* "  ;; this is a comment")
-
 (defn path-to-doc [fn]
   (let [ns (-> (java.io.File. fn)
                (read-file-ns-decl)
                (second)
                (str))
-        groups (->> fn
+        groups (parse-file fn)]
-                    (gen-doc!)
-                    (group-lines))]
     {:ns ns
      :groups groups}))
 
@@ -233,8 +178,7 @@
      - :version
   "
   [output-file-name files-to-analyze props]
-    (spit output-file-name
+  (let [source (uberdoc-html
-	  (uberdoc-html
                 output-file-name
                 (map path-to-doc files-to-analyze)
                 props)))
@@ -270,27 +214,34 @@
      using the found source files and a project file expected to be in its default location.
 
    If no source files are found, complain with a usage message."
-  [sources]
+  [args]
-  (let [sources (format-sources sources)]
+  (with-command-line args
+    (str "Leiningen plugin for running marginalia against your project.\n\n"
+         "Usage: lein marg <options?> <src1> ... <src-n>\n")
+    [[dir d "Directory into which the documentation will be written" "./docs"]
+     [file f "File into which the documentation will be written" "uberdoc.html"]
+     src]
+    (let [sources (format-sources (seq src))]
       (if-not sources
         (do
           (println "Wrong number of arguments passed to marginalia.")
-        (println "Please present paths to source files as follows:")
+          (print-help))
-        (usage))
+        (binding [*docs* dir]
-      (do
           (println "Generating uberdoc for the following source files:")
           (doseq [s sources]
             (println "  " s))
           (println)
-        (ensure-directory! "./docs")
+          (ensure-directory! *docs*)
-        (uberdoc! "./docs/uberdoc.html" sources (parse-project-file))
+          (uberdoc! (str *docs* "/" file) sources (parse-project-file))
-        (println "Done generating your docs, please see ./docs/uberdoc.html")
+          (println "Done generating your documentation, please see"
-        (println)))))
+                   (str *docs* "/" file))
+          (println ""))))))
 
 (defn -main
   "The main entry point into Marginalia."
   [& sources]
-  (run-marginalia sources))
+  (binding [marginalia.html/*resources* ""]
+    (run-marginalia sources)))
 
 
 ;; # Example Usage

src/marginalia/html.clj

@@ -1,20 +1,11 @@
 (ns marginalia.html
-  "# Utilities for converting parse results into html.
+  "Utilities for converting parse results into html."
-   ## Plus a few other goodies.
-
-       Here's a random code block (println \"hi!\")
-
-   Like I said:
-
-   * utils for docs -> html
-   * other goodies
-
-   hello world"
   (:use [hiccup.core :only (html escape-html)]
         [hiccup.page-helpers :only (doctype)])
   (:require [clojure.string :as str])
   (:import [com.petebevin.markdown MarkdownProcessor]))
 
+(def ^{:dynamic true} *resources* "./resources/")
 
 (defn css-rule [rule]
   (let [sels (reverse (rest (reverse rule)))
@@ -26,6 +17,7 @@
   "Quick and dirty dsl for inline css rules, similar to hiccup.
 
    ex. `(css [:h1 {:color \"blue\"}] [:div.content p {:text-indent \"1em\"}])`
+
    -> `h1 {color: blue;} div.content p {text-indent: 1em;}`"
   [& rules]
   (html [:style {:type "text/css"}
@@ -59,8 +51,13 @@
 (def mdp (com.petebevin.markdown.MarkdownProcessor.))
 
 (defn md 
-  "Markdown string to html converter. Translates strings like \"# header!\"
+  "Markdown string to html converter. Translates strings like:
-   -> \"<h1>header!</h1>"
+
+   \"# header!\" -> `\"<h1>header!</h1>\"`
+
+   \"## header!\" -> `\"<h2>header!</h2>\"`
+
+   ..."
   [s]
   (.markdown mdp s))
 
@@ -68,13 +65,14 @@
   "Inserts super-fancy characters into the doc section."
   [s]
   (-> s
-      (str/replace #"-&gt;"  "&rarr;")
+      (str/replace #"->"  "&rarr;")
       (str/replace #"&quot;" "\"")))
 
 ;; As a result of docifying then grouping, you'll end up with a seq like this one:
-;;
+;; <pre><code>[...
-;;     [{:docs [{:docs-text "Some doc text"}]
+;; {:docs [{:docs-text "Some doc text"}]
-;;       :codes [{:code-text "(def something \"hi\")"}]}]
+;;  :codes [{:code-text "(def something \"hi\")"}]}
+;; ...]</code></pre>
 ;;
 ;; `docs-to-html` and `codes-to-html` convert their respective entries into html,
 ;; and `group-to-html` calls them on each seq item to do so.
@@ -98,33 +96,29 @@
   "Converts a docs section to html by threading each doc line through the forms
    outlined above.
 
-   ex. `(docs-to-html [{:doc-text \"#hello world!\"} {:docstring-text \"I'm a docstring!}])
+   ex. (docs-to-html [{:doc-text \"# hello world!\"} {:docstring-text \"I'm a docstring!}])
-   -> \"<h1>hello world!</h1><br />\"`
+   
+   ->  `\"<h1>hello world!</h1><br />\"`
    "
   [docs]
-  (->> docs
+  (-> docs
-       (map #(if (:docs-text %)
+      str
-               (prep-docs-text (:docs-text %))
+      prep-docs-text
-               (prep-docstring-text (:docstring-text %))))
+      replace-special-chars
-       (map replace-special-chars)
-       (interpose "\n")
-       (apply str)
       (md)))
 
+(defn codes-to-html [code-block]
+  (html [:pre {:class "brush: clojure"} code-block]))
 
-(defn codes-to-html [codes]
+(defn section-to-html [section]
-  (html [:pre {:class "brush: clojure"}
+  (html [:tr
-         (->> codes
+         [:td {:class "docs"} (docs-to-html
-              (map :code-text)
+                               (if (= (:type section) :comment)
-              (map escape-html)
+                                 (:raw section)
-              (interpose "\n")
+                                 (:docstring section)))]
-              (apply str))]))
+         [:td {:class "codes"}] (if (= (:type section) :code)
-
+                                  (codes-to-html (:raw section))
-(defn group-to-html [group]
+                                  "")]))
-  (html
-   [:tr
-    [:td {:class "docs"} (docs-to-html (:docs group))]
-    [:td {:class "codes"} (codes-to-html (:codes group))]]))
 
 (defn dependencies-html [deps & header-name]
   (let [header-name (or header-name "dependencies")]
@@ -170,7 +164,7 @@
            (when css
              (map #(vector :link {:tyle "text/css" :rel "stylesheet" :href %}) css))))))
 
-;; Is <h1/> overloaded?  Maybe we should consider redistributing
+;; Is &lt;h1/&gt; overloaded?  Maybe we should consider redistributing
 ;; header numbers instead of adding classes to all the h1 tags.
 (defn header-html [project-info]
   (html
@@ -221,7 +215,7 @@
        [:a {:href "#toc" :class "toc-link"}
         "toc"]]]]
     [:td {:class "codes"}]]
-   (map group-to-html (:groups doc))
+   (map section-to-html (:groups doc))
    [:tr
     [:td {:class "spacer docs"} "&nbsp;"]
     [:td {:class "codes"}]]))
@@ -358,16 +352,16 @@
     [:head
      [:meta {:http-equiv "Content-Type" :content "text/html" :charset "utf-8"}]
      [:meta {:name "description" :content (:description project-metadata)}]
-     (inline-js "jquery-1.4.4.min.js")
+     (inline-js (str *resources* "jquery-1.4.4.min.js"))
-     (inline-js "xregexp-min.js")
+     (inline-js (str *resources* "xregexp-min.js"))
-     (inline-js "shCore.js")
+     (inline-js (str *resources* "shCore.js"))
-     (inline-js "shBrushClojure.js")
+     (inline-js (str *resources* "shBrushClojure.js"))
-     (inline-js "app.js")
+     (inline-js (str *resources* "app.js"))
      #_[:script {:type "text/javascript" :src "./../resources/app.js"}]
-     (inline-css "shCore.css")
+     (inline-css (str *resources* "shCore.css"))
      (css
       [:.syntaxhighlighter {:overflow "hidden !important"}])
-     (inline-css "shThemeEclipse.css")
+     (inline-css (str *resources* "shThemeEclipse.css"))
      reset-css
      header-css
      floating-toc-css

src/marginalia/parser.clj

@@ -0,0 +1,233 @@
+;; This file contains the complete Marginalia parser.
+;; It leverages the Clojure reader instead of implementing a complete
+;; Clojure parsing solution.
+(ns marginalia.parser
+  "Provides the parsing facilities for Marginalia."
+  (:refer-clojure :exclude [replace])
+  (:use [clojure.contrib [reflect :only (get-field)]]
+        [clojure [string :only (join replace)]]))
+
+(defrecord Comment [content])
+
+(defmethod print-method Comment [comment ^String out]
+  (.write out (str \" (.content comment) \")))
+
+(def top-level-comments (atom []))
+(def sub-level-comments (atom []))
+
+(def *comments* nil)
+
+(defn read-comment [reader semicolon]
+  (let [sb (StringBuilder.)]
+    (.append sb semicolon)
+    (loop [c (.read reader)]
+      (let [ch (char c)]
+        (if (or (= ch \newline)
+                (= ch \return))
+          (let [line (dec (.getLineNumber reader))]
+            (swap! *comments* conj
+                   {:form (Comment. (.toString sb))
+                    :start line
+                    :end line})
+            reader)
+          (do
+            (.append sb (Character/toString ch))
+            (recur (.read reader))))))))
+
+(defn set-comment-reader [reader]
+  (aset (get-field clojure.lang.LispReader :macros nil)
+        (int \;)
+        reader))
+
+(defn skip-spaces-and-comments [rdr]
+  (loop [c (.read rdr)]
+    (cond (= c -1) nil
+          (= (char c) \;)
+          (do (read-comment rdr \;)
+              (recur (.read rdr)))
+          (#{\space \tab \return \newline \,} (char c))
+          (recur (.read rdr))
+          :else (.unread rdr c))))
+
+(defn parse* [reader]
+  (take-while
+   :form
+   (flatten
+    (repeatedly
+     (fn []
+       (binding [*comments* top-level-comments]
+         (skip-spaces-and-comments reader))
+       (let [start (.getLineNumber reader)
+             form (binding [*comments* sub-level-comments]
+                    (. clojure.lang.LispReader
+                       (read reader false nil false)))
+             end (.getLineNumber reader)
+             code {:form form :start start :end end}
+             comments @top-level-comments]
+         (swap! top-level-comments (constantly []))
+         (if (empty? comments)
+           [code]
+           (vec (concat comments [code])))))))))
+
+(defn strip-docstring [docstring raw]
+  (-> raw
+      (replace (str \" (-> docstring
+                           str
+                           (replace "\"" "\\\""))
+                    \")
+               "")
+      (replace #"\n\s*\n" "\n")
+      (replace #"\n\s*\)" ")")))
+
+(defn get-var-docstring [nspace-sym sym]
+  (try
+    (-> `(var ~(symbol (str nspace-sym) (str sym))) eval meta :doc)
+    ;; HACK: to handle types
+    (catch Exception _)))
+
+(defmulti dispatch-form (fn [form _ _] (first form)))
+
+(defn- extract-common-docstring
+  [form raw nspace-sym]
+  (let [sym (second form)
+        _ (if (= 'ns (first form))
+            (try (require sym)
+                 (catch Exception _)))
+        nspace (find-ns sym)]
+    (let [docstring (if nspace
+                      (-> nspace meta :doc)
+                      (get-var-docstring nspace-sym sym))]
+      [docstring
+       (strip-docstring docstring raw)
+       (if nspace sym nspace-sym)])))
+
+(defmethod dispatch-form 'ns
+  [form raw nspace-sym]
+  (let [[ds r s] (extract-common-docstring form raw nspace-sym)]
+    (let [[_ _ ds & _] form
+          ds (when (string? ds) ds)]
+      [ds
+       (strip-docstring ds r)
+       s])))
+
+(defmethod dispatch-form 'def
+  [form raw nspace-sym]
+  (extract-common-docstring form raw nspace-sym))
+
+(defmethod dispatch-form 'defn
+  [form raw nspace-sym]
+  (extract-common-docstring form raw nspace-sym))
+
+(defmethod dispatch-form 'defprotocol
+  [form raw nspace-sym]
+  ;; this needs some work to extract embedded docstrings
+  (extract-common-docstring form raw nspace-sym))
+
+(defmethod dispatch-form 'defmulti
+  [form raw nspace-sym]
+  (extract-common-docstring form raw nspace-sym))
+
+(defmethod dispatch-form 'defmethod
+  [form raw nspace-sym]
+  (let [ds        (nth form 3)
+        docstring (when (string? ds) ds)]
+    [docstring
+     (strip-docstring docstring raw)
+     nspace-sym]))
+
+(defmethod dispatch-form :default
+  [form raw nspace-sym]
+  (if (re-find #"^def" (-> form first name))
+    (extract-common-docstring form raw nspace-sym)
+    [nil raw nspace-sym]))
+
+(defn extract-docstring [m raw nspace-sym]
+  (let [raw (join "\n" (subvec raw (-> m :start dec) (:end m)))
+        form (:form m)]
+    (dispatch-form form raw nspace-sym)))
+
+(defn- ->str [m]
+  (replace (-> m :form .content) #"^;+\s*" ""))
+
+(defn merge-comments [f s]
+  {:form (Comment. (str (->str f) "\n" (->str s)))
+   :start (:start f)
+   :end (:end s)})
+
+(defn comment? [o]
+  (->> o :form (instance? Comment)))
+
+(defn code? [o]
+  (and (->> o :form (instance? Comment) not)
+       (->> o :form nil? not)))
+
+(defn adjacent? [f s]
+  (= (-> f :end) (-> s :start dec)))
+
+(defn arrange-in-sections [parsed-code raw-code]
+  (loop [sections []
+         f (first parsed-code)
+         s (second parsed-code)
+         nn (nnext parsed-code)
+         nspace nil]
+    (if f
+      (cond
+       ;; ignore comments with only one semicolon
+       (and (comment? f) (re-find #"^;\s" (-> f :form .content)))
+       (recur sections s (first nn) (next nn) nspace)
+       ;; merging comments block
+       (and (comment? f) (comment? s) (adjacent? f s))
+       (recur sections (merge-comments f s)
+              (first nn) (next nn)
+              nspace)
+       ;; merging adjacent code blocks
+       (and (code? f) (code? s) (adjacent? f s))
+       (let [[fdoc fcode nspace] (extract-docstring f raw-code nspace)
+             [sdoc scode _] (extract-docstring s raw-code nspace)]
+         (recur sections (assoc s
+                           :type :code
+                           :raw (str (or (:raw f) fcode) "\n" scode)
+                           :docstring (str (or (:docstring f) fdoc) "\n\n" sdoc))
+                (first nn) (next nn) nspace))
+       ;; adjacent comments are added as extra documentation to code block
+       (and (comment? f) (code? s) (adjacent? f s))
+       (let [[doc code nspace] (extract-docstring s raw-code nspace)]
+         (recur sections (assoc s
+                           :type :code
+                           :raw code
+                           :docstring (str doc "\n\n" (->str f)))
+                (first nn) (next nn) nspace))
+       ;; adding comment section
+       (comment? f)
+       (recur (conj sections (assoc f :type :comment :raw (->str f)))
+              s
+              (first nn) (next nn)
+              nspace)
+       ;; adding code section
+       :else
+       (let [[doc code nspace] (extract-docstring f raw-code nspace)]
+         (recur (conj sections (if (= (:type f) :code)
+                                 f
+                                 {:type :code
+                                  :raw code
+                                  :docstring doc}))
+                s (first nn) (next nn) nspace)))
+      sections)))
+
+(defn parse [source-string]
+  (let [make-reader #(java.io.BufferedReader.
+                      (java.io.StringReader. (str source-string "\n")))
+        lines (vec (line-seq (make-reader)))
+        reader (clojure.lang.LineNumberingPushbackReader. (make-reader))
+        old-cmt-rdr (aget (get-field clojure.lang.LispReader :macros nil) (int \;))]
+    (try
+      (set-comment-reader read-comment)
+      (let [parsed-code (-> reader parse* doall)]
+        (set-comment-reader old-cmt-rdr)
+        (arrange-in-sections parsed-code lines))
+      (catch Exception e
+        (set-comment-reader old-cmt-rdr)
+        (throw e)))))
+
+(defn parse-file [file]
+  (parse (slurp file)))

src/problem_cases/general.clj

@@ -6,7 +6,7 @@
 ;; Should have only this comment in the left margin.
 ;; See [https://github.com/fogus/marginalia/issues/#issue/4](https://github.com/fogus/marginalia/issues/#issue/4)
 
-(defn parse-bool [v] (condp = (.trim (text v))
+(defn parse-bool [v] (condp = (.trim (str v))
                          "0" false
                          "1" true
                          "throw exception here"))
@@ -21,10 +21,17 @@
   "Here is just a string.  It should be to the right."
   (* x x))
 
-(defmacro foobar
+(defprotocol Relation
-  "This is a macro docstring.  It should be on the left."
+  (select     [this predicate]
-  [& body]
+    "Confines the query to rows for which the predicate is true
-  `~body)
+
+     Ex. (select (table :users) (where (= :id 5)))")
+  (join       [this table2 join_on]
+    "Joins two tables on join_on
+
+     Ex. (join (table :one) (table :two) :id)
+         (join (table :one) (table :two)
+               (where (= :one.col :two.col)))"))
 
 (defmulti bazfoo
   "This is a defmulti docstring, it should also be on the left"
@@ -59,6 +66,7 @@
 
 ; Define single-character indicator rules.
 ; I use `clojure.template/do-template` to reduce repetition.
+(comment
   (do-template [rule-name token]
                (h/defrule rule-name
                  "Padded on the front with optional whitespace."
@@ -70,4 +78,11 @@
                <array-start>     \[
                <array-end>       \]
                <object-start>    \{
-  <object-end>      \})
+               <object-end>      \}))
+
+(defmulti kompile identity)
+
+(defmethod kompile [::standard AutoIncClause]
+  "This is a docstring.  On the left."
+  [_]
+  "GENERATED ALWAYS AS IDENTITY")