marginalia

0.7.1


lightweight literate programming for clojure -- inspired by docco

dependencies

org.clojure/clojure
1.3.0
org.clojure/tools.namespace
0.1.1
org.clojure/tools.cli
0.2.1
hiccup
0.3.7
org.markdownj/markdownj
0.3.0-1.0.2b4

dev dependencies

lein-clojars
0.6.0
jline
0.9.94
org.clojars.autre/lein-vimclojure
1.0.0
lein-marginalia
0.7.1



(this space intentionally left almost blank)

namespaces

 

marginalia.core

toc

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
  (:require [clojure.java.io :as io]
            [clojure.string  :as str])
  (:use [marginalia
         [html :only (uberdoc-html index-html single-page-html)]
         [parser :only (parse-file)]]
        [clojure.tools
         [namespace :only (read-file-ns-decl)]
         [cli :only (cli)]]))
(def ^{:dynamic true} *test* "src/marginalia/core.clj")
(def ^{:dynamic true} *docs* "./docs")
(def ^{:dynamic true} *comment* #"^\s*;;\s?")

File System Utilities

Performs roughly the same task as the UNIX ls. That is, returns a seq of the filenames at a given directory. If a path to a file is supplied, then the seq contains only the original path given.

(defn ls
  [path]
  (let [file (java.io.File. path)]
    (if (.isDirectory file)
      (seq (.list file))
      (when (.exists file)
        [path]))))
(defn mkdir [path]
  (.mkdirs (io/file path)))

Ensure that the directory specified by path exists. If not then make it so. Here is a snowman ☃

(defn ensure-directory!
  [path]
  (when-not (ls path)
    (mkdir path)))

Many Marginalia fns use dir? to recursively search a filepath.

(defn dir?
  [path]
  (.isDirectory (java.io.File. path)))

Returns a seq of clojure file paths (strings) in alphabetical order.

(defn find-processable-file-paths
  [dir matching-re]
  (->> (io/file dir)
       (file-seq)
       (filter #(re-find matching-re (.getCanonicalPath %)))
       (map #(.getCanonicalPath %))
       (sort)))

Project Info Parsing

Marginalia will parse info out of your project.clj to display in the generated html file's header.

Parses a project.clj file and returns a map in the following form

   {:name
    :version
    :dependencies
    :dev-dependencies
    etc...}

by merging into the name and version information the rest of the defproject forms (:dependencies, etc)

(defn parse-project-form
  [[_ project-name version-number & attributes]]
  (merge {:name (str project-name)
	  :version version-number}
	 (apply hash-map attributes)))

Parses a project file -- './project.clj' by default -- and returns a map assembled according to the logic in parse-project-form.

(defn parse-project-file
  ([] (parse-project-file "./project.clj"))
  ([path]
      (try
        (let [rdr (clojure.lang.LineNumberingPushbackReader.
                   (java.io.FileReader.
                    (java.io.File. path)))]
          (parse-project-form (read rdr)))
	(catch Exception e
          (throw (Exception.
                  (str
                   "There was a problem reading the project definition from "
                   path)))))))

Source File Analysis

(defn end-of-block? [cur-group groups lines]
  (let [line (first lines)
        next-line (second lines)
        next-line-code (get next-line :code-text )]
    (when (or (and (:code-text line)
                   (:docs-text next-line))
              (re-find #"^\(def" (str/trim next-line-code)))
      true)))
(defn merge-line [line m]
  (cond
   (:docstring-text line) (assoc m
                            :docs
                            (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 {}
         groups []
         lines doc-lines]
    (cond
     (empty? lines) (conj groups cur-group)
     (end-of-block? cur-group groups lines)
     (recur (merge-line (first lines) {}) (conj groups cur-group) (rest lines))
     :else (recur (merge-line (first lines) cur-group) groups (rest lines)))))
(defn path-to-doc [fn]
  (let [ns (-> (java.io.File. fn)
               (read-file-ns-decl)
               (second)
               (str))
        groups (parse-file fn)]
    {:ns ns
     :groups groups}))

Ouput Generation

(defn filename-contents
  [props output-dir all-files parsed-file]
  {:name (io/file output-dir (str (:ns parsed-file) ".html"))
   :contents (single-page-html props parsed-file all-files)})
(defn multidoc!
  [output-dir files-to-analyze props]
  (let [parsed-files (map path-to-doc files-to-analyze)
        index (index-html props parsed-files)
        pages (map #(filename-contents props output-dir parsed-files %) parsed-files)]
    (doseq [f (conj pages {:name (io/file output-dir "toc.html")
                           :contents index})]
           (spit (:name f) (:contents f)))))

Generates an uberdoc html file from 3 pieces of information:

  1. The path to spit the result (output-file-name)
  2. Results from processing source files (path-to-doc)
  3. Project metadata as a map, containing at a minimum the following:
    • :name
    • :version
(defn uberdoc!
  [output-file-name files-to-analyze props]
  (let [source (uberdoc-html
                props
                (map path-to-doc files-to-analyze))]
    (spit output-file-name source)))

External Interface (command-line, lein, cake, etc)

These functions support Marginalia's use by client software or command-line users.

Given a collection of filepaths, returns a lazy sequence of filepaths to all .clj files on those paths: directory paths will be searched recursively for .clj files.

(defn format-sources
  [sources]
  (if (nil? sources)
    (concat
     (find-processable-file-paths "./src" #"\.clj$")
     (find-processable-file-paths "./src" #"\.cljs$"))
    (->> sources
         (mapcat #(if (dir? %)
                    (concat
                     (find-processable-file-paths % #"\.clj$")
                     (find-processable-file-paths % #"\.cljs$"))
                    [(.getCanonicalPath (io/file %))])))))
(defn split-deps [deps]
  (when deps
    (for [d (.split deps ";")
          :let [[group artifact version] (.split d ":")]]
      [(if (= group artifact) artifact (str group "/" artifact))
       version])))

Default generation: given a collection of filepaths in a project, find the .clj files at these paths and, if Clojure source files are found:

  1. Print out a message to std out letting a user know which files are to be processed;
  2. Create the docs directory inside the project folder if it doesn't already exist;

  3. Call the uberdoc! function to generate the output file at its default location, 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.

(defn run-marginalia
  [args & [project]]
  (let [[{:keys [dir file name version desc deps css js multi]} 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"]
             ["-n" "--name" "Project name - if not given will be taken from project.clj"]
             ["-v" "--version" "Project version - if not given will be taken from project.clj"]
             ["-D" "--desc" "Project description - if not given will be taken from project.clj"]
             ["-a" "--deps" "Project dependencies in the form <group1>:<artifact1>:<version1>;<group2>...
                 If not given will be taken from project.clj"]
             ["-c" "--css" "Additional css resources <resource1>;<resource2>;...
                 If not given will be taken from project.clj."]
             ["-j" "--js" "Additional javascript resources <resource1>;<resource2>;...
                 If not given will be taken from project.clj"]
             ["-m" "--multi" "Generate each namespace documentation as a separate file" :flag true])
        sources (distinct (format-sources (seq files)))]
    (if-not sources
      (do
        (println "Wrong number of arguments passed to marginalia.")
        (println help))
      (binding [*docs* dir]
        (let [project-clj (or project
                              (when (.exists (io/file "project.clj"))
                                (parse-project-file)))
              choose #(or %1 %2)
              marg-opts (merge-with choose
                                    {:css (when css (.split css ";"))
                                     :javascript (when js (.split js ";"))}
                                    (:marginalia project-clj))
              opts (merge-with choose
                               {:name name
                                :version version
                                :description desc
                                :dependencies (split-deps deps)
                                :multi multi
                                :marginalia marg-opts}
                               project-clj)]
          (println "Generating Marginalia documentation for the following source files:")
          (doseq [s sources]
            (println "  " s))
          (println)
          (ensure-directory! *docs*)
          (if multi
            (multidoc! *docs* sources opts)
            (uberdoc!  (str *docs* "/" file) sources opts))
          (println "Done generating your documentation in" *docs*)
          (println ""))))))
 

marginalia.html

toc

Utilities for converting parse results into html.

(ns marginalia.html
  (: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* "./vendor/")
(defn css-rule [rule]
  (let [sels (reverse (rest (reverse rule)))
        props (last rule)]
    (str (apply str (interpose " " (map name sels)))
         "{" (apply str (map #(str (name (key %)) ":" (val %) ";") props)) "}")))

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;}

(defn css
  [& rules]
  (html [:style {:type "text/css"}
         (apply str (map css-rule rules))]))

Stolen from leiningen

(defn slurp-resource
  [resource-name]
  (try
    (-> (.getContextClassLoader (Thread/currentThread))
        (.getResourceAsStream resource-name)
        (java.io.InputStreamReader.)
        (slurp))
    (catch java.lang.NullPointerException npe
      (println (str "Could not locate resources at " resource-name))
      (println "    ... attempting to fix.")
      (let [resource-name (str "./resources/" resource-name)]
        (try
          (-> (.getContextClassLoader (Thread/currentThread))
              (.getResourceAsStream resource-name)
              (java.io.InputStreamReader.)
              (slurp))
          (catch java.lang.NullPointerException npe
            (println (str "    STILL could not locate resources at " resource-name ". Giving up!"))))))))
(defn inline-js [resource]
  (let [src (slurp-resource resource)]
    (html [:script {:type "text/javascript"}
            src])))
(defn inline-css [resource]
  (let [src (slurp-resource resource)]
    (html [:style {:type "text/css"}
           (slurp-resource resource)])))

The following functions handle preparation of doc text (both comment and docstring based) for display through html & css.

Markdown processor.

(def mdp (com.petebevin.markdown.MarkdownProcessor.))

Markdown string to html converter. Translates strings like:

"# header!" -> "<h1>header!</h1>"

"## header!" -> "<h2>header!</h2>"

...

(defn md
  [s]
  (.markdown mdp s))

As a result of docifying then grouping, you'll end up with a seq like this one:

[...
{:docs [{:docs-text "Some doc text"}]
 :codes [{:code-text "(def something \"hi\")"}]}
...]

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.

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!}])

-> "<h1>hello world!</h1><br />"

(defn docs-to-html
  [docs]
  (-> docs
      str
      (md)))
(defn codes-to-html [code-block]
  (html [:pre {:class "brush: clojure"}
         (escape-html code-block)]))
(defn section-to-html [section]
  (html [:tr
         [:td {:class "docs"} (docs-to-html
                               (if (= (:type section) :comment)
                                 (:raw section)
                                 (:docstring section)))]
         [:td {:class "codes"} (if (= (:type section) :code)
                                  (codes-to-html (:raw section)))]]))
(defn dependencies-html [deps & header-name]
  (when-let [deps (seq deps)]
    (let [header-name (or header-name "dependencies")]
      (html [:div {:class "dependencies"}
             [:h3 header-name]
             [:table
              (map #(html [:tr
                           [:td {:class "dep-name"} (str (first %))]
                           [:td {:class "dotted"} [:hr]]
                           [:td {:class "dep-version"} (second %)]])
                   deps)]]))))

Load Optional Resources

Use external Javascript and CSS in your documentation. For example: To format Latex math equations, download the MathJax Javascript library to the docs directory and then add

:marginalia {:javascript ["mathjax/MathJax.js"]}

to project.clj. Below is a simple example of both inline and block formatted equations.

When \(a \ne 0\), there are two solutions to \(ax^2 + bx + c = 0\) and they are $$x = {-b \pm \sqrt{b^2-4ac} \over 2a}.$$

Generate script and link tags for optional external javascript and css.

(defn opt-resources-html
  [project-info]
  (let [options (:marginalia project-info)
        javascript (:javascript options)
        css (:css options)]
    (html (concat
           (when javascript
             (map #(vector :script {:type "text/javascript" :src %}) javascript))
           (when css
             (map #(vector :link {:tyle "text/css" :rel "stylesheet" :href %}) css))))))

Is <h1/> overloaded? Maybe we should consider redistributing header numbers instead of adding classes to all the h1 tags.

(defn header-html [project-info]
  (html
   [:tr
    [:td {:class "docs"}
     [:div {:class "header"}
      [:h1 {:class "project-name"} (:name project-info)]
      [:h2 {:class "project-version"} (:version project-info)]
      [:br]
      (md (:description project-info))]
     (dependencies-html (:dependencies project-info))
     (dependencies-html (:dev-dependencies project-info) "dev dependencies")]
    [:td {:class "codes"
          :style "text-align: center; vertical-align: middle;color: #666;padding-right:20px"}
     [:br]
     [:br]
     [:br]
     "(this space intentionally left almost blank)"]]))

Creates an 'a' tag pointing to the namespace-name, either as an anchor (if anchor? is true) or as a link to a separate $namespace-name.html file. If attrs aren't empty, they are added to the resulting tag.

(defn link-to-namespace
  [namespace-name anchor? & attrs]
  [:a (into {:href (if anchor?
                   (str "#" namespace-name)
                   (str namespace-name ".html"))}
            attrs)
   namespace-name])

This is a hack, as in the case when anchor? is false, the link will contain a reference to toc.html which might not even exist.

(defn link-to-toc
  [anchor?]
  (link-to-namespace "toc" anchor? {:class "toc-link"}))
(defn toc-html [props docs]
  (html
   [:tr
    [:td {:class "docs"}
     [:div {:class "toc"}
      [:a {:name "toc"} [:h3 "namespaces"]]
      [:ul
       (map #(vector :li (link-to-namespace (:ns %) (:uberdoc? props)))
            docs)]]]
    [:td {:class "codes"} "&nbsp;"]]))
(defn floating-toc-html [docs]
  [:div {:id "floating-toc"}
   [:ul
    (map #(vector :li {:class "floating-toc-li"
                       :id (str "floating-toc_" (:ns %))}
                  (:ns %))
         docs)]])
(defn groups-html [props doc]
  (html
   [:tr
    [:td {:class "docs"}
     [:div {:class "docs-header"}
      [:a {:class "anchor" :name (:ns doc) :href (str "#" (:ns doc))}
       [:h1 {:class "project-name"}
        (:ns doc)]
       (link-to-toc (:uberdoc? props))]]]
    [:td {:class "codes"}]]
   (map section-to-html (:groups doc))
   [:tr
    [:td {:class "spacer docs"} "&nbsp;"]
    [:td {:class "codes"}]]))
(def reset-css
  (css [:html {:margin 0 :padding 0}]
       [:h1 {:margin 0 :padding 0}]
       [:h2 {:margin 0 :padding 0}]
       [:h3 {:margin 0 :padding 0}]
       [:h4 {:margin 0 :padding 0}]
       [:a {:color "#261A3B"}]
       [:a:visited {:color "#261A3B"}]))
(def header-css
  (css [:.header {:margin-top "30px"}]
       [:h1.project-name {:font-size "34px"
                          :display "inline"}]
       [:h2.project-version {:font-size "18px"
                             :margin-top 0
                             :display "inline"
                             :margin-left "10px"}]
       [:.toc-link {:font-size "12px"
                    :margin-left "10px"
                    :color "#252519"
                    :text-decoration "none"}]
       [:.toc-link:hover {:color "#5050A6"}]
       [:.toc :h1 {:font-size "34px"
                   :margin 0}]
       [:.docs-header {:border-bottom "dotted #aaa 1px"
                       :padding-bottom "10px"
                       :margin-bottom "25px"}]
       [:.toc :h1 {:font-size "24px"}]
       [:.toc {:border-bottom "solid #bbb 1px"
               :margin-bottom "40px"}]
       [:.toc :ul {:margin-left "20px"
                   :padding-left "0px"
                   :padding-top 0
                   :margin-top 0}]
       [:.toc :li {:list-style-type "none"
                   :padding-left 0}]
       [:.dependencies {}]
       [:.dependencies :table {:font-size "16px"
                               :width "99.99%"
                               :border "none"
                               :margin-left "20px"}]
       [:.dependencies :td {:padding-right "20px;"
                            :white-space "nowrap"}]
       [:.dependencies :.dotted {:width "99%"}]
       [:.dependencies :.dotted :hr {:height 0
                                     :noshade "noshade"
                                     :color "transparent"
                                     :background-color "transparent"
                                     :border-bottom "dotted #bbb 1px"
                                     :border-top "none"
                                     :border-left "none"
                                     :border-right "none"
                                     :margin-bottom "-6px"}]
       [:.dependencies :.dep-version {:text-align "right"}]
       [:.plugins :ul {:margin-left "20px"
                       :padding-left "0px"
                       :padding-top 0
                       :margin-top 0}]
       [:.plugins :li {:list-style-type "none"
                       :padding-left 0}]
       [:.header :p {:margin-left "20px"}]))
(def floating-toc-css
  (css [:#floating-toc {:position "fixed"
                        :top "10px"
                        :right "20px"
                        :height "20px"
                        :overflow "hidden"
                        :text-align "right"}]
       [:#floating-toc :li {:list-style-type "none"
                            :margin 0
                            :padding 0}]))
(def general-css
  (css
   [:body {:margin 0
           :padding 0
           :font-family "'Palatino Linotype', 'Book Antiqua', Palatino, FreeSerif, serif;"
           :font-size "16px"
           :color "#252519"
           :background-color "#F5F5FF"}]
   [:h1 {:font-size "20px"
         :margin-top 0}]
   [:a.anchor {:text-decoration "none"
              :color "#252519"}]
   [:a.anchor:hover {:color "#5050A6"}]
   [:table {:border-spacing 0
            :border-bottom "solid #ddd 1px;"
            :margin-bottom "10px"}]
   [:code {:display "inline"}]
   [:p {:margin-top "8px"}]
   [:tr {:margin "0px"
         :padding "0px"}]
   [:td.docs {:width "410px"
              :max-width "410px"
              :vertical-align "top"
              :margin "0px"
              :padding-left "55px"
              :padding-right "20px"
              :border "none"
              :background-color "#FFF"}]
   [:td.docs :pre {:font-size "12px"
                   :overflow "hidden"}]
   [:td.codes {:width "55%"
               :background-color "#F5F5FF"
               :vertical-align "top"
               :margin "0px"
               :padding-left "20px"
               :border "none"
               :overflow "hidden"
               :font-size "10pt"
               :border-left "solid #E5E5EE 1px"}]
   [:td.spacer {:padding-bottom "40px"}]
   [:pre :code {:display "block"
                :padding "4px"}]
   [:code {:background-color "ghostWhite"
           :border "solid #DEDEDE 1px"
           :padding-left "3px"
           :padding-right "3px"
           :font-size "14px"}]
   [:.syntaxhighlighter :code {:font-size "13px"}]
   [:.footer {:text-align "center"}]))

Notice that we're inlining the css & javascript for SyntaxHighlighter (inline-js & inline-css) to be able to package the output as a single file (uberdoc if you will). It goes without saying that all this is WIP and will prabably change in the future.

(defn page-template
  [project-metadata opt-resources header toc content]
  (html
   (doctype :html5)
   [:html
    [:head
     [:meta {:http-equiv "Content-Type" :content "text/html" :charset "utf-8"}]
     [:meta {:name "description" :content (:description project-metadata)}]
     (inline-css (str *resources* "shCore.css"))
     (css
      [:.syntaxhighlighter {:overflow "hidden !important"}])
     (inline-css (str *resources* "shThemeMarginalia.css"))
     reset-css
     header-css
     floating-toc-css
     general-css
     (inline-js (str *resources* "jquery-1.4.4.min.js"))
     (inline-js (str *resources* "xregexp-min.js"))
     (inline-js (str *resources* "shCore.js"))
     (inline-js (str *resources* "shBrushClojure.js"))
     opt-resources
     [:title (:name project-metadata) " -- Marginalia"]]
    [:body
     [:table
      header
      toc
      content]
     [:div {:class "footer"}
      "Generated by "
      [:a {:href "https://github.com/fogus/marginalia"} "Marginalia"]
      ".&nbsp;&nbsp;"
      "Syntax highlighting provided by Alex Gorbatchev's "
      [:a {:href "http://alexgorbatchev.com/SyntaxHighlighter/"}
       "SyntaxHighlighter"]
      #_floating-toc]
     [:script {:type "text/javascript"}
      "SyntaxHighlighter.defaults['gutter'] = false;
       SyntaxHighlighter.all()"]]]))

Syntax highlighting is done a bit differently than docco. Instead of embedding the higlighting metadata on the parse / html gen phase, we use SyntaxHighlighter to do it in javascript.

This generates a stand alone html file (think lein uberjar). It's probably the only var consumers will use.

(defn uberdoc-html
  [project-metadata docs]
  (page-template
   project-metadata
   (opt-resources-html project-metadata)
   (header-html project-metadata)
   (toc-html {:uberdoc? true} docs)
   (map #(groups-html {:uberdoc? true} %) docs)))
(defn index-html
  [project-metadata docs]
  (page-template
   project-metadata
   (opt-resources-html project-metadata)
   (header-html project-metadata)
   (toc-html {:uberdoc? false} docs))) ;; no contents

no contents

(defn single-page-html
  [project-metadata doc all-docs]
  (page-template
   project-metadata
   (opt-resources-html project-metadata)
    ;; no header
    ;; no toc
   (groups-html {:uberdoc? false} doc)))
 

marginalia.main

toc
(ns marginalia.main
  (:use [marginalia.html :only [*resources*]]
        [marginalia.core :only [run-marginalia]])
  (:gen-class))

The main entry point into Marginalia.

(defn -main
  [& sources]
  (binding [*resources* ""]
    (run-marginalia sources)))

Example Usage

(comment
  ;; Command line example
  (-main "./src/marginalia/core.clj" "./src/marginalia/html.clj")

  ;; This will find all marginalia source files, and then generate an uberdoc.
  (apply -main (find-clojure-file-paths "./src"))

;; Move these to tests
  (merge-line {:docstring-text "hello world" :line 3} {:docs ["stuff"]})
  (merge-line {:code-text "(defn asdf" :line 4} {:docs ["stuff"]})
  (merge-line {:docs-text "There's only one method in this module", :line 4} {}))
 

marginalia.parser

toc

Provides the parsing facilities for Marginalia.

This file contains the complete Marginalia parser. It leverages the Clojure reader instead of implementing a complete Clojure parsing solution.

(ns marginalia.parser
  (:refer-clojure :exclude [replace])
  (:use [clojure [string :only (join replace)]]))

Access to private or protected field. field-name is a symbol or keyword.

Extracted from clojure.contrib.reflect

(defn get-field
  [klass field-name obj]
  (-> klass (.getDeclaredField (name field-name))
      (doto (.setAccessible true))
      (.get obj)))

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).

Extracted from clojure.contrib.reflect

(defn call-method
  [klass method-name params obj & args]
  (-> klass (.getDeclaredMethod (name method-name)
                                (into-array Class params))
      (doto (.setAccessible true))
      (.invoke obj (into-array Object args))))
(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 ^{:dynamic true} *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))
(defrecord DoubleColonKeyword [content])
(defmethod print-method DoubleColonKeyword [dck ^java.io.Writer out]
  (.write out (str \: (.content dck))))
(defmethod print-dup DoubleColonKeyword [dck ^java.io.Writer out]
  (print-method dck out))
(defn ^:private read-token [reader c]
  (call-method clojure.lang.LispReader :readToken
               [java.io.PushbackReader Character/TYPE]
               nil reader c))
(defn ^:private match-symbol [s]
  (call-method clojure.lang.LispReader :matchSymbol
               [String]
               nil s))
(defn read-keyword [reader colon]
  (let [c (.read reader)]
    (if (= (int \:) c)
      (-> (read-token reader (char c))
          match-symbol
          DoubleColonKeyword.)
      (do (.unread reader c)
          (-> (read-token reader colon)
              match-symbol)))))
(defn set-keyword-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]
                    (try (. clojure.lang.LispReader
                            (read reader false nil false))
                         (catch Exception ex
                           (let [msg (str "Problem parsing near line " start
                                          " <" (.readLine reader) ">"
                                          " original reported cause is "
                                          (.getCause ex) " -- "
                                          (.getMessage ex))
                                 e (RuntimeException. msg)]
                             (.setStackTrace e (.getStackTrace ex))
                             (throw e)))))
             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 #"#?\^\{\s*:doc\s*\}" )
      (replace #"\n\s*\n" "\n")
      (replace #"\n\s*\)" ")")))
(defn get-var-docstring [nspace-sym sym]
  (let [s (if nspace-sym
            (symbol (str nspace-sym) (str sym))
            (symbol (str sym)))]
    (try
      (-> `(var ~s) eval meta :doc)
      ;; HACK: to handle types
      (catch Exception _))))
(defmulti dispatch-form (fn [form _ _]
                          (if (seq? form) (first form) form)))
(defn- extract-common-docstring
  [form raw nspace-sym]
  (let [sym (second form)]
    (if (symbol? sym)
      (let [maybe-metadocstring (:doc (meta sym))]
        (do
          (when (= 'ns (first form))
            (try (require sym)
                 (catch Exception _)))
          (let [nspace (find-ns sym)
                [maybe-ds remainder] (let [[_ _ ? & more?] form] [? more?])
                docstring (if (and (string? maybe-ds) remainder)
                            maybe-ds
                            (if (= (first form) 'ns)
                              (if (not maybe-metadocstring)
                                (when (string? maybe-ds) maybe-ds)
                                maybe-metadocstring)
                              (if-let [ds maybe-metadocstring]
                                ds
                                (when nspace
                                  (-> nspace meta :doc)
                                  (get-var-docstring nspace-sym sym)))))]
            [docstring
             (strip-docstring docstring raw)
             (if (or (= 'ns (first form)) nspace) sym nspace-sym)])))
      [nil raw nspace-sym])))
(defn- extract-impl-docstring
  [fn-body]
  (filter string? (rest fn-body)))
(defn- extract-internal-docstrings
  [body]
  (mapcat #(extract-impl-docstring %)
          body))
(defmethod dispatch-form 'defprotocol
  [form raw nspace-sym]
  (let [[ds r s] (extract-common-docstring form raw nspace-sym)]
    (let [internal-dses (if ds
                          (extract-internal-docstrings (nthnext form 3))
                          (extract-internal-docstrings (nthnext form 2)))]
      (with-meta
        [ds r s]
        {:internal-docstrings internal-dses}))))
(defmethod dispatch-form 'ns
  [form raw nspace-sym]
  (extract-common-docstring form raw nspace-sym))
(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 'defn-
  [form raw nspace-sym]
  (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]
  [nil raw nspace-sym])
(defn dispatch-inner-form
  [form raw nspace-sym]
  (conj
   (reduce (fn [[adoc araw] inner-form]
             (if (seq? inner-form)
               (let [[d r] (dispatch-form inner-form
                                          araw
                                          nspace-sym)]
                 [(str adoc d) r])
               [adoc araw]))
           [nil raw]
           form)
   nspace-sym))
(defn- dispatch-literal
  [form raw nspace-sym]
  [nil raw])
(defmethod dispatch-form :default
  [form raw nspace-sym]
  ;; Strings which are inlined into clojure files outside of forms are parsed
  ;; as `String` instances, while numbers - as `Number` subclasses.
  (cond (or (string? form) (number? form) (keyword? form))
          (dispatch-literal form raw nspace-sym)
        (and (first form)
             (.isInstance clojure.lang.Named (first form))
             (re-find #"^def" (-> form first name)))
          (extract-common-docstring form raw nspace-sym)
        :else
          (dispatch-inner-form form 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]
  (-> (-> m :form .content)
      (replace #"^;+\s(\s*)" "$1")
      (replace #"^;+" )))
(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)
      (set-keyword-reader read-keyword)
      (let [parsed-code (-> reader parse* doall)]
        (set-comment-reader old-cmt-rdr)
        (set-keyword-reader nil)
        (arrange-in-sections parsed-code lines))
      (catch Exception e
        (set-comment-reader old-cmt-rdr)
        (set-keyword-reader nil)
        (throw e)))))
(defn parse-file [file]
  (parse (slurp file)))
 

problem-cases.general

toc

A place to examine poor parser behavior. These should go in tests when they get written.

(ns problem-cases.general)
[::foo]
{:foo 43}
{::foo 42}

private docstring

(defn ^:private private-fn  [])

docstring

(defn public-fn  []
  (let [x (private-fn)]
        (count x)))

Should have only this comment in the left margin. See https://github.com/fogus/marginalia/issues/#issue/4

(defn parse-bool [v] (condp = (.trim (str v))
                         "0" false
                         "1" true
                         "throw exception here"))

Here is a docstring. It should be to the left.

(defn a-function 
  [x]
  (* x x))

Here is a docstring. It should be to the left.

(defn b-function
  [x]
  "Here is just a string.  It should be to the right."
  (* x x))

Defines a relation... duh!

(defprotocol Relation
  (select     [this predicate]
    "Confines the query to rows for which the predicate is true
     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)))"))

This is a defmulti docstring, it should also be on the left

(defmulti bazfoo
  class)
(defmethod bazfoo String [s]
  "This is a defmethod docstring.  It should be on the left."
  (vec (seq s)))
(bazfoo "abc")

This is a protocol docstring. It should be on the left.

(defprotocol Foo
  (lookup  [cache e])
  (has?    [cache e] )
  (hit     [cache e])
  (miss    [cache e ret]))

This is also a docstring via metadata. It should be on the left.

(def 
  a 42)

This is also a docstring via metadata. It should be on the left.

(def 
  b 42)

This is also a docstring via metadata. It should be on the left.

(def 
  c
  "This is just a value.  It should be on the right.")

From fnparse

Padded on the front with optional whitespace.

(comment
  (do-template [rule-name token]
               (h/defrule rule-name
                 (h/lit token))
               <escape-char-start> \\
               <str-delimiter>   \"
               <value-separator> \,
               <name-separator>  \:
               <array-start>     \[
               <array-end>       \]
               <object-start>    \{
               <object-end>      \}))

Issue #26: Angle-bracket in Function Name Breaks Layout

(defn <test [] nil)

(defn test-html-entities-in-doc
  []
  nil)
(defmulti kompile identity)
(defmethod kompile [:standard]
  [_]
  "GENERATED ALWAYS AS IDENTITY")

strict-eval-op-fn is used to define functions of the above pattern for fuctions such as +, *, etc. Cljs special forms defined this way are applyable, such as (apply + [1 2 3]).

Resulting expressions are wrapped in an anonymous function and, down the line, called, like so:

   (+ 1 2 3) -> (function(){...}.call(this, 1 2 3)

(defn strict-eval-op-fn
  [op inc-ind-str ind-str op nl]
  (ind-str
   "(function() {" nl
   (inc-ind-str
    "var _out = arguments[0];" nl
    "for(var _i=1; _i<arguments.length; _i++) {" nl
    (inc-ind-str
     "_out = _out " op " arguments[_i];")
    nl
    "}" nl
    "return _out;")
   nl
   "})"))
'(defn special-forms []
  {'def     handle-def
   'fn      handle-fn
   'fn*     handle-fn
   'set!    handle-set
   'let     handle-let
   'defn    handle-defn
   'aget    handle-aget
   'aset    handle-aset
   'if      handle-if
   'while   handle-while
   'when    handle-when
   'doto    handle-doto
   '->      handle-->
   '->>     handle-->>
   'not     handle-not
   'do      handle-do
   'cond    handle-cond
   '=       (make-lazy-op '==)
   '>       (make-lazy-op '>)
   '<       (make-lazy-op '<)
   '>=      (make-lazy-op '>=)
   '<=      (make-lazy-op '<=)
   'or      (make-lazy-op '||)
   'and     (make-lazy-op '&&)
   'doseq   handle-doseq
   'instanceof handle-instanceof
   'gensym handle-gensym
   'gensym-str handle-gensym-str})
'(defn greater [a b]
  (>= a b))
'(fact
  (greater 2 1) => truthy)
'(file->tickets commits)
(defmulti ns-kw-mm identity)
(defmethod ns-kw-mm ::foo [_] :problem-cases.general/foo)
(defmethod ns-kw-mm :user/foo [_] :user/foo)
(defmethod ns-kw-mm :foo [_] :foo)
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter