From 93889d291d8b9539fb6b6950b98394c526cd96ed Mon Sep 17 00:00:00 2001 From: akater 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