More changes to correctly generate source links

Author: tomfaulhaber

params/clojure-contrib/params.clj

@@ -5,7 +5,7 @@
   {:name "clojure-contrib",
    :file-prefix file-prefix,
    :root root,
-   :web-src-dir "http://github.com/clojure/clojure-contrib/blob/",
+   :web-src-dir "https://github.com/clojure/clojure-contrib/blob/",
 
    :web-home "http://clojure.github.com/clojure-contrib/",
    :output-path (str file-prefix "/autodoc/"),
@@ -34,7 +34,7 @@
                :version "v1.1"
                :status "stable"
                :params {:built-clojure-jar "/home/tom/src/clj/clojure/clojure-slim.jar"
-                        :load-classpath [(str root "/classes")]}}
+                        :load-classpath [(str root "/src") (str root "/classes")]}}
               ]
 
    :load-except-list 
@@ -48,6 +48,7 @@
     #"/javadoc"
     #"/jmx/Bean"
     #"/test/clojure/clojure/contrib/"
+    #"/src/main/clojure/clojure/contrib/test_base64"
     #"/target/classes/"
     #"/target/test-classes/"
     ],

src/autodoc/branches.clj

@@ -3,7 +3,7 @@
         [clojure.java.shell :only [with-sh-dir sh]]
         [clojure.pprint :only [cl-format pprint]]
         [clojure.contrib.str-utils :only (re-split)]
-        [autodoc.params :only (params)]
+        [autodoc.params :only (params expand-classpath)]
         [autodoc.build-html :only (branch-subdir)]
         [autodoc.doc-files :only (xform-tree)])
 
@@ -28,14 +28,6 @@
     (system (str "git checkout " branch))
     (system (str "git merge origin/" branch))))
 
-(defn expand-wildcards 
-  "Find all the files under root that match re. Not truly wildcard expansion, but..."
-  [root re]
-  (if (instance? java.util.regex.Pattern re)
-    (for [f (file-seq (File. root)) :when (re-find re (.getAbsolutePath f))] 
-      (.getAbsolutePath f))
-    (list re)))
-
 (defn path-str [path-seq] 
   (apply str (interpose (System/getProperty "path.separator")
                         (map #(.getAbsolutePath (file %)) path-seq))))
@@ -63,7 +55,7 @@
                       "src"
                       (.getPath (File. (params :root) (params :source-path)))
                       "."])
-                    (mapcat (partial expand-wildcards (params :root)) (params :load-classpath))
+                    (expand-classpath branch-name (params :root) (params :load-classpath))
                     (expand-jar-path (params :load-jar-dirs)))
         tmp-file (File/createTempFile "collect-" ".clj")]
     (exec-clojure class-path 

src/autodoc/build_html.clj

@@ -5,12 +5,12 @@
   (:require [clojure.string :as str]
             [clojure.contrib.str-utils :as cc-str])
   (:use [net.cgrand.enlive-html :exclude (deftemplate)]
-        [clojure.java.io :only (file writer)]
+        [clojure.java.io :only (as-file file writer)]
         [clojure.java.shell :only (sh)]
         [clojure.pprint :only (pprint cl-format)]
         [clojure.contrib.json :only (pprint-json)]
         [autodoc.collect-info :only (contrib-info)]
-        [autodoc.params :only (params)]))
+        [autodoc.params :only (params expand-classpath)]))
 
 (def *layout-file* "layout.html")
 (def *master-toc-file* "master-toc.html")
@@ -297,17 +297,36 @@ actually changed). This reduces the amount of random doc file changes that happe
      (memoize 
       (fn [] (.getAbsolutePath (file ".")))))
 
+(def expand-src-file 
+     (memoize
+      (fn [f branch] 
+        (let [fl (as-file f)]
+          (if (.isAbsolute fl)
+            f
+            (if-let [result (first 
+                             (filter #(.exists %)
+                                     (map #(File. % f)
+                                          (expand-classpath 
+                                           branch
+                                           (params :root) 
+                                           (params :load-classpath)))))]
+              (.getAbsolutePath result)
+              (do 
+                (cl-format *err* "No absolute path for file metadata ~a~%" f)
+                nil)))))))
+
 (defn var-base-file
   "strip off the prepended path to the source directory from the filename"
-  [f]
-  (cond
-   (.startsWith f (params :root)) (.substring f (inc (src-prefix-length)))
-   (.startsWith f (memoized-working-directory)) (.substring f (inc (.length (memoized-working-directory))))
-   true (.getPath (file (params :source-path) f))))
+  [f branch]
+  (let [f (or (expand-src-file f branch) f)]
+    (cond
+     (.startsWith f (params :root)) (.substring f (inc (src-prefix-length)))
+     (.startsWith f (memoized-working-directory)) (.substring f (inc (.length (memoized-working-directory))))
+     true (.getPath (file (params :source-path) f)))))
 
 (defn var-src-link [v branch]
   (when (and (:file v) (:line v))
-    (when-let [web-file (web-src-file (var-base-file (:file v)) branch)]
+    (when-let [web-file (web-src-file (var-base-file (:file v) branch) branch)]
       (cl-format nil "~a#L~d" web-file (:line v)))))
 
 ;;; TODO: factor out var from namespace and sub-namespace into a separate template.
@@ -465,7 +484,7 @@ vars in ns-info that begin with that letter"
     :wiki-url (str (params :web-home) "/" (var-url ns v))
     :source-url (var-src-link v branch)
     :raw-source-url (when (:file v)
-                      (web-raw-src-file (var-base-file (:file v)) branch))))
+                      (web-raw-src-file (var-base-file (:file v) branch) branch))))
 
 (defn structured-index 
   "Create a structured index of all the reference information about contrib"

src/autodoc/params.clj

@@ -1,4 +1,5 @@
-(ns autodoc.params)
+(ns autodoc.params
+  (import [java.io File]))
 
 ;;; 
 ;;; Description and default values for settable parameters. These are overridden in the
@@ -102,3 +103,22 @@
   [args]
   (let [[params args] (consume extract-arg args)]
     [(into {} (for [[p v] params] [p (convert-arg p v)])) (into [] args)]))
+
+(defn expand-wildcards 
+  "Find all the files under root that match re. Not truly wildcard expansion, but..."
+  [root re]
+  (if (instance? java.util.regex.Pattern re)
+    (for [f (file-seq (File. root)) :when (re-find re (.getAbsolutePath f))] 
+      (.getAbsolutePath f))
+    (list re)))
+
+;;; Expand any regexp patterns in the classpath to the set of 
+;;; available files. This function is memoized so the filesystem work will 
+;;; only be done of the first call. The classpath is expanded relative to 
+;;; the argument root, branch is included to force the memoization to a
+;;; single branch
+
+(def expand-classpath
+     (memoize
+      (fn [branch root cp]
+        (mapcat (partial expand-wildcards root) cp))))