1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/gen_html_docs.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,540 @@
     1.4 +;;; gen-html-docs.clj: Generate HTML documentation for Clojure libs
     1.5 +
     1.6 +;; by Craig Andera, http://pluralsight.com/craig, candera@wangdera.com
     1.7 +;; February 13th, 2009
     1.8 +
     1.9 +;; Copyright (c) Craig Andera, 2009. All rights reserved.  The use
    1.10 +;; and distribution terms for this software are covered by the Eclipse
    1.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.12 +;; which can be found in the file epl-v10.html at the root of this
    1.13 +;; distribution.  By using this software in any fashion, you are
    1.14 +;; agreeing to be bound by the terms of this license.  You must not
    1.15 +;; remove this notice, or any other, from this software.
    1.16 +
    1.17 +;; Generates a single HTML page that contains the documentation for
    1.18 +;; one or more Clojure libraries. See the comments section at the end
    1.19 +;; of this file for usage.
    1.20 +
    1.21 +;; TODO
    1.22 +;; 
    1.23 +;; * Make symbols in the source hyperlinks to the appropriate section
    1.24 +;;   of the documentation.
    1.25 +;; * Investigate issue with miglayout mentioned here: 
    1.26 +;;   http://groups.google.com/group/clojure/browse_thread/thread/5a0c4395e44f5a79/3ae483100366bd3d?lnk=gst&q=documentation+browser#3ae483100366bd3d
    1.27 +;;
    1.28 +;; DONE
    1.29 +;;
    1.30 +;; * Move to clojure.contrib
    1.31 +;;   * Change namespace
    1.32 +;;   * Change license as appropriate
    1.33 +;;   * Double-check doc strings
    1.34 +;; * Remove doc strings from source code
    1.35 +;; * Add collapse/expand functionality for all namespaces
    1.36 +;; * Add collapse/expand functionality for each namespace
    1.37 +;; * See if converting to use clojure.contrib.prxml is possible
    1.38 +;; * Figure out why the source doesn't show up for most things
    1.39 +;; * Add collapsible source
    1.40 +;; * Add links at the top to jump to each namespace
    1.41 +;; * Add object type (var, function, whatever)
    1.42 +;; * Add argument lists for functions
    1.43 +;; * Add links at the top of each namespace to jump to members
    1.44 +;; * Add license statement
    1.45 +;; * Remove the whojure dependency
    1.46 +
    1.47 +(ns 
    1.48 +  ^{:author "Craig Andera",
    1.49 +     :doc "Generates a single HTML page that contains the documentation for
    1.50 +one or more Clojure libraries."} 
    1.51 +  clojure.contrib.gen-html-docs
    1.52 +  (:require [clojure.contrib.io :as io]
    1.53 +            [clojure.contrib.string :as s])
    1.54 +  (:use [clojure.contrib repl-utils def prxml])
    1.55 +  (:import [java.lang Exception]
    1.56 +	   [java.util.regex Pattern]))
    1.57 +
    1.58 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.59 +;; Doc generation constants
    1.60 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1.61 +
    1.62 +(def *script* " // <![CDATA[
    1.63 +
    1.64 +function getElem(id)
    1.65 +{
    1.66 +  if( document.getElementById )
    1.67 +  {
    1.68 +    return document.getElementById( id )
    1.69 +  }
    1.70 +  else if ( document.all )
    1.71 +  {
    1.72 +    return eval( 'document.all.' + id )
    1.73 +  }
    1.74 +  else
    1.75 +    return false;
    1.76 +}
    1.77 +
    1.78 +function setDisplayStyle(id,displayStyle)
    1.79 +{
    1.80 +  var elem = getElem (id)
    1.81 +  if (elem)
    1.82 +  {
    1.83 +    elem.style.display = displayStyle
    1.84 +  }
    1.85 +
    1.86 +}
    1.87 +
    1.88 +function setLinkToggleText (id, text)
    1.89 +{
    1.90 + var elem = getElem (id)
    1.91 + if (elem)
    1.92 + {
    1.93 +   elem.innerHTML = text
    1.94 + }
    1.95 +}
    1.96 +
    1.97 +function collapse(id)
    1.98 +{
    1.99 +  setDisplayStyle (id, 'none')
   1.100 +}
   1.101 +
   1.102 +function expand (id)
   1.103 +{
   1.104 +  setDisplayStyle (id, 'block')
   1.105 +}
   1.106 +
   1.107 +function toggleSource( id )
   1.108 +{
   1.109 +  toggle(id, 'linkto-' + id, 'Hide Source', 'Show Source')
   1.110 +}
   1.111 +
   1.112 +function toggle(targetid, linkid, textWhenOpen, textWhenClosed)
   1.113 +{
   1.114 +  var elem = getElem (targetid)
   1.115 +  var link = getElem (linkid)
   1.116 +
   1.117 +  if (elem && link)
   1.118 +  {
   1.119 +    var isOpen = false
   1.120 +    if (elem.style.display == '')
   1.121 +    {
   1.122 +      isOpen = link.innerHTML == textWhenOpen
   1.123 +    }
   1.124 +    else if( elem.style.display == 'block' )
   1.125 +    {
   1.126 +      isOpen = true
   1.127 +    }
   1.128 +    
   1.129 +    if (isOpen)
   1.130 +    {
   1.131 +      elem.style.display = 'none'
   1.132 +      link.innerHTML = textWhenClosed
   1.133 +    }
   1.134 +    else
   1.135 +    {
   1.136 +      elem.style.display = 'block'
   1.137 +      link.innerHTML = textWhenOpen
   1.138 +    }
   1.139 +  }
   1.140 +}
   1.141 +
   1.142 +      //]]>
   1.143 +")
   1.144 +
   1.145 +(def *style* "
   1.146 +.library
   1.147 +{
   1.148 +  padding: 0.5em 0 0 0 
   1.149 +}
   1.150 +.all-libs-toggle,.library-contents-toggle
   1.151 +{
   1.152 + font-size: small;
   1.153 +}
   1.154 +.all-libs-toggle a,.library-contents-toggle a
   1.155 +{
   1.156 + color: white
   1.157 +}
   1.158 +.library-member-doc-whitespace
   1.159 +{
   1.160 + white-space: pre
   1.161 +}
   1.162 +.library-member-source-toggle
   1.163 +{
   1.164 +  font-size: small;
   1.165 +  margin-top: 0.5em
   1.166 +}
   1.167 +.library-member-source
   1.168 +{
   1.169 +  display: none;
   1.170 +  border-left: solid lightblue 
   1.171 +}
   1.172 +.library-member-docs
   1.173 +{
   1.174 +  font-family:monospace
   1.175 +}
   1.176 +.library-member-arglists
   1.177 +{
   1.178 +  font-family: monospace
   1.179 +}
   1.180 +.library-member-type
   1.181 +{
   1.182 +  font-weight: bold; 
   1.183 +  font-size: small;
   1.184 +  font-style: italic;
   1.185 +  color: darkred
   1.186 +}
   1.187 +.lib-links
   1.188 +{
   1.189 +  margin: 0 0 1em 0
   1.190 +}
   1.191 +
   1.192 +.lib-link-header
   1.193 +{
   1.194 +  color: white;
   1.195 +  background: darkgreen;
   1.196 +  width: 100%
   1.197 +}
   1.198 +
   1.199 +.library-name 
   1.200 +{ 
   1.201 +  color: white;
   1.202 +  background: darkblue;
   1.203 +  width: 100%
   1.204 +}
   1.205 +
   1.206 +.missing-library
   1.207 +{
   1.208 +  color: darkred; 
   1.209 +  margin: 0 0 1em 0 
   1.210 +}
   1.211 +
   1.212 +.library-members
   1.213 +{
   1.214 +  list-style: none
   1.215 +}
   1.216 +
   1.217 +.library-member-name
   1.218 +{
   1.219 +  font-weight: bold;
   1.220 +  font-size: 105%
   1.221 +}")
   1.222 +
   1.223 +(defn- extract-documentation 
   1.224 +  "Pulls the documentation for a var v out and turns it into HTML"
   1.225 +  [v]
   1.226 +  (if-let [docs (:doc (meta v))]
   1.227 +    (map 
   1.228 +     (fn [l] 
   1.229 +       [:div {:class "library-member-doc-line"} 
   1.230 +	(if (= 0 (count l)) 
   1.231 +	  [:span {:class "library-member-doc-whitespace"} " "] ; We need something here to make the blank line show up
   1.232 +	  l)]) 
   1.233 +     (s/split #"\n" docs)) 
   1.234 +    ""))
   1.235 +
   1.236 +(defn- member-type 
   1.237 +  "Figures out for a var x whether it's a macro, function, var or multifunction"
   1.238 +  [x]
   1.239 +  (try 
   1.240 +   (let [dx (deref x)] 
   1.241 +     (cond 
   1.242 +      (:macro (meta x)) :macro 
   1.243 +      (fn? dx) :fn 
   1.244 +      (= clojure.lang.MultiFn (:tag (meta x))) :multi 
   1.245 +      true :var))
   1.246 +   (catch Exception e
   1.247 +     :unknown)))
   1.248 +
   1.249 +(defn- anchor-for-member 
   1.250 +  "Returns a suitable HTML anchor name given a library id and a member
   1.251 +  id" 
   1.252 +  [libid memberid]
   1.253 +  (str "member-" libid "-" memberid))
   1.254 +
   1.255 +(defn- id-for-member-source 
   1.256 +  "Returns a suitable HTML id for a source listing given a library and
   1.257 +  a member"
   1.258 +  [libid memberid]
   1.259 +  (str "membersource-" libid "-" memberid))
   1.260 +
   1.261 +(defn- id-for-member-source-link 
   1.262 +  "Returns a suitable HTML id for a link to a source listing given a
   1.263 +  library and a member"
   1.264 +  [libid memberid]
   1.265 +  (str "linkto-membersource-" libid "-" memberid))
   1.266 +
   1.267 +(defn- symbol-for 
   1.268 +  "Given a namespace object ns and a namespaceless symbol memberid
   1.269 +  naming a member of that namespace, returns a namespaced symbol that
   1.270 +  identifies that member."
   1.271 +  [ns memberid]
   1.272 +  (symbol (name (ns-name ns)) (name memberid)))
   1.273 +
   1.274 +(defn- elide-to-one-line 
   1.275 +  "Elides a string down to one line."
   1.276 +  [s]
   1.277 +  (s/replace-re #"(\n.*)+" "..." s))
   1.278 +
   1.279 +(defn- elide-string 
   1.280 +  "Returns a string that is at most the first limit characters of s"
   1.281 +  [s limit]
   1.282 +  (if (< (- limit 3) (count s))
   1.283 +    (str (subs s 0 (- limit 3)) "...")
   1.284 +    s))
   1.285 +
   1.286 +(defn- doc-elided-src 
   1.287 +  "Returns the src with the docs elided."
   1.288 +  [docs src]
   1.289 +  (s/replace-re (re-pattern (str "\"" (Pattern/quote docs) "\"")) 
   1.290 +	  (str "\""
   1.291 +		  (elide-to-one-line docs)
   1.292 +;; 	          (elide-string docs 10)
   1.293 +;;	          "..."
   1.294 +		  "\"")
   1.295 +	  src))
   1.296 +
   1.297 +(defn- format-source [libid memberid v]
   1.298 +  (try
   1.299 +   (let [docs (:doc (meta v)) 
   1.300 +	 src (if-let [ns (find-ns libid)]
   1.301 +	       (get-source (symbol-for ns memberid)))]
   1.302 +     (if (and src docs)
   1.303 +       (doc-elided-src docs src)
   1.304 +       src))
   1.305 +   (catch Exception ex
   1.306 +     nil)))
   1.307 +
   1.308 +(defn- generate-lib-member [libid [n v]]
   1.309 +  [:li {:class "library-member"}
   1.310 +   [:a {:name (anchor-for-member libid n)}]
   1.311 +   [:dl {:class "library-member-table"} 
   1.312 +    [:dt {:class "library-member-name"}
   1.313 +     (str n)]
   1.314 +    [:dd 
   1.315 +     [:div {:class "library-member-info"}
   1.316 +      [:span {:class "library-member-type"} (name (member-type v))]
   1.317 +      " "
   1.318 +      [:span {:class "library-member-arglists"} (str (:arglists (meta v)))]]
   1.319 +     (into [:div {:class "library-member-docs"}] (extract-documentation v))
   1.320 +     (let [member-source-id (id-for-member-source libid n)
   1.321 +	   member-source-link-id (id-for-member-source-link libid n)]
   1.322 +       (if-let [member-source (format-source libid n v)] 
   1.323 +	 [:div {:class "library-member-source-section"}
   1.324 +	  [:div {:class "library-member-source-toggle"}
   1.325 +	   "[ "
   1.326 +	   [:a {:href (format "javascript:toggleSource('%s')" member-source-id)
   1.327 +		:id member-source-link-id} "Show Source"]
   1.328 +	   " ]"]	  
   1.329 +	  [:div {:class "library-member-source" :id member-source-id}
   1.330 +	   [:pre member-source]]]))]]])
   1.331 +
   1.332 +(defn- anchor-for-library 
   1.333 +  "Given a symbol id identifying a namespace, returns an identifier
   1.334 +suitable for use as the name attribute of an HTML anchor tag."
   1.335 +  [id]
   1.336 +  (str "library-" id))
   1.337 +
   1.338 +(defn- generate-lib-member-link 
   1.339 +  "Emits a hyperlink to a member of a namespace given libid (a symbol
   1.340 +identifying the namespace) and the vector [n v], where n is the symbol
   1.341 +naming the member in question and v is the var pointing to the
   1.342 +member." 
   1.343 +  [libid [n v]]
   1.344 +  [:a {:class "lib-member-link" 
   1.345 +       :href (str "#" (anchor-for-member libid n))} (name n)])
   1.346 +
   1.347 +(defn- anchor-for-library-contents 
   1.348 +  "Returns an HTML ID that identifies the element that holds the
   1.349 +documentation contents for the specified library."
   1.350 +  [lib]
   1.351 +  (str "library-contents-" lib))
   1.352 +
   1.353 +(defn- anchor-for-library-contents-toggle 
   1.354 +  "Returns an HTML ID that identifies the element that toggles the
   1.355 +visibility of the library contents."
   1.356 +  [lib]
   1.357 +  (str "library-contents-toggle-" lib))
   1.358 +
   1.359 +(defn- generate-lib-doc 
   1.360 +  "Emits the HTML that documents the namespace identified by the
   1.361 +symbol lib."
   1.362 +  [lib]
   1.363 +  [:div {:class "library"} 
   1.364 +   [:a {:name (anchor-for-library lib)}]
   1.365 +   [:div {:class "library-name"} 
   1.366 +    [:span {:class "library-contents-toggle"} 
   1.367 +     "[ "
   1.368 +     [:a {:id (anchor-for-library-contents-toggle lib) 
   1.369 +	  :href (format "javascript:toggle('%s', '%s', '-', '+')" 
   1.370 +			(anchor-for-library-contents lib)
   1.371 +			(anchor-for-library-contents-toggle lib))} 
   1.372 +      "-"]
   1.373 +     " ] "]
   1.374 +    (name lib)]
   1.375 +   (let [ns (find-ns lib)]
   1.376 +     (if ns 
   1.377 +       (let [lib-members (sort (ns-publics ns))]
   1.378 +	 [:a {:name (anchor-for-library lib)}]
   1.379 +	 [:div {:class "library-contents" :id (anchor-for-library-contents lib)}
   1.380 +	  (into [:div {:class "library-member-links"}]
   1.381 +		(interpose " " (map #(generate-lib-member-link lib %) lib-members)))
   1.382 +	  (into [:ol {:class "library-members"}]
   1.383 +		(map #(generate-lib-member lib %) lib-members))])
   1.384 +       [:div {:class "missing-library library-contents" :id (anchor-for-library-contents lib)} "Could not load library"]))])
   1.385 +
   1.386 +(defn- load-lib 
   1.387 +  "Calls require on the library identified by lib, eating any
   1.388 +exceptions."
   1.389 +  [lib]
   1.390 +  (try 
   1.391 +   (require lib)
   1.392 +   (catch java.lang.Exception x
   1.393 +       nil)))
   1.394 +
   1.395 +(defn- generate-lib-link 
   1.396 +  "Generates a hyperlink to the documentation for a namespace given
   1.397 +lib, a symbol identifying that namespace."
   1.398 +  [lib]
   1.399 +  (let [ns (find-ns lib)]
   1.400 +    (if ns
   1.401 +      [:a {:class "lib-link" :href (str "#" (anchor-for-library lib))} (str (ns-name ns))])))
   1.402 +
   1.403 +(defn- generate-lib-links 
   1.404 +  "Generates the list of hyperlinks to each namespace, given libs, a
   1.405 +vector of symbols naming namespaces."
   1.406 +  [libs]
   1.407 +  (into [:div {:class "lib-links"} 
   1.408 +	 [:div {:class "lib-link-header"} "Namespaces"
   1.409 +	  [:span {:class "all-libs-toggle"} 
   1.410 +	   " [ "
   1.411 +	   [:a {:href "javascript:expandAllNamespaces()"}
   1.412 +	    "Expand All"]
   1.413 +	   " ] [ "
   1.414 +	   [:a {:href "javascript:collapseAllNamespaces()"}
   1.415 +	    "Collapse All"]
   1.416 +	   " ]"]]] 
   1.417 +	(interpose " " (map generate-lib-link libs))))
   1.418 +
   1.419 +(defn generate-toggle-namespace-script 
   1.420 +  [action toggle-text lib]
   1.421 +  (str (format "%s('%s');\n" action (anchor-for-library-contents lib))
   1.422 +       (format "setLinkToggleText('%s', '%s');\n" (anchor-for-library-contents-toggle lib) toggle-text)))
   1.423 +
   1.424 +(defn generate-all-namespaces-action-script 
   1.425 +  [action toggle-text libs]
   1.426 +  (str (format  "function %sAllNamespaces()" action)
   1.427 +       \newline
   1.428 +       "{"
   1.429 +       \newline
   1.430 +       (reduce str (map #(generate-toggle-namespace-script action toggle-text %) libs))
   1.431 +       \newline
   1.432 +       "}"))
   1.433 +
   1.434 +(defn generate-documentation 
   1.435 +  "Returns a string which is the HTML documentation for the libraries
   1.436 +named by libs. Libs is a vector of symbols identifying Clojure
   1.437 +libraries."
   1.438 +  [libs]
   1.439 +  (dorun (map load-lib libs))
   1.440 +  (let [writer (new java.io.StringWriter)]
   1.441 +   (binding [*out* writer] 
   1.442 +     (prxml 
   1.443 +      [:html {:xmlns "http://www.w3.org/1999/xhtml"}
   1.444 +       [:head 
   1.445 +	[:title "Clojure documentation browser"]
   1.446 +	[:style *style*]
   1.447 +	[:script {:language "JavaScript" :type "text/javascript"} [:raw! *script*]]
   1.448 +	
   1.449 +	[:script {:language "JavaScript" :type "text/javascript"}
   1.450 +	 [:raw! "// <![CDATA[!" \newline]
   1.451 +	 (generate-all-namespaces-action-script "expand" "-" libs)
   1.452 +	 (generate-all-namespaces-action-script "collapse" "+" libs)
   1.453 +	 [:raw! \newline "// ]]>"]]]
   1.454 +       (let [lib-vec (sort libs)] 
   1.455 +	 (into [:body (generate-lib-links lib-vec)]
   1.456 +	       (map generate-lib-doc lib-vec)))]))
   1.457 +   (.toString writer)))
   1.458 +
   1.459 +
   1.460 +(defn generate-documentation-to-file 
   1.461 +  "Calls generate-documentation on the libraries named by libs and
   1.462 +emits the generated HTML to the path named by path."
   1.463 +  [path libs]
   1.464 +  (io/spit path (generate-documentation libs)))
   1.465 +
   1.466 +(comment 
   1.467 +  (generate-documentation-to-file 
   1.468 +   "C:/TEMP/CLJ-DOCS.HTML"
   1.469 +   ['clojure.contrib.accumulators])
   1.470 +
   1.471 +  (defn gen-all-docs [] 
   1.472 +    (generate-documentation-to-file 
   1.473 +     "C:/temp/clj-libs.html"
   1.474 +     [
   1.475 +     'clojure.set
   1.476 +     'clojure.main 
   1.477 +     'clojure.core  
   1.478 +     'clojure.zip   
   1.479 +     'clojure.xml
   1.480 +     'clojure.contrib.accumulators
   1.481 +     'clojure.contrib.apply-macro
   1.482 +     'clojure.contrib.auto-agent
   1.483 +     'clojure.contrib.combinatorics
   1.484 +     'clojure.contrib.command-line
   1.485 +     'clojure.contrib.complex-numbers
   1.486 +     'clojure.contrib.cond
   1.487 +     'clojure.contrib.def
   1.488 +     'clojure.contrib.io
   1.489 +     'clojure.contrib.enum
   1.490 +     'clojure.contrib.error-kit
   1.491 +     'clojure.contrib.except
   1.492 +     'clojure.contrib.fcase
   1.493 +     'clojure.contrib.generic
   1.494 +     'clojure.contrib.generic.arithmetic
   1.495 +     'clojure.contrib.generic.collection
   1.496 +     'clojure.contrib.generic.comparison
   1.497 +     'clojure.contrib.generic.functor
   1.498 +     'clojure.contrib.generic.math-functions
   1.499 +     'clojure.contrib.import-static
   1.500 +     'clojure.contrib.javadoc
   1.501 +     'clojure.contrib.javalog
   1.502 +     'clojure.contrib.lazy-seqs
   1.503 +     'clojure.contrib.lazy-xml
   1.504 +     'clojure.contrib.macro-utils
   1.505 +     'clojure.contrib.macros
   1.506 +     'clojure.contrib.math
   1.507 +     'clojure.contrib.miglayout
   1.508 +     'clojure.contrib.mmap
   1.509 +     'clojure.contrib.monads
   1.510 +     'clojure.contrib.ns-utils
   1.511 +     'clojure.contrib.prxml
   1.512 +     'clojure.contrib.repl-ln
   1.513 +     'clojure.contrib.repl-utils
   1.514 +     'clojure.contrib.seq
   1.515 +     'clojure.contrib.server-socket
   1.516 +     'clojure.contrib.shell
   1.517 +     'clojure.contrib.sql
   1.518 +     'clojure.contrib.stream-utils
   1.519 +     'clojure.contrib.string
   1.520 +     'clojure.contrib.test-contrib
   1.521 +     'clojure.contrib.trace
   1.522 +     'clojure.contrib.types
   1.523 +     'clojure.contrib.zip-filter
   1.524 +     'clojure.contrib.javadoc.browse
   1.525 +     'clojure.contrib.json.read
   1.526 +     'clojure.contrib.json.write
   1.527 +     'clojure.contrib.lazy-xml.with-pull
   1.528 +     'clojure.contrib.miglayout.internal
   1.529 +     'clojure.contrib.probabilities.finite-distributions
   1.530 +     'clojure.contrib.probabilities.monte-carlo
   1.531 +     'clojure.contrib.probabilities.random-numbers
   1.532 +     'clojure.contrib.sql.internal
   1.533 +     'clojure.contrib.test-clojure.evaluation
   1.534 +     'clojure.contrib.test-clojure.for
   1.535 +     'clojure.contrib.test-clojure.numbers
   1.536 +     'clojure.contrib.test-clojure.printer
   1.537 +     'clojure.contrib.test-clojure.reader
   1.538 +     'clojure.contrib.test-clojure.sequences
   1.539 +     'clojure.contrib.test-contrib.shell
   1.540 +     'clojure.contrib.test-contrib.string
   1.541 +     'clojure.contrib.zip-filter.xml
   1.542 +     ]))
   1.543 +  )