├── Step1.png ├── Step2.png ├── Step3.png ├── Excel-REPL.v12.suo ├── Spreadsheet Snapshot.png ├── Excel-REPL ├── nrepl │ ├── clojure │ │ ├── tools │ │ │ ├── nrepl │ │ │ │ ├── server.clj │ │ │ │ ├── debug.clj │ │ │ │ ├── middleware │ │ │ │ │ ├── pr_values.clj │ │ │ │ │ ├── load_file.clj │ │ │ │ │ ├── interruptible_eval.clj │ │ │ │ │ └── session.clj │ │ │ │ ├── ack.clj │ │ │ │ ├── misc.clj │ │ │ │ ├── sync_channel.clj │ │ │ │ ├── middleware.clj │ │ │ │ ├── transport.clj │ │ │ │ └── bencode.clj │ │ │ └── nrepl.clj │ │ └── data │ │ │ ├── drawbridge_client.clj │ │ │ └── json.clj │ ├── excel_repl │ │ ├── util.clj │ │ ├── formatting.clj │ │ ├── schedule_udf.clj │ │ ├── coerce_db.clj │ │ ├── interop.clj │ │ └── udf.clj │ └── clr_http │ │ └── lite │ │ ├── util.clj │ │ ├── core.clj │ │ ├── cookies.clj │ │ └── client.clj ├── SampleClipboard.txt ├── Excel-REPL.csproj.user ├── packages.config ├── Excel-REPL-AddIn.dna ├── Python.cs ├── DB.cs ├── Class1.cs ├── excel-repl.clj ├── Excel-REPL.csproj └── MainClass.cs ├── Install Instructions.txt ├── default dependencies.txt ├── Excel-REPL.sln └── readme.md /Step1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/whamtet/Excel-REPL/HEAD/Step1.png -------------------------------------------------------------------------------- /Step2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/whamtet/Excel-REPL/HEAD/Step2.png -------------------------------------------------------------------------------- /Step3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/whamtet/Excel-REPL/HEAD/Step3.png -------------------------------------------------------------------------------- /Excel-REPL.v12.suo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/whamtet/Excel-REPL/HEAD/Excel-REPL.v12.suo -------------------------------------------------------------------------------- /Spreadsheet Snapshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/whamtet/Excel-REPL/HEAD/Spreadsheet Snapshot.png -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/server.clj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/whamtet/Excel-REPL/HEAD/Excel-REPL/nrepl/clojure/tools/nrepl/server.clj -------------------------------------------------------------------------------- /Excel-REPL/nrepl/excel_repl/util.clj: -------------------------------------------------------------------------------- 1 | (ns excel-repl.util) 2 | (import System.Windows.Forms.Clipboard) 3 | 4 | (defn comma-interpose [s] (apply str (interpose ", " s))) 5 | (defn line-interpose [s] (apply str (interpose "\r\n" s))) 6 | 7 | (defn to-clipboard [s] 8 | (Clipboard/SetText s)) 9 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/excel_repl/formatting.clj: -------------------------------------------------------------------------------- 1 | (ns excel-repl.formatting) 2 | 3 | (import ClojureExcel.MainClass) 4 | (import System.Windows.Forms.MessageBox) 5 | 6 | (defn f [x] 7 | ;(future 8 | (MyRibbon/SetOutput (map #(.ToUpper %) x))) 9 | ;) 10 | 11 | (set! MainClass/format_code f) 12 | -------------------------------------------------------------------------------- /Excel-REPL/SampleClipboard.txt: -------------------------------------------------------------------------------- 1 | Version:0.9 2 | StartHTML:0000000213 3 | EndHTML:0000002410 4 | StartFragment:0000000249 5 | EndFragment:0000002374 6 | SourceURL:http://excel-repl.net 7 | 8 | 9 | {0} 10 | 11 | 12 | {1} 13 | 14 | -------------------------------------------------------------------------------- /Install Instructions.txt: -------------------------------------------------------------------------------- 1 | MANUAL INSTALLATION 2 | 3 | If you lack administrator privileges for the automatic installer, you can still install Excel-REPL manually. Copy the contents of Debug into 4 | 5 | C:\Users\USER\AppData\Roaming\Microsoft\AddIns 6 | 7 | where USER is your home folder. 8 | 9 | Next open Microsoft Excel and select Options, AddIns. Add Excel-REPL and it will auto-load every time in the future. 10 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/debug.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.nrepl.debug) 2 | 3 | (def ^{:private true} pr-agent (agent *out*)) 4 | 5 | (defn- write-out [out & args] 6 | (binding [*out* out] 7 | (pr "Thd " (-> System.Threading.Thread/CurrentThread (.ManagedThreadId)) ": ") 8 | (apply prn args) 9 | out)) 10 | 11 | (defn prn-thread [& args] 12 | (send pr-agent write-out args)) 13 | 14 | 15 | -------------------------------------------------------------------------------- /Excel-REPL/Excel-REPL.csproj.user: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | ShowAllFiles 5 | 6 | 7 | Program 8 | C:\Program Files\Microsoft Office\root\Office16\EXCEL.EXE 9 | "Z:\Downloads\Excel-REPL\Excel-REPL\bin\Debug\Excel-REPL-AddIn.xll" 10 | 11 | -------------------------------------------------------------------------------- /Excel-REPL/packages.config: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/excel_repl/schedule_udf.clj: -------------------------------------------------------------------------------- 1 | (ns excel-repl.schedule-udf) 2 | 3 | ;;ok, two strategies 4 | ;;for ns we will concatenate a list of namespaces to compile 5 | ;;ExportUDFS will invoke a fixed function that compiles them 6 | 7 | ;;for in-macro-context we shall concatenate a list of fuctions to execute 8 | ;;INVOKEMacroContext shall execute them all and return the last result 9 | 10 | (def nss (ref [])) 11 | (def fns (ref [])) 12 | 13 | (defn add-ns [ns] 14 | (dosync 15 | (alter nss conj ns))) 16 | 17 | (defn add-curr-ns [] 18 | (add-ns *ns*)) 19 | 20 | (defn add-fn [fn] 21 | (dosync 22 | (alter fns conj fn))) 23 | 24 | (defn get-ns [] 25 | (dosync 26 | (let [a @nss] 27 | (ref-set nss []) 28 | a))) 29 | 30 | (defn get-fns [] 31 | (dosync 32 | (let [a @fns] 33 | (ref-set fns []) 34 | a))) 35 | -------------------------------------------------------------------------------- /default dependencies.txt: -------------------------------------------------------------------------------- 1 | Microsoft.CSharp 2 | System 3 | System.Core 4 | System.Data 5 | System.Data.DataSetExtensions 6 | System.Xml 7 | System.Xml.Linq 8 | 9 | ExcelDNA 10 | ======== 11 | ExcelDna.Integration 12 | 13 | Clojure 14 | ======= 15 | Clojure 16 | Microsoft.Dynamic 17 | Microsoft.Scripting 18 | 19 | NetOffice Excel 20 | =============== 21 | 22 | NetOffice 23 | OfficeApi 24 | VBIDEApi 25 | ExcelApi 26 | Microsoft.Office.Interop.Excel 27 | 28 | Misc 29 | ==== 30 | System.Web 31 | System.Drawing 32 | System.Windows.Forms 33 | 34 | DotNetZip 35 | ========= 36 | Iconic.Zip 37 | 38 | Official .NET driver for MongoDB 39 | ================================ 40 | 41 | MongoDB.Bson 42 | MongoDB.Driver 43 | 44 | NOTE!!!! 45 | Set ExcelDna.Integration reference to CopyLocal=True 46 | so that it may be loaded -------------------------------------------------------------------------------- /Excel-REPL/Excel-REPL-AddIn.dna: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 19 | 20 | 21 | -------------------------------------------------------------------------------- /Excel-REPL/Python.cs: -------------------------------------------------------------------------------- 1 | using Microsoft.Scripting.Hosting; 2 | using System; 3 | using System.Collections.Generic; 4 | using System.Linq; 5 | using System.Text; 6 | using System.Threading.Tasks; 7 | 8 | namespace clojureexcel 9 | { 10 | public class Python 11 | { 12 | private static ScriptEngine engine; 13 | private static ScriptScope scope; 14 | 15 | static Python() 16 | { 17 | } 18 | private static void Init() 19 | { 20 | engine = IronPython.Hosting.Python.CreateEngine(); 21 | scope = engine.CreateScope(); 22 | var paths = engine.GetSearchPaths(); 23 | paths.Add("C:\\Program Files (x86)\\Excel-REPL\\Excel-REPL\\Lib"); 24 | paths.Add("C:\\Anaconda\\Lib"); 25 | paths.Add("C:\\Program Files (x86)\\Excel-REPL\\Excel-REPL\\python"); 26 | paths.Add("C:\\Users\\xuehuit\\Documents\\Visual Studio 2012\\Projects\\Excel-REPL\\Excel-REPL\\python"); 27 | engine.SetSearchPaths(paths); 28 | 29 | String initCode = @" 30 | from pygments import highlight 31 | from pygments.lexers import ClojureLexer 32 | from pygments.formatters import HtmlFormatter 33 | 34 | clojureLexer = ClojureLexer() 35 | htmlFormatter = HtmlFormatter() 36 | 37 | def raw(code): 38 | return highlight(code, clojureLexer, htmlFormatter)"; 39 | 40 | engine.Execute(initCode, scope); 41 | } 42 | 43 | 44 | public static dynamic Eval(String input) 45 | { 46 | return engine.Execute(input, scope); 47 | } 48 | 49 | public static String Html(String code) 50 | { 51 | code = String.Format("raw(\"\"\"{0}\"\"\")", code); 52 | return Eval(code); 53 | } 54 | 55 | public static String Css() 56 | { 57 | return Eval("htmlFormatter.get_style_defs()"); 58 | } 59 | } 60 | } -------------------------------------------------------------------------------- /Excel-REPL/DB.cs: -------------------------------------------------------------------------------- 1 | using clojure.lang; 2 | using MongoDB.Bson; 3 | using MongoDB.Bson.Serialization.Attributes; 4 | using MongoDB.Driver.Builders; 5 | using System; 6 | using System.Text; 7 | 8 | public static class DB 9 | { 10 | private static IFn read_string = clojure.clr.api.Clojure.var("clojure.core", "read-string"); 11 | private static IFn pr_str = clojure.clr.api.Clojure.var("clojure.core", "pr-str"); 12 | public static MongoDB.Driver.MongoClient Connect(String s) 13 | { 14 | var client = new MongoDB.Driver.MongoClient(s); 15 | return client; 16 | } 17 | //mongodb://[username:password@]hostname[:port][/[database][?options]] 18 | public static MongoDB.Driver.MongoClient Connect(String host, int port) 19 | { 20 | return new MongoDB.Driver.MongoClient(String.Format("mongodb://{0}:{1}", host, port)); 21 | } 22 | public static MongoDB.Driver.MongoClient Connect() 23 | { 24 | return new MongoDB.Driver.MongoClient(); 25 | } 26 | 27 | public static void Set(MongoDB.Driver.MongoClient c, String k, BsonDocument v) 28 | { 29 | var db = c.GetServer().GetDatabase("db"); 30 | var coll = db.GetCollection(k); 31 | Entity entity = new Entity { data = v, _id = k}; 32 | coll.Save(entity); 33 | } 34 | public static Object Get(MongoDB.Driver.MongoClient c, String k) 35 | { 36 | var db = c.GetServer().GetDatabase("db"); 37 | var coll = db.GetCollection(k); 38 | var query = Query.EQ(e => e._id, k); 39 | var entity = coll.FindOne(query); 40 | var v = entity.GetElement("data"); 41 | //return read_string.invoke(v.Value.ToString()); 42 | return v.Value; 43 | } 44 | 45 | public class Entity 46 | { 47 | [BsonId] 48 | public string _id { get; set; } 49 | 50 | public BsonDocument data { get; set; } 51 | } 52 | } 53 | -------------------------------------------------------------------------------- /Excel-REPL/Class1.cs: -------------------------------------------------------------------------------- 1 | using clojure.lang; 2 | using ExcelDna.Integration; 3 | using System; 4 | using System.Windows.Forms; 5 | using System.Threading; 6 | //using System.Text.RegularExpressions; 7 | 8 | public class Class1 9 | { 10 | private static IFn ifn_list; 11 | 12 | public Class1(IFn foo) 13 | { 14 | foo; 15 | } 16 | 17 | private void Poo() { } 18 | 19 | private static Object cleanValue(object o) 20 | { 21 | if (o == null) 22 | { 23 | return ""; 24 | } 25 | if (o is bool) 26 | { 27 | return o; 28 | } 29 | if (o is Ratio) 30 | { 31 | return ((Ratio)o).ToDouble(null); 32 | } 33 | if (o is sbyte 34 | || o is byte 35 | || o is short 36 | || o is ushort 37 | || o is int 38 | || o is uint 39 | || o is long 40 | || o is ulong 41 | || o is float 42 | || o is double 43 | || o is decimal) 44 | { 45 | return o; 46 | } 47 | else 48 | { 49 | return o.ToString(); 50 | } 51 | } 52 | 53 | public static Object RaggedArray(Object arrayCandidate) 54 | { 55 | var input = arrayCandidate as Object[,]; 56 | if (input == null) 57 | { 58 | return arrayCandidate; 59 | } 60 | int m = input.GetUpperBound(0) + 1; 61 | int n = input.GetUpperBound(1) + 1; 62 | Object[][] output = new Object[m][]; 63 | for (int i = 0; i < m; i++) 64 | { 65 | Object[] row = new Object[n]; 66 | for (int j = 0; j < n; j++) 67 | { 68 | row[j] = input[i, j]; 69 | } 70 | output[i] = row; 71 | } 72 | return output; 73 | } 74 | 75 | 76 | } 77 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/middleware/pr_values.clj: -------------------------------------------------------------------------------- 1 | 2 | (ns ^{:author "Chas Emerick"} 3 | clojure.tools.nrepl.middleware.pr-values 4 | (:require [clojure.tools.nrepl.transport :as t] 5 | [clojure.tools.nrepl.debug :as debug]) ;DM: Added 6 | (:use [clojure.tools.nrepl.middleware :only (set-descriptor!)]) 7 | (:import clojure.tools.nrepl.transport.Transport)) 8 | 9 | (defn pr-values 10 | "Middleware that returns a handler which transforms any :value slots 11 | in messages sent via the request's Transport to strings via `pr`, 12 | delegating all actual message handling to the provided handler. 13 | 14 | Requires that results of eval operations are sent in messages in a 15 | :value slot." 16 | [h] 17 | (fn [{:keys [op ^Transport transport] :as msg}] 18 | (h (assoc msg :transport (let [wt (reify Transport 19 | (recv [this] (.recv transport)) 20 | (recv [this timeout] (.recv transport timeout)) 21 | (send [this resp] 22 | #_(debug/prn-thread "pr-values - sending on to " (.GetHashCode transport)) 23 | (.send transport 24 | (if-let [[_ v] (find resp :value)] 25 | (let [repr (System.IO.StringWriter.)] ;;; java.io.StringWriter. 26 | (assoc resp :value (do (if *print-dup* 27 | (print-dup v repr) 28 | (print-method v repr)) 29 | (str repr)))) 30 | resp)) 31 | this))] 32 | #_(debug/prn-thread "pr-values - reify, wrapping " (.GetHashCode wt) " around " (.GetHashCode transport)) 33 | wt) 34 | )))) 35 | 36 | (set-descriptor! #'pr-values 37 | {:requires #{} 38 | :expects #{} 39 | :handles {}}) -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/ack.clj: -------------------------------------------------------------------------------- 1 | 2 | (ns clojure.tools.nrepl.ack 3 | (:require [clojure.tools.nrepl :as repl] 4 | [clojure.tools.nrepl.transport :as t]) 5 | (:import (clojure.lang Future FutureTimeoutException))) ;DM: (java.util.concurrent Future TimeUnit TimeoutException) 6 | 7 | ; could be a lot fancier, but it'll do for now 8 | (def ^{:private true} ack-port-promise (atom nil)) 9 | 10 | (defn reset-ack-port! 11 | [] 12 | (reset! ack-port-promise (promise)) 13 | ; save people the misery of ever trying to deref the empty promise in their REPL 14 | nil) 15 | 16 | (defn wait-for-ack 17 | "Waits for a presumably just-launched nREPL server to connect and 18 | deliver its port number. Returns that number if it's delivered 19 | within `timeout` ms, otherwise nil. Assumes that `ack` 20 | middleware has been applied to the local nREPL server handler. 21 | 22 | Expected usage: 23 | 24 | (reset-ack-port!) 25 | (start-server already-running-server-port) 26 | => (wait-for-ack) 27 | 59872 ; the port of the server started via start-server" 28 | [timeout] 29 | (let [^Future f (future @@ack-port-promise)] 30 | (try 31 | ; no deref with timeout in 1.2 32 | (.get f timeout) ;DM: remove TimeUnit/MILLISECONDS 33 | (catch FutureTimeoutException e)))) ;DM: TimeoutException 34 | 35 | (defn handle-ack 36 | [h] 37 | (fn [{:keys [op port transport] :as msg}] 38 | (if (not= op "ack") 39 | (h msg) 40 | (try 41 | (deliver @ack-port-promise port) 42 | (t/send transport {:status :done}))))) 43 | 44 | ; TODO could stand to have some better error handling around all of this 45 | (defn send-ack 46 | [my-port ack-port] 47 | (with-open [transport (repl/connect :port ack-port)] 48 | (let [client (repl/client transport 1000)] 49 | ; consume response from the server, solely to let that side 50 | ; finish cleanly without (by default) spewing a SocketException when 51 | ; the ack client goes away suddenly 52 | (dorun (repl/message client {:op :ack :port my-port}))))) -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/misc.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:doc "Misc utilities used in nREPL's implementation (potentially also useful 2 | for anyone extending it)." 3 | :author "Chas Emerick, modified for ClojureCLR by David Miller"} 4 | clojure.tools.nrepl.misc) 5 | 6 | (try 7 | (require 'clojure.tools.logging) 8 | (defmacro log [& args] `(clojure.tools.logging/error ~@args)) 9 | (catch Exception t ;;; Throwable 10 | ;(println "clojure.tools.logging not available, falling back to stdout/err") 11 | (defn log 12 | [ex & msgs] 13 | (let [ex (when (instance? Exception ex) ex) ;;; Throwable 14 | msgs (if ex msgs (cons ex msgs))] 15 | (binding [*out* *err*] 16 | (apply println "ERROR:" msgs) 17 | (when ex (println (.StackTrace ^Exception ex)))))))) ;;; (.printStackTrace ^Throwable ex))))))) 18 | 19 | (defmacro returning 20 | "Executes `body`, returning `x`." 21 | [x & body] 22 | `(let [x# ~x] ~@body x#)) 23 | 24 | (defn uuid 25 | "Returns a new UUID string." 26 | [] 27 | (str (Guid/NewGuid))) ;;; java.util.UUID/randomUUID 28 | 29 | (defn response-for 30 | "Returns a map containing the :session and :id from the \"request\" `msg` 31 | as well as all entries specified in `response-data`, which can be one 32 | or more maps (which will be merged), *or* key-value pairs. 33 | 34 | (response-for msg :status :done :value \"5\") 35 | (response-for msg {:status :interrupted}) 36 | 37 | The :session value in `msg` may be any Clojure reference type (to accommodate 38 | likely implementations of sessions) that has an :id slot in its metadata, 39 | or a string." 40 | [{:keys [session id]} & response-data] 41 | {:pre [(seq response-data)]} 42 | (let [{:keys [status] :as response} (if (map? (first response-data)) 43 | (reduce merge response-data) 44 | (apply hash-map response-data)) 45 | response (if (not status) 46 | response 47 | (assoc response :status (if (coll? status) 48 | status 49 | #{status}))) 50 | basis (merge (when id {:id id}) 51 | ; AReference should make this suitable for any session implementation? 52 | (when session {:session (if (instance? clojure.lang.AReference session) 53 | (-> session meta :id) 54 | session)}))] 55 | (merge basis response))) -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/data/drawbridge_client.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.data.drawbridge-client 2 | (:require [clojure.data.json :as json] 3 | [clojure.tools.nrepl :as nrepl] 4 | [clr-http.lite.client :as http] 5 | ) 6 | (:import ClojureExcel.MainClass 7 | System.IO.StreamReader 8 | )) 9 | 10 | ;DateTime.Now.Ticks / TimeSpan.TicksPerMillisecond 11 | (defn time-millis [] 12 | (/ (.Ticks DateTime/Now) TimeSpan/TicksPerMillisecond)) 13 | 14 | (defn ring-client-transport 15 | "Returns an nREPL client-side transport to connect to HTTP nREPL 16 | endpoints implemented by `ring-handler`. 17 | 18 | This fn is implicitly registered as the implementation of 19 | clojure.tools.nrepl/url-connect for `http` and `https` schemes; 20 | so, once this namespace is loaded, any tool that uses url-connect 21 | will use this implementation for connecting to HTTP and HTTPS 22 | nREPL endpoints." 23 | [url] 24 | (let [incoming (MainClass/GetCollection); a bit of a hack 25 | fill #(when-let [responses (->> % 26 | StreamReader. 27 | line-seq 28 | rest 29 | drop-last 30 | (remove empty?) 31 | (map json/read-str) 32 | (remove nil?) 33 | seq)] 34 | (doseq [response responses] 35 | (.Add incoming response))) 36 | 37 | session-cookies (atom nil) 38 | 39 | http (fn [& [msg]] 40 | (let [ 41 | req-map (merge {:as :stream 42 | :cookies @session-cookies} 43 | (when msg {:form-params msg})) 44 | {:keys [cookies body] :as resp} ((if msg http/post http/get) 45 | url 46 | req-map)] 47 | (println "cookies" cookies) 48 | (swap! session-cookies merge cookies) 49 | (fill body))) 50 | poll #(MainClass/TakeItem incoming) 51 | ] 52 | (clojure.tools.nrepl.transport.FnTransport. 53 | (fn read [timeout] 54 | (let [t (time-millis)] 55 | (or (poll) 56 | (when (pos? timeout) 57 | (http) 58 | (recur (- timeout (- (time-millis) t))))))) 59 | http 60 | (fn close [])))) 61 | 62 | 63 | ;(.removeMethod nrepl/url-connect "http") 64 | ;(.removeMethod nrepl/url-connect "https") 65 | 66 | (.addMethod nrepl/url-connect "http" #'ring-client-transport) 67 | (.addMethod nrepl/url-connect "https" #'ring-client-transport) 68 | 69 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clr_http/lite/util.clj: -------------------------------------------------------------------------------- 1 | (ns clr-http.lite.util 2 | "Helper functions for the HTTP client." 3 | (:require [clojure.clr.io :as io]) 4 | (:import 5 | System.Text.Encoding 6 | System.IO.MemoryStream 7 | System.IO.Stream 8 | System.IO.Compression.GZipStream 9 | System.IO.Compression.CompressionMode 10 | System.IO.Compression.DeflateStream 11 | )) 12 | 13 | (assembly-load-with-partial-name "System.Web") 14 | (import System.Web.HttpUtility) 15 | 16 | (defn utf8-bytes 17 | "Returns the UTF-8 bytes corresponding to the given string." 18 | [^String s] 19 | (.GetBytes Encoding/UTF8 s)) 20 | 21 | (defn utf8-string 22 | "Returns the String corresponding to the UTF-8 decoding of the given bytes." 23 | [b] 24 | (if (string? b) 25 | b 26 | (.GetString Encoding/UTF8 b))) 27 | 28 | (defn url-decode 29 | "Returns the form-url-decoded version of the given string, using either a 30 | specified encoding or UTF-8 by default." 31 | [encoded & [encoding]] 32 | (HttpUtility/UrlDecode encoded (or encoding Encoding/UTF8))) 33 | 34 | (defn url-encode 35 | "Returns an UTF-8 URL encoded version of the given string." 36 | [unencoded] 37 | (HttpUtility/UrlEncode unencoded Encoding/UTF8)) 38 | 39 | (defn base64-encode 40 | "Encode an array of bytes into a base64 encoded string." 41 | [unencoded] 42 | (Convert/ToBase64String unencoded)) 43 | 44 | (defn to-byte-array 45 | "Returns a byte array for the InputStream provided." 46 | [is] 47 | (with-open [os (MemoryStream.)] 48 | (io/copy is os) 49 | (.ToArray os))) 50 | 51 | (defn gunzip 52 | "Returns a gunzip'd version of the given byte array." 53 | [b] 54 | (when b 55 | (if (instance? Stream b) 56 | (GZipStream. b CompressionMode/Decompress) 57 | (with-open [ 58 | is (GZipStream. (MemoryStream. b) CompressionMode/Decompress) 59 | ] 60 | (to-byte-array is))))) 61 | 62 | (defn gzip 63 | "gzips binary array" 64 | [b] 65 | (when b 66 | (with-open [compressIntoMs (MemoryStream.)] 67 | (with-open [gzs (GZipStream. compressIntoMs CompressionMode/Compress)] 68 | (.Write gzs b 0 (.Length b))) 69 | (.ToArray compressIntoMs)))) 70 | 71 | (defn inflate 72 | "Returns a zlip inflated version of a the given byte array." 73 | [b] 74 | (when b 75 | (with-open [ 76 | is (DeflateStream. (MemoryStream. b) CompressionMode/Decompress) 77 | ] 78 | (to-byte-array is)))) 79 | 80 | (defn deflate 81 | "Deflates binary array" 82 | [b] 83 | (when b 84 | (with-open [ 85 | mem-stream (MemoryStream.) 86 | ] 87 | (with-open [deflate-stream (DeflateStream. mem-stream CompressionMode/Compress)] 88 | (.Write deflate-stream b 0 (.Length b))) 89 | (.ToArray mem-stream)))) 90 | 91 | (defmacro doto-set 92 | "Similar to doto however sets Csharp properties instead" 93 | [new & rest] 94 | (let [x (gensym)] 95 | `(let [~x ~new] 96 | ~@(for [[a b] rest] 97 | `(set! (~a ~x) ~b)) 98 | ~x))) 99 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/excel_repl/coerce_db.clj: -------------------------------------------------------------------------------- 1 | (ns excel-repl.coerce-db 2 | (:use [clojure.data.json :only [write-str read-str]] 3 | ) 4 | (:import [clojure.lang IPersistentMap Keyword IPersistentCollection Ratio Symbol] 5 | [System.Collections IEnumerable IDictionary IList] 6 | ; [java.util Map List Set] 7 | ; [com.mongodb DBObject BasicDBObject BasicDBList] 8 | ; [com.mongodb.gridfs GridFSFile] 9 | ; [com.mongodb.util JSON] 10 | )) 11 | 12 | (assembly-load "MongoDB.Bson") 13 | (import '[MongoDB.Bson BsonArray BsonInt32 BsonInt64 BsonBoolean 14 | BsonDateTime BsonDouble BsonNull BsonRegularExpression 15 | BsonString BsonSymbol BsonDocument BsonElement 16 | BsonValue BsonExtensionMethods 17 | ]) 18 | 19 | 20 | 21 | (defprotocol ConvertibleFromMongo 22 | (mongo->clojure [o])) 23 | 24 | (extend-protocol ConvertibleFromMongo 25 | BsonDocument 26 | (mongo->clojure [^BsonDocument m] 27 | (into {} 28 | (map #(vector (mongo->clojure (.Name %)) (mongo->clojure (.Value %))) (seq m)))) 29 | BsonArray 30 | (mongo->clojure [^IEnumerable l] 31 | (mapv mongo->clojure l)) 32 | Object 33 | (mongo->clojure [o] o) 34 | nil 35 | (mongo->clojure [o] o) 36 | BsonInt32 37 | (mongo->clojure [o] (int o)) 38 | BsonInt64 39 | (mongo->clojure [o] (long o)) 40 | BsonBoolean 41 | (mongo->clojure [o] (.Value o)) 42 | BsonDateTime 43 | (mongo->clojure [o] (str o)) 44 | BsonDouble 45 | (mongo->clojure [o] (.Value o)) 46 | BsonNull 47 | (mongo->clojure [o]) 48 | BsonRegularExpression 49 | (mongo->clojure [o] (-> o .Pattern re-pattern)) 50 | String 51 | (mongo->clojure [o] 52 | (let [s (str o)] 53 | (if (.StartsWith s ":") 54 | (keyword (.Substring s 1)) 55 | s))) 56 | BsonString 57 | (mongo->clojure [o] 58 | (let [s (str o)] 59 | (if (.StartsWith s ":") 60 | (keyword (.Substring s 1)) 61 | s))) 62 | BsonSymbol 63 | (mongo->clojure [o] (-> o str symbol)) 64 | ) 65 | 66 | 67 | ;; ;;; Converting data from Clojure into data objects suitable for Mongo 68 | 69 | (defprotocol ConvertibleToMongo 70 | (clojure->mongo [o])) 71 | 72 | (extend-protocol ConvertibleToMongo 73 | IPersistentMap 74 | (clojure->mongo [m] 75 | (let [out (BsonDocument.)] 76 | (doseq [[k v] m] 77 | (.Add out (str k) (clojure->mongo v))) 78 | out)) 79 | IPersistentCollection 80 | (clojure->mongo [m] (BsonArray. (map clojure->mongo m))) 81 | Keyword 82 | (clojure->mongo [^Keyword o] 83 | (BsonString. (str o))) 84 | nil 85 | (clojure->mongo [o] BsonNull/Value) 86 | Object 87 | (clojure->mongo [o] (BsonValue/Create o)) 88 | Ratio 89 | (clojure->mongo [o] (BsonValue/Create (.ToDouble o nil))) 90 | Symbol 91 | (clojure->mongo [o] (-> o str BsonValue/Create)) 92 | Int64 93 | (clojure->mongo [o] (BsonInt64. o)) 94 | ) 95 | -------------------------------------------------------------------------------- /Excel-REPL/excel-repl.clj: -------------------------------------------------------------------------------- 1 | ;no ns. this will be evaluated in clojure.core for simplicity 2 | 3 | (import System.Environment) 4 | (import System.IO.Directory) 5 | (import System.Windows.Forms.MessageBox) 6 | 7 | (import ExcelDna.Integration.ExcelReference) 8 | (import ExcelDna.Integration.XlCall) 9 | (import ClojureExcel.MainClass) 10 | 11 | ;(import NetOffice.ExcelApi.Application) 12 | 13 | (require '[clojure.repl :as r]) 14 | (require 'clojure.pprint) 15 | (require '[clojure.string :as string]) 16 | (require 'clojure.walk) 17 | 18 | (defn show 19 | "Show MessageBox" 20 | [x] 21 | (MessageBox/Show x)) 22 | 23 | (defn get-cd 24 | "returns current directory as a string" 25 | [] 26 | (Directory/GetCurrentDirectory)) 27 | 28 | (defn set-cd 29 | "sets current directory as a string" 30 | [new-d] 31 | (Directory/SetCurrentDirectory new-d)) 32 | 33 | (defn get-load-path [] 34 | (set (string/split (Environment/GetEnvironmentVariable "CLOJURE_LOAD_PATH") #";"))) 35 | 36 | (defn set-load-path! [s] 37 | (let [ 38 | new-path (apply str (interpose ";" s)) 39 | ] 40 | (Environment/SetEnvironmentVariable "CLOJURE_LOAD_PATH" new-path) 41 | new-path)) 42 | 43 | (defn append-load-path! 44 | "appends file string to clojure load path" 45 | [new-path] 46 | (set-load-path! (conj (get-load-path) new-path))) 47 | 48 | (defn split-lines [s] 49 | (string/split s #"\n")) 50 | 51 | (defmacro with-out-strs 52 | "evaluates expression and returns list of lines printed" 53 | [x] 54 | `(split-lines (with-out-str ~x))) 55 | 56 | (defmacro source 57 | "function source returned as string" 58 | [x] 59 | `(with-out-strs (r/source ~x))) 60 | 61 | (defmacro doc 62 | "function docstring" 63 | [x] 64 | `(with-out-strs (r/doc ~x))) 65 | 66 | (defmacro pprint 67 | "pprint to string" 68 | [x] 69 | `(with-out-strs (clojure.pprint/pprint ~x))) 70 | 71 | (defmacro time-str 72 | "times evaluation of expression x" 73 | [x] 74 | `(with-out-strs (time ~x))) 75 | 76 | 77 | (def letters "ABCDEFGHIJKLMNOPQRSTUVWXYZ") 78 | (def letter->val (into {} (map-indexed (fn [i s] [s i]) letters))) 79 | 80 | (defn letter->val2 81 | "column number of excel coumn A, AZ etc" 82 | [[s t :as ss]] 83 | (if t 84 | (apply + 26 85 | (map * 86 | (map letter->val (reverse ss)) 87 | (map #(Math/Pow 26 %) (range)))) 88 | (letter->val s))) 89 | 90 | (defn col-num 91 | "column number of reference in form A4 etc" 92 | [s] 93 | (if (string? s) 94 | (letter->val2 (re-find #"[A-Z]+" s)) 95 | (second s))) 96 | 97 | (defn row-num 98 | [s] 99 | (if (string? s) 100 | (dec (int (re-find #"[0-9]+" s))) 101 | (first s))) 102 | 103 | (defn get-values 104 | "Returns values at ref which is of the form A1 or A1:B6. 105 | Single cell selections are returned as a value, 2D selections as an Object[][] array" 106 | [sheet ref] 107 | (let [ 108 | refs (if (.Contains ref ":") (string/split ref #":") [ref ref]) 109 | [i id] (map row-num refs) 110 | [j jd] (map col-num refs) 111 | value (.GetValue (ExcelReference. i id j jd sheet)) 112 | ] 113 | (if (.Contains ref ":") 114 | (MainClass/RaggedArray value) 115 | value))) 116 | 117 | ;;otha stuff 118 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clr_http/lite/core.clj: -------------------------------------------------------------------------------- 1 | (ns clr-http.lite.core 2 | "Core HTTP request/response implementation." 3 | (:require [clojure.clr.io :as io] 4 | [clr-http.lite.util :as util] 5 | [clr-http.lite.cookies :as cookies] 6 | ) 7 | (:import 8 | System.Net.WebRequest 9 | System.Net.CookieContainer)) 10 | 11 | (defn safe-conj [a b] 12 | (if (vector? a) 13 | (conj a b) 14 | [a b])) 15 | 16 | (defn parse-headers 17 | "Takes a URLConnection and returns a map of names to values. 18 | 19 | If a name appears more than once (like `set-cookie`) then the value 20 | will be a vector containing the values in the order they appeared 21 | in the headers." 22 | [conn] 23 | (let [headers (.Headers conn)] 24 | (apply merge-with 25 | safe-conj 26 | (for [header (.Headers conn)] 27 | {header (.Get headers header)})))) 28 | 29 | (defn- coerce-body-entity 30 | "Coerce the http-entity from an HttpResponse to either a byte-array, or a 31 | stream that closes itself and the connection manager when closed." 32 | [{:keys [as]} conn] 33 | (let [ins (.GetResponseStream conn)] 34 | (if (or (= :stream as) (nil? ins)) 35 | ins 36 | (util/to-byte-array ins)))) 37 | 38 | (defn request 39 | "Executes the HTTP request corresponding to the given Ring request map and 40 | returns the Ring response map corresponding to the resulting HTTP response. 41 | Note that where Ring uses InputStreams for the request and response bodies, 42 | the clj-http uses ByteArrays for the bodies." 43 | [{:keys [request-method scheme server-name server-port uri query-string 44 | headers content-type character-encoding body socket-timeout 45 | cookies save-request? follow-redirects] :as req}] 46 | (let [http-url (str (name scheme) "://" server-name 47 | (when server-port (str ":" server-port)) 48 | uri 49 | (when query-string (str "?" query-string))) 50 | request (WebRequest/Create http-url) 51 | Headers (.Headers request) 52 | ;^CookieContainer cookie-container (.CookieContainer request) 53 | cookie-container (CookieContainer.) 54 | ] 55 | (when (and content-type character-encoding) 56 | (set! (.ContentType request) (str content-type 57 | "; charset=" 58 | character-encoding))) 59 | (when (and content-type (not character-encoding)) 60 | (set! (.ContentType request) content-type)) 61 | (doseq [[h v] headers] 62 | (.Add Headers h v)) 63 | (when (false? follow-redirects) 64 | (set! (.AllowAutoRedirect request) false)) 65 | (set! (.Method request) (.ToUpper (name request-method))) 66 | (when socket-timeout 67 | (set! (.ReadWriteTimeout request) socket-timeout)) 68 | (doseq [cookie (map cookies/map->cookie cookies)] 69 | (if (empty? (.Domain cookie)) 70 | (set! (.Domain cookie) server-name)) 71 | (.Add cookie-container cookie)) 72 | (set! (.CookieContainer request) cookie-container) 73 | (when body 74 | (with-open [out (.GetRequestStream request)] 75 | (io/copy body out))) 76 | (try 77 | (let [ 78 | response (.GetResponse request) 79 | ] 80 | (merge {:headers (parse-headers response) 81 | :status (-> response .StatusCode int) 82 | :body (when-not (= request-method :head) 83 | (coerce-body-entity req response)) 84 | :cookies (into {} (map cookies/cookie->map (.Cookies response))) 85 | } 86 | (when save-request? 87 | {:request (-> req 88 | (dissoc :save-request?) 89 | (assoc :http-url http-url))}))) 90 | (catch Exception e 91 | {:status 500 92 | :body (str e)})))) 93 | -------------------------------------------------------------------------------- /Excel-REPL.sln: -------------------------------------------------------------------------------- 1 | 2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio 2013 4 | VisualStudioVersion = 12.0.31101.0 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Excel-REPL", "Excel-REPL\Excel-REPL.csproj", "{2EB259F1-F88C-44C2-8B63-F61522F43595}" 7 | EndProject 8 | Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "ConsoleApplication1", "ConsoleApplication1\ConsoleApplication1.csproj", "{C0515150-373D-416A-A2AD-904F08A21979}" 9 | EndProject 10 | Project("{54435603-DBB4-11D2-8724-00A0C9A8B90C}") = "Setup2", "Setup2\Setup2.vdproj", "{0FC739F3-17D8-42F0-9747-579693D2C1AC}" 11 | EndProject 12 | Project("{6141683F-8A12-4E36-9623-2EB02B2C2303}") = "Setup5", "Setup5\Setup5.isproj", "{EB97A841-84D8-494C-A778-828120AC86FA}" 13 | EndProject 14 | Global 15 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 16 | CD_ROM|Any CPU = CD_ROM|Any CPU 17 | Debug|Any CPU = Debug|Any CPU 18 | DVD-5|Any CPU = DVD-5|Any CPU 19 | Release|Any CPU = Release|Any CPU 20 | SingleImage|Any CPU = SingleImage|Any CPU 21 | EndGlobalSection 22 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 23 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.CD_ROM|Any CPU.ActiveCfg = Release|Any CPU 24 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.CD_ROM|Any CPU.Build.0 = Release|Any CPU 25 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 26 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.Debug|Any CPU.Build.0 = Debug|Any CPU 27 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.DVD-5|Any CPU.ActiveCfg = Debug|Any CPU 28 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.DVD-5|Any CPU.Build.0 = Debug|Any CPU 29 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.Release|Any CPU.ActiveCfg = Release|Any CPU 30 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.Release|Any CPU.Build.0 = Release|Any CPU 31 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.SingleImage|Any CPU.ActiveCfg = Release|Any CPU 32 | {2EB259F1-F88C-44C2-8B63-F61522F43595}.SingleImage|Any CPU.Build.0 = Release|Any CPU 33 | {C0515150-373D-416A-A2AD-904F08A21979}.CD_ROM|Any CPU.ActiveCfg = Release|Any CPU 34 | {C0515150-373D-416A-A2AD-904F08A21979}.CD_ROM|Any CPU.Build.0 = Release|Any CPU 35 | {C0515150-373D-416A-A2AD-904F08A21979}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 36 | {C0515150-373D-416A-A2AD-904F08A21979}.Debug|Any CPU.Build.0 = Debug|Any CPU 37 | {C0515150-373D-416A-A2AD-904F08A21979}.DVD-5|Any CPU.ActiveCfg = Debug|Any CPU 38 | {C0515150-373D-416A-A2AD-904F08A21979}.DVD-5|Any CPU.Build.0 = Debug|Any CPU 39 | {C0515150-373D-416A-A2AD-904F08A21979}.Release|Any CPU.ActiveCfg = Release|Any CPU 40 | {C0515150-373D-416A-A2AD-904F08A21979}.Release|Any CPU.Build.0 = Release|Any CPU 41 | {C0515150-373D-416A-A2AD-904F08A21979}.SingleImage|Any CPU.ActiveCfg = Release|Any CPU 42 | {C0515150-373D-416A-A2AD-904F08A21979}.SingleImage|Any CPU.Build.0 = Release|Any CPU 43 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.CD_ROM|Any CPU.ActiveCfg = Release 44 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.CD_ROM|Any CPU.Build.0 = Release 45 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.Debug|Any CPU.ActiveCfg = Debug 46 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.DVD-5|Any CPU.ActiveCfg = Debug 47 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.DVD-5|Any CPU.Build.0 = Debug 48 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.Release|Any CPU.ActiveCfg = Release 49 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.SingleImage|Any CPU.ActiveCfg = Release 50 | {0FC739F3-17D8-42F0-9747-579693D2C1AC}.SingleImage|Any CPU.Build.0 = Release 51 | {EB97A841-84D8-494C-A778-828120AC86FA}.CD_ROM|Any CPU.ActiveCfg = CD_ROM 52 | {EB97A841-84D8-494C-A778-828120AC86FA}.CD_ROM|Any CPU.Build.0 = CD_ROM 53 | {EB97A841-84D8-494C-A778-828120AC86FA}.Debug|Any CPU.ActiveCfg = DVD-5 54 | {EB97A841-84D8-494C-A778-828120AC86FA}.Debug|Any CPU.Build.0 = DVD-5 55 | {EB97A841-84D8-494C-A778-828120AC86FA}.DVD-5|Any CPU.ActiveCfg = DVD-5 56 | {EB97A841-84D8-494C-A778-828120AC86FA}.DVD-5|Any CPU.Build.0 = DVD-5 57 | {EB97A841-84D8-494C-A778-828120AC86FA}.Release|Any CPU.ActiveCfg = SingleImage 58 | {EB97A841-84D8-494C-A778-828120AC86FA}.Release|Any CPU.Build.0 = SingleImage 59 | {EB97A841-84D8-494C-A778-828120AC86FA}.SingleImage|Any CPU.ActiveCfg = SingleImage 60 | {EB97A841-84D8-494C-A778-828120AC86FA}.SingleImage|Any CPU.Build.0 = SingleImage 61 | EndGlobalSection 62 | GlobalSection(SolutionProperties) = preSolution 63 | HideSolutionNode = FALSE 64 | EndGlobalSection 65 | EndGlobal 66 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/sync_channel.clj: -------------------------------------------------------------------------------- 1 | ;- 2 | ; Copyright (c) David Miller. All rights reserved. 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this distribution. 6 | ; By using this software in any fashion, you are agreeing to be bound by 7 | ; the terms of this license. 8 | ; You must not remove this notice, or any other, from this software. 9 | 10 | 11 | (ns #^{:author "David Miller" 12 | :doc "A simple synchronous channel"} 13 | clojure.tools.nrepl.sync-channel 14 | (:refer-clojure :exclude (take))) 15 | 16 | ;; Reason for existence 17 | ;; 18 | ;; The original (ClojureJVM) FnTransport code uses a java.util.concurrent.SynchronousQueue. 19 | ;; However, in that use there is a single producer and a single consumer. 20 | ;; The CLR does not supply such a construct. 21 | ;; (The closest equivalent would be a System.Collections.Concurrent.BlockingCollection with zero capacity, 22 | ;; but that class only allows capacity greater than zero.) 23 | ;; 24 | ;; Rather then do a full-blown implementation of a synchronous queue, 25 | ;; something along the lines of Doug Lea's C# implementation 26 | ;; http://code.google.com/p/netconcurrent/source/browse/trunk/src/Spring/Spring.Threading/Threading/Collections/SynchronousQueue.cs 27 | ;; we can go with a much simpler construct - a synchronous channel between producer and consumer 28 | ;; that blocks either one if the other is not waiting. 29 | 30 | (defprotocol SyncChannel 31 | "A synchronous channel (single-threaded on producer and consumer)" 32 | (put [this value] "Put a value to this channel (Producer)") 33 | (take [this] "Get a value from this channel (Consumer)") 34 | (poll [this] [this timeout] "Get a value from this channel if one is available (within the designated timeout period)")) 35 | 36 | 37 | (definterface ITakeValue 38 | (takeValue [])) 39 | 40 | ;; SimpleSyncChannel assumes there is a single producer thread and a single consumer thread. 41 | (deftype SimpleSyncChannel [#^:volatile-mutable value 42 | #^:volatile-mutable c-waiting? 43 | #^:volatile-mutable p-waiting? 44 | lock] 45 | SyncChannel 46 | (put [this v] 47 | (when (nil? v) 48 | (throw (NullReferenceException. "Cannot put nil on SyncChannel"))) 49 | (locking lock 50 | (when p-waiting? 51 | (throw (Exception. "Producer not single-threaded"))) 52 | (set! value v) 53 | (System.Threading.Monitor/Pulse lock) 54 | (set! p-waiting? true) 55 | (System.Threading.Monitor/Wait lock) 56 | (set! p-waiting? false))) 57 | 58 | (poll [this] 59 | (locking lock 60 | (when c-waiting? 61 | (throw (Exception. "Consumer not single-threaded"))) 62 | (when-not (nil? value) 63 | (.takeValue ^ITakeValue this)))) 64 | 65 | (poll [this timeout] 66 | (locking lock 67 | (when c-waiting? 68 | (throw (Exception. "Consumer not single-threaded"))) 69 | (if (nil? value) 70 | (do 71 | (set! c-waiting? true) 72 | (let [result 73 | (when (System.Threading.Monitor/Wait lock (int timeout)) 74 | (.takeValue ^ITakeValue this))] 75 | (set! c-waiting? false) 76 | result)) 77 | (.takeValue ^ITakeValue this)))) 78 | 79 | (take [this] 80 | (locking lock 81 | (when c-waiting? 82 | (throw (Exception. "Consumer not single-threaded"))) 83 | (when (nil? value) 84 | (set! c-waiting? true) 85 | (System.Threading.Monitor/Wait lock) 86 | (set! c-waiting? false)) 87 | (.takeValue ^ITakeValue this))) 88 | 89 | ITakeValue 90 | (takeValue [this] 91 | (let [curval value] 92 | (set! value nil) 93 | (System.Threading.Monitor/Pulse lock) 94 | curval))) 95 | 96 | (defn make-simple-sync-channel [] 97 | (SimpleSyncChannel. nil false false (Object.))) 98 | 99 | 100 | (comment 101 | 102 | (def prn-agent (agent nil)) 103 | (defn sprn [& strings] (send-off prn-agent (fn [v] (apply prn strings)))) 104 | (defn f [n] 105 | (let [sc (make-simple-sync-channel) 106 | p (agent nil) 107 | c (agent nil)] 108 | (send c (fn [v] (dotimes [i n] (sprn (str "Consumer " i)) (sprn (str "====> "(take sc)))))) 109 | (send p (fn [v] (dotimes [i n] (sprn (str "Producer " i)) (put sc i)))) 110 | [p c sc])) 111 | ) 112 | 113 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/middleware/load_file.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:author "Chas Emerick"} 2 | clojure.tools.nrepl.middleware.load-file 3 | (:require [clojure.tools.nrepl.middleware.interruptible-eval :as eval]) 4 | (:use [clojure.tools.nrepl.middleware :as middleware :only (set-descriptor!)])) 5 | 6 | ; need to hold file contents "out of band" so as to avoid JVM method 7 | ; size limitations (cannot eval an expression larger than some size 8 | ; [64k?]), so the naive approach of just interpolating file contents 9 | ; into an expression to be evaluated doesn't work 10 | ; see http://code.google.com/p/counterclockwise/issues/detail?id=429 11 | ; and http://groups.google.com/group/clojure/browse_thread/thread/f54044da06b9939f 12 | (defonce ^{:private true 13 | :doc "An atom that temporarily holds the contents of files to 14 | be loaded."} file-contents (atom {})) 15 | 16 | (defn- load-large-file-code 17 | "A variant of `load-file-code` that returns an 18 | expression that will only work if evaluated within the same process 19 | where it was called. Here to work around the JVM method size limit 20 | so that (by default, for those tools using the load-file middleware) 21 | loading files of any size will work when the nREPL server is running 22 | remotely or locally." 23 | [file file-path file-name] 24 | ; mini TTL impl so that any code orphaned by errors that occur 25 | ; between here and the evaluation of the Compiler/load expression 26 | ; below are cleaned up on subsequent loads 27 | (let [t (Environment/TickCount) ;DM: System/currentTimeMillis 28 | file-key ^{:t t} [file-path (gensym)]] 29 | (swap! file-contents 30 | (fn [file-contents] 31 | (let [expired-keys 32 | (filter 33 | (comp #(and % 34 | (< 100000000 (- (Environment/TickCount) %))) ;DM: (< 10000 (- (System/currentTimeMillis) %)) -- need to switch to ticks 35 | :t meta) 36 | (keys file-contents))] 37 | (assoc (apply dissoc file-contents expired-keys) 38 | file-key file)))) 39 | (binding [*print-length* nil 40 | *print-level* nil] 41 | (pr-str `(try 42 | (clojure.lang.Compiler/load 43 | (System.IO.StringReader. (@@(var file-contents) '~file-key)) ;DM: java.io.StringReader. 44 | ~file-path 45 | ~file-name) 46 | (finally 47 | (swap! @(var file-contents) dissoc '~file-key))))))) 48 | 49 | (defn ^{:dynamic true} load-file-code 50 | "Given the contents of a file, its _source-path-relative_ path, 51 | and its filename, returns a string of code containing a single 52 | expression that, when evaluated, will load those contents with 53 | appropriate filename references and line numbers in metadata, etc. 54 | 55 | Note that because a single expression is produced, very large 56 | file loads will fail due to the JVM method size limitation. 57 | In such cases, see `load-large-file-code'`." 58 | [file file-path file-name] 59 | (Console/WriteLine "LOADFILE: {0} {1} {2}" file file-path file-name) 60 | (apply format 61 | "(clojure.lang.Compiler/load (System.IO.StringReader. %s) nil %s %s)" ;DM: java.io.StringReader. Add nil (load needs four args) 62 | (map (fn [item] 63 | (binding [*print-length* nil 64 | *print-level* nil] 65 | (pr-str item))) 66 | [file file-path file-name]))) 67 | 68 | (defn wrap-load-file 69 | "Middleware that evaluates a file's contents, as per load-file, 70 | but with all data supplied in the sent message (i.e. safe for use 71 | with remote REPL environments). 72 | 73 | This middleware depends on the availability of an :op \"eval\" 74 | middleware below it (such as interruptible-eval)." 75 | [h] 76 | (fn [{:keys [op file file-name file-path] :as msg}] 77 | (if (not= op "load-file") 78 | (h msg) 79 | (h (assoc msg 80 | :op "eval" 81 | :code ((if (thread-bound? #'load-file-code) 82 | load-file-code 83 | load-large-file-code) 84 | file file-path file-name)))))) 85 | 86 | (set-descriptor! #'wrap-load-file 87 | {:requires #{} 88 | :expects #{"eval"} 89 | :handles {"load-file" 90 | {:doc "Loads a body of code, using supplied path and filename info to set source file and line number metadata. Delegates to underlying \"eval\" middleware/handler." 91 | :requires {"file" "Full contents of a file of code."} 92 | :optional {"file-path" "Source-path-relative path of the source file, e.g. clojure/java/io.clj" 93 | "file-name" "Name of source file, e.g. io.clj"} 94 | :returns (-> (meta #'eval/interruptible-eval) 95 | ::middleware/descriptor 96 | :handles 97 | (get "eval") 98 | :returns)}}}) -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clr_http/lite/cookies.clj: -------------------------------------------------------------------------------- 1 | (ns clr-http.lite.cookies 2 | (:require 3 | [clojure.string :as string] 4 | [clr-http.lite.util :as util] 5 | ) 6 | (:import 7 | System.Net.Cookie 8 | System.Net.CookieCollection 9 | )) 10 | 11 | (defn compact-map 12 | "Removes all map entries where value is nil." 13 | [m] 14 | (reduce #(if (get m %2) (assoc %1 %2 (get m %2)) %1) 15 | (sorted-map) (sort (keys m)))) 16 | 17 | (defn cookie->map 18 | "Converts a ClientCookie object into a tuple where the first item is 19 | the name of the cookie and the second item the content of the 20 | cookie." 21 | [cookie] 22 | [(.Name cookie) 23 | (compact-map 24 | {:comment (.Comment cookie) 25 | :comment-url (if (.CommentUri cookie) (str (.CommentUri cookie))) 26 | :discard (.Discard cookie) 27 | :domain (.Domain cookie) 28 | :expires (let [expires (.Expires cookie)] 29 | (if-not (= (DateTime. 0) expires) expires)) 30 | :path (.Path cookie) 31 | :ports (let [ports 32 | (filter identity (map #(try (Int32/Parse %) (catch Exception e)) 33 | (-> cookie .Port (string/replace "\"" "") (string/split #","))))] 34 | (if-not (empty? ports) ports)) 35 | :secure (.Secure cookie) 36 | :value (try 37 | (util/url-decode (.Value cookie)) 38 | (catch Exception _ (.Value cookie))) 39 | :version (.Version cookie)})]) 40 | 41 | (defn map->cookie 42 | [[cookie-name value]] 43 | (if (map? value) 44 | (let [ 45 | {:keys [value comment comment-url discard domain expires path ports secure version]} value 46 | cookie 47 | (util/doto-set 48 | (Cookie. (name cookie-name) (-> value name util/url-encode)) 49 | (.Comment comment) 50 | (.Discard (if (nil? discard) true discard)) 51 | (.Domain domain) 52 | (.Path path) 53 | (.Secure (boolean secure)) 54 | (.Version (or version 0)) 55 | )] 56 | (if comment-url (set! (.CommentUri cookie) (Uri. comment-url))) 57 | (if ports (set! (.Port cookie) (->> ports (interpose ",") (apply str) pr-str))) 58 | (if expires (set! (.Discard cookie) expires)) 59 | cookie) 60 | (Cookie. (name cookie-name) (-> value name util/url-encode)))) 61 | 62 | #_(defn decode-cookie 63 | "Decode the Set-Cookie string into a cookie seq." 64 | [set-cookie-str] 65 | (if-not (string/blank? set-cookie-str) 66 | ;; I just want to parse a cookie without providing origin. How? 67 | (let [domain (string/lower-case (str (gensym))) 68 | origin (CookieOrigin. domain 80 "/" false) 69 | [cookie-name cookie-content] (-> (cookie-spec) 70 | (.parse (BasicHeader. 71 | "set-cookie" 72 | set-cookie-str) 73 | origin) 74 | first 75 | to-cookie)] 76 | [cookie-name 77 | (if (= domain (:domain cookie-content)) 78 | (dissoc cookie-content :domain) cookie-content)]))) 79 | 80 | #_(defn decode-cookies 81 | "Converts a cookie string or seq of strings into a cookie map." 82 | [cookies] 83 | (reduce #(assoc %1 (first %2) (second %2)) {} 84 | (map decode-cookie (if (sequential? cookies) cookies [cookies])))) 85 | 86 | #_(defn decode-cookie-header 87 | "Decode the Set-Cookie header into the cookies key." 88 | [response] 89 | (if-let [cookies (get (:headers response) "set-cookie")] 90 | (assoc response 91 | :cookies (decode-cookies cookies) 92 | :headers (dissoc (:headers response) "set-cookie")) 93 | response)) 94 | 95 | #_(defn cookie-response 96 | "Adds cookies map to server response" 97 | [response] 98 | (if-let [^CookieCollection cookies (.Cookies response)] 99 | (assoc response :cookies (seq cookies)) 100 | response)) 101 | 102 | #_(defn encode-cookie 103 | "Encode the cookie into a string used by the Cookie header." 104 | [cookie] 105 | (when-let [header (-> (cookie-spec) 106 | (.formatCookies [(to-basic-client-cookie cookie)]) 107 | first)] 108 | (.getValue ^org.apache.http.Header header))) 109 | 110 | #_(defn encode-cookies 111 | "Encode the cookie map into a string." 112 | [cookie-map] (string/join ";" (map encode-cookie (seq cookie-map)))) 113 | 114 | #_(defn encode-cookie-header 115 | "Encode the :cookies key of the request into a Cookie header." 116 | [request] 117 | (if (:cookies request) 118 | (-> request 119 | (assoc-in [:headers "Cookie"] (encode-cookies (:cookies request))) 120 | (dissoc :cookies)) 121 | request)) 122 | 123 | #_(defn cookie-request 124 | "Adds cookies to request based on request map" 125 | [request] 126 | ;have to look into this one 127 | ) 128 | 129 | #_(defn wrap-cookies 130 | [client] 131 | #_(fn [request] 132 | (let [response (client (encode-cookie-header request))] 133 | (decode-cookie-header response)))) 134 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/excel_repl/interop.clj: -------------------------------------------------------------------------------- 1 | (ns excel-repl.interop) 2 | 3 | (import ExcelDna.Integration.ExcelReference) 4 | (import ExcelDna.Integration.XlCall) 5 | (import ClojureExcel.MainClass) 6 | 7 | (assembly-load "ExcelApi") 8 | (import NetOffice.ExcelApi.Application) 9 | 10 | (require '[clojure.string :as str]) 11 | 12 | (defn comma-interpose [s] (apply str (interpose ", " s))) 13 | (defn line-interpose [s] (apply str (interpose "\r\n" s))) 14 | 15 | 16 | (def letters "ABCDEFGHIJKLMNOPQRSTUVWXYZ") 17 | (def letter->val (into {} (map-indexed (fn [i s] [s i]) letters))) 18 | 19 | (defn letter->val2 20 | "column number of excel coumn A, AZ etc" 21 | [[s t :as ss]] 22 | (if t 23 | (apply + 26 24 | (map * 25 | (map letter->val (reverse ss)) 26 | (map #(Math/Pow 26 %) (range)))) 27 | (letter->val s))) 28 | 29 | (defn col-num 30 | "column number of reference in form A4 etc" 31 | [s] 32 | (if (string? s) 33 | (letter->val2 (re-find #"[A-Z]+" s)) 34 | (second s))) 35 | 36 | (defn row-num 37 | [s] 38 | (if (string? s) 39 | (dec (int (re-find #"[0-9]+" s))) 40 | (first s))) 41 | 42 | ;;DEPRECATED!! 43 | ;;WRITING TO THE WORKBOOK RANDOMLY CRASHES IT. 44 | #_(defn insert-value 45 | "Inserts val at ref." 46 | [sheet ref val] 47 | (let [ 48 | i (row-num ref) 49 | j (col-num ref) 50 | ref (ExcelReference. i i j j sheet) 51 | ] 52 | (.SetValue ref val))) 53 | 54 | (defn split-str [s] 55 | (map #(str "\"" (apply str %) "\"") (partition-all 250 s))) 56 | 57 | (defn concatenated-str [s] 58 | (format "CONCATENATE(%s)" (comma-interpose (split-str s)))) 59 | 60 | (defn excel-pr-str [s] 61 | (if (string? s) (concatenated-str (.Replace s "\"" "\"\"")) s)) 62 | 63 | (defn formula-str 64 | "Generates Excel formula string =f(arg1, \"arg2\"...). 65 | Long strings a split via =CONCATENATE to conform to the Excel 255 character limit" 66 | [f & args] 67 | (format "=%s(%s)" f (comma-interpose (map excel-pr-str args)))) 68 | 69 | 70 | (defn regularize-array 71 | "ensures array is rectangular" 72 | [arr] 73 | (let [ 74 | n (apply max (map count arr)) 75 | extend #(take n (concat % (repeat nil))) 76 | ] 77 | (map extend arr))) 78 | 79 | 80 | ;;DEPRECATED!! 81 | ;;WRITING TO THE WORKBOOK RANDOMLY CRASHES IT. 82 | #_(defn insert-values 83 | "Inserts 2d array of values at ref." 84 | [sheet ref values] 85 | (let [ 86 | values (regularize-array values) 87 | m (count values) 88 | n (count (first values)) 89 | values (-> values to-array-2d MainClass/RectangularArray) 90 | i (row-num ref) 91 | j (col-num ref) 92 | id (+ i m -1) 93 | jd (+ j n -1) 94 | ref (ExcelReference. i id j jd sheet) 95 | ] 96 | (-> ref (.SetValue values)))) 97 | 98 | (defn get-values 99 | "Returns values at ref which is of the form A1 or A1:B6. 100 | Single cell selections are returned as a value, 2D selections as an Object[][] array" 101 | [sheet ref] 102 | (let [ 103 | refs (if (.Contains ref ":") (str/split ref #":") [ref ref]) 104 | [i id] (map row-num refs) 105 | [j jd] (map col-num refs) 106 | value (.GetValue (ExcelReference. i id j jd sheet)) 107 | ] 108 | (if (.Contains ref ":") 109 | (MainClass/RaggedArray value) 110 | value))) 111 | 112 | ;;DEPRECATED!! 113 | ;;WRITING TO THE WORKBOOK RANDOMLY CRASHES IT. 114 | #_(defn insert-formula 115 | "Takes a single formula and inserts it into one or many cells. 116 | Use this instead of insert-values when you have a formula. 117 | Because Excel-REPL abuses threads the formulas may be stale when first inserted. 118 | " 119 | [sheet ref formula] 120 | (let [ 121 | refs (if (.Contains ref ":") (str/split ref #":") [ref ref]) 122 | [i id] (map row-num refs) 123 | [j jd] (map col-num refs) 124 | ref (ExcelReference. i id j jd sheet) 125 | ] 126 | (XlCall/Excel XlCall/xlcFormulaFill (object-array [formula ref])))) 127 | 128 | ;;DEPRECATED!! 129 | ;;WRITING TO THE WORKBOOK RANDOMLY CRASHES IT. 130 | #_(defn add-sheet 131 | "Adds new sheet to current workbook." 132 | [name] 133 | (let [ 134 | sheets (-> (Application/GetActiveInstance) .ActiveWorkbook .Worksheets) 135 | existing-names (set (map #(.Name %) sheets)) 136 | name (if (existing-names name) 137 | (loop [i 1] 138 | (let [new-name (format "%s (%s)" name i)] 139 | (if (existing-names new-name) 140 | (recur (inc i)) 141 | new-name))) name) 142 | sheet (.Add sheets) 143 | ] 144 | (set! (.Name sheet) name))) 145 | 146 | (defn require-sheet [v] 147 | "Require excel spreadsheet. V is of form 148 | [sheet A C D] 149 | [sheet A C D :as alias] 150 | A C D are the columns containing source code" 151 | (let [ 152 | sheet-name (first v) 153 | [_as alias-name] (take-last 2 v) 154 | [alias-name cols] 155 | (if (= :as _as) 156 | [alias-name (drop 1 (drop-last 2 v))] 157 | [sheet-name (drop 1 v)]) 158 | ns-aliases (-> *ns* ns-aliases keys set) 159 | ] 160 | (if-not (ns-aliases alias-name) 161 | (let [ 162 | source 163 | (apply str 164 | (flatten 165 | (for [col cols] 166 | (line-interpose 167 | (filter string? 168 | (map first 169 | (get-values (str sheet-name) (format "%s1:%s200" col col)))))))) 170 | ] 171 | (MainClass/my_eval source (str sheet-name)) 172 | (require (vector sheet-name :as alias-name)))))) 173 | 174 | ;;DEPRECATED!! 175 | ;;WRITING TO THE WORKBOOK RANDOMLY CRASHES IT. 176 | #_(defmacro clear-contents 177 | "Clears an m by n grid at sheet, ref. 178 | Must be called inside udf/in-macro-context" 179 | [sheet ref m n] 180 | `(interop/insert-values ~sheet ~ref 181 | (let [ 182 | row# (repeat ~n nil) 183 | rows# (repeat ~m row#) 184 | ] 185 | rows#))) 186 | 187 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/excel_repl/udf.clj: -------------------------------------------------------------------------------- 1 | (ns excel-repl.udf) 2 | 3 | (import System.CodeDom.Compiler.CompilerParameters) 4 | (import Microsoft.CSharp.CSharpCodeProvider) 5 | (import System.Reflection.BindingFlags) 6 | (import ClojureExcel.MainClass) 7 | (import System.Windows.Forms.MessageBox) 8 | 9 | (assembly-load "ExcelApi") 10 | (import NetOffice.ExcelApi.Application) 11 | 12 | (require '[excel-repl.schedule-udf :as schedule-udf]) 13 | (require '[excel-repl.util :as util]) 14 | 15 | (def loaded-classes (MainClass/AssemblyPaths));convenience method because Stack Overflow gave the example in C# 16 | (defn load-path [s] (some #(if (.Contains % s) %) loaded-classes)) 17 | 18 | (defn my-compile [code] 19 | (let [ 20 | cp (CompilerParameters.) 21 | ] 22 | (set! (.GenerateExecutable cp) false) 23 | (set! (.GenerateInMemory cp) true) 24 | (-> cp .ReferencedAssemblies (.Add (load-path "System.Windows.Forms.dll"))) 25 | (-> cp .ReferencedAssemblies (.Add (load-path "Clojure.dll"))) 26 | (-> cp .ReferencedAssemblies (.Add (load-path "ExcelDna.Integration.dll"))) 27 | ; (-> cp .ReferencedAssemblies (.Add (load-path "System.dll"))) 28 | ; (-> cp .ReferencedAssemblies (.Add "Z:\\Documents\\Visual Studio 2013\\Projects\\Excel-REPL\\ProcessOutput\\bin\\Debug")) 29 | (-> cp .ReferencedAssemblies (.Add (load-path "System.Core.dll"))) 30 | (.CompileAssemblyFromSource 31 | (CSharpCodeProvider.) 32 | cp (into-array [code])))) 33 | 34 | (def to-clean {"?" "_QMARK_" "!" "_BANG_" ">" "_GT_" "<" "_LT_" "-" "_"}) 35 | 36 | (defn clean-str [s] 37 | (reduce (fn [s [old new]] (.Replace s old new)) (.ToLower (str s)) to-clean)) 38 | 39 | 40 | (defn dirty-arglist? [l] 41 | (some #(or (= '& %) (map? %)) l)) 42 | 43 | (defn filter-arglists [v] 44 | (let [ 45 | {:keys [name arglists doc export async]} (meta v) 46 | arglists (remove dirty-arglist? arglists) 47 | ] 48 | (if (and (not-empty arglists) export) [(clean-str name) arglists doc async (var-get v)]))) 49 | 50 | (defn filter-ns-interns [ns] 51 | (filter identity (map filter-arglists (vals (ns-interns ns))))) 52 | 53 | (defn filter-all-interns [] 54 | (mapcat filter-ns-interns (schedule-udf/get-ns))) 55 | 56 | (defn emit-static-method [method-name name arglist doc async] 57 | (let [ 58 | doc (format "[ExcelFunction(Description=@\"%s\")]" (or doc "")) 59 | f #(if (vector? %) 60 | (if (vector? (first %)) 61 | "Object[,] " 62 | "Object[] ") 63 | "Object ") 64 | arg-types (map f arglist) 65 | clean-args (map #(if (vector? %) (gensym) (clean-str %)) arglist) 66 | arglist1 (util/comma-interpose (map str arg-types clean-args)) 67 | clean-args2 (map (fn [original-arg cleaned] 68 | (if (and (vector? original-arg) (vector? (first original-arg))) 69 | (format "RaggedArray(%s)" cleaned) 70 | cleaned)) arglist clean-args) 71 | arglist2 (util/comma-interpose clean-args2) 72 | arglist3 (util/comma-interpose clean-args) 73 | 74 | invoke-body (format "try { return cleanValue(%s.invoke(%s)); } catch (Exception e) {return e.ToString();}" name arglist2) 75 | invoke-body (if async 76 | (format "return ExcelAsyncUtil.Run(\"\", new Object[]{%s}, delegate 77 | { 78 | %s 79 | });" arglist3 invoke-body) 80 | invoke-body) 81 | ] 82 | (format "%s 83 | public static object %s(%s) 84 | { 85 | %s 86 | }" doc method-name arglist1 invoke-body))) 87 | 88 | (defn emit-static-methods [[name arglists doc async]] 89 | (let [ 90 | method-names (if (= 1 (count arglists)) 91 | [(.ToUpper name)] 92 | (map #(str (.ToUpper name) (count %)) arglists))] 93 | (util/line-interpose (map #(emit-static-method %1 name %2 doc async) method-names arglists)))) 94 | 95 | (defn class-str 96 | ([d] 97 | (let [ 98 | fns (map first d) 99 | fn-str (util/comma-interpose fns) 100 | construct-fn-str (util/comma-interpose (map #(str "IFn " %) fns)) 101 | construct-body-str (apply str (map #(format " Class1.%s = %s;\r\n" % %) fns)) 102 | static-methods (util/line-interpose (map emit-static-methods d)) 103 | 104 | s (MainClass/ResourceSlurp "Class1.cs") 105 | s (.Replace s "ifn_list" fn-str) 106 | s (.Replace s "IFn foo" construct-fn-str) 107 | s (.Replace s "foo;" construct-body-str) 108 | s (.Replace s " private void Poo() { }" static-methods) 109 | ] 110 | s))) 111 | 112 | (defn get-methods [t] 113 | (.GetMethods t (enum-or BindingFlags/Public BindingFlags/Static))) 114 | 115 | (defn export-udfs [] 116 | (let [d (filter-all-interns)] 117 | (if (not-empty d) 118 | (let [ 119 | _ (-> d class-str util/to-clipboard) 120 | t (-> d class-str my-compile .CompiledAssembly .GetTypes first) 121 | types (map last d) 122 | constructor-args (object-array types) 123 | ] 124 | (Activator/CreateInstance t constructor-args) 125 | (MainClass/RegisterMethods (get-methods t)))))) 126 | 127 | (defn export-fns [] 128 | (schedule-udf/add-curr-ns) 129 | (.Run (Application/GetActiveInstance) "ExportUdfs")) 130 | 131 | (defmacro in-macro-context 132 | "Evaluates body within an Excel macro context so that cell values can be set without throwing an exception." 133 | [& body] 134 | `(do 135 | (schedule-udf/add-fn 136 | (fn [] ~@body)) 137 | (.Run (NetOffice.ExcelApi.Application/GetActiveInstance) "InvokeAnonymousMacros"))) 138 | 139 | (defn invoke-anonymous-macros [] 140 | (or (last (map #(%) (schedule-udf/get-fns))) "Result Empty")) 141 | 142 | (set! MainClass/export_udfs export-udfs) 143 | ;(set! MainClass/invoke_anonymous_macros invoke-anonymous-macros) 144 | 145 | (defn split-words [n s] 146 | (loop [ 147 | todo s 148 | sb (StringBuilder.) 149 | i 0 150 | done []] 151 | (if-let [c (first todo)] 152 | (do 153 | (.Append sb c) 154 | (if (and (> i n) (= \space c)) 155 | (recur (rest s) (StringBuilder.) 0 (conj done (str sb))) 156 | (recur (rest s) sb (inc i) done))) 157 | (let [ 158 | last-line (str sb) 159 | ] 160 | (if (= "" last-line) 161 | done 162 | (conj done last-line)))))) 163 | 164 | 165 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Excel REPL 2 | 3 | Boost your productivity with a full Clojure programming environment in Microsoft Excel 4 | 5 | Excel REPL makes it easy to start a ClojureCLR Repl from within Excel. Simply install it as an Excel Add-In to provide a few additional Excel Functions 6 | 7 | ## Download 8 | 9 | [Installer](https://github.com/whamtet/Excel-REPL/releases/download/0.1/Excel-REPL.exe) (requires administrator permissions). 10 | 11 | There is a [Manual Installer](https://github.com/whamtet/Excel-REPL/releases/download/0.1/Excel-REPL.zip) if you lack administrator permissions on your machine. 12 | 13 | ## Usage 14 | 15 | Select output column 16 | 17 | ![Step1](Step1.png) 18 | 19 | Type ```=Load(A:A)``` where A is the input column. Press CTRL+SHIFT+ENTER, not just enter. 20 | 21 | ![Step2](Step2.png) 22 | 23 | Create your first bug. Excel-REPL splits the stack trace down the output column. 24 | 25 | NB: Excel 2003 or earlier does not support entire column selection. Type ```=Load(A1:A200)``` instead. 26 | 27 | ![Step3](Step3.png) 28 | 29 | ## Demo Spreadsheet. 30 | 31 | Download [Excel-REPL.xlsx](https://github.com/whamtet/Excel-REPL/releases/download/0.1/Excel-REPL.xlsx) for a quick demo. 32 | If this doesn't work correctly you must have an installation error. Please contact the author straight away. 33 | 34 | ## Export 35 | 36 | ```clojure 37 | (defn ^:export f [] ...) 38 | 39 | (defn ^:export g ([] "No Args") ([x] "One Arg")) 40 | 41 | (defn ^:export h [single-cell-argument [_ :as excel-array-argument]] ...) 42 | 43 | (defn ^:export i [[[_] :as two-d-array] ...) 44 | 45 | (require 'excel-repl.udf) 46 | (excel-repl.udf/export-fns) ;exports the above functions 47 | ``` 48 | 49 | `excel-repl.udf/export-fns` will export as Excel user defined functions all functions with `^:export` metadata in the current namespace. Functions with a single arglist are simply exported as their name. Multiarity functions include the arity. In the example above f will export `=F()` and g will export `=G0()` and `=G1(x)`. 50 | 51 | Excel REPL assumes all arguments are passed as single cell selections (A1, B6 etc). To indicate that an argument should be an array selection declare that argument with vector destructuring. For 2D arrays use double destructuring. 52 | 53 | `excel-repl.udf/export-fns` abuses Excel slightly and may fail on the first one or two invocations in a given session. 54 | 55 | ## Asynchronous Export 56 | 57 | ```clojure 58 | (defn ^:export ^:async f [x] ...) 59 | ``` 60 | Asynchronous export caches on arguments to f. 61 | 62 | ## Read workbook 63 | 64 | You may read values directly from the workbook 65 | 66 | ```clojure 67 | (require '[excel-repl.interop :as interop]) 68 | 69 | (interop/get-values "MySheet" "A6") 70 | (interop/get-values "AnotherSheet" "A6:B7") 71 | 72 | ``` 73 | Please see [interop.clj](https://github.com/whamtet/Excel-REPL/blob/master/Excel-REPL/nrepl/excel_repl/interop.clj) for the functions to manipulate the worksheet. 74 | 75 | ## Returning 1D and 2D arrays 76 | 77 | If `Load` returns a 1 or 2 dimensional collection you may paste it into a range of Excel Cells. To do so 78 | 79 | 1) Drag from the top left hand corner the number of cells for your output 80 | 81 | 2) Click in the formula bar and enter your formula 82 | 83 | 3) Press Control + Shift + Enter instead of simply enter 84 | 85 | WARNING: Only `Load` can be used in this way. If you return exported functions in this way Excel will crash. 86 | 87 | ## Error Messages 88 | 89 | Errors are caught and returned as text within the output cells. The stacktrace is split down the column so select multiple cells for output as mentioned above. 90 | 91 | ## Auxiliary Methods 92 | 93 | Excel REPL adds useful functions and macros to clojure.core that are useful when interacting with a worksheet. Please see [excel-repl.clj](https://github.com/whamtet/Excel-REPL/blob/master/Excel-REPL/excel-repl.clj) for details. 94 | 95 | If you wish to pull stuff off the net straight into your worksheet [clr-http-lite](https://github.com/whamtet/clr-http-lite) is included 96 | 97 | ```clojure 98 | 99 | (require '[clr-http.lite.client :as client]) 100 | 101 | (client/get "http://google.com") 102 | => {:status 200 103 | :headers {"date" "Sun, 01 Aug 2010 07:03:49 GMT" 104 | "cache-control" "private, max-age=0" 105 | "content-type" "text/html; charset=ISO-8859-1" 106 | ...} 107 | :body "..."} 108 | 109 | ``` 110 | 111 | ## Database 112 | 113 | Excel REPL provides convenience methods for connecting directly to a mongo database 114 | 115 | ```clojure 116 | (require '[excel-repl.coerce-db :as coerce-db]) 117 | 118 | (defonce connection (DB/Connect)) 119 | 120 | (DB/Set connection "test-values" (coerce-db/clojure->mongo {:hi "there"} )) 121 | (-> connection (DB/Get "test-values") coerce-db/mongo->clojure str); {:hi "there"} 122 | ``` 123 | 124 | ## NREPL 125 | 126 | Excel REPL uses ClojureCLR which has less support than the main JVM implementation. You may wish to connect to an external Clojure repl. Both HTTP and TCP connections are supported. 127 | 128 | ```clojure 129 | (require '[clojure.tools.nrepl :as nrepl]) 130 | (require '[clojure.data.drawbridge-client :as drawbridge-client]) ;Adds Http support to Nrepl 131 | 132 | (def timeout 10000); 10 seconds 133 | (def tcp-client (nrepl/client (nrepl/url-connect "nrepl://localhost:50000")) timeout) 134 | (def http-client (nrepl/client (nrepl/url-connect "http://some.server/drawbridge-client")) timeout) 135 | 136 | (defn remote-eval-str 137 | "evaluates string on remote repl" 138 | [code-str] 139 | (-> tcp-client 140 | (nrepl/message {:op "eval" :code code-str}) 141 | nrepl/response-values)) 142 | 143 | (defmacro remote-eval [& body] 144 | `(first (remote-eval-str (nrepl/code ~@body)))) 145 | 146 | (remote-eval (+ 1 2)); 3 147 | ``` 148 | 149 | For information about connecting to a Clojure repl via Http, visit [Drawbridge](https://github.com/cemerick/drawbridge). 150 | 151 | ## NREPL Server 152 | 153 | You may also use Excel-REPL as an nrepl server. This makes it easy to push data over to the spreadsheet 154 | 155 | ```clojure 156 | (require '[clojure.tools.nrepl.server :as server]) 157 | (defonce server (server/start-server)) 158 | ``` 159 | 160 | ## Build 161 | 162 | The build process is a bit of a manual hack. Please contact the author if you want help with this. 163 | 164 | ## System Requirements 165 | 166 | Excel Repl works with Microsoft Excel 97+ (that's quite old) and Microsoft .NET 4.0 or 4.5. 167 | 168 | ## Gotchas 169 | 170 | Be careful when spitting. Excel sometimes runs the code several times, creating a race condition. Use the following pattern 171 | 172 | ```clojure 173 | (defonce o (Object.)) 174 | (locking o (spit my-file contents)) 175 | ``` 176 | -------------------------------------------------------------------------------- /Excel-REPL/Excel-REPL.csproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Debug 6 | AnyCPU 7 | {2EB259F1-F88C-44C2-8B63-F61522F43595} 8 | Library 9 | Properties 10 | Excel_REPL 11 | Excel-REPL 12 | v4.5 13 | 512 14 | 15 | 16 | true 17 | full 18 | false 19 | bin\Debug\ 20 | DEBUG;TRACE 21 | prompt 22 | 4 23 | 24 | 25 | pdbonly 26 | true 27 | bin\Release\ 28 | TRACE 29 | prompt 30 | 4 31 | 32 | 33 | 34 | ..\packages\Clojure.1.7.0\lib\net40\Clojure.dll 35 | True 36 | 37 | 38 | Z:\Downloads\clojure-clr\bin\4.0\Release\clojure.clr.io.clj.dll 39 | 40 | 41 | ..\packages\NetOffice.Excel.1.7.3.0\lib\net45\ExcelApi.dll 42 | True 43 | 44 | 45 | ..\packages\ExcelDna.Integration.0.33.9\lib\ExcelDna.Integration.dll 46 | True 47 | 48 | 49 | ..\packages\DotNetZip.1.9.3\lib\net20\Ionic.Zip.dll 50 | 51 | 52 | ..\packages\Clojure.1.7.0\lib\net40\Microsoft.Dynamic.dll 53 | True 54 | 55 | 56 | True 57 | 58 | 59 | ..\packages\Clojure.1.7.0\lib\net40\Microsoft.Scripting.dll 60 | True 61 | 62 | 63 | ..\packages\NetOffice.Core.1.7.3.0\lib\net45\NetOffice.dll 64 | True 65 | 66 | 67 | ..\packages\NetOffice.Core.1.7.3.0\lib\net45\OfficeApi.dll 68 | True 69 | 70 | 71 | ..\packages\NetOffice.Outlook.1.7.3.0\lib\net45\OutlookApi.dll 72 | True 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | ..\packages\NetOffice.Core.1.7.3.0\lib\net45\VBIDEApi.dll 86 | True 87 | 88 | 89 | 90 | 91 | Code 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | PreserveNewest 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | xcopy "Z:\Downloads\Excel-REPL\packages\ExcelDNA.AddIn.0.33.9\tools\ExcelDna.xll" "$(TargetDir)Excel-REPL-AddIn.xll*" /C /Y 111 | xcopy "$(TargetDir)Excel-REPL-AddIn.dna*" "$(TargetDir)Excel-REPL-AddIn64.dna*" /C /Y 112 | xcopy "Z:\Downloads\Excel-REPL\packages\ExcelDNA.AddIn.0.33.9\tools\ExcelDna64.xll" "$(TargetDir)Excel-REPL-AddIn64.xll*" /C /Y 113 | Z:\Downloads\Excel-REPL\packages\ExcelDNA.AddIn.0.33.9\tools\ExcelDnaPack.exe "$(TargetDir)Excel-REPL-AddIn.dna" /Y 114 | Z:\Downloads\Excel-REPL\packages\ExcelDNA.AddIn.0.33.9\tools\ExcelDnaPack.exe "$(TargetDir)Excel-REPL-AddIn64.dna" /Y 115 | 116 | 123 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/middleware.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.tools.nrepl.middleware 2 | (:require clojure.tools.nrepl 3 | [clojure.tools.nrepl.transport :as transport] 4 | [clojure.tools.nrepl.misc :as misc] 5 | [clojure.set :as set]) 6 | (:refer-clojure :exclude (comparator))) 7 | 8 | (defn- var-name 9 | [^clojure.lang.Var v] 10 | (str (.ns v) \/ (.sym v))) 11 | 12 | (defn- wrap-conj-descriptor 13 | [descriptor-map h] 14 | (fn [{:keys [op descriptors] :as msg}] 15 | (h (if-not (= op "describe") 16 | msg 17 | (assoc msg :descriptors (merge descriptor-map descriptors)))))) 18 | 19 | (defn set-descriptor! 20 | "Sets the given [descriptor] map as the ::descriptor metadata on 21 | the provided [middleware-var], after assoc'ing in the var's 22 | fully-qualified name as the descriptor's \"implemented-by\" value." 23 | [middleware-var descriptor] 24 | (let [descriptor (-> descriptor 25 | (assoc :implemented-by (-> middleware-var var-name symbol)) 26 | (update-in [:expects] (fnil conj #{}) "describe"))] 27 | (alter-meta! middleware-var assoc ::descriptor descriptor) 28 | (alter-var-root middleware-var #(comp (partial wrap-conj-descriptor 29 | (:handles descriptor)) %)))) 30 | 31 | (defn- safe-version 32 | [m] 33 | (into {} (filter (fn [[_ v]] (or (number? v) (string? v))) m))) 34 | 35 | (defn- java-version 36 | [] 37 | (let [version-string (.ToString Environment/Version) ;;; (System/getProperty "java.version") 38 | version-seq (re-seq #"\d+" version-string) 39 | ;; add detailed version info only if we found four numbers in the version string 40 | version-map (if (<= 3 (count version-seq)) 41 | (zipmap [:major :minor :incremental :update] version-seq) 42 | {})] 43 | (assoc version-map :version-string version-string))) 44 | 45 | (defn wrap-describe 46 | [h] 47 | (fn [{:keys [op descriptors verbose? transport] :as msg}] 48 | (if (= op "describe") 49 | (transport/send transport (misc/response-for msg 50 | {:ops (if verbose? 51 | descriptors 52 | (into {} (map #(vector (key %) {}) descriptors))) 53 | :versions {:nrepl (safe-version clojure.tools.nrepl/version) 54 | :clojure (safe-version 55 | (assoc *clojure-version* :version-string (clojure-version))) 56 | :java {:version-string (safe-version (java-version))}} 57 | :status :done})) 58 | (h msg)))) 59 | 60 | (set-descriptor! #'wrap-describe 61 | {:handles {"describe" 62 | {:doc "Produce a machine- and human-readable directory and documentation for the operations supported by an nREPL endpoint." 63 | :requires {} 64 | :optional {"verbose?" "Include informational detail for each \"op\"eration in the return message."} 65 | :returns {"ops" "Map of \"op\"erations supported by this nREPL endpoint" 66 | "versions" "Map containing version maps (like *clojure-version*, e.g. major, minor, incremental, and qualifier keys) for values, component names as keys. Common keys include \"nrepl\" and \"clojure\"."}}}}) 67 | ; eliminate implicit expectation of "describe" handler; this is the only 68 | ; special case introduced by the conj'ing of :expects "describe" by set-descriptor! 69 | (alter-meta! #'wrap-describe update-in [::descriptor :expects] disj "describe") 70 | 71 | (defn- dependencies 72 | [set start dir] 73 | (let [ops (start dir) 74 | deps (set/select 75 | (comp seq (partial set/intersection ops) :handles) 76 | set)] 77 | (when (deps start) 78 | (throw (ArgumentException. ;DM: IllegalArgumentException 79 | (format "Middleware %s depends upon itself via %s" 80 | (:implemented-by start) 81 | dir)))) 82 | (concat ops 83 | (mapcat #(dependencies set % dir) deps)))) 84 | 85 | (defn- comparator 86 | [{a-requires :requires a-expects :expects a-handles :handles} 87 | {b-requires :requires b-expects :expects b-handles :handles}] 88 | (or (->> (into {} [[[a-requires b-handles] -1] 89 | [[a-expects b-handles] 1] 90 | [[b-requires a-handles] 1] 91 | [[b-expects a-handles] -1]]) 92 | (map (fn [[sets ret]] 93 | (and (seq (apply set/intersection sets)) ret))) 94 | (some #{-1 1})) 95 | 0)) 96 | 97 | (defn- extend-deps 98 | [middlewares] 99 | (let [descriptor #(-> % meta ::descriptor) 100 | middlewares (concat middlewares 101 | (->> (map descriptor middlewares) 102 | (mapcat (juxt :expects :requires)) 103 | (mapcat identity) 104 | (filter var?)))] 105 | (doseq [m (remove descriptor middlewares)] 106 | (binding [*out* *err*] 107 | (printf "[WARNING] No nREPL middleware descriptor in metadata of %s, see clojure.tools.middleware/set-descriptor!" m) 108 | (println))) 109 | (let [middlewares (set (for [m middlewares] 110 | (-> (descriptor m) 111 | ; only conj'ing m here to support direct reference to 112 | ; middleware dependencies in :expects and :requires, 113 | ; e.g. interruptable-eval's dep on 114 | ; clojure.tools.nrepl.middleware.pr-values/pr-values 115 | (update-in [:handles] (comp set #(conj % m) keys)) 116 | (assoc :implemented-by m))))] 117 | (set (for [m middlewares] 118 | (reduce 119 | #(update-in % [%2] into (dependencies middlewares % %2)) 120 | m #{:expects :requires})))))) 121 | 122 | (defn- conj-sorted 123 | [stack comparator x] 124 | (let [comparisons (->> stack 125 | (map-indexed #(vector % (comparator x %2))) 126 | (remove (comp zero? second))) 127 | lower (ffirst (filter (comp neg? second) comparisons)) 128 | upper (ffirst (reverse (filter (comp pos? second) comparisons))) 129 | ; default conj'ing at the end, a good default for descriptor-less middlewares 130 | [before after] (split-at (or (and upper (inc upper)) lower (count stack)) stack)] 131 | (into [] (concat before [x] after)))) 132 | 133 | ;; TODO throw exception when the stack doesn't satisfy the requirements of the descriptors involved 134 | (defn linearize-middleware-stack 135 | [middlewares] 136 | (->> middlewares 137 | extend-deps 138 | (sort-by (comp count (partial apply concat) (juxt :expects :requires))) 139 | reverse 140 | (reduce #(conj-sorted % comparator %2) []) 141 | (map :implemented-by))) 142 | 143 | ;;; documentation utilities ;;; 144 | 145 | ; oh, kill me now 146 | (defn- markdown-escape 147 | [^String s] 148 | (System.Text.RegularExpressions.Regex/Replace s "([*_])" "\\\\$1")) ;DM: (.replaceAll s "([*_])" "\\\\$1") 149 | 150 | (defn- message-slot-markdown 151 | [msg-slot-docs] 152 | (apply str (for [[k v] msg-slot-docs] 153 | (format "* `%s` %s\n" (pr-str k) (markdown-escape v))))) 154 | 155 | (defn- describe-markdown 156 | "Given a message containing the response to a verbose :describe message, 157 | generates a markdown string conveying the information therein, suitable for 158 | use in e.g. wiki pages, github, etc. 159 | 160 | (This is currently private because markdown conversion surely shouldn't 161 | be part of the API here...?)" 162 | [{:keys [ops versions]}] 163 | (apply str "# Supported nREPL operations 164 | 165 | generated from a verbose 'describe' response (nREPL v" 166 | (:version-string clojure.tools.nrepl/version) 167 | ")\n\n## Operations" 168 | (for [[op {:keys [doc optional requires returns]}] ops] 169 | (str "\n\n### `" (pr-str op) "`\n\n" 170 | (markdown-escape doc) "\n\n" 171 | "###### Required parameters\n\n" 172 | (message-slot-markdown requires) 173 | "\n\n###### Optional parameters\n\n" 174 | (message-slot-markdown optional) 175 | "\n\n###### Returns\n\n" 176 | (message-slot-markdown returns))))) -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clr_http/lite/client.clj: -------------------------------------------------------------------------------- 1 | (ns clr-http.lite.client 2 | "Batteries-included HTTP client." 3 | (:require [clojure.string :as str] 4 | [clojure.clr.io :as io] 5 | [clr-http.lite.core :as core] 6 | [clr-http.lite.util :as util]) 7 | (:import 8 | System.Text.Encoding 9 | System.Text.UTF8Encoding 10 | ) 11 | (:refer-clojure :exclude (get))) 12 | 13 | (def str->encoding 14 | (into {} 15 | (for [encoding (Encoding/GetEncodings)] 16 | [(.Name encoding) (.GetEncoding encoding)]))) 17 | 18 | (defn update [m k f & args] 19 | (assoc m k (apply f (m k) args))) 20 | 21 | (defn parse-url [url] 22 | (let [uri (Uri. url)] 23 | {:scheme (-> uri .Scheme keyword) 24 | :server-name (.Host uri) 25 | :server-port (.Port uri) 26 | :uri (.LocalPath uri) 27 | :user-info (.UserInfo uri) 28 | :query-string (let [q (.Query uri)] 29 | (if-not (empty? q) (.Substring q 1)))})) 30 | 31 | (def unexceptional-status? 32 | #{200 201 202 203 204 205 206 207 300 301 302 303 307}) 33 | 34 | (defn wrap-exceptions [client] 35 | (fn [req] 36 | (let [{:keys [status] :as resp} (client req)] 37 | (if (or (not (clojure.core/get req :throw-exceptions true)) 38 | (unexceptional-status? status)) 39 | resp 40 | (throw (Exception. (pr-str resp))) 41 | #_(throw+ resp "clj-http: status %s" (:status %)))))) 42 | 43 | (declare wrap-redirects) 44 | 45 | (defn follow-redirect [client req resp] 46 | (let [url (get-in resp [:headers "location"])] 47 | ((wrap-redirects client) (assoc req :url url)))) 48 | 49 | (defn wrap-redirects [client] 50 | (fn [{:keys [request-method follow-redirects] :as req}] 51 | (let [{:keys [status] :as resp} (client req)] 52 | (cond 53 | (= false follow-redirects) 54 | resp 55 | (and (#{301 302 307} status) (#{:get :head} request-method)) 56 | (follow-redirect client req resp) 57 | (and (= 303 status) (= :head request-method)) 58 | (follow-redirect client (assoc req :request-method :get) resp) 59 | :else 60 | resp)))) 61 | 62 | (defn wrap-decompression [client] 63 | (fn [req] 64 | (if (get-in req [:headers "Accept-Encoding"]) 65 | (client req) 66 | (let [req-c (update req :headers assoc "Accept-Encoding" "gzip, deflate") 67 | resp-c (client req-c)] 68 | (case (or (get-in resp-c [:headers "Content-Encoding"]) 69 | (get-in resp-c [:headers "content-encoding"])) 70 | "gzip" (update resp-c :body util/gunzip) 71 | "deflate" (update resp-c :body util/inflate) 72 | resp-c))))) 73 | 74 | (defn wrap-output-coercion [client] 75 | (fn [{:keys [as] :as req}] 76 | (let [{:keys [body] :as resp} (client req)] 77 | (if body 78 | (cond 79 | (keyword? as) 80 | (condp = as 81 | ;; Don't do anything for streams 82 | :stream resp 83 | ;; Don't do anything when it's a byte-array 84 | :byte-array resp 85 | ;; Automatically determine response type 86 | :auto 87 | (assoc resp 88 | :body 89 | (let [typestring (get-in resp [:headers "content-type"])] 90 | (cond 91 | (.startsWith (str typestring) "text/") 92 | (if-let [charset (second (re-find #"charset=(.*)" 93 | (str typestring)))] 94 | (.GetString (Activator/CreateInstance (str->encoding charset UTF8Encoding)) body) 95 | (util/utf8-string body)) 96 | :else 97 | (util/utf8-string body)))) 98 | ;; No :as matches found 99 | (update-in resp [:body] util/utf8-string)) 100 | ;; Try the charset given if a string is specified 101 | (string? as) 102 | (update-in resp [:body] #(.GetString (Activator/CreateInstance (str->encoding as UTF8Encoding)) %)) 103 | ;; Return a regular UTF-8 string body 104 | :else 105 | (update-in resp [:body] util/utf8-string)) 106 | resp)))) 107 | 108 | (defn wrap-input-coercion [client] 109 | (fn [{:keys [body body-encoding length] :as req}] 110 | (let [ 111 | encoding (str->encoding body-encoding UTF8Encoding) 112 | ] 113 | (if body 114 | (cond 115 | (string? body) 116 | (client (assoc req 117 | :body (.GetBytes (Activator/CreateInstance encoding) body) 118 | :character-encoding (or body-encoding "UTF-8"))) 119 | :else 120 | (client req)) 121 | (client req))))) 122 | 123 | (defn content-type-value [type] 124 | (if (keyword? type) 125 | (str "application/" (name type)) 126 | type)) 127 | 128 | (defn wrap-content-type [client] 129 | (fn [{:keys [content-type] :as req}] 130 | (if content-type 131 | (client (update-in req [:content-type] content-type-value)) 132 | (client req)))) 133 | 134 | (defn wrap-accept [client] 135 | (fn [{:keys [accept] :as req}] 136 | (if accept 137 | (client (-> req 138 | (dissoc :accept) 139 | (assoc-in [:headers "Accept"] 140 | (content-type-value accept)))) 141 | (client req)))) 142 | 143 | (defn accept-encoding-value [accept-encoding] 144 | (str/join ", " (map name accept-encoding))) 145 | 146 | (defn wrap-accept-encoding [client] 147 | (fn [{:keys [accept-encoding] :as req}] 148 | (if accept-encoding 149 | (client (-> req (dissoc :accept-encoding) 150 | (assoc-in [:headers "Accept-Encoding"] 151 | (accept-encoding-value accept-encoding)))) 152 | (client req)))) 153 | 154 | (defn generate-query-string [params] 155 | (str/join "&" 156 | (mapcat (fn [[k v]] 157 | (if (sequential? v) 158 | (map #(str (util/url-encode (name %1)) 159 | "=" 160 | (util/url-encode (str %2))) 161 | (repeat k) v) 162 | [(str (util/url-encode (name k)) 163 | "=" 164 | (util/url-encode (str v)))])) 165 | params))) 166 | 167 | (defn wrap-query-params [client] 168 | (fn [{:keys [query-params] :as req}] 169 | (if query-params 170 | (client (-> req (dissoc :query-params) 171 | (assoc :query-string 172 | (generate-query-string query-params)))) 173 | (client req)))) 174 | 175 | (defn basic-auth-value [basic-auth] 176 | (let [basic-auth (if (string? basic-auth) 177 | basic-auth 178 | (str (first basic-auth) ":" (second basic-auth)))] 179 | (str "Basic " (util/base64-encode (util/utf8-bytes basic-auth))))) 180 | 181 | (defn wrap-basic-auth [client] 182 | (fn [req] 183 | (if-let [basic-auth (:basic-auth req)] 184 | (client (-> req 185 | (dissoc :basic-auth) 186 | (assoc-in [:headers "Authorization"] 187 | (basic-auth-value basic-auth)))) 188 | (client req)))) 189 | 190 | (defn parse-user-info [user-info] 191 | (when user-info 192 | (str/split user-info #":"))) 193 | 194 | (defn wrap-user-info [client] 195 | (fn [req] 196 | (if-let [[user password] (parse-user-info (:user-info req))] 197 | (client (assoc req :basic-auth [user password])) 198 | (client req)))) 199 | 200 | (defn wrap-method [client] 201 | (fn [req] 202 | (if-let [m (:method req)] 203 | (client (-> req 204 | (dissoc :method) 205 | (assoc :request-method m))) 206 | (client req)))) 207 | 208 | (defn wrap-form-params [client] 209 | (fn [{:keys [form-params request-method] :as req}] 210 | (if (and form-params (= :post request-method)) 211 | (client (-> req 212 | (dissoc :form-params) 213 | (assoc :content-type 214 | (content-type-value 215 | :x-www-form-urlencoded) 216 | :body (generate-query-string form-params)))) 217 | (client req)))) 218 | 219 | (defn wrap-url [client] 220 | (fn [req] 221 | (if-let [url (:url req)] 222 | (client (-> req (dissoc :url) (merge (parse-url url)))) 223 | (client req)))) 224 | 225 | #_(defn wrap-unknown-host [client] 226 | (fn [{:keys [ignore-unknown-host?] :as req}] 227 | (try 228 | (client req) 229 | (catch UnknownHostException e 230 | (if ignore-unknown-host? 231 | nil 232 | (throw e)))))) 233 | 234 | (defn wrap-request 235 | "Returns a battaries-included HTTP request function coresponding to the given 236 | core client. See client/client." 237 | [request] 238 | (-> request 239 | wrap-query-params 240 | wrap-user-info 241 | wrap-url 242 | wrap-redirects 243 | wrap-decompression 244 | wrap-input-coercion 245 | wrap-output-coercion 246 | wrap-exceptions 247 | wrap-basic-auth 248 | wrap-accept 249 | wrap-accept-encoding 250 | wrap-content-type 251 | wrap-form-params 252 | wrap-method 253 | ;wrap-unknown-host 254 | )) 255 | 256 | (def #^{:doc 257 | "Executes the HTTP request corresponding to the given map and returns 258 | the response map for corresponding to the resulting HTTP response. 259 | 260 | In addition to the standard Ring request keys, the following keys are also 261 | recognized: 262 | * :url 263 | * :method 264 | * :query-params 265 | * :basic-auth 266 | * :content-type 267 | * :accept 268 | * :accept-encoding 269 | * :as 270 | 271 | The following additional behaviors over also automatically enabled: 272 | * Exceptions are thrown for status codes other than 200-207, 300-303, or 307 273 | * Gzip and deflate responses are accepted and decompressed 274 | * Input and output bodies are coerced as required and indicated by the :as 275 | option."} 276 | request 277 | (wrap-request #'core/request)) 278 | 279 | (defn get 280 | "Like #'request, but sets the :method and :url as appropriate." 281 | [url & [req]] 282 | (request (merge req {:method :get :url url}))) 283 | 284 | (defn head 285 | "Like #'request, but sets the :method and :url as appropriate." 286 | [url & [req]] 287 | (request (merge req {:method :head :url url}))) 288 | 289 | (defn post 290 | "Like #'request, but sets the :method and :url as appropriate." 291 | [url & [req]] 292 | (request (merge req {:method :post :url url}))) 293 | 294 | (defn put 295 | "Like #'request, but sets the :method and :url as appropriate." 296 | [url & [req]] 297 | (request (merge req {:method :put :url url}))) 298 | 299 | (defn delete 300 | "Like #'request, but sets the :method and :url as appropriate." 301 | [url & [req]] 302 | (request (merge req {:method :delete :url url}))) 303 | 304 | (defmacro with-connection-pool 305 | "This macro is a no-op, but left in to support backward-compatibility 306 | with clj-http." 307 | [opts & body] 308 | `(do 309 | ~@body)) 310 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/transport.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:author "Chas Emerick"} 2 | clojure.tools.nrepl.transport 3 | (:require [clojure.tools.nrepl.bencode :as be] 4 | [clojure.clr.io :as io] ;DM: clojure.java.io 5 | [clojure.tools.nrepl.debug :as debug] 6 | [clojure.tools.nrepl.sync-channel :as sc] ;DM: Added 7 | clojure.main ;Matt: Added 8 | (clojure walk set)) 9 | (:use [clojure.tools.nrepl.misc :only (returning uuid)]) 10 | (:refer-clojure :exclude (send)) 11 | (:import (System.IO Stream EndOfStreamException) ;DM: (java.io InputStream OutputStream PushbackInputStream 12 | (clojure.lang PushbackInputStream PushbackTextReader) ;DM: PushbackReader IOException EOFException) 13 | (System.Net.Sockets Socket SocketException) ;DM: (java.net Socket SocketException) 14 | (System.Collections.Concurrent ;DM: (java.util.concurrent SynchronousQueue LinkedBlockingQueue 15 | |BlockingCollection`1[System.Object]|) ;DM: BlockingQueue TimeUnit) 16 | ; clojure.tools.nrepl.transport.Transport ;DM: Added 17 | clojure.lang.RT )) 18 | 19 | (defprotocol Transport 20 | "Defines the interface for a wire protocol implementation for use 21 | with nREPL." 22 | (recv [this] [this timeout] 23 | "Reads and returns the next message received. Will block. 24 | Should return nil the a message is not available after `timeout` 25 | ms or if the underlying channel has been closed.") 26 | (send [this msg] "Sends msg. Implementations should return the transport.")) 27 | 28 | (deftype FnTransport [recv-fn send-fn close] 29 | Transport 30 | ;; TODO this keywordization/stringification has no business being in FnTransport 31 | (send [this msg] #_(debug/prn-thread "FnTransport:: send " msg) (-> msg clojure.walk/stringify-keys send-fn) this) 32 | (recv [this] #_(debug/prn-thread "FnTransprot:: recv ") (.recv this Int32/MaxValue)) ;DM: Long/MAX_VALUE 33 | (recv [this timeout] #_(debug/prn-thread "FnTransport:: recv [" timeout "]") (clojure.walk/keywordize-keys (recv-fn timeout))) 34 | System.IDisposable ;DM: java.io.Closeable 35 | (Dispose [this] #_(debug/prn-thread "FnTranpsort:: Dispose " (.GetHashCode this)) (close))) ;DM: (close [this] (close))) TODO: This violates good IDisposable practice 36 | 37 | (defn fn-transport 38 | "Returns a Transport implementation that delegates its functionality 39 | to the 2 or 3 functions provided." 40 | ([read write] (fn-transport read write nil)) 41 | ([read write close] 42 | (let [read-queue (sc/make-simple-sync-channel) ;DM: (SynchronousQueue.) 43 | msg-pump (future (try 44 | (while true 45 | #_(debug/prn-thread "fn-transport:: ready to read") 46 | (sc/put read-queue (read)) ;DM: .put 47 | #_(debug/prn-thread "fn-transport:: put to queue")) ;DEBUG 48 | (catch Exception t ;DM: Throwable 49 | #_(debug/prn-thread "fn-transport:: caught exception!!!!") 50 | (sc/put read-queue t))))] ;DM: .put 51 | (FnTransport. 52 | (let [failure (atom nil)] 53 | #(if @failure 54 | (throw @failure) 55 | (let [msg (sc/poll read-queue % )] ;DM: .poll, remove TimeUnit/MILLISECONDS 56 | #_(debug/prn-thread "fn-transport:: read from queue: " (let [mstr (str msg)] (if (< (count mstr) 75) mstr (subs mstr 0 75)))) ;DEBUG 57 | (if (instance? Exception msg) ;DM: Throwable 58 | (do #_(debug/prn-thread "fn-transport:: read Exception: " (let [mstr (str msg)] (if (< (count mstr) 75) mstr (subs mstr 0 75)))) (reset! failure msg) (throw msg)) 59 | msg)))) 60 | write 61 | (fn [] (close) #_(future-cancel msg-pump)))))) 62 | 63 | (defmulti #^{:private true} > input 82 | (map (fn [[k v]] [k ( "))) ;DM: .write 141 | session-id (atom nil) 142 | read-msg #(let [code (read r)] 143 | (merge {:op "eval" :code [code] :ns @cns :id (str "eval" (uuid))} 144 | (when @session-id {:session @session-id}))) 145 | read-seq (atom (cons {:op "clone"} (repeatedly read-msg))) 146 | write (fn [{:strs [out err value status ns new-session id] :as msg}] 147 | (when new-session (reset! session-id new-session)) 148 | (when ns (reset! cns ns)) 149 | (doseq [^String x [out err value] :when x] 150 | (.Write w x)) ;DM: .write 151 | (when (and (= status #{:done}) id (.startsWith ^String id "eval")) 152 | (prompt true)) 153 | (.Flush w)) ;DM: .flush 154 | read #(let [head (promise)] 155 | (swap! read-seq (fn [s] 156 | (deliver head (first s)) 157 | (rest s))) 158 | @head)] 159 | (fn-transport read write 160 | (when s 161 | (swap! read-seq (partial cons {:session @session-id :op "close"})) 162 | #(.Close s)))))) ;DM: .close 163 | 164 | (defn tty-greeting 165 | "A greeting fn usable with clojure.tools.nrepl.server/start-server, 166 | meant to be used in conjunction with Transports returned by the 167 | `tty` function. 168 | 169 | Usually, Clojure-aware client-side tooling would provide this upon connecting 170 | to the server, but telnet et al. isn't that." 171 | [transport] 172 | (send transport {:out (str ";; Clojure " (clojure-version) 173 | \newline "user=> ")})) 174 | 175 | (deftype QueueTransport [^|System.Collections.Concurrent.BlockingCollection`1[System.Object]| in 176 | ^|System.Collections.Concurrent.BlockingCollection`1[System.Object]| out] ;DM: ^BlockingQueue 177 | clojure.tools.nrepl.transport.Transport 178 | (send [this msg] (.Add out msg) this) ;DM: .put 179 | (recv [this] (.Take in)) ;DM: .take 180 | (recv [this timeout] (let [x nil] (.TryTake in (by-ref x) (int timeout)) x))) ;DM: .poll, removed TimeUnit/MILLISECONDS, added (int .), let, ref 181 | 182 | (defn piped-transports 183 | "Returns a pair of Transports that read from and write to each other." 184 | [] 185 | (let [a (|System.Collections.Concurrent.BlockingCollection`1[System.Object]|.) ;DM: LinkedBlockingQueue 186 | b (|System.Collections.Concurrent.BlockingCollection`1[System.Object]|.)] ;DM: LinkedBlockingQueue 187 | [(QueueTransport. a b) (QueueTransport. b a)])) 188 | -------------------------------------------------------------------------------- /Excel-REPL/MainClass.cs: -------------------------------------------------------------------------------- 1 | using clojure.lang; 2 | using ExcelDna.Integration; 3 | using System; 4 | using System.Collections.Generic; 5 | using System.Linq; 6 | using System.Text; 7 | using System.IO; 8 | using System.Text.RegularExpressions; 9 | using System.Reflection; 10 | using System.Collections.Concurrent; 11 | using System.Windows.Forms; 12 | using System.Threading; 13 | 14 | namespace ClojureExcel 15 | { 16 | public class MainClass : ExcelDna.Integration.CustomUI.ExcelRibbon, IExcelAddIn 17 | { 18 | public void AutoClose() { } 19 | public void AutoOpen() 20 | { 21 | Init(); 22 | ExcelIntegration.RegisterUnhandledExceptionHandler( 23 | ex => "!!! EXCEPTION: " + ex.ToString()); 24 | } 25 | 26 | private static Object GetFirst(Object o) 27 | { 28 | return ((Object[,])o)[0, 0]; 29 | } 30 | 31 | public static IFn export_udfs, format_code; 32 | 33 | public static void ExportUdfs() 34 | { 35 | try 36 | { 37 | export_udfs.invoke(); 38 | } 39 | catch (Exception e) 40 | { 41 | MessageBox.Show(e.ToString()); 42 | } 43 | } 44 | //referenced by excel-repl.udf 45 | public static Object AssemblyPaths() 46 | { 47 | var assemblies = AppDomain.CurrentDomain 48 | .GetAssemblies() 49 | .Where(a => !a.IsDynamic) 50 | .Select(a => a.Location); 51 | return assemblies; 52 | } 53 | //referenced by excel-repl.udf 54 | public static void RegisterMethods(MethodInfo[] methods) 55 | { 56 | List l = new List(); 57 | foreach (MethodInfo info in methods) 58 | { 59 | l.Add(info); 60 | } 61 | Integration.RegisterMethods(l); 62 | } 63 | 64 | private static void Init() 65 | { 66 | try 67 | { 68 | string path = Directory.GetParent(Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)).FullName; 69 | if (Environment.OSVersion.Version.Major >= 6) 70 | { 71 | path = Directory.GetParent(path).ToString(); 72 | } 73 | 74 | 75 | String clojureSrc = ResourceSlurp("excel-repl.clj"); 76 | GetFirst(my_eval2(clojureSrc, "clojure.core")); 77 | clojureSrc = ResourceSlurp("interop.clj"); 78 | my_eval2(clojureSrc, "excel-repl.interop"); 79 | } 80 | catch (Exception e) 81 | { 82 | msg = e.ToString(); 83 | } 84 | } 85 | public static String ResourceSlurp(String resource) 86 | { 87 | return (String)slurp.invoke(Assembly.GetExecutingAssembly().GetManifestResourceStream("Excel_REPL." + resource)); 88 | } 89 | //used by drawbridge-client 90 | public static BlockingCollection GetCollection() 91 | { 92 | return new BlockingCollection(); 93 | } 94 | public static String appendLoadPath(String newPath) 95 | { 96 | String loadPath = Environment.GetEnvironmentVariable("CLOJURE_LOAD_PATH"); 97 | if (loadPath == null) 98 | { 99 | loadPath = newPath; 100 | } 101 | else 102 | { 103 | loadPath += ";" + newPath; 104 | } 105 | Environment.SetEnvironmentVariable("CLOJURE_LOAD_PATH", loadPath); 106 | return loadPath; 107 | } 108 | public static IFn load_string = clojure.clr.api.Clojure.var("clojure.core", "load-string"); 109 | public static IFn slurp = clojure.clr.api.Clojure.var("clojure.core", "slurp"); 110 | public static IFn spit = clojure.clr.api.Clojure.var("clojure.core", "spit"); 111 | private static string msg = "nothing"; 112 | 113 | 114 | public static String GetMsg() 115 | { 116 | return msg; 117 | } 118 | 119 | public static Object my_eval(String input) 120 | { 121 | return my_eval2(input, getSheetName()); 122 | } 123 | 124 | public static Object my_eval2(String input, String sheetName) 125 | { 126 | Object o; 127 | try 128 | { 129 | if (!input.Trim().StartsWith("(ns")) 130 | { 131 | input = String.Format("(ns {0})\n", sheetName) + input; 132 | } 133 | o = load_string.invoke(input); 134 | } 135 | catch (Exception e) 136 | { 137 | return pack(Regex.Split(e.ToString(), "\n")); 138 | } 139 | return process_output(o); 140 | } 141 | 142 | private static Object cleanValue(object o) 143 | { 144 | if (o == null) 145 | { 146 | return ""; 147 | } 148 | if (o is bool) 149 | { 150 | return o; 151 | } 152 | if (o is Ratio) 153 | { 154 | return ((Ratio)o).ToDouble(null); 155 | } 156 | if (o is sbyte 157 | || o is byte 158 | || o is short 159 | || o is ushort 160 | || o is int 161 | || o is uint 162 | || o is long 163 | || o is ulong 164 | || o is float 165 | || o is double 166 | || o is decimal) 167 | { 168 | return o; 169 | } 170 | else 171 | { 172 | return o.ToString(); 173 | } 174 | } 175 | 176 | private static Object process_output(Object o) 177 | { 178 | return process_output(o, 1); 179 | } 180 | private static Object process_output(Object o, int level) 181 | { 182 | if (o is IPersistentCollection) 183 | { 184 | o = ((IPersistentCollection)o).seq(); 185 | } 186 | if (o is ISeq) 187 | { 188 | ISeq r2 = (ISeq)o; 189 | object[] outArr = new object[r2.count()]; 190 | int i = 0; 191 | while (r2 != null) 192 | { 193 | outArr[i] = level == 1 ? process_output(r2.first(), 0) : cleanValue(r2.first()); 194 | i++; 195 | r2 = r2.next(); 196 | } 197 | return level == 1 ? pack(outArr) : outArr; 198 | } 199 | else 200 | { 201 | return level == 1 ? pack(cleanValue(o)) : cleanValue(o); 202 | } 203 | } 204 | private static object pack(object o) 205 | { 206 | if (o is object[]) 207 | { 208 | object[] o2 = (object[])o; 209 | int m = o2.Length; 210 | m = m < 2 ? 2 : m; 211 | int n = 2; 212 | foreach (object o3 in o2) 213 | { 214 | if (o3 is object[]) 215 | { 216 | object[] o4 = (object[])o3; 217 | if (o4.Length > n) 218 | { 219 | n = o4.Length; 220 | } 221 | } 222 | } 223 | var oot = new object[m, n]; 224 | for (int i = 0; i < m; i++) 225 | { 226 | if (i >= o2.Length) 227 | { 228 | for (int j = 0; j < n; j++) 229 | { 230 | oot[i, j] = ""; 231 | } 232 | } 233 | else 234 | { 235 | object o3 = o2[i]; 236 | if (o3 is object[]) 237 | { 238 | object[] o4 = (object[])o3; 239 | for (int j = 0; j < o4.Length; j++) 240 | { 241 | oot[i, j] = o4[j]; 242 | } 243 | for (int j = o4.Length; j < n; j++) 244 | { 245 | oot[i, j] = ""; 246 | } 247 | } 248 | else 249 | { 250 | oot[i, 0] = o3; 251 | for (int j = 1; j < n; j++) 252 | { 253 | oot[i, j] = ""; 254 | } 255 | } 256 | } 257 | } 258 | return oot; 259 | } 260 | else 261 | { 262 | var oot = new object[2, 2]; 263 | oot[0, 0] = o; 264 | oot[0, 1] = ""; 265 | oot[1, 0] = ""; 266 | oot[1, 1] = ""; 267 | return oot; 268 | } 269 | } 270 | 271 | public static String GetVersion() 272 | { 273 | return "0.0.1"; 274 | } 275 | public static Object RaggedArray(Object arrayCandidate) 276 | { 277 | var input = arrayCandidate as Object[,]; 278 | if (input == null) 279 | { 280 | return arrayCandidate; 281 | } 282 | int m = input.GetUpperBound(0) + 1; 283 | int n = input.GetUpperBound(1) + 1; 284 | Object[][] output = new Object[m][]; 285 | for (int i = 0; i < m; i++ ) 286 | { 287 | Object[] row = new Object[n]; 288 | for (int j = 0; j < n; j++) 289 | { 290 | row[j] = input[i, j]; 291 | } 292 | output[i] = row; 293 | } 294 | return output; 295 | } 296 | 297 | public static Object[,] RectangularArray(Object[] input) 298 | { 299 | int m = input.Length; 300 | Object[] firstRow = (Object[])input[0]; 301 | int n = firstRow.Length; 302 | var output = new Object[m, n]; 303 | for (var i = 0; i < m; i++) 304 | { 305 | Object[] row = (Object[])input[i]; 306 | for (var j = 0; j < n; j++) 307 | { 308 | output[i, j] = row[j]; 309 | } 310 | } 311 | 312 | return output; 313 | } 314 | 315 | public static String getSheetName() 316 | { 317 | ExcelReference reference = (ExcelReference)XlCall.Excel(XlCall.xlfCaller); 318 | string sheetName = (string)XlCall.Excel(XlCall.xlSheetNm, reference); 319 | sheetName = Regex.Split(sheetName, "\\]")[1]; 320 | sheetName = sheetName.Replace(" ", ""); 321 | return sheetName; 322 | } 323 | 324 | //referenced by clojure.data.drawbridge-client 325 | public static Object TakeItem(BlockingCollection c) 326 | { 327 | Object outObj; 328 | c.TryTake(out outObj, 0); 329 | return outObj; 330 | } 331 | public static object Load(Object[] name) 332 | { 333 | 334 | StringBuilder input = new StringBuilder(); 335 | foreach (Object s in name) 336 | { 337 | if (s.GetType() != typeof(ExcelEmpty)) 338 | { 339 | input.Append(s + "\n"); 340 | } 341 | } 342 | 343 | return my_eval(input.ToString()); 344 | 345 | } 346 | } 347 | } 348 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "High level nREPL client support." 10 | :author "Chas Emerick, modified for ClojureCLR by David Miller"} 11 | clojure.tools.nrepl 12 | (:require [clojure.tools.nrepl.transport :as transport] 13 | clojure.set 14 | [clojure.tools.nrepl.debug :as debug] 15 | [clojure.clr.io :as io]) ;DM: [clojure.java.io :as io]) 16 | (:use [clojure.tools.nrepl.misc :only (uuid)]) 17 | (:import clojure.lang.LineNumberingTextReader ;DM: LineNumberingPushbackReader 18 | (System.IO TextReader Path))) ;DM: (java.io Reader StringReader Writer PrintWriter))) 19 | 20 | (defn response-seq 21 | "Returns a lazy seq of messages received via the given Transport. 22 | Called with no further arguments, will block waiting for each message. 23 | The seq will end only when the underlying Transport is closed (i.e. 24 | returns nil from `recv`) or if a message takes longer than `timeout` 25 | millis to arrive." 26 | ([transport] (response-seq transport Int32/MaxValue)) ;DM: Long/MAX_VALUE 27 | ([transport timeout] 28 | (take-while identity (repeatedly #(transport/recv transport timeout))))) 29 | 30 | (def ^:private sw (doto (System.Diagnostics.Stopwatch.) (.Start))) 31 | 32 | (defn client 33 | "Returns a fn of zero and one argument, both of which return the current head of a single 34 | response-seq being read off of the given client-side transport. The one-arg arity will 35 | send a given message on the transport before returning the seq. 36 | 37 | Most REPL interactions are best performed via `message` and `client-session` on top of 38 | a client fn returned from this fn." 39 | [transport response-timeout] 40 | (let [latest-head (atom nil) 41 | update #(swap! latest-head 42 | (fn [[timestamp seq :as head] now] 43 | #_(debug/prn-thread "client::update ") ;DEBUG 44 | (if (< timestamp now) 45 | [now %] 46 | head)) 47 | ; nanoTime appropriate here; looking to maintain ordering, not actual timestamps 48 | (.ElapsedTicks sw)) ;DM: (System/nanoTime)) 49 | tracking-seq (fn tracking-seq [responses] 50 | #_(debug/prn-thread "client:: tracking seq") ;DEBUG 51 | (lazy-seq 52 | (if (seq responses) 53 | (let [rst (tracking-seq (rest responses))] 54 | (update rst) 55 | (cons (first responses) rst)) 56 | (do (update nil) nil)))) 57 | restart #(let [head (-> transport 58 | (response-seq response-timeout) 59 | tracking-seq)] 60 | #_(debug/prn-thread "client:: restart") ;DEBUG 61 | (reset! latest-head [0 head]) 62 | head)] 63 | ^{::transport transport ::timeout response-timeout} 64 | (fn this 65 | ([] #_(debug/prn-thread "client:: []") ;DEBUG 66 | (or (second @latest-head) 67 | (restart))) 68 | ([msg] 69 | #_(debug/prn-thread "client: [" msg "]") ;DEGBUG 70 | (transport/send transport msg) 71 | (this))))) 72 | 73 | (defn- take-until 74 | "Like (take-while (complement f) coll), but includes the first item in coll that 75 | returns true for f." 76 | [f coll] 77 | (let [[head tail] (split-with (complement f) coll)] 78 | (concat head (take 1 tail)))) 79 | 80 | (defn- delimited-transport-seq 81 | [client termination-statuses delimited-slots] 82 | (with-meta 83 | (comp (partial take-until (comp #(seq (clojure.set/intersection % termination-statuses)) 84 | set 85 | :status)) 86 | (let [keys (keys delimited-slots)] 87 | (partial filter #(= delimited-slots (select-keys % keys)))) 88 | client 89 | #(merge % delimited-slots)) 90 | (-> (meta client) 91 | (update-in [::termination-statuses] (fnil into #{}) termination-statuses) 92 | (update-in [::taking-until] merge delimited-slots)))) 93 | 94 | (defn message 95 | "Sends a message via [client] with a fixed message :id added to it. 96 | Returns the head of the client's response seq, filtered to include only 97 | messages related to the message :id that will terminate upon receipt of a 98 | \"done\" :status." 99 | [client {:keys [id] :as msg :or {id (uuid)}}] 100 | #_(debug/prn-thread "message:: sending:" msg) ;DEBUG 101 | (let [f (delimited-transport-seq client #{"done"} {:id id})] 102 | #_(debug/prn-thread "message:: Sending to f") ;DEBUG 103 | (f (assoc msg :id id)))) 104 | 105 | (defn new-session 106 | "Provokes the creation and retention of a new session, optionally as a clone 107 | of an existing retained session, the id of which must be provided as a :clone 108 | kwarg. Returns the new session's id." 109 | [client & {:keys [clone]}] 110 | #_(debug/prn-thread "new-session: " (merge {:op "clone"} (when clone {:session clone}))) ;DEBUG 111 | (let [resp (first (message client (merge {:op "clone"} (when clone {:session clone}))))] 112 | (or (:new-session resp) 113 | (throw (InvalidOperationException. ;DM: IllegalStateException. 114 | (str "Could not open new session; :clone response: " resp)))))) 115 | 116 | (defn client-session 117 | "Returns a function of one argument. Accepts a message that is sent via the 118 | client provided with a fixed :session id added to it. Returns the 119 | head of the client's response seq, filtered to include only 120 | messages related to the :session id that will terminate when the session is 121 | closed." 122 | [client & {:keys [session clone]}] 123 | (let [session (or session (apply new-session client (when clone [:clone clone])))] 124 | #_(debug/prn-thread "client-session:: have session") ;DEBUG 125 | (delimited-transport-seq client #{"session-closed"} {:session session}))) 126 | 127 | (defn combine-responses 128 | "Combines the provided seq of response messages into a single response map. 129 | 130 | Certain message slots are combined in special ways: 131 | 132 | - only the last :ns is retained 133 | - :value is accumulated into an ordered collection 134 | - :status and :session are accumulated into a set 135 | - string values (associated with e.g. :out and :err) are concatenated" 136 | [responses] 137 | (reduce 138 | (fn [m [k v]] 139 | (case k 140 | (:id :ns) (assoc m k v) 141 | :value (update-in m [k] (fnil conj []) v) 142 | :status (update-in m [k] (fnil into #{}) v) 143 | :session (update-in m [k] (fnil conj #{}) v) 144 | (if (string? v) 145 | (update-in m [k] #(str % v)) 146 | (assoc m k v)))) 147 | {} (apply concat responses))) 148 | 149 | (defn code* 150 | "Returns a single string containing the pr-str'd representations 151 | of the given expressions." 152 | [& expressions] 153 | (apply str (map pr-str expressions))) 154 | 155 | (defmacro code 156 | "Expands into a string consisting of the macro's body's forms 157 | (literally, no interpolation/quasiquoting of locals or other 158 | references), suitable for use in an :eval message, e.g.: 159 | 160 | {:op :eval, :code (code (+ 1 1) (slurp \"foo.txt\"))}" 161 | [& body] 162 | (apply code* body)) 163 | 164 | (defn read-response-value 165 | "Returns the provided response message, replacing its :value string with 166 | the result of (read)ing it. Returns the message unchanged if the :value 167 | slot is empty or not a string." 168 | [{:keys [value] :as msg}] 169 | (if-not (string? value) 170 | msg 171 | (try 172 | (assoc msg :value (read-string value)) 173 | (catch Exception e 174 | (throw (InvalidOperationException. (str "Could not read response value: " value) e)))))) ;DM: IllegalStateException 175 | 176 | (defn response-values 177 | "Given a seq of responses (as from response-seq or returned from any function returned 178 | by client or client-session), returns a seq of values read from :value slots found 179 | therein." 180 | [responses] 181 | (->> responses 182 | (map read-response-value) 183 | combine-responses 184 | :value)) 185 | 186 | (defn connect 187 | "Connects to a socket-based REPL at the given host (defaults to localhost) and port, 188 | returning the Transport (by default clojure.tools.nrepl.transport/bencode) 189 | for that connection. 190 | 191 | Transports are most easily used with `client`, `client-session`, and 192 | `message`, depending on the semantics desired." 193 | [& {:keys [port host transport-fn] :or {transport-fn transport/bencode 194 | host "localhost"}}] 195 | {:pre [transport-fn port]} 196 | (transport-fn (.Client (System.Net.Sockets.TcpClient. ^String host (int port))))) ;DM: java.net.Socket. 197 | 198 | (defn- ^System.Uri to-uri ;DM: ^java.net.URI 199 | [x] 200 | {:post [(instance? System.Uri %)]} ;DM: java.net.URI 201 | (if (string? x) 202 | (System.Uri. x) ;DM: java.net.URI 203 | x)) 204 | 205 | (defn- socket-info 206 | [x] 207 | (let [uri (to-uri x) 208 | port (.Port uri)] ;DM: .getPort 209 | (merge {:host (.Host uri)} ;DM: .getHost 210 | (when (pos? port) 211 | {:port port})))) 212 | 213 | (def ^{:private false} uri-scheme #(-> (to-uri %) .Scheme .ToLower)) ;DM: .getScheme .toLowerCase 214 | 215 | (defmulti url-connect 216 | "Connects to an nREPL endpoint identified by the given URL/URI. Valid 217 | examples include: 218 | 219 | nrepl://192.168.0.12:7889 220 | telnet://localhost:5000 221 | http://your-app-name.heroku.com/repl 222 | 223 | This is a multimethod that dispatches on the scheme of the URI provided 224 | (which can be a string or java.net.URI). By default, implementations for 225 | nrepl (corresponding to using the default bencode transport) and 226 | telnet (using the clojure.tools.nrepl.transport/tty transport) are 227 | registered. Alternative implementations may add support for other schemes, 228 | such as HTTP, HTTPS, JMX, existing message queues, etc." 229 | uri-scheme) 230 | 231 | ;; TODO oh so ugly 232 | (defn- add-socket-connect-method! 233 | [protocol connect-defaults] 234 | (defmethod url-connect protocol 235 | [uri] 236 | (apply connect (mapcat identity 237 | (merge connect-defaults 238 | (socket-info uri)))))) 239 | 240 | (add-socket-connect-method! "nrepl" {:transport-fn transport/bencode 241 | :port 7888}) 242 | (add-socket-connect-method! "telnet" {:transport-fn transport/tty}) 243 | 244 | (defmethod url-connect :default 245 | [uri] 246 | (throw (ArgumentException. ;DM: IllegalArgumentException. 247 | (format "No nREPL support known for scheme %s, url %s" (uri-scheme uri) uri)))) 248 | 249 | (def ^{:doc "Current version of nREPL, map of :major, :minor, :incremental, and :qualifier."} 250 | version 251 | (when-let [in (try (-> connect ;DM: (.getResourceAsStream (class connect) "/clojure/tools/nrepl/version.txt") 252 | (class) ;DM: TODO: If only we had a way of embedding resources in AOT-compiled assemblies 253 | (System.Reflection.Assembly/GetAssembly) 254 | (.GetManifestResourceStream (.Replace "/clojure/tools/nrepl/version.txt" \/ Path/DirectorySeparatorChar))) 255 | (catch NotSupportedException e nil))] 256 | (with-open [^TextReader reader (io/text-reader in)] ;DM: ^java.io.BufferedReader io/reader 257 | (let [version-string (-> reader .ReadLine .Trim)] ;DM: .readLine .trim 258 | (assoc (->> version-string 259 | (re-find #"(\d+)\.(\d+)\.(\d+)-?(.*)") 260 | rest 261 | (zipmap [:major :minor :incremental :qualifier])) 262 | :version-string version-string))))) 263 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/middleware/interruptible_eval.clj: -------------------------------------------------------------------------------- 1 | (ns ^{:author "Chas Emerick"} 2 | clojure.tools.nrepl.middleware.interruptible-eval 3 | (:require [clojure.tools.nrepl.transport :as t] 4 | clojure.tools.nrepl.middleware.pr-values 5 | [clojure.tools.nrepl.debug :as debug] 6 | clojure.main) 7 | (:use [clojure.tools.nrepl.misc :only (response-for returning)] 8 | [clojure.tools.nrepl.middleware :only (set-descriptor!)]) 9 | (:import clojure.lang.LineNumberingTextReader ;DM: clojure.lang.LineNumberingPushbackReader 10 | (System.IO StringReader TextWriter) ;DM: (java.io StringReader Writer) 11 | clojure.lang.AtomicLong ;DM: java.util.concurrent.atomic.AtomicLong 12 | (System.Threading Thread ThreadStart WaitCallback ThreadAbortException) ;DM: (java.util.concurrent Executor LinkedBlockingQueue ThreadFactory 13 | )) ;DM: SynchronousQueue TimeUnit ThreadPoolExecutor) 14 | 15 | (def ^{:dynamic true 16 | :doc "The message currently being evaluated."} 17 | *msg* nil) 18 | 19 | (def ^{:dynamic true 20 | :doc "Function returning the evaluation of its argument."} 21 | *eval* nil) 22 | 23 | (defn- capture-thread-bindings 24 | "Capture thread bindings, excluding nrepl implementation vars." 25 | [] 26 | (dissoc (get-thread-bindings) #'*msg* #'*eval*)) 27 | 28 | (defn evaluate 29 | "Evaluates some code within the dynamic context defined by a map of `bindings`, 30 | as per `clojure.core/get-thread-bindings`. 31 | 32 | Uses `clojure.main/repl` to drive the evaluation of :code in a second 33 | map argument (either a string or a seq of forms to be evaluated), which may 34 | also optionally specify a :ns (resolved via `find-ns`). The map MUST 35 | contain a Transport implementation in :transport; expression results and errors 36 | will be sent via that Transport. 37 | 38 | Returns the dynamic scope that remains after evaluating all expressions 39 | in :code. 40 | 41 | It is assumed that `bindings` already contains useful/appropriate entries 42 | for all vars indicated by `clojure.main/with-bindings`." 43 | [bindings {:keys [code ns transport session eval] :as msg}] 44 | (let [explicit-ns-binding (when-let [ns (and ns (-> ns symbol find-ns))] 45 | {#'*ns* ns}) 46 | bindings (atom (merge bindings explicit-ns-binding)) 47 | session (or session (atom nil)) 48 | out (@bindings #'*out*) 49 | err (@bindings #'*err*)] 50 | (if (and ns (not explicit-ns-binding)) 51 | (t/send transport (response-for msg {:status #{:error :namespace-not-found :done}})) 52 | (with-bindings @bindings 53 | (try 54 | #_(debug/prn-thread "Evaluating " code " in " (.ManagedThreadId (Thread/CurrentThread))) ;DEBUG 55 | (clojure.main/repl 56 | :eval (if eval (find-var (symbol eval)) clojure.core/eval) 57 | ;; clojure.main/repl paves over certain vars even if they're already thread-bound 58 | :init #(do (set! *compile-path* (@bindings #'*compile-path*)) 59 | (set! *1 (@bindings #'*1)) 60 | (set! *2 (@bindings #'*2)) 61 | (set! *3 (@bindings #'*3)) 62 | (set! *e (@bindings #'*e))) 63 | :read (if (string? code) 64 | (let [reader (LineNumberingTextReader. (StringReader. code))] ;DM: LineNumberingPushbackReader 65 | #(read reader false %2)) 66 | (let [^System.Collections.IEnumerator code (.GetEnumerator code)] ;DM: .iterator 67 | #(or (and (.MoveNext code) (.Current code)) %2))) ;DM: .hasNext .next 68 | :prompt (fn []) 69 | :need-prompt (constantly false) 70 | ; TODO pretty-print? 71 | :print (fn [v] 72 | (reset! bindings (assoc (capture-thread-bindings) 73 | #'*3 *2 74 | #'*2 *1 75 | #'*1 v)) 76 | (.Flush ^TextWriter err) ;DM: .flush ^Writer 77 | (.Flush ^TextWriter out) ;DM: .flush ^Writer 78 | (reset! session @bindings) 79 | #_(debug/prn-thread "Evaluating " code " yields " v) ;DEBUG 80 | (t/send transport (response-for msg 81 | {:value v 82 | :ns (-> *ns* ns-name str)}))) 83 | ; TODO customizable exception prints 84 | :caught (fn [e] 85 | (let [root-ex (#'clojure.main/root-cause e)] 86 | (when-not (instance? ThreadAbortException root-ex) ;DM: ThreadDeath 87 | (reset! bindings (assoc (capture-thread-bindings) #'*e e)) 88 | (t/send transport (response-for msg {:status :eval-error 89 | :ex (-> e class str) 90 | :root-ex (-> root-ex class str)})) 91 | (clojure.main/repl-caught e))))) 92 | (finally 93 | (.Flush ^TextWriter out) ;DM: .flush ^Writer 94 | (.Flush ^TextWriter err))))) ;DM: .flush ^Writer 95 | @bindings)) 96 | 97 | ;(defn- configure-thread-factory 98 | ; "Returns a new ThreadFactory for the given session. This implementation 99 | ; generates daemon threads, with names that include the session id." 100 | ; [] 101 | ; (let [session-thread-counter (AtomicLong. 0)] 102 | ; (reify ThreadFactory 103 | ; (newThread [_ runnable] 104 | ; (doto (Thread. runnable 105 | ; (format "nREPL-worker-%s" (.getAndIncrement session-thread-counter))) 106 | ; (.setDaemon true)))))) 107 | ; 108 | ;(def ^{:private true} jdk6? (try 109 | ; (Class/forName "java.util.ServiceLoader") 110 | ; true 111 | ; (catch ClassNotFoundException e false))) 112 | ; 113 | ;; this is essentially the same as Executors.newCachedThreadPool, except 114 | ;; for the JDK 5/6 fix described below 115 | ;(defn- configure-executor 116 | ; "Returns a ThreadPoolExecutor, configured (by default) to 117 | ; have no core threads, use an unbounded queue, create only daemon threads, 118 | ; and allow unused threads to expire after 30s." 119 | ; [& {:keys [keep-alive queue thread-factory] 120 | ; :or {keep-alive 30000 121 | ; queue (SynchronousQueue.)}}] 122 | ; (let [^ThreadFactory thread-factory (or thread-factory (configure-thread-factory))] 123 | ; ; ThreadPoolExecutor in JDK5 *will not run* submitted jobs if the core pool size is zero and 124 | ; ; the queue has not yet rejected a job (see http://kirkwylie.blogspot.com/2008/10/java5-vs-java6-threadpoolexecutor.html) 125 | ; (ThreadPoolExecutor. (if jdk6? 0 1) Integer/MAX_VALUE 126 | ; (long 30000) TimeUnit/MILLISECONDS 127 | ; ^BlockingQueue queue 128 | ; thread-factory))) 129 | 130 | ;DM:Added 131 | (def ^{:private true} session-thread-counter (AtomicLong. 0)) 132 | 133 | #_(defn- exec-eval [f] 134 | (let [tstart (gen-delegate ThreadStart [] 135 | (try 136 | #_(debug/prn-thread "exec-eval: Starting in thread " (.ManagedThreadId (Thread/CurrentThread))) 137 | (f) 138 | #_(debug/prn-thread "exec-eval: Exiting thread " (.ManagedThreadId (Thread/CurrentThread))) 139 | (catch ThreadAbortException e 140 | #_(debug/prn-thread "exec-eval: Aborting thread " (.ManagedThreadId (Thread/CurrentThread))) 141 | #_(Thread/ResetAbort) 142 | nil))) 143 | thread (doto (Thread. tstart) 144 | (.set_Name (format "nREPL-worker-%s" (.getAndIncrement session-thread-counter))) 145 | (.set_IsBackground true) 146 | (.Start))] 147 | #_(debug/prn-thread "exec-eval: Started thread " (.ManagedThreadId thread)) 148 | nil)) 149 | 150 | (defn- exec-eval [f interrupt-handle] 151 | (let [done-handle (System.Threading.AutoResetEvent. false) 152 | handles (make-array System.Threading.WaitHandle 2) 153 | tstart (gen-delegate ThreadStart [] 154 | (try 155 | #_(debug/prn-thread "exec-eval: Starting in thread " (.ManagedThreadId (Thread/CurrentThread))) 156 | (f) 157 | #_(debug/prn-thread "exec-eval: Exiting thread " (.ManagedThreadId (Thread/CurrentThread))) 158 | (catch ThreadAbortException e 159 | #_(debug/prn-thread "exec-eval: Aborting thread " (.ManagedThreadId (Thread/CurrentThread))) 160 | (Thread/ResetAbort) 161 | nil) 162 | (finally (.Set done-handle)))) 163 | thread (doto (Thread. tstart) 164 | (.set_Name (format "nREPL-worker-%s" (.getAndIncrement session-thread-counter))) 165 | (.set_IsBackground true) 166 | (.Start))] 167 | #_(debug/prn-thread "exec-eval: Started thread " (.ManagedThreadId thread)) 168 | #_(debug/prn-thread "exec-eval: Starting wait") 169 | (aset handles 0 interrupt-handle) 170 | (aset handles 1 done-handle) 171 | (let [i (System.Threading.WaitHandle/WaitAny handles)] 172 | #_(debug/prn-thread "exec-eval: done waiting, handle = " i) 173 | (when (= i 0) 174 | #_(debug/prn-thread "exec-eval: interrupted, aborting thread") 175 | (.Abort thread)) 176 | #_(when (= i 1) 177 | (debug/prn-thread "exec.eval: normal exit"))) 178 | nil)) 179 | 180 | ;DM:end Added 181 | 182 | ; A little mini-agent implementation. Needed because agents cannot be used to host REPL 183 | ; evaluation: http://dev.clojure.org/jira/browse/NREPL-17 184 | (defn- prep-session 185 | [session] 186 | (locking session 187 | (returning session 188 | (when-not (-> session meta :queue) 189 | (alter-meta! session assoc :queue (atom clojure.lang.PersistentQueue/EMPTY)))))) 190 | 191 | (declare run-next) 192 | (defn- run-next* 193 | [session executor ihandle] ;DM: removed ^Executor 194 | #_(debug/prn-thread "run-next* on session ") ;DEBUG 195 | (let [qa (-> session meta :queue)] 196 | (loop [] 197 | (let [q @qa 198 | qn (pop q)] 199 | (if-not (compare-and-set! qa q qn) 200 | (recur) 201 | (when (seq qn) 202 | (let [fnext (run-next session executor ihandle (peek qn))] 203 | (exec-eval fnext ihandle)))))))) 204 | ;DM: (.execute executor (run-next session executor (peek qn))) 205 | 206 | (defn- run-next 207 | [session executor ihandle f] 208 | #(try 209 | #_(debug/prn-thread "run-next: ready to run f, thread = " (.ManagedThreadId (Thread/CurrentThread))) 210 | (f) 211 | #_(debug/prn-thread "run-next: after running f, thread = " (.ManagedThreadId (Thread/CurrentThread))) 212 | (finally 213 | #_(debug/prn-thread "run-next: looping, thread = " (.ManagedThreadId (Thread/CurrentThread))) 214 | (run-next* session executor ihandle)))) 215 | 216 | (defn- queue-eval 217 | "Queues the function for the given session." 218 | [session executor ihandle f] ;DM: removed ^Executor 219 | (let [qa (-> session prep-session meta :queue)] 220 | (loop [] 221 | (let [q @qa] 222 | (if-not (compare-and-set! qa q (conj q f)) 223 | (recur) 224 | (when (empty? q) 225 | (let [fnext (run-next session executor ihandle f)] 226 | (exec-eval fnext ihandle)))))))) 227 | ;DM: (.execute executor (run-next session executor f)) 228 | 229 | (defn interruptible-eval 230 | "Evaluation middleware that supports interrupts. Returns a handler that supports 231 | \"eval\" and \"interrupt\" :op-erations that delegates to the given handler 232 | otherwise." 233 | [h & {:keys [executor] :or {executor nil}}] ;DM: (configure-executor) replaced with nil 234 | (let [interrupt-handle (System.Threading.AutoResetEvent. false)] 235 | (fn [{:keys [op session interrupt-id id transport] :as msg}] 236 | (case op 237 | "eval" 238 | (if-not (:code msg) 239 | (do #_(debug/prn-thread "IEval: no code: " msg) (t/send transport (response-for msg :status #{:error :no-code}))) 240 | (queue-eval session executor interrupt-handle 241 | (fn [] 242 | (alter-meta! session assoc 243 | :thread (Thread/CurrentThread) ;DM: Thread/currentThread 244 | :eval-msg msg) 245 | (binding [*msg* msg] 246 | #_(debug/prn-thread "IEval: getting ready to call evaluate, thread = " (.ManagedThreadId (Thread/CurrentThread))) 247 | (evaluate @session msg) 248 | #_(debug/prn-thread "IEval: sending status done") 249 | (t/send transport (response-for msg :status :done)) 250 | (alter-meta! session dissoc :thread :eval-msg))))) 251 | 252 | "interrupt" 253 | ; interrupts are inherently racy; we'll check the agent's :eval-msg's :id and 254 | ; bail if it's different than the one provided, but it's possible for 255 | ; that message's eval to finish and another to start before we send 256 | ; the interrupt / .stop. 257 | (let [{:keys [id eval-msg ihandle]} (meta session)] ;;; ^Thread thread 258 | #_(debug/prn-thread "IEval: interrupt received") 259 | #_(debug/prn-thread "IEval: interrupt-id = " interrupt-id ", id = " (:id eval-msg)) 260 | #_(debug/prn-thread "IEval: ihandle = " ihandle) 261 | #_(debug/prn-thread "IEval: interrupt thread = " (and thread (.ManagedThreadId thread))) 262 | #_(if (or (not interrupt-id) 263 | (= interrupt-id (:id eval-msg))) 264 | (if-not thread 265 | (debug/prn-thread "IEval: interrupt: Sending status :done :session-idle") 266 | (debug/prn-thread "IEval: interrupt: aborting thread, sending status :interrupted")) 267 | (debug/prn-thread "IEval: interrupt: sending interrupt-id-mismatch")) 268 | (if (or (not interrupt-id) 269 | (= interrupt-id (:id eval-msg))) 270 | (if-not ihandle ;;; thread 271 | (t/send transport (response-for msg :status #{:done :session-idle})) 272 | (do 273 | ; notify of the interrupted status before we .stop the thread so 274 | ; it is received before the standard :done status (thereby ensuring 275 | ; that is stays within the scope of a clojure.tools.nrepl/message seq) 276 | #_(debug/prn-thread "IEval: interrupt: sending :interrupted status message") 277 | (t/send transport {:status #{:interrupted} 278 | :id (:id eval-msg) 279 | :session id}) 280 | #_(debug/prn-thread "IEval: interrupt: preparing to abort thread " #_(.ManagedThreadId thread)) 281 | #_(.Abort thread) ;DM: .stop 282 | (.Set ihandle) 283 | #_(debug/prn-thread "IEval: interrupt: thread .Abort called") 284 | #_(debug/prn-thread "IEval: interrupt: preparing to send :done status") 285 | (t/send transport (response-for msg :status #{:done})) 286 | #_(debug/prn-thread "IEval: interrupt: preparing to send :done status AGAIN") 287 | (t/send transport (response-for msg :status #{:done})) 288 | 289 | )) 290 | (t/send transport (response-for msg :status #{:error :interrupt-id-mismatch :done})))) 291 | 292 | (h msg))))) 293 | 294 | (set-descriptor! #'interruptible-eval 295 | {:requires #{"clone" "close" #'clojure.tools.nrepl.middleware.pr-values/pr-values} 296 | :expects #{} 297 | :handles {"eval" 298 | {:doc "Evaluates code." 299 | :requires {"code" "The code to be evaluated." 300 | "session" "The ID of the session within which to evaluate the code."} 301 | :optional {"id" "An opaque message ID that will be included in responses related to the evaluation, and which may be used to restrict the scope of a later \"interrupt\" operation."} 302 | :returns {}} 303 | "interrupt" 304 | {:doc "Attempts to interrupt some code evaluation." 305 | :requires {"session" "The ID of the session used to start the evaluation to be interrupted."} 306 | :optional {"id" "An opaque message ID that will be included in responses related to the evaluation, and which may be used to restrict the scope of a later \"interrupt\" operation." 307 | "eval" "A fully-qualified symbol naming a var whose function value will be used to evaluate [code], instead of `clojure.core/eval` (the default)."} 308 | :returns {"status" "'interrupted' if an evaluation was identified and interruption will be attempted 309 | 'session-idle' if the session is not currently evaluating any code 310 | 'interrupt-id-mismatch' if the session is currently evaluating code sent using a different ID than specified by the \"interrupt-id\" value "}}}}) -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/middleware/session.clj: -------------------------------------------------------------------------------- 1 | 2 | (ns ^{:doc "Support for persistent, cross-connection REPL sessions." 3 | :author "Chas Emerick"} 4 | clojure.tools.nrepl.middleware.session 5 | (:use [clojure.tools.nrepl.misc :only (uuid response-for returning log)] 6 | [clojure.tools.nrepl.middleware.interruptible-eval :only (*msg*)] 7 | [clojure.tools.nrepl.middleware :only (set-descriptor!)]) 8 | (:require (clojure main test) 9 | [clojure.tools.nrepl.debug :as debug] 10 | [clojure.tools.nrepl.transport :as t]) 11 | (:import clojure.tools.nrepl.transport.Transport 12 | (System.IO TextReader TextWriter StringReader StreamWriter StringWriter) ;DM: java.io PipedReader PipedWriter Reader Writer PrintWriter StringReader 13 | clojure.lang.LineNumberingTextReader ;DM: clojure.lang.LineNumberingPushbackReader 14 | )) ;DM: java.util.concurrent.LinkedBlockingQueue 15 | 16 | (def ^{:private true} sessions (atom {})) 17 | 18 | ;; TODO the way this is currently, :out and :err will continue to be 19 | ;; associated with a particular *msg* (and session) even when produced from a future, 20 | ;; agent, etc. due to binding conveyance. This may or may not be desirable 21 | ;; depending upon the expectations of the client/user. I'm not sure at the moment 22 | ;; how best to make it configurable though... 23 | 24 | (def ^{:dynamic true :private true} *out-limit* 1024) 25 | (def ^{:dynamic true :private true} *skipping-eol* false) 26 | 27 | 28 | ;DM: ; I would really love to follow this implementation more closely, 29 | ;DM: ; but I run into the proxy-super-with-multiple-arities problems, 30 | ;DM: ; as detailed in http://kotka.de/blog/2010/03/proxy_gen-class_little_brother.html. 31 | ;DM: ; Also, given the way we solve the problem, I have to make sure there are flushes on newlines. 32 | 33 | ;DM: (defn- session-out 34 | ;DM: "Returns a PrintWriter suitable for binding as *out* or *err*. All of 35 | ;DM: the content written to that PrintWriter will (when .flush-ed) be sent on the 36 | ;DM: given transport in messages specifying the given session-id. 37 | ;DM: `channel-type` should be :out or :err, as appropriate." 38 | ;DM: [channel-type session-id transport] 39 | ;DM: (let [buf (clojure.tools.nrepl.StdOutBuffer.)] 40 | ;DM: (PrintWriter. (proxy [Writer] [] 41 | ;DM: (close [] (.flush ^Writer this)) 42 | ;DM: (write [& [x ^Integer off ^Integer len]] 43 | ;DM: (locking buf 44 | ;DM: (cond 45 | ;DM: (number? x) (.append buf (char x)) 46 | ;DM: (not off) (.append buf x) 47 | ;DM: ; the CharSequence overload of append takes an *end* idx, not length! 48 | ;DM: (instance? CharSequence x) (.append buf ^CharSequence x off (+ len off)) 49 | ;DM: :else (.append buf ^chars x off len)) 50 | ;DM: (when (<= *out-limit* (.length buf)) 51 | ;DM: (.flush ^Writer this)))) 52 | ;DM: (flush [] 53 | ;DM: (let [text (locking buf (let [text (str buf)] 54 | ;DM: (.setLength buf 0) 55 | ;DM: text))] 56 | ;DM: (when (pos? (count text)) 57 | ;DM: (t/send (or (:transport *msg*) transport) 58 | ;DM: (response-for *msg* :session session-id 59 | ;DM: channel-type text)))))) 60 | ;DM: true))) 61 | 62 | 63 | (defn- session-out 64 | "Returns a PrintWriter suitable for binding as *out* or *err*. All of 65 | the content written to that PrintWriter will (when .flush-ed) be sent on the 66 | given transport in messages specifying the given session-id. 67 | `channel-type` should be :out or :err, as appropriate." 68 | [channel-type session-id transport] 69 | (let [buf (StringBuilder.) 70 | maybe-flush (fn [^StringWriter w ^StringBuilder buf] 71 | (when (or (<= *out-limit* (.Length buf)) 72 | (.Contains (.ToString buf) (Environment/NewLine))) 73 | (.Flush w))) 74 | newline (Environment/NewLine) 75 | nl-len (.Length newline) 76 | send-segment (fn [^String segment] 77 | #_(debug/prn-thread "Sending " segment) 78 | (t/send (or (:transport *msg*) transport) 79 | (response-for *msg* :session session-id 80 | channel-type segment))) 81 | send-text (fn [^String text] 82 | (let [text-len (.Length text)] 83 | (when (pos? text-len) 84 | (loop [start 0] 85 | (let [idx (.IndexOf text newline start)] 86 | (if (neg? idx) 87 | (send-segment (.Substring text start)) ; no more newlines, just spit out remainder 88 | (let [idx2 (+ idx nl-len)] 89 | (send-segment (.Substring text start (- idx2 start))) 90 | (when (< idx2 text-len) 91 | (recur idx2)))))))))] 92 | (identity (proxy [StringWriter] [buf] 93 | (Dispose [isDisposing] (when isDisposing (.Flush ^TextWriter this))) 94 | (Write 95 | ([x] (locking buf 96 | (proxy-super Write x) 97 | (maybe-flush this buf))) 98 | ([ x y ] (locking buf 99 | (proxy-super Write x y) 100 | (maybe-flush this buf))) 101 | ([ x y z] (locking buf 102 | (proxy-super Write x y z) 103 | (maybe-flush this buf))) 104 | ([ x y z w] (locking buf 105 | (proxy-super Write x y z w) 106 | (maybe-flush this buf)))) 107 | (WriteLine 108 | ([] (locking buf 109 | (proxy-super WriteLine) 110 | (maybe-flush this buf))) 111 | ([x] (locking buf 112 | (proxy-super WriteLine x) 113 | (maybe-flush this buf))) 114 | ([ x y ] (locking buf 115 | (proxy-super WriteLine x y) 116 | (maybe-flush this buf))) 117 | ([ x y z] (locking buf 118 | (proxy-super WriteLine x y z) 119 | (maybe-flush this buf))) 120 | ([ x y z w] (locking buf 121 | (proxy-super WriteLine x y z w) 122 | (maybe-flush this buf)))) 123 | (Flush [] 124 | (let [text (locking buf (let [text (str buf)] 125 | (.set_Length buf 0) 126 | text))] 127 | (send-text text))))))) 128 | 129 | 130 | (defn- session-in 131 | "Returns a LineNumberingPushbackReader suitable for binding to *in*. 132 | When something attempts to read from it, it will (if empty) send a 133 | {:status :need-input} message on the provided transport so the client/user 134 | can provide content to be read." 135 | [session-id transport] 136 | (let [input-queue (|System.Collections.Concurrent.BlockingCollection`1[System.Object]|.) ;DM: LinkedBlockingQueue. 137 | request-input (fn [] 138 | #_(debug/prn-thread "Request input") 139 | (cond (> (.Count input-queue) 0) ;DM: .size 140 | (.Take input-queue) ;DM: .take 141 | *skipping-eol* 142 | nil 143 | :else 144 | (do 145 | #_(debug/prn-thread "Sending message") 146 | (t/send transport 147 | (response-for *msg* :session session-id 148 | :status :need-input)) 149 | (.Take input-queue)))) ;DM: .take 150 | do-read (fn [buf off len] 151 | #_(debug/prn-thread "do-read") 152 | (locking input-queue 153 | (loop [i off] 154 | (cond 155 | (>= i (+ off len)) 156 | (+ off len) 157 | (> (.Count input-queue) 0) ;DM: (.peek input-queue) 158 | (do (aset-char buf i (char (.Take input-queue))) ;DM: .take 159 | (recur (inc i))) 160 | :else 161 | i)))) 162 | reader (LineNumberingTextReader. ;DM: LineNumberingPushbackReader. 163 | (proxy [TextReader] [] ;DM: Reader 164 | (Dispose [disposing] (when disposing (.Dispose input-queue))) ;DM: (close [] (.clear input-queue)) 165 | (Peek [] -1) ;DM: ADDED -- we'll just say we don't support it 166 | (Read ;DM: read 167 | ([] 168 | #_(debug/prn-thread "Read[]") 169 | (let [first-character (request-input)] ;DM: (let [^Reader this this] (proxy-super read)) 170 | (if (or (nil? first-character) (= first-character -1)) ;DM: [x] 171 | (int -1) ;DM: let [^Reader this this] 172 | (int first-character)))) ;DM: if (instance? java.nio.CharBuffer x 173 | ;DM: proxy-super read ^java.nio.CharBuffer x 174 | ;DM: proxy-super read ^chars x 175 | ([^chars buf off len] 176 | #_(debug/prn-thread "Read[3]") 177 | (if (zero? len) 178 | -1 179 | (let [first-character (request-input)] 180 | (if (or (nil? first-character) (= first-character -1)) 181 | -1 182 | (do 183 | (aset-char buf off (char first-character)) 184 | (- (do-read buf (inc off) (dec len)) 185 | off)))))))))] 186 | {:input-queue input-queue 187 | :stdin-reader reader})) 188 | 189 | (defn- create-session 190 | "Returns a new atom containing a map of bindings as per 191 | `clojure.core/get-thread-bindings`. Values for *out*, *err*, and *in* 192 | are obtained using `session-in` and `session-out`, *ns* defaults to 'user, 193 | and other bindings as optionally provided in `baseline-bindings` are 194 | merged in." 195 | ([transport] (create-session transport {})) 196 | ([transport baseline-bindings] 197 | (clojure.main/with-bindings 198 | (let [id (uuid) 199 | out (session-out :out id transport) 200 | {:keys [input-queue stdin-reader]} (session-in id transport)] 201 | (binding [*out* out 202 | *err* (session-out :err id transport) 203 | *in* stdin-reader 204 | *ns* (create-ns 'user) 205 | *out-limit* (or (baseline-bindings #'*out-limit*) 1024) 206 | ; clojure.test captures *out* at load-time, so we need to make sure 207 | ; runtime output of test status/results is redirected properly 208 | ; TODO is this something we need to consider in general, or is this 209 | ; specific hack reasonable? 210 | clojure.test/*test-out* out] 211 | ; nrepl.server happens to use agents for connection dispatch 212 | ; don't capture that *agent* binding for userland REPL sessions 213 | (atom (merge baseline-bindings (dissoc (get-thread-bindings) #'*agent*)) 214 | :meta {:id id 215 | :stdin-reader stdin-reader 216 | :input-queue input-queue})))))) 217 | 218 | (defn- register-session 219 | "Registers a new session containing the baseline bindings contained in the 220 | given message's :session." 221 | [{:keys [session transport] :as msg}] 222 | (let [session (create-session transport @session) 223 | id (-> session meta :id)] 224 | (swap! sessions assoc id session) 225 | (t/send transport (response-for msg :status :done :new-session id)))) 226 | 227 | (defn- close-session 228 | "Drops the session associated with the given message." 229 | [{:keys [session transport] :as msg}] 230 | #_(debug/prn-thread "close-session" (-> session meta :id)) ;DEBUG 231 | (swap! sessions dissoc (-> session meta :id)) 232 | (t/send transport (response-for msg :status #{:done :session-closed}))) 233 | 234 | (defn session 235 | "Session middleware. Returns a handler which supports these :op-erations: 236 | 237 | * \"ls-sessions\", which results in a response message 238 | containing a list of the IDs of the currently-retained sessions in a 239 | :session slot. 240 | * \"close\", which drops the session indicated by the 241 | ID in the :session slot. The response message's :status will include 242 | :session-closed. 243 | * \"clone\", which will cause a new session to be retained. The ID of this 244 | new session will be returned in a response message in a :new-session 245 | slot. The new session's state (dynamic scope, etc) will be a copy of 246 | the state of the session identified in the :session slot of the request. 247 | 248 | Messages indicating other operations are delegated to the given handler, 249 | with the session identified by the :session ID added to the message. If 250 | no :session ID is found, a new session is created (which will only 251 | persist for the duration of the handling of the given message). 252 | 253 | Requires the interruptible-eval middleware (specifically, its binding of 254 | *msg* to the currently-evaluated message so that session-specific *out* 255 | and *err* content can be associated with the originating message)." 256 | [h] 257 | (fn [{:keys [op session transport out-limit] :as msg}] 258 | (let [the-session (if session 259 | (@sessions session) 260 | (create-session transport))] 261 | (if-not the-session 262 | (t/send transport (response-for msg :status #{:error :unknown-session})) 263 | (let [msg (assoc msg :session the-session)] 264 | ;; TODO yak, this is ugly; need to cleanly thread out-limit through to 265 | ;; session-out without abusing a dynamic var 266 | ;; (there's no reason to allow a connected client to fark around with 267 | ;; a session-out's "buffer") 268 | (when out-limit (swap! the-session assoc #'*out-limit* out-limit)) 269 | (case op 270 | "clone" (register-session msg) 271 | "close" (close-session msg) 272 | "ls-sessions" (t/send transport (response-for msg :status :done 273 | :sessions (or (keys @sessions) []))) 274 | (h msg))))))) 275 | 276 | (set-descriptor! #'session 277 | {:requires #{} 278 | :expects #{} 279 | :handles {"close" 280 | {:doc "Closes the specified session." 281 | :requires {"session" "The ID of the session to be closed."} 282 | :optional {} 283 | :returns {}} 284 | "ls-sessions" 285 | {:doc "Lists the IDs of all active sessions." 286 | :requires {} 287 | :optional {} 288 | :returns {"sessions" "A list of all available session IDs."}} 289 | "clone" 290 | {:doc "Clones the current session, returning the ID of the newly-created session." 291 | :requires {} 292 | :optional {"session" "The ID of the session to be cloned; if not provided, a new session with default bindings is created, and mapped to the returned session ID."} 293 | :returns {"new-session" "The ID of the new session."}}}}) 294 | 295 | (defn add-stdin 296 | "stdin middleware. Returns a handler that supports a \"stdin\" :op-eration, which 297 | adds content provided in a :stdin slot to the session's *in* Reader. Delegates to 298 | the given handler for other operations. 299 | 300 | Requires the session middleware." 301 | [h] 302 | (fn [{:keys [op stdin session transport] :as msg}] 303 | (cond 304 | (= op "eval") 305 | (let [in (-> (meta session) ^LineNumberingTextReader (:stdin-reader))] ;DM: LineNumberingPushbackReader 306 | (binding [*skipping-eol* true] 307 | (clojure.main/skip-if-eol in)) 308 | (h msg)) 309 | (= op "stdin") 310 | (let [q (-> (meta session) ^TextWriter (:input-queue))] ;DM: ^Writer 311 | (if (empty? stdin) 312 | (.Add q -1) ;DM: .put 313 | (locking q 314 | (doseq [c stdin] (.Add q c)))) ;DM: .put 315 | (t/send transport (response-for msg :status :done))) 316 | :else 317 | (h msg)))) 318 | 319 | (set-descriptor! #'add-stdin 320 | {:requires #{#'session} 321 | :expects #{"eval"} 322 | :handles {"stdin" 323 | {:doc "Add content from the value of \"stdin\" to *in* in the current session." 324 | :requires {"stdin" "Content to add to *in*."} 325 | :optional {} 326 | :returns {"status" "A status of \"need-input\" will be sent if a session's *in* requires content in order to satisfy an attempted read operation."}}}}) -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/tools/nrepl/bencode.clj: -------------------------------------------------------------------------------- 1 | ;- 2 | ; Copyright (c) Meikel Brandmeyer. All rights reserved. 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this distribution. 6 | ; By using this software in any fashion, you are agreeing to be bound by 7 | ; the terms of this license. 8 | ; You must not remove this notice, or any other, from this software. 9 | 10 | (ns #^{:author "Meikel Brandmeyer, modified for ClojureCLR by David Miller" 11 | :doc "A netstring and bencode implementation for Clojure."} 12 | clojure.tools.nrepl.bencode 13 | (:require [clojure.clr.io :as io]) ;;; clojure.java.io 14 | (:import (System.IO IOException EndOfStreamException ;;; (java.io IOException EOFException ByteArrayOutputStream 15 | Stream MemoryStream ) ;;; InputStream OutputStream PushbackInputStream) 16 | clojure.lang.RT clojure.lang.PushbackInputStream)) ;;; Added PushbackInputStream 17 | 18 | ;; # Motivation 19 | ;; 20 | ;; In each and every application, which contacts peer processes via some 21 | ;; communication channel, the handling of the communication channel is 22 | ;; obviously a central part of the application. Unfortunately introduces 23 | ;; handling of buffers of varying sizes often bugs in form of buffer 24 | ;; overflows and similar. 25 | ;; 26 | ;; A strong factor in this situation is of course the protocol which goes 27 | ;; over the wire. Depending on its design it might be difficult to estimate 28 | ;; the size of the input up front. This introduces more handling of message 29 | ;; buffers to accomodate for inputs of varying sizes. This is particularly 30 | ;; difficult in languages like C, where there is no bounds checking of array 31 | ;; accesses and where errors might go unnoticed for considerable amount of 32 | ;; time. 33 | ;; 34 | ;; To address these issues D. Bernstein developed the so called 35 | ;; [netstrings][net]. They are especially designed to allow easy construction 36 | ;; of the message buffers, easy and robust parsing. 37 | ;; 38 | ;; BitTorrent extended this to the [bencode][bc] protocol which also 39 | ;; includes ways to encode numbers and collections like lists or maps. 40 | ;; 41 | ;; *wire* is based on these ideas. 42 | ;; 43 | ;; [net]: http://cr.yp.to/proto/netstrings.txt 44 | ;; [bc]: http://wiki.theory.org/BitTorrentSpecification#Bencoding 45 | ;; 46 | ;; # Netstrings 47 | ;; 48 | ;; Now let's start with the basic netstrings. They consist of a byte count, 49 | ;; followed a colon and the binary data and a trailing comma. Examples: 50 | ;; 51 | ;; 13:Hello, World!, 52 | ;; 10:Guten Tag!, 53 | ;; 0:, 54 | ;; 55 | ;; The initial byte count allows to efficiently allocate a sufficiently 56 | ;; sized message buffer. The trailing comma serves as a hint to detect 57 | ;; incorrect netstrings. 58 | ;; 59 | ;; ## Low-level reading 60 | ;; 61 | ;; We will need some low-level reading helpers to read the bytes from 62 | ;; the input stream. These are `read-byte` as well as `read-bytes`. They 63 | ;; are split out, because doing such a simple task as reading a byte is 64 | ;; mild catastrophe in Java. So it would add some clutter to the algorithm 65 | ;; `read-netstring`. 66 | ;; 67 | ;; On the other hand they might be also useful elsewhere. 68 | ;; 69 | ;; To remove some magic numbers from the code below. 70 | 71 | (def #^{:const true} i 105) 72 | (def #^{:const true} l 108) 73 | (def #^{:const true} d 100) 74 | (def #^{:const true} comma 44) 75 | (def #^{:const true} minus 45) 76 | 77 | ;; These two are only used boxed. So we keep them extra here. 78 | 79 | (def e 101) 80 | (def colon 58) 81 | 82 | (defn #^{:private true} read-byte 83 | #^long [#^Stream input] ;;; #^InputStream 84 | (let [c (.ReadByte input)] ;;; .read 85 | (when (neg? c) 86 | (throw (EndOfStreamException. "Invalid netstring. Unexpected end of input."))) ;;; EOFException. 87 | ;; Here we have a quirk for example. `.read` returns -1 on end of 88 | ;; input. However the Java `Byte` has only a range from -128 to 127. 89 | ;; How does the fit together? 90 | ;; 91 | ;; The whole thing is shifted. `.read` actually returns an int 92 | ;; between zero and 255. Everything below the value 128 stands 93 | ;; for itself. But larger values are actually negative byte values. 94 | ;; 95 | ;; So we have to do some translation here. `Byte/byteValue` would 96 | ;; do that for us, but we want to avoid boxing here. 97 | c )) ;;; not a problem for CLR (if (< 127 c) (- c 256) c))) 98 | 99 | (defn #^{:private true :tag |System.Byte[]|} read-bytes ;;; :tag "[B" 100 | #^Object [#^Stream input n] ;;; #^InputStream 101 | (let [content (byte-array n)] 102 | (loop [offset (int 0) 103 | len (int n)] 104 | (let [result (.Read input content offset len)] ;;; .read 105 | (when (and (pos? len) (zero? result)) ;;; (when (neg? result) 106 | (throw 107 | (EndOfStreamException. ;;; EOFException. 108 | "Invalid netstring. Less data available than expected."))) 109 | (when (not= result len) 110 | (recur (+ offset result) (- len result))))) 111 | content)) 112 | 113 | ;; `read-long` is used for reading integers from the stream as well 114 | ;; as the byte count prefixes of byte strings. The delimiter is \: 115 | ;; for byte count prefixes and \e for integers. 116 | 117 | (defn #^{:private true} read-long 118 | #^long [#^Stream input delim] ;;; #^InputStream 119 | (loop [n (long 0)] 120 | ;; We read repeatedly a byte from the input… 121 | (let [b (read-byte input)] 122 | ;; …and stop at the delimiter. 123 | (cond 124 | (= b minus) (- (read-long input delim)) 125 | (= b delim) n 126 | :else (recur (+ (* n (long 10)) (- (long b) (long 48)))))))) 127 | 128 | ;; ## Reading a netstring 129 | ;; 130 | ;; Let's dive straight into reading a netstring from an `InputStream`. 131 | ;; 132 | ;; For convenience we split the function into two subfunctions. The 133 | ;; public `read-netstring` is the normal entry point, which also checks 134 | ;; for the trailing comma after reading the payload data with the 135 | ;; private `read-netstring*`. 136 | ;; 137 | ;; The reason we need the less strict `read-netstring*` is that with 138 | ;; bencode we don't have a trailing comma. So a check would not be 139 | ;; beneficial here. 140 | ;; 141 | ;; However the consumer doesn't have to care. `read-netstring` as 142 | ;; well as `read-bencode` provide the public entry points, which do 143 | ;; the right thing. Although they both may reference the `read-netstring*` 144 | ;; underneath. 145 | ;; 146 | ;; With this in mind we define the inner helper function first. 147 | 148 | (declare #^|System.Byte[]| string>payload ;;; #^"[B" 149 | #^String stringpayload` and `stringpayload ;;; :tag "[B" 171 | [#^String s] 172 | (.GetBytes System.Text.Encoding/UTF8 s)) ;;; (.getBytes s "UTF-8")) 173 | 174 | (defn #^{:private true :tag String} stringpayload (str (alength content))) ] ;;; added line 192 | (doto output 193 | (.Write lenbytes 0 (alength lenbytes)) ;;; (.write (string>payload (str (alength content)))) 194 | (.WriteByte (byte colon)) ;;; .write (int colon) 195 | (.Write content 0 (alength content)))) ) ;;; (.write content) 196 | 197 | (defn write-netstring 198 | "Write the given binary data to the output stream in form of a classic 199 | netstring." 200 | [#^Stream output content] ;;; #^OutputStream 201 | (doto output 202 | (write-netstring* content) 203 | (.WriteByte (byte comma)))) ;;; .write (int comma) 204 | 205 | ;; # Bencode 206 | ;; 207 | ;; However most of the time we don't want to send simple blobs of data 208 | ;; back and forth. The data sent between the communication peers usually 209 | ;; have some structure, which has to be carried along the way to the 210 | ;; other side. Here [bencode][bc] come into play. 211 | ;; 212 | ;; Bencode defines additionally to netstrings easily parseable structures 213 | ;; for lists, maps and numbers. It allows to communicate information 214 | ;; about the data structure to the peer on the other side. 215 | ;; 216 | ;; ## Tokens 217 | ;; 218 | ;; The data is encoded in tokens in bencode. There are several types of 219 | ;; tokens: 220 | ;; 221 | ;; * A netstring without trailing comma for string data. 222 | ;; * A tag specifiyng the type of the following tokens. 223 | ;; The tag may be one of these: 224 | ;; * `\i` to encode integers. 225 | ;; * `\l` to encode lists of items. 226 | ;; * `\d` to encode maps of item pairs. 227 | ;; * `\e` to end the a previously started tag. 228 | ;; 229 | ;; ## Reading bencode 230 | ;; 231 | ;; Reading bencode encoded data is basically parsing a stream of tokens 232 | ;; from the input. Hence we need a read-token helper which allows to 233 | ;; retrieve the next token. 234 | 235 | (defn #^{:private true} read-token 236 | [#^PushbackInputStream input] 237 | (let [ch (read-byte input)] 238 | (cond 239 | (= (long e) ch) nil 240 | (= i ch) :integer 241 | (= l ch) :list 242 | (= d ch) :map 243 | :else (do 244 | (.Unread input (byte ch)) ;;; (.unread input (int ch)) 245 | (read-netstring* input))))) 246 | 247 | ;; To read the bencode encoded data we walk a long the sequence of tokens 248 | ;; and act according to the found tags. 249 | 250 | (declare read-integer read-list read-map) 251 | 252 | (defn read-bencode 253 | "Read bencode token from the input stream." 254 | [input] 255 | (let [token (read-token input)] 256 | (case token 257 | :integer (read-integer input) 258 | :list (read-list input) 259 | :map (read-map input) 260 | token))) 261 | 262 | ;; Of course integers and the collection types are have to treated specially. 263 | ;; 264 | ;; Integers for example consist of a sequence of decimal digits. 265 | 266 | (defn #^{:private true} read-integer 267 | [input] 268 | (read-long input e)) 269 | 270 | ;; *Note:* integers are an ugly special case, which cannot be 271 | ;; handled with `read-token` or `read-netstring*`. 272 | ;; 273 | ;; Lists are just a sequence of other tokens. 274 | 275 | (declare token-seq) 276 | 277 | (defn #^{:private true} read-list 278 | [input] 279 | (vec (token-seq input))) 280 | 281 | ;; Maps are sequences of key/value pairs. The keys are always 282 | ;; decoded into strings. The values are kept as is. 283 | 284 | (defn #^{:private true} read-map 285 | [input] 286 | (->> (token-seq input) 287 | (partition 2) 288 | (map (fn [[k v]] [(string> #(read-bencode input) 297 | repeatedly 298 | (take-while identity))) 299 | 300 | ;; ## Writing bencode 301 | ;; 302 | ;; Writing bencode is similar easy as reading it. The main entry point 303 | ;; takes a string, map, sequence or integer and writes it according to 304 | ;; the rules to the given OutputStream. 305 | 306 | (defmulti write-bencode 307 | "Write the given thing to the output stream. “Thing” means here a 308 | string, map, sequence or integer. Alternatively an ByteArray may 309 | be provided whose contents are written as a bytestring. Similar 310 | the contents of a given InputStream are written as a byte string. 311 | Named things (symbols or keywords) are written in the form 312 | 'namespace/name'." 313 | (fn [_output thing] 314 | (cond 315 | (instance? |System.Byte[]| thing) :bytes ;;; (RT/classForName "[B") 316 | (instance? Stream thing) :input-stream ;;; InputStream 317 | (integer? thing) :integer 318 | (string? thing) :string 319 | (symbol? thing) :named 320 | (keyword? thing) :named 321 | (map? thing) :map 322 | (or (nil? thing) (coll? thing) (.IsArray (class thing))) :list ;;; .isArray 323 | :else (type thing)))) 324 | 325 | (defmethod write-bencode :default 326 | [output x] 327 | (throw (ArgumentException. (str "Cannot write value of type " (class x))))) ;;; IllegalArgumentException. 328 | 329 | ;; The following methods should be pretty straight-forward. 330 | ;; 331 | ;; The easiest case is of course when we already have a byte array. 332 | ;; We can simply pass it on to the underlying machinery. 333 | 334 | (defmethod write-bencode :bytes 335 | [output bytes] 336 | (write-netstring* output bytes)) 337 | 338 | ;; For strings we simply write the string as a netstring without 339 | ;; trailing comma after encoding the string as UTF-8 bytes. 340 | 341 | (defmethod write-bencode :string 342 | [output string] 343 | (write-netstring* output (string>payload string))) 344 | 345 | ;; Streaming does not really work, since we need to know the 346 | ;; number of bytes to write upfront. So we read in everything 347 | ;; for InputStreams and pass on the byte array. 348 | 349 | (defmethod write-bencode :input-stream 350 | [output stream] 351 | (let [bytes (MemoryStream.)] ;;; ByteArrayOutputStream. 352 | (io/copy stream bytes) 353 | (write-netstring* output (.ToArray bytes)))) ;;; .toByteArray 354 | 355 | ;; Integers are again the ugly special case. 356 | 357 | (defmethod write-bencode :integer 358 | [#^Stream output n] ;;; #^OutputStream 359 | (let [nbytes (string>payload (str n))] 360 | (doto output 361 | (.WriteByte (byte i)) ;;; (.write (int i)) 362 | (.Write nbytes 0 (alength nbytes)) ;;; (.write (string>payload (str n))) 363 | (.WriteByte (byte e)))) ) ;;; (.write (int e)) 364 | 365 | ;; Symbols and keywords are converted to a string of the 366 | ;; form 'namespace/name' or just 'name' in case its not 367 | ;; qualified. We do not add colons for keywords since the 368 | ;; other side might not have the notion of keywords. 369 | 370 | (defmethod write-bencode :named 371 | [output thing] 372 | (let [nspace (namespace thing) 373 | name (name thing)] 374 | (->> (str (when nspace (str nspace "/")) name) 375 | string>payload 376 | (write-netstring* output)))) 377 | 378 | ;; Lists as well as maps work recursively to print their elements. 379 | 380 | (defmethod write-bencode :list 381 | [#^Stream output lst] ;;; #^OutputStream 382 | (.WriteByte output (byte l)) ;;; (.write output (int l)) 383 | (doseq [elt lst] 384 | (write-bencode output elt)) 385 | (.WriteByte output (byte e))) ;;; (.write output (int e)) 386 | 387 | ;; However, maps are a bit special because their keys are sorted 388 | ;; lexicographically based on their byte string represantation. 389 | 390 | (declare lexicographically) 391 | 392 | (defmethod write-bencode :map 393 | [#^Stream output m] ;;; #^OutputStream 394 | (let [translation (into {} (map (juxt string>payload identity) (keys m))) 395 | key-strings (sort lexicographically (keys translation)) 396 | >value (comp m translation)] 397 | (.WriteByte output (byte d)) ;;; (.write output (int d)) 398 | (doseq [k key-strings] 399 | (write-netstring* output k) 400 | (write-bencode output (>value k))) 401 | (.WriteByte output (byte e)))) ;;; (.write output (int e)) 402 | 403 | ;; However, since byte arrays are not `Comparable` we need a custom 404 | ;; comparator which we can feed to `sort`. 405 | 406 | (defn #^{:private true} lexicographically 407 | [#^|System.Byte[]| a #^|System.Byte[]| b] ;;; #^"[B" #^"[B" 408 | (let [alen (alength a) 409 | blen (alength b) 410 | len (min alen blen)] 411 | (loop [i 0] 412 | (if (== i len) 413 | (- alen blen) 414 | (let [x (- (int (aget a i)) (int (aget b i)))] 415 | (if (zero? x) 416 | (recur (inc i)) 417 | x)))))) 418 | -------------------------------------------------------------------------------- /Excel-REPL/nrepl/clojure/data/json.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stuart Sierra, 2012. All rights reserved. The use 2 | ;; and distribution terms for this software are covered by the Eclipse 3 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this 5 | ;; distribution. By using this software in any fashion, you are 6 | ;; agreeing to be bound by the terms of this license. You must not 7 | ;; remove this notice, or any other, from this software. 8 | 9 | ;; Modified to run under ClojureCLR by David Miller 10 | ;; Changes are 11 | ;; Copyright (c) David Miller, 2013. All rights reserved. The use 12 | ;; and distribution terms for this software are covered by the Eclipse 13 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 14 | ;; which can be found in the file epl-v10.html at the root of this 15 | ;; distribution. By using this software in any fashion, you are 16 | ;; agreeing to be bound by the terms of this license. You must not 17 | ;; remove this notice, or any other, from this software. 18 | 19 | ;; Changes to Stuart Sierra's code are clearly marked. 20 | ;; An end-of-line comment start with ;DM: indicates a change on that line. 21 | ;; The commented material indicates what was in the original code or indicates a new line inserted. 22 | ;; For example, a comment such as the following 23 | ;; (defn- read-array [^PushbackTextReader stream] ;DM: ^PushbackReader 24 | ;; indicates that the type hint needed to be replaced 25 | ;; More substantial changes are commented more substantially. 26 | 27 | 28 | (ns ^{:author "Stuart Sierra, modifed for ClojureCLR by David Miller" 29 | :doc "JavaScript Object Notation (JSON) parser/generator. 30 | See http://www.json.org/"} 31 | clojure.data.json 32 | (:refer-clojure :exclude (read)) 33 | (:require [clojure.pprint :as pprint]) 34 | ;DM: (:import (java.io PrintWriter PushbackReader StringWriter 35 | ;DM: StringReader Reader EOFException))) 36 | (:import (System.IO EndOfStreamException StreamWriter StringReader ;DM: Added 37 | StringWriter TextWriter) ;DM: Added 38 | (clojure.lang PushbackTextReader) ;DM: Added 39 | (System.Globalization NumberStyles StringInfo) ;DM: Added 40 | )) ;DM: Added 41 | 42 | (set! *warn-on-reflection* true) 43 | 44 | ;;; JSON READER 45 | 46 | (def ^:dynamic ^:private *bigdec*) 47 | (def ^:dynamic ^:private *key-fn*) 48 | (def ^:dynamic ^:private *value-fn*) 49 | 50 | (defn- default-write-key-fn 51 | [x] 52 | (cond (instance? clojure.lang.Named x) 53 | (name x) 54 | (nil? x) 55 | (throw (Exception. "JSON object properties may not be nil")) 56 | :else (str x))) 57 | 58 | (defn- default-value-fn [k v] v) 59 | 60 | (declare -read) 61 | 62 | (defmacro ^:private codepoint [c] 63 | (int c)) 64 | 65 | (defn- codepoint-clause [[test result]] 66 | (cond (list? test) 67 | [(map int test) result] 68 | (= test :whitespace) 69 | ['(9 10 13 32) result] 70 | (= test :simple-ascii) 71 | [(remove #{(codepoint \") (codepoint \\) (codepoint \/)} 72 | (range 32 127)) 73 | result] 74 | :else 75 | [(int test) result])) 76 | 77 | (defmacro ^:private codepoint-case [e & clauses] 78 | `(case ~e 79 | ~@(mapcat codepoint-clause (partition 2 clauses)) 80 | ~@(when (odd? (count clauses)) 81 | [(last clauses)]))) 82 | 83 | (defn- read-array [^PushbackTextReader stream] ;DM: ^PushbackReader 84 | ;; Expects to be called with the head of the stream AFTER the 85 | ;; opening bracket. 86 | (loop [result (transient [])] 87 | (let [c (.Read stream)] ;DM: .read 88 | (when (neg? c) 89 | (throw (EndOfStreamException. "JSON error (end-of-file inside array)"))) ;DM: EOFException. 90 | (codepoint-case c 91 | :whitespace (recur result) 92 | \, (recur result) 93 | \] (persistent! result) 94 | (do (.Unread stream c) ;DM: .unread 95 | (let [element (-read stream true nil)] 96 | (recur (conj! result element)))))))) 97 | 98 | (defn- read-object [^PushbackTextReader stream] ;DM: ^PushbackReader 99 | ;; Expects to be called with the head of the stream AFTER the 100 | ;; opening bracket. 101 | (loop [key nil, result (transient {})] 102 | (let [c (.Read stream)] ;DM: .read 103 | (when (neg? c) 104 | (throw (EndOfStreamException. "JSON error (end-of-file inside object)"))) ;DM: EOFException. 105 | (codepoint-case c 106 | :whitespace (recur key result) 107 | 108 | \, (recur nil result) 109 | 110 | \: (recur key result) 111 | 112 | \} (if (nil? key) 113 | (persistent! result) 114 | (throw (Exception. "JSON error (key missing value in object)"))) 115 | 116 | (do (.Unread stream c) ;DM: .unread 117 | (let [element (-read stream true nil)] 118 | (if (nil? key) 119 | (if (string? element) 120 | (recur element result) ;DM: .read 121 | (throw (Exception. "JSON error (non-string key in object)"))) 122 | (recur nil 123 | (let [out-key (*key-fn* key) 124 | out-value (*value-fn* out-key element)] 125 | (if (= *value-fn* out-value) 126 | result 127 | (assoc! result out-key out-value))))))))))) 128 | 129 | (defn- read-hex-char [^PushbackTextReader stream] ;DM: ^PushbackReader 130 | ;; Expects to be called with the head of the stream AFTER the 131 | ;; initial "\u". Reads the next four characters from the stream. 132 | (let [a (.Read stream) ;DM: .read 133 | b (.Read stream) ;DM: .read 134 | c (.Read stream) ;DM: .read 135 | d (.Read stream)] ;DM: .read 136 | (when (or (neg? a) (neg? b) (neg? c) (neg? d)) 137 | (throw (EndOfStreamException. ;DM: EOFException. 138 | "JSON error (end-of-file inside Unicode character escape)"))) 139 | (let [s (str (char a) (char b) (char c) (char d))] 140 | (char (Int32/Parse s NumberStyles/HexNumber))))) ;DM: (Integer/parseInt s 16) 141 | 142 | (defn- read-escaped-char [^PushbackTextReader stream] ;DM: ^PushbackReader 143 | ;; Expects to be called with the head of the stream AFTER the 144 | ;; initial backslash. 145 | (let [c (.Read stream)] ;DM: .read 146 | (codepoint-case c 147 | (\" \\ \/) (char c) 148 | \b \backspace 149 | \f \formfeed 150 | \n \newline 151 | \r \return 152 | \t \tab 153 | \u (read-hex-char stream)))) 154 | 155 | (defn- read-quoted-string [^PushbackTextReader stream] ;DM: ^PushbackReader 156 | ;; Expects to be called with the head of the stream AFTER the 157 | ;; opening quotation mark. 158 | (let [buffer (StringBuilder.)] 159 | (loop [] 160 | (let [c (.Read stream)] ;DM: .read 161 | (when (neg? c) 162 | (throw (EndOfStreamException. "JSON error (end-of-file inside string)"))) ;DM: EOFException. 163 | (codepoint-case c 164 | \" (str buffer) 165 | \\ (do (.Append buffer (read-escaped-char stream)) ;DM: .append 166 | (recur)) 167 | (do (.Append buffer (char c)) ;DM: .append 168 | (recur))))))) 169 | 170 | (defn- read-integer [^String string] 171 | (if (< (count string) 18) ; definitely fits in a Long 172 | (Int64/Parse string) ;DM: Long/valueOf 173 | (or (try (Int64/Parse string) ;DM: Long/valueOf 174 | (catch OverflowException e nil) ;DM: Added 175 | (catch FormatException e nil)) ;DM: NumberFormatException 176 | (clojure.lang.BigInteger/Parse string)))) ;DM: (bigint string) TODO: Fix when we have a BigInteger c-tor that takes a string 177 | 178 | (defn- read-decimal [^String string] 179 | (if *bigdec* 180 | (clojure.lang.BigDecimal/Parse string) ;DM: (bigdec string) -- TODO: we can change this back when we fix BigDecimal 181 | (Double/Parse string))) ;DM: Double/valueOf 182 | 183 | (defn- read-number [^PushbackTextReader stream] ;DM: ^PushbackReader 184 | (let [buffer (StringBuilder.) 185 | decimal? (loop [decimal? false] 186 | (let [c (.Read stream)] ;DM: .read 187 | (codepoint-case c 188 | (\- \+ \0 \1 \2 \3 \4 \5 \6 \7 \8 \9) 189 | (do (.Append buffer (char c)) ;DM: .append 190 | (recur decimal?)) 191 | (\e \E \.) 192 | (do (.Append buffer (char c)) ;DM: .append 193 | (recur true)) 194 | (do (.Unread stream c) ;DM: .unread 195 | decimal?))))] 196 | (if decimal? 197 | (read-decimal (str buffer)) 198 | (read-integer (str buffer))))) 199 | 200 | (defn- -read 201 | [^PushbackTextReader stream eof-error? eof-value] ;DM: ^PushbackReader 202 | (loop [] 203 | (let [c (.Read stream)] ;DM: .read 204 | (if (neg? c) ;; Handle end-of-stream 205 | (if eof-error? 206 | (throw (EndOfStreamException. "JSON error (end-of-file)")) ;DM: EOFException. 207 | eof-value) 208 | (codepoint-case 209 | c 210 | :whitespace (recur) 211 | 212 | ;; Read numbers 213 | (\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9) 214 | (do (.Unread stream c) ;DM: .unread 215 | (read-number stream)) 216 | 217 | ;; Read strings 218 | \" (read-quoted-string stream) 219 | 220 | ;; Read null as nil 221 | \n (if (and (= (codepoint \u) (.Read stream)) ;DM: .read 222 | (= (codepoint \l) (.Read stream)) ;DM: .read 223 | (= (codepoint \l) (.Read stream))) ;DM: .read 224 | nil 225 | (throw (Exception. "JSON error (expected null)"))) 226 | 227 | ;; Read true 228 | \t (if (and (= (codepoint \r) (.Read stream)) ;DM: .read 229 | (= (codepoint \u) (.Read stream)) ;DM: .read 230 | (= (codepoint \e) (.Read stream))) ;DM: .read 231 | true 232 | (throw (Exception. "JSON error (expected true)"))) 233 | 234 | ;; Read false 235 | \f (if (and (= (codepoint \a) (.Read stream)) ;DM: .read 236 | (= (codepoint \l) (.Read stream)) ;DM: .read 237 | (= (codepoint \s) (.Read stream)) ;DM: .read 238 | (= (codepoint \e) (.Read stream))) ;DM: .read 239 | false 240 | (throw (Exception. "JSON error (expected false)"))) 241 | 242 | ;; Read JSON objects 243 | \{ (read-object stream) 244 | 245 | ;; Read JSON arrays 246 | \[ (read-array stream) 247 | 248 | (throw (Exception. 249 | (str "JSON error (unexpected character): " (char c))))))))) 250 | 251 | (defn read 252 | "Reads a single item of JSON data from a java.io.Reader. Options are 253 | key-value pairs, valid options are: 254 | 255 | :eof-error? boolean 256 | 257 | If true (default) will throw exception if the stream is empty. 258 | 259 | :eof-value Object 260 | 261 | Object to return if the stream is empty and eof-error? is 262 | false. Default is nil. 263 | 264 | :bigdec boolean 265 | 266 | If true use BigDecimal for decimal numbers instead of Double. 267 | Default is false. 268 | 269 | :key-fn function 270 | 271 | Single-argument function called on JSON property names; return 272 | value will replace the property names in the output. Default 273 | is clojure.core/identity, use clojure.core/keyword to get 274 | keyword properties. 275 | 276 | :value-fn function 277 | 278 | Function to transform values in the output. For each JSON 279 | property, value-fn is called with two arguments: the property 280 | name (transformed by key-fn) and the value. The return value 281 | of value-fn will replace the value in the output. If value-fn 282 | returns itself, the property will be omitted from the output. 283 | 284 | The default value-fn returns the value unchanged." 285 | [reader & options] 286 | (let [{:keys [eof-error? eof-value bigdec key-fn value-fn] 287 | :or {bigdec false 288 | eof-error? true 289 | key-fn identity 290 | value-fn default-value-fn}} options] 291 | (binding [*bigdec* bigdec 292 | *key-fn* key-fn 293 | *value-fn* value-fn] 294 | (-read (PushbackTextReader. reader) eof-error? eof-value)))) ;DM: PushbackReader. 295 | 296 | (defn read-str 297 | "Reads one JSON value from input String. Options are the same as for 298 | read." 299 | [string & options] 300 | (apply read (StringReader. string) options)) 301 | 302 | ;;; JSON WRITER 303 | 304 | (def ^:dynamic ^:private *escape-unicode*) 305 | (def ^:dynamic ^:private *escape-slash*) 306 | 307 | (defprotocol JSONWriter 308 | (-write [object out] 309 | "Print object to PrintWriter out as JSON")) 310 | 311 | (defn- write-string [^String s ^TextWriter out] ;DM: ^CharSequence ^PrintWriter 312 | (let [sb (StringBuilder. (count s))] 313 | (.Append sb \") ;DM: .append 314 | (dotimes [i (count s)] 315 | (let [cp (int (.get_Chars s i))] ;DM: (Character/codePointAt s i) 316 | (codepoint-case cp 317 | ;; Printable JSON escapes 318 | \" (.Append sb "\\\"") ;DM: .append 319 | \\ (.Append sb "\\\\") ;DM: .append 320 | \/ (.Append sb (if *escape-slash* "\\/" "/")) ;DM: .append 321 | ;; Simple ASCII characters 322 | :simple-ascii (.Append sb (.get_Chars s i)) ;DM: .append .charAt 323 | ;; JSON escapes 324 | \backspace (.Append sb "\\b") ;DM: .append 325 | \formfeed (.Append sb "\\f") ;DM: .append 326 | \newline (.Append sb "\\n") ;DM: .append 327 | \return (.Append sb "\\r") ;DM: .append 328 | \tab (.Append sb "\\t") ;DM: .append 329 | ;; Any other character is Unicode 330 | (if *escape-unicode* 331 | (.Append sb (format "\\u%04x" cp)) ; Hexadecimal-escaped ;DM: .append 332 | (.Append sb (.get_Chars s i)))))) ;DM: (.appendCodePoint sb cp) 333 | (.Append sb \") ;DM: .append 334 | (.Write out (str sb)))) ;DM: .print 335 | 336 | (defn- write-object [m ^TextWriter out] ;DM: ^PrintWriter 337 | (.Write out \{) ;DM: .print 338 | (loop [x m] 339 | (when (seq m) 340 | (let [[k v] (first x) 341 | out-key (*key-fn* k) 342 | out-value (*value-fn* k v)] 343 | (when-not (string? out-key) 344 | (throw (Exception. "JSON object keys must be strings"))) 345 | (when-not (= *value-fn* out-value) 346 | (write-string out-key out) 347 | (.Write out \:) ;DM: .print 348 | (-write out-value out))) 349 | (let [nxt (next x)] 350 | (when (seq nxt) 351 | (.Write out \,) ;DM: .print 352 | (recur nxt))))) 353 | (.Write out \})) ;DM: .print 354 | 355 | (defn- write-array [s ^TextWriter out] ;DM: ^PrintWriter 356 | (.Write out \[) ;DM: .print 357 | (loop [x s] 358 | (when (seq x) 359 | (let [fst (first x) 360 | nxt (next x)] 361 | (-write fst out) 362 | (when (seq nxt) 363 | (.Write out \,) ;DM: .print 364 | (recur nxt))))) 365 | (.Write out \])) ;DM: .print 366 | 367 | (defn- write-bignum [x ^TextWriter out] ;DM: ^PrintWriter 368 | (.Write out (str x))) ;DM: .print 369 | 370 | (defn- write-plain [x ^TextWriter out] ;DM: ^PrintWriter 371 | (.Write out x)) ;DM: .print 372 | 373 | (defn- write-null [x ^TextWriter out] ;DM: ^PrintWriter 374 | (.Write out "null")) ;DM: .print 375 | 376 | (defn- write-named [x out] 377 | (write-string (name x) out)) 378 | 379 | (defn- write-generic [x out] 380 | (if (.IsArray (class x)) ;DM: isArray 381 | (-write (seq x) out) 382 | (throw (Exception. (str "Don't know how to write JSON of " (class x)))))) 383 | 384 | (defn- write-ratio [x out] 385 | (-write (double x) out)) 386 | 387 | ;;DM: Added write-float 388 | (defn- write-float [x ^TextWriter out] 389 | (.Write out (fp-str x))) 390 | 391 | 392 | ;DM: ;; nil, true, false 393 | ;DM: (extend nil JSONWriter {:-write write-null}) 394 | ;DM: (extend java.lang.Boolean JSONWriter {:-write write-plain}) 395 | ;DM: 396 | ;DM: ;; Numbers 397 | ;DM: (extend java.lang.Number JSONWriter {:-write write-plain}) 398 | ;DM: (extend clojure.lang.Ratio JSONWriter {:-write write-ratio}) 399 | ;DM: (extend clojure.lang.BigInt JSONWriter {:-write write-bignum}) 400 | ;DM: (extend java.math.BigInteger JSONWriter {:-write write-bignum}) 401 | ;DM: (extend java.math.BigDecimal JSONWriter {:-write write-bignum}) 402 | ;DM: 403 | ;DM: ;; Symbols, Keywords, and Strings 404 | ;DM: (extend clojure.lang.Named JSONWriter {:-write write-named}) 405 | ;DM: (extend java.lang.CharSequence JSONWriter {:-write write-string}) 406 | ;DM: 407 | ;DM: ;; Collections 408 | ;DM: (extend java.util.Map JSONWriter {:-write write-object}) 409 | ;DM: (extend java.util.Collection JSONWriter {:-write write-array}) 410 | ;DM: 411 | ;DM: ;; Maybe a Java array, otherwise fail 412 | ;DM: (extend java.lang.Object JSONWriter {:-write write-generic}) 413 | 414 | ;;DM: Following added 415 | ;; nil, true, false 416 | (extend nil JSONWriter {:-write write-null}) 417 | (extend clojure.lang.Named JSONWriter {:-write write-named}) 418 | (extend System.Boolean JSONWriter {:-write write-plain}) 419 | 420 | ;; Numbers 421 | ;; no equivalent to java.lang.Number. Sigh. 422 | (extend System.Byte JSONWriter {:-write write-plain}) 423 | (extend System.SByte JSONWriter {:-write write-plain}) 424 | (extend System.Int16 JSONWriter {:-write write-plain}) 425 | (extend System.Int32 JSONWriter {:-write write-plain}) 426 | (extend System.Int64 JSONWriter {:-write write-plain}) 427 | (extend System.UInt16 JSONWriter {:-write write-plain}) 428 | (extend System.UInt32 JSONWriter {:-write write-plain}) 429 | (extend System.UInt64 JSONWriter {:-write write-plain}) 430 | (extend System.Double JSONWriter {:-write write-float}) 431 | (extend System.Single JSONWriter {:-write write-float}) 432 | (extend System.Decimal JSONWriter {:-write write-plain}) 433 | (extend clojure.lang.Ratio JSONWriter {:-write write-ratio}) 434 | (extend clojure.lang.BigInt JSONWriter {:-write write-bignum}) 435 | (extend clojure.lang.BigInteger JSONWriter {:-write write-bignum}) 436 | (extend clojure.lang.BigDecimal JSONWriter {:-write write-bignum}) 437 | 438 | ;; Symbols, Keywords, and Strings 439 | (extend clojure.lang.Named JSONWriter {:-write write-named}) 440 | (extend System.String JSONWriter {:-write write-string}) 441 | 442 | ;; Collections 443 | (extend clojure.lang.IPersistentMap JSONWriter {:-write write-object}) 444 | (extend System.Collections.IDictionary JSONWriter {:-write write-object}) 445 | ;; Cannot handle generic types!!!! 446 | (extend System.Collections.ICollection JSONWriter {:-write write-array}) 447 | (extend clojure.lang.ISeq JSONWriter {:-write write-array}) 448 | 449 | ;; Maybe a Java array, otherwise fail 450 | (extend System.Object JSONWriter {:-write write-generic}) 451 | ;;DM: End addition 452 | 453 | (defn write 454 | "Write JSON-formatted output to a java.io.Writer. Options are 455 | key-value pairs, valid options are: 456 | 457 | :escape-unicode boolean 458 | 459 | If true (default) non-ASCII characters are escaped as \\uXXXX 460 | 461 | :escape-slash boolean 462 | If true (default) the slash / is escaped as \\/ 463 | 464 | :key-fn function 465 | 466 | Single-argument function called on map keys; return value will 467 | replace the property names in the output. Must return a 468 | string. Default calls clojure.core/name on symbols and 469 | keywords and clojure.core/str on everything else. 470 | 471 | :value-fn function 472 | 473 | Function to transform values before writing. For each 474 | key-value pair in the input, called with two arguments: the 475 | key (BEFORE transformation by key-fn) and the value. The 476 | return value of value-fn will replace the value in the output. 477 | If the return value is a number, boolean, string, or nil it 478 | will be included literally in the output. If the return value 479 | is a non-map collection, it will be processed recursively. If 480 | the return value is a map, it will be processed recursively, 481 | calling value-fn again on its key-value pairs. If value-fn 482 | returns itself, the key-value pair will be omitted from the 483 | output." 484 | [x writer & options] ; ^Writer -- can't do. we might get a TextWriter or a Stream 485 | (let [{:keys [escape-unicode escape-slash key-fn value-fn] 486 | :or {escape-unicode true 487 | escape-slash true 488 | key-fn default-write-key-fn 489 | value-fn default-value-fn}} options] 490 | (binding [*escape-unicode* escape-unicode 491 | *escape-slash* escape-slash 492 | *key-fn* key-fn 493 | *value-fn* value-fn] 494 | (-write x (if (instance? TextWriter writer) writer (StreamWriter. writer)))))) ;DM: (-write x(PrintWriter. writer)) 495 | 496 | (defn write-str 497 | "Converts x to a JSON-formatted string. Options are the same as 498 | write." 499 | [x & options] 500 | (let [sw (StringWriter.)] 501 | (apply write x sw options) 502 | (.ToString sw))) ;DM: .toString 503 | 504 | ;;; JSON PRETTY-PRINTER 505 | 506 | ;; Based on code by Tom Faulhaber 507 | 508 | (defn- pprint-array [s] 509 | ((pprint/formatter-out "~<[~;~@{~w~^, ~:_~}~;]~:>") s)) 510 | 511 | (defn- pprint-object [m] 512 | ((pprint/formatter-out "~<{~;~@{~<~w:~_~w~:>~^, ~_~}~;}~:>") 513 | (for [[k v] m] [(*key-fn* k) v]))) 514 | 515 | (defn- pprint-generic [x] 516 | (if (.IsArray (class x)) ;DM: isArray 517 | (pprint-array (seq x)) 518 | ;; pprint proxies Writer, so we can't just wrap it 519 | (print (with-out-str (-write x (if (instance? TextWriter *out*) *out* (StreamWriter. *out*))))))) ; DM: PrintWriter 520 | 521 | (defn- pprint-dispatch [x] 522 | (cond (nil? x) (print "null") 523 | (true? x) (print "true") ;DM: Added 524 | (false? x) (print "false") ;DM: Added 525 | (instance? System.Collections.IDictionary x) (pprint-object x) ;DM: java.util.Map 526 | (instance? System.Collections.ICollection x) (pprint-array x) ;DM: java.util.Collection 527 | (instance? clojure.lang.ISeq x) (pprint-array x) 528 | :else (pprint-generic x))) 529 | 530 | (defn pprint 531 | "Pretty-prints JSON representation of x to *out*. Options are the 532 | same as for write except :value-fn, which is not supported." 533 | [x & options] 534 | (let [{:keys [escape-unicode escape-slash key-fn] 535 | :or {escape-unicode true 536 | escape-slash true 537 | key-fn default-write-key-fn}} options] 538 | (binding [*escape-unicode* escape-unicode 539 | *escape-slash* escape-slash 540 | *key-fn* key-fn] 541 | (pprint/write x :dispatch pprint-dispatch)))) 542 | 543 | ;; Local Variables: 544 | ;; mode: clojure 545 | ;; eval: (define-clojure-indent (codepoint-case (quote defun))) 546 | ;; End: --------------------------------------------------------------------------------