;;; gen-html-docs.clj: Generate HTML documentation for Clojure libs

 

 ;; by Craig Andera, http://pluralsight.com/craig, candera@wangdera.com

 ;; February 13th, 2009

 

 ;; Copyright (c) Craig Andera, 2009. All rights reserved.  The use

 ;; and distribution terms for this software are covered by the Eclipse

 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

 ;; which can be found in the file epl-v10.html at the root of this

 ;; distribution.  By using this software in any fashion, you are

 ;; agreeing to be bound by the terms of this license.  You must not

 ;; remove this notice, or any other, from this software.

 

 ;; Generates a single HTML page that contains the documentation for

 ;; one or more Clojure libraries. See the comments section at the end

 ;; of this file for usage.

 

 ;; TODO

 ;; 

 ;; * Make symbols in the source hyperlinks to the appropriate section

 ;;   of the documentation.

 ;; * Investigate issue with miglayout mentioned here: 

 ;;   http://groups.google.com/group/clojure/browse_thread/thread/5a0c4395e44f5a79/3ae483100366bd3d?lnk=gst&q=documentation+browser#3ae483100366bd3d

 ;;

 ;; DONE

 ;;

 ;; * Move to clojure.contrib

 ;;   * Change namespace

 ;;   * Change license as appropriate

 ;;   * Double-check doc strings

 ;; * Remove doc strings from source code

 ;; * Add collapse/expand functionality for all namespaces

 ;; * Add collapse/expand functionality for each namespace

 ;; * See if converting to use clojure.contrib.prxml is possible

 ;; * Figure out why the source doesn't show up for most things

 ;; * Add collapsible source

 ;; * Add links at the top to jump to each namespace

 ;; * Add object type (var, function, whatever)

 ;; * Add argument lists for functions

 ;; * Add links at the top of each namespace to jump to members

 ;; * Add license statement

 ;; * Remove the whojure dependency

 

 (ns 

   ^{:author "Craig Andera",

      :doc "Generates a single HTML page that contains the documentation for

 one or more Clojure libraries."} 

   clojure.contrib.gen-html-docs

   (:require [clojure.contrib.io :as io]

             [clojure.contrib.string :as s])

   (:use [clojure.contrib repl-utils def prxml])

   (:import [java.lang Exception]

 	   [java.util.regex Pattern]))

 

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; Doc generation constants

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

 (def *script* " // <![CDATA[

 

 function getElem(id)

 {

   if( document.getElementById )

   {

     return document.getElementById( id )

   }

   else if ( document.all )

   {

     return eval( 'document.all.' + id )

   }

   else

     return false;

 }

 

 function setDisplayStyle(id,displayStyle)

 {

   var elem = getElem (id)

   if (elem)

   {

     elem.style.display = displayStyle

   }

 

 }

 

 function setLinkToggleText (id, text)

 {

  var elem = getElem (id)

  if (elem)

  {

    elem.innerHTML = text

  }

 }

 

 function collapse(id)

 {

   setDisplayStyle (id, 'none')

 }

 

 function expand (id)

 {

   setDisplayStyle (id, 'block')

 }

 

 function toggleSource( id )

 {

   toggle(id, 'linkto-' + id, 'Hide Source', 'Show Source')

 }

 

 function toggle(targetid, linkid, textWhenOpen, textWhenClosed)

 {

   var elem = getElem (targetid)

   var link = getElem (linkid)

 

   if (elem && link)

   {

     var isOpen = false

     if (elem.style.display == '')

     {

       isOpen = link.innerHTML == textWhenOpen

     }

     else if( elem.style.display == 'block' )

     {

       isOpen = true

     }

     

     if (isOpen)

     {

       elem.style.display = 'none'

       link.innerHTML = textWhenClosed

     }

     else

     {

       elem.style.display = 'block'

       link.innerHTML = textWhenOpen

     }

   }

 }

 

       //]]>

 ")

 

 (def *style* "

 .library

 {

   padding: 0.5em 0 0 0 

 }

 .all-libs-toggle,.library-contents-toggle

 {

  font-size: small;

 }

 .all-libs-toggle a,.library-contents-toggle a

 {

  color: white

 }

 .library-member-doc-whitespace

 {

  white-space: pre

 }

 .library-member-source-toggle

 {

   font-size: small;

   margin-top: 0.5em

 }

 .library-member-source

 {

   display: none;

   border-left: solid lightblue 

 }

 .library-member-docs

 {

   font-family:monospace

 }

 .library-member-arglists

 {

   font-family: monospace

 }

 .library-member-type

 {

   font-weight: bold; 

   font-size: small;

   font-style: italic;

   color: darkred

 }

 .lib-links

 {

   margin: 0 0 1em 0

 }

 

 .lib-link-header

 {

   color: white;

   background: darkgreen;

   width: 100%

 }

 

 .library-name 

 { 

   color: white;

   background: darkblue;

   width: 100%

 }

 

 .missing-library

 {

   color: darkred; 

   margin: 0 0 1em 0 

 }

 

 .library-members

 {

   list-style: none

 }

 

 .library-member-name

 {

   font-weight: bold;

   font-size: 105%

 }")

 

 (defn- extract-documentation 

   "Pulls the documentation for a var v out and turns it into HTML"

   [v]

   (if-let [docs (:doc (meta v))]

     (map 

      (fn [l] 

        [:div {:class "library-member-doc-line"} 

 	(if (= 0 (count l)) 

 	  [:span {:class "library-member-doc-whitespace"} " "] ; We need something here to make the blank line show up

 	  l)]) 

      (s/split #"\n" docs)) 

     ""))

 

 (defn- member-type 

   "Figures out for a var x whether it's a macro, function, var or multifunction"

   [x]

   (try 

    (let [dx (deref x)] 

      (cond 

       (:macro (meta x)) :macro 

       (fn? dx) :fn 

       (= clojure.lang.MultiFn (:tag (meta x))) :multi 

       true :var))

    (catch Exception e

      :unknown)))

 

 (defn- anchor-for-member 

   "Returns a suitable HTML anchor name given a library id and a member

   id" 

   [libid memberid]

   (str "member-" libid "-" memberid))

 

 (defn- id-for-member-source 

   "Returns a suitable HTML id for a source listing given a library and

   a member"

   [libid memberid]

   (str "membersource-" libid "-" memberid))

 

 (defn- id-for-member-source-link 

   "Returns a suitable HTML id for a link to a source listing given a

   library and a member"

   [libid memberid]

   (str "linkto-membersource-" libid "-" memberid))

 

 (defn- symbol-for 

   "Given a namespace object ns and a namespaceless symbol memberid

   naming a member of that namespace, returns a namespaced symbol that

   identifies that member."

   [ns memberid]

   (symbol (name (ns-name ns)) (name memberid)))

 

 (defn- elide-to-one-line 

   "Elides a string down to one line."

   [s]

   (s/replace-re #"(\n.*)+" "..." s))

 

 (defn- elide-string 

   "Returns a string that is at most the first limit characters of s"

   [s limit]

   (if (< (- limit 3) (count s))

     (str (subs s 0 (- limit 3)) "...")

     s))

 

 (defn- doc-elided-src 

   "Returns the src with the docs elided."

   [docs src]

   (s/replace-re (re-pattern (str "\"" (Pattern/quote docs) "\"")) 

 	  (str "\""

 		  (elide-to-one-line docs)

 ;; 	          (elide-string docs 10)

 ;;	          "..."

 		  "\"")

 	  src))

 

 (defn- format-source [libid memberid v]

   (try

    (let [docs (:doc (meta v)) 

 	 src (if-let [ns (find-ns libid)]

 	       (get-source (symbol-for ns memberid)))]

      (if (and src docs)

        (doc-elided-src docs src)

        src))

    (catch Exception ex

      nil)))

 

 (defn- generate-lib-member [libid [n v]]

   [:li {:class "library-member"}

    [:a {:name (anchor-for-member libid n)}]

    [:dl {:class "library-member-table"} 

     [:dt {:class "library-member-name"}

      (str n)]

     [:dd 

      [:div {:class "library-member-info"}

       [:span {:class "library-member-type"} (name (member-type v))]

       " "

       [:span {:class "library-member-arglists"} (str (:arglists (meta v)))]]

      (into [:div {:class "library-member-docs"}] (extract-documentation v))

      (let [member-source-id (id-for-member-source libid n)

 	   member-source-link-id (id-for-member-source-link libid n)]

        (if-let [member-source (format-source libid n v)] 

 	 [:div {:class "library-member-source-section"}

 	  [:div {:class "library-member-source-toggle"}

 	   "[ "

 	   [:a {:href (format "javascript:toggleSource('%s')" member-source-id)

 		:id member-source-link-id} "Show Source"]

 	   " ]"]	  

 	  [:div {:class "library-member-source" :id member-source-id}

 	   [:pre member-source]]]))]]])

 

 (defn- anchor-for-library 

   "Given a symbol id identifying a namespace, returns an identifier

 suitable for use as the name attribute of an HTML anchor tag."

   [id]

   (str "library-" id))

 

 (defn- generate-lib-member-link 

   "Emits a hyperlink to a member of a namespace given libid (a symbol

 identifying the namespace) and the vector [n v], where n is the symbol

 naming the member in question and v is the var pointing to the

 member." 

   [libid [n v]]

   [:a {:class "lib-member-link" 

        :href (str "#" (anchor-for-member libid n))} (name n)])

 

 (defn- anchor-for-library-contents 

   "Returns an HTML ID that identifies the element that holds the

 documentation contents for the specified library."

   [lib]

   (str "library-contents-" lib))

 

 (defn- anchor-for-library-contents-toggle 

   "Returns an HTML ID that identifies the element that toggles the

 visibility of the library contents."

   [lib]

   (str "library-contents-toggle-" lib))

 

 (defn- generate-lib-doc 

   "Emits the HTML that documents the namespace identified by the

 symbol lib."

   [lib]

   [:div {:class "library"} 

    [:a {:name (anchor-for-library lib)}]

    [:div {:class "library-name"} 

     [:span {:class "library-contents-toggle"} 

      "[ "

      [:a {:id (anchor-for-library-contents-toggle lib) 

 	  :href (format "javascript:toggle('%s', '%s', '-', '+')" 

 			(anchor-for-library-contents lib)

 			(anchor-for-library-contents-toggle lib))} 

       "-"]

      " ] "]

     (name lib)]

    (let [ns (find-ns lib)]

      (if ns 

        (let [lib-members (sort (ns-publics ns))]

 	 [:a {:name (anchor-for-library lib)}]

 	 [:div {:class "library-contents" :id (anchor-for-library-contents lib)}

 	  (into [:div {:class "library-member-links"}]

 		(interpose " " (map #(generate-lib-member-link lib %) lib-members)))

 	  (into [:ol {:class "library-members"}]

 		(map #(generate-lib-member lib %) lib-members))])

        [:div {:class "missing-library library-contents" :id (anchor-for-library-contents lib)} "Could not load library"]))])

 

 (defn- load-lib 

   "Calls require on the library identified by lib, eating any

 exceptions."

   [lib]

   (try 

    (require lib)

    (catch java.lang.Exception x

        nil)))

 

 (defn- generate-lib-link 

   "Generates a hyperlink to the documentation for a namespace given

 lib, a symbol identifying that namespace."

   [lib]

   (let [ns (find-ns lib)]

     (if ns

       [:a {:class "lib-link" :href (str "#" (anchor-for-library lib))} (str (ns-name ns))])))

 

 (defn- generate-lib-links 

   "Generates the list of hyperlinks to each namespace, given libs, a

 vector of symbols naming namespaces."

   [libs]

   (into [:div {:class "lib-links"} 

 	 [:div {:class "lib-link-header"} "Namespaces"

 	  [:span {:class "all-libs-toggle"} 

 	   " [ "

 	   [:a {:href "javascript:expandAllNamespaces()"}

 	    "Expand All"]

 	   " ] [ "

 	   [:a {:href "javascript:collapseAllNamespaces()"}

 	    "Collapse All"]

 	   " ]"]]] 

 	(interpose " " (map generate-lib-link libs))))

 

 (defn generate-toggle-namespace-script 

   [action toggle-text lib]

   (str (format "%s('%s');\n" action (anchor-for-library-contents lib))

        (format "setLinkToggleText('%s', '%s');\n" (anchor-for-library-contents-toggle lib) toggle-text)))

 

 (defn generate-all-namespaces-action-script 

   [action toggle-text libs]

   (str (format  "function %sAllNamespaces()" action)

        \newline

        "{"

        \newline

        (reduce str (map #(generate-toggle-namespace-script action toggle-text %) libs))

        \newline

        "}"))

 

 (defn generate-documentation 

   "Returns a string which is the HTML documentation for the libraries

 named by libs. Libs is a vector of symbols identifying Clojure

 libraries."

   [libs]

   (dorun (map load-lib libs))

   (let [writer (new java.io.StringWriter)]

    (binding [*out* writer] 

      (prxml 

       [:html {:xmlns "http://www.w3.org/1999/xhtml"}

        [:head 

 	[:title "Clojure documentation browser"]

 	[:style *style*]

 	[:script {:language "JavaScript" :type "text/javascript"} [:raw! *script*]]

 	

 	[:script {:language "JavaScript" :type "text/javascript"}

 	 [:raw! "// <![CDATA[!" \newline]

 	 (generate-all-namespaces-action-script "expand" "-" libs)

 	 (generate-all-namespaces-action-script "collapse" "+" libs)

 	 [:raw! \newline "// ]]>"]]]

        (let [lib-vec (sort libs)] 

 	 (into [:body (generate-lib-links lib-vec)]

 	       (map generate-lib-doc lib-vec)))]))

    (.toString writer)))

 

 

 (defn generate-documentation-to-file 

   "Calls generate-documentation on the libraries named by libs and

 emits the generated HTML to the path named by path."

   [path libs]

   (io/spit path (generate-documentation libs)))

 

 (comment 

   (generate-documentation-to-file 

    "C:/TEMP/CLJ-DOCS.HTML"

    ['clojure.contrib.accumulators])

 

   (defn gen-all-docs [] 

     (generate-documentation-to-file 

      "C:/temp/clj-libs.html"

      [

      'clojure.set

      'clojure.main 

      'clojure.core  

      'clojure.zip   

      'clojure.xml

      'clojure.contrib.accumulators

      'clojure.contrib.apply-macro

      'clojure.contrib.auto-agent

      'clojure.contrib.combinatorics

      'clojure.contrib.command-line

      'clojure.contrib.complex-numbers

      'clojure.contrib.cond

      'clojure.contrib.def

      'clojure.contrib.io

      'clojure.contrib.enum

      'clojure.contrib.error-kit

      'clojure.contrib.except

      'clojure.contrib.fcase

      'clojure.contrib.generic

      'clojure.contrib.generic.arithmetic

      'clojure.contrib.generic.collection

      'clojure.contrib.generic.comparison

      'clojure.contrib.generic.functor

      'clojure.contrib.generic.math-functions

      'clojure.contrib.import-static

      'clojure.contrib.javadoc

      'clojure.contrib.javalog

      'clojure.contrib.lazy-seqs

      'clojure.contrib.lazy-xml

      'clojure.contrib.macro-utils

      'clojure.contrib.macros

      'clojure.contrib.math

      'clojure.contrib.miglayout

      'clojure.contrib.mmap

      'clojure.contrib.monads

      'clojure.contrib.ns-utils

      'clojure.contrib.prxml

      'clojure.contrib.repl-ln

      'clojure.contrib.repl-utils

      'clojure.contrib.seq

      'clojure.contrib.server-socket

      'clojure.contrib.shell

      'clojure.contrib.sql

      'clojure.contrib.stream-utils

      'clojure.contrib.string

      'clojure.contrib.test-contrib

      'clojure.contrib.trace

      'clojure.contrib.types

      'clojure.contrib.zip-filter

      'clojure.contrib.javadoc.browse

      'clojure.contrib.json.read

      'clojure.contrib.json.write

      'clojure.contrib.lazy-xml.with-pull

      'clojure.contrib.miglayout.internal

      'clojure.contrib.probabilities.finite-distributions

      'clojure.contrib.probabilities.monte-carlo

      'clojure.contrib.probabilities.random-numbers

      'clojure.contrib.sql.internal

      'clojure.contrib.test-clojure.evaluation

      'clojure.contrib.test-clojure.for

      'clojure.contrib.test-clojure.numbers

      'clojure.contrib.test-clojure.printer

      'clojure.contrib.test-clojure.reader

      'clojure.contrib.test-clojure.sequences

      'clojure.contrib.test-contrib.shell

      'clojure.contrib.test-contrib.string

      'clojure.contrib.zip-filter.xml

      ]))

   )