Re: [PATCH] Add support for trace and error output streams in Common Lisp

[akater <nuclearspace@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1361 bytes --]

Bastien <bzg@gnu.org> writes:

> Hi,
>
> akater <nuclearspace@gmail.com> writes:
>
>> This patch can't be merged right away: I need to sort out the exact
>> SLIME version where the feature will be introduced. Some doc update is
>> needed, too.
>
> did you finally managed to finalize this patch?
>
> If so, can you send it to the list as an attachment?
>
> We are in feature freeze, but small enhancement on ob- and ol- files
> are acceptable if they don't break anything for the user.

Sorry for the delay.  The patch is now safe to apply.  The feature is
set to not activate until SLIME 2.28 which is likely months into the
future.  The reason for this is, I got a blessing from one of SLIME
developers but they've not responded to my PR since; I also need to test
with SLY.  Delaying activation until SLIME 2.28 looks safe enough.

There are some idiosyncrasies: I require elisp features cl-macs, cl-seq,
subr-x in the middle of ob-lispe.el, right before they are needed.  This
is mostly due to state of the patch still being uncertain.  I also
define a variable for a newline emitted by Lisp because I'm always
cautious of non-standard newlines on some platforms.  This might be
totally unnecessary.

Note also that I update the documentation in addition to ob- files.
This comes in a separate patch since the feature mentioned is not really
available yet.

[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 800 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Main patch --]
[-- Type: text/x-diff, Size: 8073 bytes --]

From 93889d291d8b9539fb6b6950b98394c526cd96ed Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Fri, 10 Apr 2020 02:52:21 +0000
Subject: [PATCH 1/2] ob-lisp.el: Add support for trace and error output
 streams

* lisp/ob-lisp.el (org-babel-execute:lisp): Support recent more
structured and featureful output from `swank:eval-and-grab-output'.

* lisp/ob-core.el (org-babel-result-cond): Acknowledge new output options.

* lisp/ob-clojure.el (ob-clojure-eval-with-slime): Support recent more
structured and featureful output from `swank:eval-and-grab-output'.

Trace and error outputs from Common Lisp are now available in
org-babel evaluation with SLIME, starting with some future version of it.
---
 lisp/ob-clojure.el | 24 +++++++++++-
 lisp/ob-core.el    |  2 +
 lisp/ob-lisp.el    | 98 +++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 121 insertions(+), 3 deletions(-)

diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el
index 299a326e4..da17ec948 100644
--- a/lisp/ob-clojure.el
+++ b/lisp/ob-clojure.el
@@ -213,7 +213,7 @@
 				     (replace-regexp-in-string "nil" "" r))
 				   result0)))))))
 
-(defun ob-clojure-eval-with-slime (expanded params)
+(defun ob-clojure-eval-with-slime--legacy (expanded params)
   "Evaluate EXPANDED code block with PARAMS using slime."
   (condition-case nil (require 'slime)
     (user-error "slime not available"))
@@ -224,6 +224,28 @@
        ,(buffer-substring-no-properties (point-min) (point-max)))
      (cdr (assq :package params)))))
 
+(defun ob-clojure-eval-with-slime--multiple-targets-support (expanded params)
+  "Evaluate EXPANDED code block with PARAMS using slime."
+  (condition-case nil (require 'slime)
+    (user-error "slime not available"))
+  (with-temp-buffer
+    (insert expanded)
+    (let ((results-alist
+	   (slime-eval
+	    `(swank:eval-and-grab-output
+	      ,(buffer-substring-no-properties (point-min) (point-max))
+	      '(common-lisp:*standard-output* common-lisp:values))
+	    (cdr (assq :package params)))))
+      (list
+       (cdr (assoc 'common-lisp:*standard-output* results-alist #'eq))
+       (cdr (assoc 'common-lisp:values results-alist #'eq))))))
+
+(defalias 'ob-clojure-eval-with-slime
+  (if (and (featurep 'slime)
+           (version< slime-version "2.25"))
+      'ob-clojure-eval-with-slime--legacy
+    'ob-clojure-eval-with-slime--multiple-targets-support))
+
 (defun org-babel-execute:clojure (body params)
   "Execute a block of Clojure code with Babel."
   (unless org-babel-clojure-backend
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index e798595bd..9ca3a81a8 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -3070,6 +3070,8 @@ Emacs shutdown."))
 		 (member "pp" ,params)
 		 (member "file" ,params)
 		 (and (or (member "output" ,params)
+			  (member "errors" ,params)
+			  (member "trace"  ,params)
 			  (member "raw"    ,params)
 			  (member "org"    ,params)
 			  (member "drawer" ,params))
diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el
index 8b126b26f..799144d2a 100644
--- a/lisp/ob-lisp.el
+++ b/lisp/ob-lisp.el
@@ -82,10 +82,14 @@ current directory string."
 	(format "(pprint %s)" body)
       body)))
 
-(defun org-babel-execute:lisp (body params)
+(defun org-babel-execute:lisp--legacy (body params)
   "Execute a block of Common Lisp code with Babel.
 BODY is the contents of the block, as a string.  PARAMS is
-a property list containing the parameters of the block."
+a property list containing the parameters of the block.
+
+This code is supposed to be superseded with the one in
+`org-babel-execute:lisp--multiple-targets-support'
+once the neccessary feature gets merged into SLIME."
   (require (pcase org-babel-lisp-eval-fn
 	     (`slime-eval 'slime)
 	     (`sly-eval 'sly)))
@@ -116,6 +120,96 @@ a property list containing the parameters of the block."
    (org-babel-pick-name (cdr (assq :rowname-names params))
 			(cdr (assq :rownames params)))))
 
+(defconst org-babel-lisp-output-options-to-slime-targets-table
+  ;; we can't reuse slime-output-targets here
+  ;; as this would make slime a requirement
+  ;; even for sly users
+  '(("output" . common-lisp:*standard-output*)
+    ("errors" . common-lisp:*error-output*)
+    ("trace" . common-lisp:*trace-output*))
+  "Mapping from output-specifying header-args for Lisp code blocks
+to output targets of Common Lisp function `swank:eval-and-grab-output'.")
+
+(defconst org-babel-lisp-output-options
+  (mapcar #'car org-babel-lisp-output-options-to-slime-targets-table)
+  "Keys from `org-babel-lisp-output-options-to-slime-targets-table'.
+Must be kept in order of their appearance in that table.")
+
+(require 'cl-seq)
+(eval-when-compile (require 'cl-macs))
+
+(cl-defun org-babel-nsubstitute-multiple (alist cl-seq &key (test #'eql))
+  "Like NSUBSTITUTE but applies all rules from ALIST."
+  (dolist (rule alist cl-seq)
+    (cl-nsubstitute (cdr rule) (car rule) cl-seq :test test)))
+
+(defconst org-babel-lisp-newline-string (make-string 1 10))
+
+(eval-when-compile (require 'subr-x))
+
+(defun org-babel-execute:lisp--multiple-targets-support (body params)
+  "Execute a block of Common Lisp code with Babel.
+BODY is the contents of the block, as a string.  PARAMS is
+a property list containing the parameters of the block."
+  (require (pcase org-babel-lisp-eval-fn
+	     (`slime-eval 'slime)
+	     (`sly-eval 'sly)))
+  (org-babel-reassemble-table
+   (let* ((result-params (cdr (assq :result-params params)))
+          (output-targets
+           ;; arguably, it is more natural in org-mode
+           ;; to receive all outputs for :results output
+           ;; so that nothing gets sent to the repl buffer,
+           ;; and emit different outputs to different result blocks
+           ;; but for now we preserve compatibility with the old ways
+           (or
+            (org-babel-nsubstitute-multiple
+             org-babel-lisp-output-options-to-slime-targets-table
+             (cl-delete-duplicates
+              (cl-intersection result-params org-babel-lisp-output-options
+			       :test #'string-equal)
+              :test #'string-equal)
+             :test #'string-equal)
+            (list 'common-lisp:values)))
+          (results-alist
+           (with-temp-buffer
+             (insert (org-babel-expand-body:lisp body params))
+             (funcall org-babel-lisp-eval-fn
+                      `(swank:eval-and-grab-output
+                        ,(let ((dir (if (assq :dir params)
+                                        (cdr (assq :dir params))
+                                      default-directory)))
+                           (format
+                            (if dir (format org-babel-lisp-dir-fmt dir)
+                              "(progn %s\n)")
+                            (buffer-substring-no-properties
+                             (point-min) (point-max))))
+                        ',output-targets)
+                      (cdr (assq :package params)))))
+          (result
+           (string-join
+            (cl-delete "" (org-babel-nsubstitute-multiple
+                           results-alist output-targets :test #'eq)
+                       :test #'string-equal)
+            org-babel-lisp-newline-string)))
+     (org-babel-result-cond result-params
+       (org-strip-quotes result)
+       (condition-case nil
+           (read (org-babel-lisp-vector-to-list result))
+         (error result))))
+   (org-babel-pick-name (cdr (assq :colname-names params))
+			(cdr (assq :colnames params)))
+   (org-babel-pick-name (cdr (assq :rowname-names params))
+			(cdr (assq :rownames params)))))
+
+(defalias 'org-babel-execute:lisp
+  (if (or (not (featurep 'slime))
+	  ;; relevant update to SLIME is in progress
+	  ;; 2.28 is an estimation
+          (version< slime-version "2.28"))
+      'org-babel-execute:lisp--legacy
+    'org-babel-execute:lisp--multiple-targets-support))
+
 (defun org-babel-lisp-vector-to-list (results)
   ;; TODO: better would be to replace #(...) with [...]
   (replace-regexp-in-string "#(" "(" results))
-- 
2.26.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Documentation patch --]
[-- Type: text/x-diff, Size: 787 bytes --]

From 0ed600fe7689beeb4c252d12754da8ca4d1e17d3 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Mon, 13 Apr 2020 12:42:49 +0000
Subject: [PATCH 2/2] Update the documentation

---
 doc/org-guide.org | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/doc/org-guide.org b/doc/org-guide.org
index 150762b13..dd31f0700 100644
--- a/doc/org-guide.org
+++ b/doc/org-guide.org
@@ -2489,7 +2489,8 @@ is the =results= header argument.  It controls the /collection/,
 - Collection ::
 
   How the results should be collected from the code block.  You may
-  choose either =output= or =value= (the default).
+  choose either =output= or =value= (the default).  Some backends may
+  offer additional flavours of output, e.g. =errors=.
 
 - Type ::
 
-- 
2.26.2