Make jack-in memoize elisp payloads on disk with byte-compilation.

technomancy · technomancy · commit 31058af0c414 · 2011-08-29T20:23:06.000-07:00
diff --git a/src/leiningen/jack_in.clj b/src/leiningen/jack_in.clj
@@ -3,7 +3,8 @@
         [leiningen.swank :only [swank]])
   (:require [clojure.java.io :as io]
             [clojure.string :as string])
-  (:import (java.util.jar JarFile)))
+  (:import (java.util.jar JarFile)
+           (java.security MessageDigest)))
 
 (defn- get-manifest [file]
   (let [attrs (-> file JarFile. .getManifest .getMainAttributes)]
@@ -21,9 +22,29 @@
                 (filter #(jar-file? (.getName (:file %))))
                 (get-payloads))))
 
-(defn payloads []
+(defn hex-digest [file]
+  (format "%x" (BigInteger. 1 (.digest (MessageDigest/getInstance "SHA1")
+                                       (-> file io/resource slurp .getBytes)))))
+
+(defn loader [file]
+  (let [feature (second (re-find #".*/(.*?).el$" file))
+        checksum (subs (hex-digest file) 0 8)
+        user-file (format "%s/.emacs.d/swank/%s-%s.elc"
+                          (System/getProperty "user.home")
+                          feature checksum)]
+    (.mkdirs (.getParentFile (io/file user-file)))
+    (io/copy (io/file (.getFile (io/resource file))) (io/file user-file))
+    (with-open [w (io/writer user-file :append true)]
+      (.write w (format "\n(provide '%s-%s)\n" feature checksum)))
+    (format "(when (not (featurep '%s-%s))
+               (if (file-readable-p \"%s\")
+                 (load-file \"%s\")
+               (byte-compile-file \"%s\" t)))"
+            feature checksum user-file user-file user-file)))
+
+(defn payload-loaders []
   (for [file (elisp-payload-files)]
-    (slurp (io/resource file))))
+    (loader file)))
 
 (defn jack-in
   "Jack in to a Clojure SLIME session from Emacs.
@@ -32,6 +53,6 @@ This task is intended to be launched from Emacs using M-x clojure-jack-in,
 which is part of the clojure-mode library."
   [project port]
   (println ";;; Bootstrapping bundled version of SLIME; please wait...\n\n")
-  (println (string/join "\n" (payloads)))
+  (println (string/join "\n" (payload-loaders)))
   (println "(run-hooks 'slime-load-hook)")
   (swank project port "localhost" ":message" "\";;; proceed to jack in\""))
