From cc582b5cd3431f8a665e4bf42f5277c12f217593 Mon Sep 17 00:00:00 2001 From: onbreath <65270097+onbreath@users.noreply.github.com> Date: Fri, 28 Nov 2025 03:37:43 +0100 Subject: [PATCH 1/7] babashka shebang --- src/scicloj/read_kinds/read.clj | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index 8033185..e31ea79 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -71,7 +71,7 @@ (when (seq out-str) {:out out-str}) (when (seq err-str) {:err err-str})))))) -(defn- babashka? [node] +(defn- babashka-shebang? [node] (-> (node/string node) (str/starts-with? "#!/usr/bin/env bb"))) @@ -80,8 +80,8 @@ returns a vector of contexts that represent evaluation" (let [top-level-nodes (node/children ast) ;; TODO: maybe some people want to include the header? - babashka (some-> (first top-level-nodes) (babashka?)) - nodes (if babashka + babashka-shebang (some-> (first top-level-nodes) (babashka-shebang?)) + nodes (if babashka-shebang (rest top-level-nodes) top-level-nodes)] ;; Babashka and Clojure can evaluate files with or without the header present, From 3608e25af4355a2a7b5a522fc55c9d31c863703f Mon Sep 17 00:00:00 2001 From: onbreath <65270097+onbreath@users.noreply.github.com> Date: Fri, 28 Nov 2025 03:38:13 +0100 Subject: [PATCH 2/7] Add region to notes for backwards compatibility for now --- src/scicloj/read_kinds/read.clj | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index e31ea79..a82ac0b 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -48,11 +48,13 @@ ;; evaluate for value, taking care to capture stderr/stdout and exceptions (let [form (node/sexpr node) - {:keys [row col]} (meta node) + {:keys [row col end-row end-col]} (meta node) out (new StringWriter) err (new StringWriter) context {:line row :column col + ;; TODO for backwards compatibility with clay + :region [row col end-row end-col] :code code :form form} result (try From ea0061f43d7f7a189a7d9e19e64e615cd7e6326b Mon Sep 17 00:00:00 2001 From: onbreath <65270097+onbreath@users.noreply.github.com> Date: Wed, 3 Dec 2025 22:09:35 +0100 Subject: [PATCH 3/7] Refactor to split read/eval and add global out/err capture --- src/scicloj/read_kinds/notes.clj | 6 +- src/scicloj/read_kinds/read.clj | 183 +++++++++++++++++++------------ 2 files changed, 117 insertions(+), 72 deletions(-) diff --git a/src/scicloj/read_kinds/notes.clj b/src/scicloj/read_kinds/notes.clj index efaf985..9b2b341 100644 --- a/src/scicloj/read_kinds/notes.clj +++ b/src/scicloj/read_kinds/notes.clj @@ -72,7 +72,8 @@ (defn read-file-as-notes "Reads a clojure source file and returns contexts." [^File file options] - (into [] notebook-xform (read/read-file file options))) + (into [] notebook-xform (-> (read/read-file file options) + (read/eval-ast options)))) (defn relative-path [^File file] (-> (str (.relativize (.toURI (io/file "")) @@ -153,7 +154,8 @@ (defn read-string-as-context "Reads a form and returns a context." [code options] - (maybe-advise (read/read-string code options))) + (maybe-advise (-> (read/read-string code options) + (read/eval-ast options)))) (comment (read-string-as-context "(+ 1 2)" {}) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index a82ac0b..dd697a5 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -27,111 +27,154 @@ :context context} ex))) +(def ^:dynamic *capture-pr-context*) +(def out-orig *out*) +(def err-orig *err*) + +(defmacro with-out-err-str [& body] + `(binding [*out* (new StringWriter) + *err* (new StringWriter)] + ~@body)) + +(defn str-and-reset! [w] + (locking w + (let [s (str w)] + (.setLength (.getBuffer ^StringWriter w) 0) + s))) + +;; TODO need to make items of these in notes +(defmacro with-out-err->context [pr-context & body] + ;; For a notebook, we capture output globally, and per note. + (case pr-context + ;; Capture global *out* and *err* + :global + ;; Threads may inherit only the root binding + `(with-out-err-str + (with-redefs [*out* *out* + *err* *err*] + ;; Futures will inherit the current binding, + ;; which was not affected by altering the root. + (binding [*capture-pr-context* :global] + ~@body))) + ;; Capture local *out* and *err*, per note + :local + `(let [global-out# *out* + global-err# *err*] + (assert (= *capture-pr-context* :global) + ":global should be captured before (around) :local") + (with-out-err-str + (let [result# (do ~@body)] + (into result# + (filter (comp not-empty val)) + {:out (str *out*) + :err (str *err*) + :global-out (str-and-reset! global-out#) + :global-err (str-and-reset! global-err#)})))))) + +(defn print-from-context [context] + (doseq [[captured print-to] (->> (map (juxt context identity) + [:out :err :global-out :global-err] + (cycle [out-orig err-orig])) + (filter first))] + (binding [*out* print-to] + (print captured) + (flush))) + context) + (defn- eval-node "Given an Abstract Syntax Tree node, returns a context. A context represents a top level form evaluation." [node options] - (let [tag (node/tag node) - code (node/string node)] - (case tag - (:newline :whitespace) {:code code - :kind :kind/whitespace} - - :uneval {:code code - :kind :kind/uneval} - - ;; extract text from comments - :comment {:code code - :kind :kind/comment - ;; remove leading semicolons or shebangs, and one non-newline space if present. - :value (str/replace-first code #"^(;|#!)*[^\S\r\n]?" "")} - - ;; evaluate for value, taking care to capture stderr/stdout and exceptions - (let [form (node/sexpr node) - {:keys [row col end-row end-col]} (meta node) - out (new StringWriter) - err (new StringWriter) - context {:line row - :column col - ;; TODO for backwards compatibility with clay - :region [row col end-row end-col] - :code code - :form form} - result (try - ;; TODO: capture `tap` or not? - (let [x (binding [*out* out - *err* err] - (eval form))] - {:value x}) - (catch Throwable ex - (when *on-eval-error* - (*on-eval-error* context ex)) - {:exception ex})) - out-str (str out) - err-str (str err)] - (merge context result - (when (seq out-str) {:out out-str}) - (when (seq err-str) {:err err-str})))))) + ;; capturing *out* and *err* as soon as possible + (with-out-err->context :local + (let [tag (node/tag node) + code (node/string node)] + (case tag + (:newline :whitespace) {:code code + :kind :kind/whitespace} + + :uneval {:code code + :kind :kind/uneval} + + ;; extract text from comments + :comment {:code code + :kind :kind/comment + ;; remove leading semicolons or shebangs, and one non-newline space if present. + :value (str/replace-first code #"^(;|#!)*[^\S\r\n]?" "")} + ;; evaluate for value, capturing exceptions + ;; TODO doesn't this break namespaced keywords? (sexpr-call + ;; without ns/alias inf) + (let [form (node/sexpr node) + {:keys [row col end-row end-col]} (meta node) + context {:line row + :column col + ;; TODO for backwards compatibility with clay + :region [row col end-row end-col] + :code code + :form form} + result (try + ;; TODO: capture `tap` or not? + (let [x (eval form)] + {:value x}) + (catch Throwable ex + (when *on-eval-error* + (*on-eval-error* context ex)) + {:exception ex}))] + (merge context result)))))) (defn- babashka-shebang? [node] (-> (node/string node) (str/starts-with? "#!/usr/bin/env bb"))) -(defn- eval-ast [ast options] +(defn- eval-ast* "Given the root Abstract Syntax Tree node, returns a vector of contexts that represent evaluation" + [ast options] (let [top-level-nodes (node/children ast) ;; TODO: maybe some people want to include the header? babashka-shebang (some-> (first top-level-nodes) (babashka-shebang?)) nodes (if babashka-shebang (rest top-level-nodes) top-level-nodes)] - ;; Babashka and Clojure can evaluate files with or without the header present, - ;; it is up to the user to specify which evaluator to use in the options. - #_(when (and babashka (not= evaluator :babashka)) - (println "Warning: Babashka header detected while evaluating in Clojure")) ;; must be eager to restore current bindings - (mapv #(eval-node % options) nodes))) + (mapv #(-> % (eval-node options) print-from-context) nodes))) +(defn eval-ast + "Evaluates an ast as retrieved via the `read-`functions." + ([ast] (eval-ast ast {})) + ([ast options] + (with-out-err->context :global + (binding [;; preserve current bindings (they will be reset to + ;; original) + *ns* *ns* + *warn-on-reflection* *warn-on-reflection* + *unchecked-math* *unchecked-math*] + (eval-ast* ast options))))) -;; TODO: DRY (defn read-string - "Parse and evaluate the first form in a string. + "Parse the first form in a string. The result can be passed to `eval-ast`. Suitable for sending text representing one thing for visualization." ([code] (read-string code {})) ([code options] (validate-options options) - ;; preserve current bindings (they will be reset to original) - (binding [*ns* *ns* - *warn-on-reflection* *warn-on-reflection* - *unchecked-math* *unchecked-math*] - (-> (parser/parse-string code) - (eval-node options))))) + [(parser/parse-string code)])) (defn read-string-all - "Parse and evaluate all forms in a string. + "Parse all forms in a string. The result can be passed to `eval-ast`. Suitable for sending a selection of text for visualization. - When reading a file, prefer using `read-file` to preserve the current ns bindings." + When reading a file, prefer using `read-file` to preserve the + current ns bindings." ([code] (read-string-all code {})) ([code options] (validate-options options) ;; preserve current bindings (they will be reset to original) - (binding [*ns* *ns* - *warn-on-reflection* *warn-on-reflection* - *unchecked-math* *unchecked-math*] - (-> (parser/parse-string-all code) - (eval-ast options))))) + (parser/parse-string-all code))) -;; TODO: DRY (defn read-file - "Similar to `clojure.core/load-file`, - but returns a representation of the forms and results of evaluation. + "Similar to `clojure.core/load-file`, but returns a representation + of the forms, which can be passed to `eval-ast`. Suitable for processing an entire namespace." [file options] (validate-options options) ;; preserve current bindings (they will be reset to original) - (binding [*ns* *ns* - *warn-on-reflection* *warn-on-reflection* - *unchecked-math* *unchecked-math*] - (-> (parser/parse-file-all file) - (eval-ast options)))) + (parser/parse-file-all file)) From 66e428ab003f647c3da1985dff2b28f1949a7f86 Mon Sep 17 00:00:00 2001 From: onbreath <65270097+onbreath@users.noreply.github.com> Date: Wed, 3 Dec 2025 22:17:43 +0100 Subject: [PATCH 4/7] Fix printing --- src/scicloj/read_kinds/read.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index dd697a5..2553326 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -72,7 +72,8 @@ :global-err (str-and-reset! global-err#)})))))) (defn print-from-context [context] - (doseq [[captured print-to] (->> (map (juxt context identity) + (doseq [[captured print-to] (->> (map (fn [k pr-to] + [(k context) pr-to]) [:out :err :global-out :global-err] (cycle [out-orig err-orig])) (filter first))] From bd6259be0f3253d219f65606767b70a865a69a1b Mon Sep 17 00:00:00 2001 From: onbreath <65270097+onbreath@users.noreply.github.com> Date: Wed, 3 Dec 2025 23:03:59 +0100 Subject: [PATCH 5/7] Put comments in right places again --- src/scicloj/read_kinds/read.clj | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index 2553326..64d8301 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -48,14 +48,14 @@ (case pr-context ;; Capture global *out* and *err* :global - ;; Threads may inherit only the root binding + ;; Futures will inherit the current binding, + ;; which is not affected by altering the root. `(with-out-err-str - (with-redefs [*out* *out* - *err* *err*] - ;; Futures will inherit the current binding, - ;; which was not affected by altering the root. - (binding [*capture-pr-context* :global] - ~@body))) + ;; Threads may inherit only the root binding + (with-redefs [*out* *out* + *err* *err*] + (binding [*capture-pr-context* :global] + ~@body))) ;; Capture local *out* and *err*, per note :local `(let [global-out# *out* From e2d9156226c1813b94cf46e12e94b0427bc7fcf0 Mon Sep 17 00:00:00 2001 From: onbreath <65270097+onbreath@users.noreply.github.com> Date: Wed, 3 Dec 2025 23:05:39 +0100 Subject: [PATCH 6/7] Move :local *out* capturing closer to eval again --- src/scicloj/read_kinds/read.clj | 38 ++++++++++++++++----------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index 64d8301..6de873a 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -86,25 +86,25 @@ "Given an Abstract Syntax Tree node, returns a context. A context represents a top level form evaluation." [node options] - ;; capturing *out* and *err* as soon as possible - (with-out-err->context :local - (let [tag (node/tag node) - code (node/string node)] - (case tag - (:newline :whitespace) {:code code - :kind :kind/whitespace} - - :uneval {:code code - :kind :kind/uneval} - - ;; extract text from comments - :comment {:code code - :kind :kind/comment - ;; remove leading semicolons or shebangs, and one non-newline space if present. - :value (str/replace-first code #"^(;|#!)*[^\S\r\n]?" "")} - ;; evaluate for value, capturing exceptions - ;; TODO doesn't this break namespaced keywords? (sexpr-call - ;; without ns/alias inf) + ;; TODO could just move down to let before eval + (let [tag (node/tag node) + code (node/string node)] + (case tag + (:newline :whitespace) {:code code + :kind :kind/whitespace} + + :uneval {:code code + :kind :kind/uneval} + + ;; extract text from comments + :comment {:code code + :kind :kind/comment + ;; remove leading semicolons or shebangs, and one non-newline space if present. + :value (str/replace-first code #"^(;|#!)*[^\S\r\n]?" "")} + ;; evaluate for value, capturing *out*, *err* and exceptions + ;; TODO doesn't this break namespaced keywords? (sexpr-call + ;; without ns/alias inf) + (with-out-err->context :local (let [form (node/sexpr node) {:keys [row col end-row end-col]} (meta node) context {:line row From 5ea7005e6cd34c7b092e637975e79e39c24913fb Mon Sep 17 00:00:00 2001 From: onbreath <65270097+onbreath@users.noreply.github.com> Date: Sat, 6 Dec 2025 07:20:25 +0100 Subject: [PATCH 7/7] Documented output capturing macro and made it less magical --- src/scicloj/read_kinds/read.clj | 47 +++++++++++++++++++++++---------- 1 file changed, 33 insertions(+), 14 deletions(-) diff --git a/src/scicloj/read_kinds/read.clj b/src/scicloj/read_kinds/read.clj index 6de873a..dc96875 100644 --- a/src/scicloj/read_kinds/read.clj +++ b/src/scicloj/read_kinds/read.clj @@ -28,8 +28,8 @@ ex))) (def ^:dynamic *capture-pr-context*) -(def out-orig *out*) -(def err-orig *err*) +(def ^:dynamic *out-orig* *out*) +(def ^:dynamic *err-orig* *err*) (defmacro with-out-err-str [& body] `(binding [*out* (new StringWriter) @@ -43,7 +43,23 @@ s))) ;; TODO need to make items of these in notes -(defmacro with-out-err->context [pr-context & body] +(defmacro with-out-err-captured + "Captures `*out*` and `*err*`, with either `:global` or `:local` + `pr-context.` `:global` is used to capture output on all threads + during notebook execution, so should be placed at the \"top\" of a + notebook eval. + + Inside a `:global` capture, `:local` can be used to capture the + output of individual note evaluations. `:local` should be called + with a symbol to bind a fn which returns a map, containing `:out`, + `:err`, `:global-out` and `:global-err` to, for consumption in the + `:local` invocation's body. + + with-out-err-captured :global => executes body, capturing output + with-out-err-captured :local fn-binding => executes body, capturing + output, retrieve captured output with (fn-binding) + " + [pr-context & body] ;; For a notebook, we capture output globally, and per note. (case pr-context ;; Capture global *out* and *err* @@ -60,22 +76,25 @@ :local `(let [global-out# *out* global-err# *err*] + (assert (symbol? '~(first body)) + ":local capture should provide a symbol to bind + captured output") (assert (= *capture-pr-context* :global) ":global should be captured before (around) :local") (with-out-err-str - (let [result# (do ~@body)] - (into result# - (filter (comp not-empty val)) - {:out (str *out*) - :err (str *err*) - :global-out (str-and-reset! global-out#) - :global-err (str-and-reset! global-err#)})))))) + (let [~(first body) #(into {} + (filter (comp not-empty val)) + {:out (str *out*) + :err (str *err*) + :global-out (str-and-reset! global-out#) + :global-err (str-and-reset! global-err#)})] + ~@(next body)))))) (defn print-from-context [context] (doseq [[captured print-to] (->> (map (fn [k pr-to] [(k context) pr-to]) [:out :err :global-out :global-err] - (cycle [out-orig err-orig])) + (cycle [*out-orig* *err-orig*])) (filter first))] (binding [*out* print-to] (print captured) @@ -104,7 +123,7 @@ ;; evaluate for value, capturing *out*, *err* and exceptions ;; TODO doesn't this break namespaced keywords? (sexpr-call ;; without ns/alias inf) - (with-out-err->context :local + (with-out-err-captured :local captured (let [form (node/sexpr node) {:keys [row col end-row end-col]} (meta node) context {:line row @@ -121,7 +140,7 @@ (when *on-eval-error* (*on-eval-error* context ex)) {:exception ex}))] - (merge context result)))))) + (merge context result (captured))))))) (defn- babashka-shebang? [node] (-> (node/string node) @@ -144,7 +163,7 @@ "Evaluates an ast as retrieved via the `read-`functions." ([ast] (eval-ast ast {})) ([ast options] - (with-out-err->context :global + (with-out-err-captured :global (binding [;; preserve current bindings (they will be reset to ;; original) *ns* *ns*