emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Neil Jerram <neil@ossau.homelinux.net>
To: emacs-orgmode@gnu.org
Subject: Re: Scheme output results
Date: Sun, 20 Aug 2017 17:43:43 +0100	[thread overview]
Message-ID: <66634adc-b42a-58eb-02fc-f043e54452e4@ossau.homelinux.net> (raw)
In-Reply-To: <877eyzo7q5.fsf@nicolasgoaziou.fr>

[-- Attachment #1: Type: text/plain, Size: 1677 bytes --]

On 23/07/17 09:52, Nicolas Goaziou wrote:
> Hello,
>
> Neil Jerram <neil@ossau.homelinux.net> writes:
>
>> I don't think that Scheme output results are correctly handled. Please
>> consider:
>>
>> #+BEGIN_SRC scheme :results output
>> (display "a") (newline)
>> (display "b") (newline)
>> (display "c") (newline)
>> '(a b c)
>> #+END_SRC
>>
>>
>> #+RESULTS: : "a\nb\nc\n"
>>
>> As compared with the Elisp equivalent:
>>
>> #+BEGIN_SRC elisp :results output
>> (princ "a") (terpri)
>> (princ "b") (terpri)
>> (princ "c") (terpri)
>> '(a b c)
>> #+END_SRC
>>
>> #+RESULTS:
>> : a
>> : b
>> : c
>>
>> I have a possible fix for this - on another computer, so not to hand
>> right now - but thought it would be check first whether you agree with
>> me that the Scheme results should be more like the Elisp ones.
> That sounds like a good idea. Could you send your fix as a proper patch
> with a commit message?
>
> Thank you!
>
> Regards,

With apologies for the slow follow up, attached is a patch that works 
well for me.

I think a concern with it would be whether the Geiser retort object and 
functions have always existed, and whether we can rely on them 
continuing to exist.  But - at least for me - every Scheme evaluation 
was previously giving "An error occurred", because of an unexpected 
extra "Mark set" message, so I am pretty sure that my patch is an 
improvement.

I guess (following any revisions) you will also need assignment papers.  
I believe I have these on file for Guile already (since about 1990), and 
it's possible that those are worded so as to cover Emacs as well.  Would 
you mind checking, as I've forgotten how to do that myself?

Regards - Neil


[-- Attachment #2: 0001-Improve-Scheme-code-evaluation.patch --]
[-- Type: text/x-patch, Size: 3559 bytes --]

From a02b60b88bcfd1896c05cd858ae80bb1ef183730 Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@tigera.io>
Date: Sun, 20 Aug 2017 17:25:58 +0100
Subject: [PATCH] Improve Scheme code evaluation

* lisp/ob-scheme.el (org-babel-scheme-execute-with-geiser): Use
  Geiser's explicit 'retort' object, instead of catching and parsing
  an expected Emacs message (which for me is in any case overwritten
  by a following "Mark set" message); this also means we don't need
  the with-output-to-string approach for getting 'output' results.
  Also 'let' Geiser variables so as to avoid popping up the REPL
  and *Geiser dbg* buffers.
---
 lisp/ob-scheme.el | 56 +++++++++++++++++++++++++++----------------------------
 1 file changed, 28 insertions(+), 28 deletions(-)

diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index b8867d5f6..bf1da01b0 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -150,35 +150,35 @@ is true; otherwise returns the last value."
     (with-temp-buffer
       (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
       (newline)
-      (insert (if output
-		  (format "(with-output-to-string (lambda () %s))" code)
-		code))
+      (insert code)
       (geiser-mode)
-      (let ((repl-buffer (save-current-buffer
-			   (org-babel-scheme-get-repl impl repl))))
-	(when (not (eq impl (org-babel-scheme-get-buffer-impl
-			     (current-buffer))))
-	  (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
-		   (org-babel-scheme-get-buffer-impl (current-buffer))
-		   (symbolp (org-babel-scheme-get-buffer-impl
-			     (current-buffer)))))
-	(setq geiser-repl--repl repl-buffer)
-	(setq geiser-impl--implementation nil)
-	(setq result (org-babel-scheme-capture-current-message
-		      (geiser-eval-region (point-min) (point-max))))
-	(setq result
-	      (if (and (stringp result) (equal (substring result 0 3) "=> "))
-		  (replace-regexp-in-string "^=> " "" result)
-		"\"An error occurred.\""))
-	(when (not repl)
-	  (save-current-buffer (set-buffer repl-buffer)
-			       (geiser-repl-exit))
-	  (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
-	  (kill-buffer repl-buffer))
-	(setq result (if (or (string= result "#<void>")
-			     (string= result "#<unspecified>"))
-			 nil
-		       result))))
+      (let ((geiser-repl-window-allow-split nil)
+	    (geiser-repl-use-other-window nil))
+	(let ((repl-buffer (save-current-buffer
+			     (org-babel-scheme-get-repl impl repl))))
+	  (when (not (eq impl (org-babel-scheme-get-buffer-impl
+			       (current-buffer))))
+	    (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+		     (org-babel-scheme-get-buffer-impl (current-buffer))
+		     (symbolp (org-babel-scheme-get-buffer-impl
+			       (current-buffer)))))
+	  (setq geiser-repl--repl repl-buffer)
+	  (setq geiser-impl--implementation nil)
+	  (let ((geiser-debug-jump-to-debug-p nil)
+		(geiser-debug-show-debug-p nil))
+	    (let ((ret (geiser-eval-region (point-min) (point-max))))
+	      (setq result (if output
+			       (geiser-eval--retort-output ret)
+			     (geiser-eval--retort-result-str ret "")))))
+	  (when (not repl)
+	    (save-current-buffer (set-buffer repl-buffer)
+				 (geiser-repl-exit))
+	    (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+	    (kill-buffer repl-buffer))
+	  (setq result (if (or (string= result "#<void>")
+			       (string= result "#<unspecified>"))
+			   nil
+			 result)))))
     result))
 
 (defun org-babel-scheme--table-or-string (results)
-- 
2.13.2


  reply	other threads:[~2017-08-20 16:43 UTC|newest]

Thread overview: 10+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-07-18 14:06 Scheme output results Neil Jerram
2017-07-23  8:52 ` Nicolas Goaziou
2017-08-20 16:43   ` Neil Jerram [this message]
2017-08-20 20:31     ` Nicolas Goaziou
2017-08-27 12:15       ` Bastien Guerry
2017-08-31 12:21         ` Neil Jerram
2017-09-05 21:17           ` Neil Jerram
2017-09-05 21:49             ` Nicolas Goaziou
2017-09-07 20:27               ` Neil Jerram
2017-09-08  4:50                 ` Nicolas Goaziou

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=66634adc-b42a-58eb-02fc-f043e54452e4@ossau.homelinux.net \
    --to=neil@ossau.homelinux.net \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).