Re: [PATCH] Use geiser for babel scheme evaluation.

Re: [PATCH] Use geiser for babel scheme evaluation.

[Greg Minshall]

hi, Eric,

this patch isn't mine, but rather Michael Gauland's; i just wondered
where it had gone.

cheers, Greg

> here is the thread:
> http://comments.gmane.org/gmane.emacs.orgmode/64229

Re: [PATCH] Use geiser for babel scheme evaluation.

[Eric Schulte]

Ah, apologies and thanks all around.

Cheers,

Greg Minshall <minshall@acm.org> writes:

> hi, Eric,
>
> this patch isn't mine, but rather Michael Gauland's; i just wondered
> where it had gone.
>
> cheers, Greg
>
>> here is the thread:
>> http://comments.gmane.org/gmane.emacs.orgmode/64229

-- 
Eric Schulte
http://cs.unm.edu/~eschulte

Re: [PATCH] Use geiser for babel scheme evaluation.

[Greg Minshall]

hi, Bastien,

>> hi.  what happened to this patch?  i don't see it anywhere.  cheers!

> Can you give a pointer to "this" patch?

here is the thread:
http://comments.gmane.org/gmane.emacs.orgmode/64229

cheers, Greg

Re: [PATCH] Use geiser for babel scheme evaluation.

[Bastien]

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

Hi Greg,

Greg Minshall <minshall@acm.org> writes:

> here is the thread:
> http://comments.gmane.org/gmane.emacs.orgmode/64229

Thanks.

I'm reattaching the patch, with a reworked ChangeLog.

(We could not apply it at the time because Michael didn't
have his copyright assignment.)

I like geiser very much, but maybe this introduces too much
external dependencies.

Eric, do you think we can go ahead and apply it?

PS: The patch does not apply, we need to revert 
http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=92e327
first.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Use-geiser-for-babel-scheme-evaluation.patch --]
[-- Type: text/x-patch, Size: 9471 bytes --]

From bc33a46041086abd5d1fec321f104aa034823576 Mon Sep 17 00:00:00 2001
From: Michael Gauland <mike_gauland@stanfordalumni.org>
Date: Wed, 9 Jan 2013 12:41:13 +1300
Subject: [PATCH] ob-scheme.el: Use geiser for babel scheme evaluation

* ob-scheme.el (run-scheme, org-babel-scheme-eoe)
(org-babel-scheme-cmd, scheme-program-name)
(org-babel-prep-session:scheme)
(org-babel-scheme-initiate-session): Deleted.
(org-babel-execute-scheme): Rewritten to use geiser.
(org-babel-scheme-repl-map, org-babel-scheme-cleanse-repl-map)
(org-babel-scheme-get-session-buffer)
(org-babel-scheme-set-session-buffer)
(org-babel-scheme-get-buffer-impl, org-babel-scheme-get-repl)
(org-bable-scheme-make-session-name)
(org-babel-scheme-execute-with-geiser): New functions.

---
 lisp/ob-scheme.el |  192 ++++++++++++++++++++++++++++++++---------------------
 1 files changed, 117 insertions(+), 75 deletions(-)

diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index c9fa44a..31e0cad 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -2,7 +2,7 @@

 ;; Copyright (C) 2010-2013 Free Software Foundation, Inc.

-;; Author: Eric Schulte
+;; Authors: Eric Schulte, Michael Gauland
 ;; Keywords: literate programming, reproducible research, scheme
 ;; Homepage: http://orgmode.org

@@ -33,27 +33,16 @@
 ;; - a working scheme implementation
 ;;   (e.g. guile http://www.gnu.org/software/guile/guile.html)
 ;;
-;; - for session based evaluation cmuscheme.el is required which is
-;;   included in Emacs
+;; - for session based evaluation geiser is required, which is available from
+;;   ELPA.

 ;;; Code:
 (require 'ob)
-(eval-when-compile (require 'cl))
-
-(declare-function run-scheme "ext:cmuscheme" (cmd))
+(load-library "geiser-impl")

 (defvar org-babel-default-header-args:scheme '()
   "Default header arguments for scheme code blocks.")

-(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
-  "String to indicate that evaluation has completed.")
-
-(defcustom org-babel-scheme-cmd "guile"
-  "Name of command used to evaluate scheme blocks."
-  :group 'org-babel
-  :version "24.1"
-  :type 'string)
-
 (defun org-babel-expand-body:scheme (body params)
   "Expand BODY according to PARAMS, return the expanded body."
   (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
@@ -65,70 +54,123 @@
                 ")\n" body ")")
       body)))

-(defvar scheme-program-name)
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+  "Map of scheme sessions to session names.")
+
+(defun org-babel-scheme-cleanse-repl-map ()
+  "Remove dead buffers from the REPL map."
+  (maphash
+   (lambda (x y)
+     (when (not (buffer-name y))
+       (remhash x org-babel-scheme-repl-map)))
+   org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-session-buffer (session-name)
+  "Look up the scheme buffer for a session; return nil if it doesn't exist."
+  (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions
+  (gethash session-name org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-set-session-buffer (session-name buffer)
+  "Record the scheme buffer used for a given session."
+  (puthash session-name buffer org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-buffer-impl (buffer)
+  "Returns the scheme implementation geiser associates with the buffer."
+  (with-current-buffer (set-buffer buffer)
+    geiser-impl--implementation))
+
+(defun org-babel-scheme-get-repl (impl name)
+  "Switch to a scheme REPL, creating it if it doesn't exist:"
+  (let ((buffer (org-babel-scheme-get-session-buffer name)))
+    (or buffer
+    (progn
+      (run-geiser impl)
+      (if name
+	  (progn
+	    (rename-buffer name t)
+	    (org-babel-scheme-set-session-buffer name (current-buffer))))
+      (current-buffer)))))
+
+(defun org-babel-scheme-make-session-name (buffer name impl)
+  "Generate a name for the session buffer.
+
+For a named session, the buffer name will be the session name.
+
+If the session is unnamed (nil), generate a name.
+
+If the session is 'none', use nil for the session name, and
+org-babel-scheme-execute-with-geiser will use a temporary session."
+  (let ((result
+	 (cond ((not name)
+		(concat buffer " " (symbol-name impl) " REPL"))
+	       ((string= name "none") nil)
+	       (name))))
+    result))
+
+(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+  "Execute code in specified REPL. If the REPL doesn't exist, create it
+using the given scheme implementation.
+
+Returns the output of executing the code if the output parameter
+is true; otherwise returns the last value."
+  (let ((result nil))
+    (with-temp-buffer
+      (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
+      (newline)
+      (insert (if output
+		  (format "(with-output-to-string (lambda () %s))" code)
+		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)
+	(geiser-eval-region (point-min) (point-max))
+	(setq result
+	      (if (equal (substring (current-message) 0 3) "=> ")
+		  (replace-regexp-in-string "^=> " "" (current-message))
+		"\"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
+		       (read result)))))
+    result))
+
 (defun org-babel-execute:scheme (body params)
   "Execute a block of Scheme code with org-babel.
 This function is called by `org-babel-execute-src-block'"
-  (let* ((result-type (cdr (assoc :result-type params)))
-	 (org-babel-scheme-cmd (or (cdr (assoc :scheme params))
-				   org-babel-scheme-cmd))
-         (full-body (org-babel-expand-body:scheme body params)))
-    (read
-     (if (not (string= (cdr (assoc :session params)) "none"))
-         ;; session evaluation
-	 (let ((session (org-babel-prep-session:scheme
-			 (cdr (assoc :session params)) params)))
-	   (org-babel-comint-with-output
-	       (session (format "%S" org-babel-scheme-eoe) t body)
-	     (mapc
-	      (lambda (line)
-		(insert (org-babel-chomp line)) (comint-send-input nil t))
-	      (list body (format "%S" org-babel-scheme-eoe)))))
-       ;; external evaluation
-       (let ((script-file (org-babel-temp-file "scheme-script-")))
-         (with-temp-file script-file
-           (insert
-            ;; return the value or the output
-            (if (string= result-type "value")
-                (format "(display %s)" full-body)
-              full-body)))
-         (org-babel-eval
-	  (format "%s %s" org-babel-scheme-cmd
-		  (org-babel-process-file-name script-file)) ""))))))
-
-(defun org-babel-prep-session:scheme (session params)
-  "Prepare SESSION according to the header arguments specified in PARAMS."
-  (let* ((session (org-babel-scheme-initiate-session session))
-	 (vars (mapcar #'cdr (org-babel-get-header params :var)))
-	 (var-lines
-	  (mapcar
-	   (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
-	   vars)))
-    (when session
-      (org-babel-comint-in-buffer session
-	(sit-for .5) (goto-char (point-max))
-	(mapc (lambda (var)
-		(insert var) (comint-send-input nil t)
-		(org-babel-comint-wait-for-output session)
-		(sit-for .1) (goto-char (point-max))) var-lines)))
-    session))
-
-(defun org-babel-scheme-initiate-session (&optional session)
-  "If there is not a current inferior-process-buffer in SESSION
-then create.  Return the initialized session."
-  (require 'cmuscheme)
-  (unless (string= session "none")
-    (let ((session-buffer (save-window-excursion
-			    (run-scheme org-babel-scheme-cmd)
-			    (rename-buffer session)
-			    (current-buffer))))
-      (if (org-babel-comint-buffer-livep session-buffer)
-	  (progn (sit-for .25) session-buffer)
-        (sit-for .5)
-        (org-babel-scheme-initiate-session session)))))
+  (let* ((source-buffer (current-buffer))
+	 (source-buffer-name (replace-regexp-in-string ;; zap surrounding *
+	  "^ ?\\*\\([^*]+\\)\\*" "\\1" (buffer-name source-buffer))))
+    (save-excursion
+      (org-babel-reassemble-table
+       (let* ((result-type (cdr (assoc :result-type params)))
+	      (impl (or (when (cdr (assoc :scheme params))
+			  (intern (cdr (assoc :scheme params))))
+			geiser-default-implementation
+			(car geiser-active-implementations)))
+	      (session (org-babel-scheme-make-session-name source-buffer-name (cdr (assoc :session params)) impl))
+	    (full-body (org-babel-expand-body:scheme body params)))
+       (org-babel-scheme-execute-with-geiser full-body           ; code
+					     (string= result-type "output")	; output?
+					     impl ; implementation
+					     (and (not (string= session "none")) session)); session
+       )
+     (org-babel-pick-name (cdr (assoc :colname-names params))
+			  (cdr (assoc :colnames params)))
+    (org-babel-pick-name (cdr (assoc :rowname-names params))
+			 (cdr (assoc :rownames params)))))))
+

 (provide 'ob-scheme)

-
-
 ;;; ob-scheme.el ends here
--
1.7.2.5

[-- Attachment #3: Type: text/plain, Size: 14 bytes --]


-- 
 Bastien

Re: [PATCH] Use geiser for babel scheme evaluation.

[Eric Schulte]

Bastien <bzg@gnu.org> writes:

> Hi Greg,
>
> Greg Minshall <minshall@acm.org> writes:
>
>> here is the thread:
>> http://comments.gmane.org/gmane.emacs.orgmode/64229
>
> Thanks.
>
> I'm reattaching the patch, with a reworked ChangeLog.
>
> (We could not apply it at the time because Michael didn't
> have his copyright assignment.)
>
> I like geiser very much, but maybe this introduces too much
> external dependencies.
>
> Eric, do you think we can go ahead and apply it?
>

I've just applied this patch.  I don't think external dependencies are a
problem if they offload language integration work to a dedicated
external package.  The more babel can re-use existing packages the
better, e.g., common lisp code blocks are just thin wrappers around
slime, but they work exceedingly well with almost no babel-side coding
or maintenance.

Thanks Greg for this patch!

>
> PS: The patch does not apply, we need to revert
> http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=92e327
> first.

Thanks for figuring out this conflict.

-- 
Eric Schulte
http://cs.unm.edu/~eschulte

Re: [PATCH] Use geiser for babel scheme evaluation.

[Bastien]

Eric Schulte <schulte.eric@gmail.com> writes:

> Thanks Greg for this patch!

(Michael Gauland is the one to thank for the patch, and Greg for the
heads up. Thanks to both!)

-- 
 Bastien

Re: [PATCH] Use geiser for babel scheme evaluation.

[Achim Gratz]

Eric Schulte writes:
> I've just applied this patch.  I don't think external dependencies are a
> problem if they offload language integration work to a dedicated
> external package.  The more babel can re-use existing packages the
> better, e.g., common lisp code blocks are just thin wrappers around
> slime, but they work exceedingly well with almost no babel-side coding
> or maintenance.

Would you mind keeping the byte-compile clean?

--8<---------------cut here---------------start------------->8---
Compiling /home/org-mode/lisp/ob-scheme.el...

In org-babel-scheme-get-buffer-impl:
ob-scheme.el:81:5:Warning: reference to free variable
    `geiser-impl--implementation'

In org-babel-scheme-execute-with-geiser:
ob-scheme.el:130:21:Warning: `message' called with 4 args to fill 3 format
    field(s)
ob-scheme.el:133:15:Warning: assignment to free variable `geiser-repl--repl'
ob-scheme.el:134:15:Warning: assignment to free variable
    `geiser-impl--implementation'

In org-babel-execute:scheme:
ob-scheme.el:163:25:Warning: reference to free variable
    `geiser-default-implementation'
ob-scheme.el:164:30:Warning: reference to free variable
    `geiser-active-implementations'

In end of data:
ob-scheme.el:181:1:Warning: the following functions are not known to be
    defined: run-geiser, geiser-mode, geiser-eval-region, geiser-repl-exit
--8<---------------cut here---------------end--------------->8---



Regards,
Achim.
-- 
+<[Q+ Matrix-12 WAVE#46+305 Neuron microQkb Andromeda XTk Blofeld]>+

Factory and User Sound Singles for Waldorf rackAttack:
http://Synth.Stromeko.net/Downloads.html#WaldorfSounds

Re: [PATCH] Use geiser for babel scheme evaluation.

[Eric Schulte]

Greg Minshall <minshall@acm.org> writes:

> hi, Bastien,
>
>>> hi.  what happened to this patch?  i don't see it anywhere.  cheers!
>
>> Can you give a pointer to "this" patch?
>
> here is the thread:
> http://comments.gmane.org/gmane.emacs.orgmode/64229
>
> cheers, Greg
>

Hi Greg,

Thanks for sending this along.

1. Have you completed the FSF assignment?  I don't see you listed on
   http://orgmode.org/worg/org-contribute.html

2. This patch no longer applies cleanly, I get the following error
   output when trying to apply it to the current repo.

    17:24 bagel:org-mode git am ~/64406-001.bin
    Applying: Use geiser for babel scheme evaluation.
    /home/eschulte/src/org-mode/.git/rebase-apply/patch:83: trailing whitespace.
        (or buffer
    /home/eschulte/src/org-mode/.git/rebase-apply/patch:87: trailing whitespace.
              (progn
    /home/eschulte/src/org-mode/.git/rebase-apply/patch:101: trailing whitespace.
      (let ((result
    /home/eschulte/src/org-mode/.git/rebase-apply/patch:226: trailing whitespace.

    error: patch failed: lisp/ob-scheme.el:65
    error: lisp/ob-scheme.el: patch does not apply
    Patch failed at 0001 Use geiser for babel scheme evaluation.

Once these are resolved we can apply this patch.  Thanks!

-- 
Eric Schulte
http://cs.unm.edu/~eschulte

Re: [PATCH] Use geiser for babel scheme evaluation.

[Greg Minshall]

hi.  what happened to this patch?  i don't see it anywhere.  cheers!

Re: [PATCH] Use geiser for babel scheme evaluation.

[Bastien]

Hi Greg,

Greg Minshall <minshall@acm.org> writes:

> hi.  what happened to this patch?  i don't see it anywhere.  cheers!

Can you give a pointer to "this" patch?

Thanks!

-- 
 Bastien

[PATCH] Babel support for scheme using geiser

[Michael Gauland]

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


Babel: User geiser for scheme interactions

* lisp/ob-scheme.el Major rewrite to support geiser

This patch uses geiser to execute scheme blocks.  Most features of babel
are tested and demonstrated in the attached org file.

Note that because ":results output" and ":var" blocks are wrapped before
being passed to scheme, "(define...)" will generate an error in such blocks.





[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Modify-ob-scheme.el-to-use-geiser.patch --]
[-- Type: text/x-diff; name="0001-Modify-ob-scheme.el-to-use-geiser.patch", Size: 9331 bytes --]

From 655d0c1e870d8957974961c8bfc989a75096c60a Mon Sep 17 00:00:00 2001
From: Michael Gauland <mike_gauland@stanfordalumni.org>
Date: Sat, 5 Jan 2013 08:03:19 +1300
Subject: [PATCH] Modify ob-scheme.el to use geiser.

---
 lisp/ob-scheme.el |  198 ++++++++++++++++++++++++++++++++--------------------
 1 files changed, 122 insertions(+), 76 deletions(-)

diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index 74e9a94..9e39c72 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -1,8 +1,8 @@
 ;;; ob-scheme.el --- org-babel functions for Scheme
 
-;; Copyright (C) 2010-2013  Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012  Free Software Foundation, Inc.
 
-;; Author: Eric Schulte
+;; Authors: Eric Schulte, Michael Gauland
 ;; Keywords: literate programming, reproducible research, scheme
 ;; Homepage: http://orgmode.org
 
@@ -33,27 +33,16 @@
 ;; - a working scheme implementation
 ;;   (e.g. guile http://www.gnu.org/software/guile/guile.html)
 ;;
-;; - for session based evaluation cmuscheme.el is required which is
-;;   included in Emacs
+;; - for session based evaluation geiser is required, which is available from
+;;   ELPA.
 
 ;;; Code:
 (require 'ob)
-(eval-when-compile (require 'cl))
-
-(declare-function run-scheme "ext:cmuscheme" (cmd))
+(load-library "geiser-impl")
 
 (defvar org-babel-default-header-args:scheme '()
   "Default header arguments for scheme code blocks.")
 
-(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
-  "String to indicate that evaluation has completed.")
-
-(defcustom org-babel-scheme-cmd "guile"
-  "Name of command used to evaluate scheme blocks."
-  :group 'org-babel
-  :version "24.1"
-  :type 'string)
-
 (defun org-babel-expand-body:scheme (body params)
   "Expand BODY according to PARAMS, return the expanded body."
   (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
@@ -65,70 +54,127 @@
                 ")\n" body ")")
       body)))
 
-(defvar scheme-program-name)
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+  "Map of scheme sessions to session names.")
+
+(defun cleanse-org-babel-scheme-repl-map ()
+  "Remove dead buffers from the REPL map."
+  (maphash
+   (lambda (x y)
+     (when (not (buffer-name y))
+       (remhash x org-babel-scheme-repl-map)))
+   org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-session-buffer (session-name)
+  "Look up the scheme buffer for a session; return nil if it doesn't exist."
+  (cleanse-org-babel-scheme-repl-map) ; Prune dead sessions
+  (gethash session-name org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-set-session-buffer (session-name buffer)
+  "Record the scheme buffer used for a given session."
+  (puthash session-name buffer org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-buffer-impl (buffer)
+  "Returns the scheme implementation geiser associates with the buffer."
+  (with-current-buffer (set-buffer buffer)
+    geiser-impl--implementation))
+
+(defun org-babel-scheme-get-repl (impl name)
+  "Switch to a scheme REPL, creating it if it doesn't exist:"
+  (let ((buffer (org-babel-scheme-get-session-buffer name)))
+    (or buffer 
+    (progn
+      (run-geiser impl)
+      (if name
+	  (progn 
+	    (rename-buffer name t)
+	    (org-babel-scheme-set-session-buffer name (current-buffer)))
+	)
+      (current-buffer)
+  ))))
+
+(defun org-babel-scheme-make-session-name (buffer name impl)
+  "Generate a name for the session buffer.
+
+For a named session, the buffer name will be the session name.
+
+If the session is unnamed (nil), generate a name.
+
+If the session is 'none', use nil for the session name, and
+org-babel-scheme-execute-with-geiser will use a temporary session."
+  (let ((result 
+	 (cond ((not name)
+		(concat buffer " " (symbol-name impl) " REPL"))
+	       ((string= name "none") nil)
+	       (name))))
+    result))
+
+(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+  "Execute code in specified REPL. If the REPL doesn't exist, create it
+using the given scheme implementation.
+
+Returns the output of executing the code if the output parameter
+is true; otherwise returns the last value."
+  (let ((result nil))
+    (with-temp-buffer
+      (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
+      (newline)
+      (insert (if output
+		  (format "(with-output-to-string (lambda () %s))" code)
+		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)
+	(geiser-eval-region (point-min) (point-max))
+	(setq result
+	      (if (equal (substring (current-message) 0 3) "=> ")
+		  (replace-regexp-in-string "^=> " "" (current-message))
+		"\"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
+		       (read result)))))
+    result
+    ))
+
 (defun org-babel-execute:scheme (body params)
   "Execute a block of Scheme code with org-babel.
 This function is called by `org-babel-execute-src-block'"
-  (let* ((result-type (cdr (assoc :result-type params)))
-	 (org-babel-scheme-cmd (or (cdr (assoc :scheme params))
-				   org-babel-scheme-cmd))
-         (full-body (org-babel-expand-body:scheme body params)))
-    (read
-     (if (not (string= (cdr (assoc :session params)) "none"))
-         ;; session evaluation
-	 (let ((session (org-babel-prep-session:scheme
-			 (cdr (assoc :session params)) params)))
-	   (org-babel-comint-with-output
-	       (session (format "%S" org-babel-scheme-eoe) t body)
-	     (mapc
-	      (lambda (line)
-		(insert (org-babel-chomp line)) (comint-send-input nil t))
-	      (list body (format "%S" org-babel-scheme-eoe)))))
-       ;; external evaluation
-       (let ((script-file (org-babel-temp-file "scheme-script-")))
-         (with-temp-file script-file
-           (insert
-            ;; return the value or the output
-            (if (string= result-type "value")
-                (format "(display %s)" full-body)
-              full-body)))
-         (org-babel-eval
-	  (format "%s %s" org-babel-scheme-cmd
-		  (org-babel-process-file-name script-file)) ""))))))
-
-(defun org-babel-prep-session:scheme (session params)
-  "Prepare SESSION according to the header arguments specified in PARAMS."
-  (let* ((session (org-babel-scheme-initiate-session session))
-	 (vars (mapcar #'cdr (org-babel-get-header params :var)))
-	 (var-lines
-	  (mapcar
-	   (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
-	   vars)))
-    (when session
-      (org-babel-comint-in-buffer session
-	(sit-for .5) (goto-char (point-max))
-	(mapc (lambda (var)
-		(insert var) (comint-send-input nil t)
-		(org-babel-comint-wait-for-output session)
-		(sit-for .1) (goto-char (point-max))) var-lines)))
-    session))
-
-(defun org-babel-scheme-initiate-session (&optional session)
-  "If there is not a current inferior-process-buffer in SESSION
-then create.  Return the initialized session."
-  (require 'cmuscheme)
-  (unless (string= session "none")
-    (let ((session-buffer (save-window-excursion
-			    (run-scheme org-babel-scheme-cmd)
-			    (rename-buffer session)
-			    (current-buffer))))
-      (if (org-babel-comint-buffer-livep session-buffer)
-	  (progn (sit-for .25) session-buffer)
-        (sit-for .5)
-        (org-babel-scheme-initiate-session session)))))
+  (let* ((source-buffer (current-buffer))
+	 (source-buffer-name (replace-regexp-in-string ;; zap surrounding *
+	  "^ ?\\*\\([^*]+\\)\\*" "\\1" (buffer-name source-buffer))))
+    (save-excursion
+      (org-babel-reassemble-table
+       (let* ((result-type (cdr (assoc :result-type params)))
+	      (impl (or (when (cdr (assoc :scheme params))
+			  (intern (cdr (assoc :scheme params))))
+			geiser-default-implementation
+			(car geiser-active-implementations)))
+	      (session (org-babel-scheme-make-session-name source-buffer-name (cdr (assoc :session params)) impl))
+	    (full-body (org-babel-expand-body:scheme body params)))
+       (org-babel-scheme-execute-with-geiser full-body           ; code
+					     (string= result-type "output")	; output?
+					     impl ; implementation
+					     (and (not (string= session "none")) session)); session
+       )
+     (org-babel-pick-name (cdr (assoc :colname-names params))
+			  (cdr (assoc :colnames params)))
+    (org-babel-pick-name (cdr (assoc :rowname-names params))
+			 (cdr (assoc :rownames params)))))))
+  
 
 (provide 'ob-scheme)
 
-
-
 ;;; ob-scheme.el ends here
-- 
1.7.2.5


[-- Attachment #1.3: ob-scheme_test.org --]
[-- Type: text/plain, Size: 11492 bytes --]

#+TITLE:     ob-scheme tests
#+AUTHOR:    Michael Gauland
#+EMAIL:     mikelygee@no8wireless.co.nz
#+DATE:      2012-12-10 Mon
#+DESCRIPTION:
#+KEYWORDS:
#+LANGUAGE:  en
#+OPTIONS:   H:3 num:nil toc:nil \n:nil @:t ::t |:t ^:{} -:t f:t *:t <:t
#+OPTIONS:   TeX:t LaTeX:t skip:nil d:nil todo:t pri:nil tags:not-in-toc
#+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js
#+EXPORT_SELECT_TAGS: export
#+EXPORT_EXCLUDE_TAGS: noexport
#+LINK_UP:   
#+LINK_HOME: 
#+XSLT:
#+LATEX_HEADER: \lstset{keywordstyle=\color{blue}\bfseries}
#+LATEX_HEADER: \lstset{frame=shadowbox}
#+LATEX_HEADER: \lstset{basicstyle=\ttfamily}
#+LATEX_HEADER: \definecolor{mygray}{gray}{0.8}
#+LATEX_HEADER: \lstset{rulesepcolor=\color{mygray}}
#+LATEX_HEADER: \lstdefinelanguage{scheme}{rulesepcolor=\color{mygray},frameround=ffff,backgroundcolor=\color{white}}
#+LATEX_HEADER: \lstdefinelanguage{Lisp}{rulesepcolor=\color{mygray},frameround=ffff,backgroundcolor=\color{white}}
#+LATEX_HEADER: \lstdefinelanguage{fundamental}{rulesepcolor=\color{blue},frameround=tttt,backgroundcolor=\color{mygray}}
#+PROPERTY: exports both
#+PROPERTY: wrap SRC fundamental

* Implementation Selection
  These tests exercise the values that determine which scheme implementation is run:
  + The =:scheme= property
  + =geiser-default-implementation=
  + The first value of =geiser-active-implementations=
  These variables currently have the values shown below. They will be changed
  during these tests, and restored afterwards.
  #+BEGIN_SRC emacs-lisp :wrap :exports results
    (list (list "Variable" "Value")
     (list "org-babel-default-header-args:scheme"
           org-babel-default-header-args:scheme)
     (list "geiser-default-implementation" geiser-default-implementation)
     (list "geiser-active-implementations" geiser-active-implementations))
  #+END_SRC

  #+RESULTS:
  | Variable                             | Value                |
  | org-babel-default-header-args:scheme | ((:scheme . racket)) |
  | geiser-default-implementation        | nil                  |
  | geiser-active-implementations        | (guile racket)       |

  # Record the version numbers of the scheme interpreters for reference:
  #+BEGIN_SRC emacs-lisp :wrap :exports results :results output
    (setq guile-version nil)
    (setq racket-version nil)
    (let ((get-version
           (lambda (binary)
             (with-temp-buffer
               (shell-command
                (concat "\"" binary "\""
                        " --version")
                (current-buffer))
               (goto-char (point-min))
               (search-forward-regexp "[0-9]\\(\.[0-9]+\\)+")
               (buffer-substring (match-beginning 0) (match-end 0))))))
      (setq guile-version (apply get-version (list geiser-guile-binary)))
      (setq racket-version (apply get-version (list geiser-racket-binary))))
  #+END_SRC

#+MACRO: guile-version src_emacs-lisp[:exports results :wrap]{guile-version}
#+MACRO: racket-version src_emacs-lisp[:exports results :wrap]{racket-version}
  These tests are being run with guile version {{{guile-version}}}, and racket version {{{racket-version}}}.

  # Create source block to restore the settings
  #+NAME: geiser-restore
  #+BEGIN_SRC emacs-lisp :wrap "SRC emacs-lisp :exports both" :exports results
    (let ((generate-script
           (lambda (v)
             (if v (concat
                    "'"
                    (with-output-to-string (princ v)))
               "nil"))))
      (concat "(progn\n "
              "(setq org-babel-default-header-args:scheme \n    "
              (funcall generate-script org-babel-default-header-args:scheme)
              ")\n"
              "(setq geiser-default-implementation \n    "
              (funcall generate-script geiser-default-implementation)
              ")\n"
              "(setq geiser-active-implementations \n    "
              (funcall generate-script geiser-active-implementations)
              "))"))
  #+END_SRC

    + Set values to (), nil, (guile, racket)
    #+BEGIN_SRC emacs-lisp :wrap :exports both :results output
    (setq org-babel-default-header-args:scheme (list))
    (setq geiser-default-implementation nil)
    (setq geiser-active-implementations '(guile racket))
    #+END_SRC

  + Run; verify guile
    This block should return {{{guile-version}}}:
    #+BEGIN_SRC scheme
    (version)
    #+END_SRC

  + Reverse geiser-active-implementations
    #+BEGIN_SRC emacs-lisp :exports both :results value
      (setq geiser-active-implementations
            (reverse geiser-active-implementations))
    #+END_SRC
  + Run; verify racket

    This block should return {{{racket-version}}}:
    #+BEGIN_SRC scheme
    (version)
    #+END_SRC
  + Set geiser-default-implementation to guile
    #+BEGIN_SRC emacs-lisp :exports both
    (setq geiser-default-implementation 'guile)
    #+END_SRC
  + Run; verify guile
    This block should return {{{guile-version}}}:
    #+BEGIN_SRC scheme
    (version)
    #+END_SRC
    
  + Set =org-babel-default-header-args:scheme= to =(('scheme . 'racket))=:
    #+BEGIN_SRC emacs-lisp :exports both
      (setq org-babel-default-header-args:scheme
            '((:scheme .  "racket")))
    #+END_SRC

  + Run; verify 
    This block should return {{{racket-version}}}:
    #+BEGIN_SRC scheme
    (version)
    #+END_SRC


  + Run a block with =:scheme guile=; expect guile.
    This block should return {{{guile-version}}}:
    #+BEGIN_SRC scheme :scheme guile
    (version)
    #+END_SRC

  + Restore variables
    #+RESULTS: geiser-restore
    #+BEGIN_SRC emacs-lisp :exports both
    (progn
     (setq org-babel-default-header-args:scheme nil)
    (setq geiser-default-implementation nil)
    (setq geiser-active-implementations '))
    #+END_SRC

    #+BEGIN_SRC emacs-lisp :wrap :exports results
      (list (list "Variable" "Value")
            (list "org-babel-default-header-args:scheme"
                  org-babel-default-header-args:scheme)
            (list "geiser-default-implementation"
                  geiser-default-implementation)
            (list "geiser-active-implementations"
                  geiser-active-implementations))
    #+END_SRC

* sessions
  + Without a session, re-define 'version':
    #+BEGIN_SRC scheme :exports code
    (define version (lambda () "This test fails."))
    #+END_SRC

  + In a new block, without a session, (version) should return a number:
    #+BEGIN_SRC scheme
    (version)
    #+END_SRC

  + With an unamed session, re-define 'version':
    #+BEGIN_SRC scheme :session :exports code
      (define version
        (lambda ()
          "This is the unnamed session."))
    #+END_SRC

  + In a new block, with an unnamed session, (version) should return =This is
    the unnamed session=:
    #+BEGIN_SRC scheme :session
    (version)
    #+END_SRC

    Make sure the change doesn't affect a non-session block:
    #+BEGIN_SRC scheme
    (version)
    #+END_SRC

  + Start a named session, and re-define 'version':
    #+BEGIN_SRC scheme :session named-session-1 :exports code
      (define version
        (lambda ()
          "This is named-session-1."))
    #+END_SRC

  + Make sure the change doesn't affect a non-session block:
    #+BEGIN_SRC scheme
    (version)
    #+END_SRC

  + ...or an unnamed session block:
    #+BEGIN_SRC scheme :session
    (version)
    #+END_SRC

  + ...but is retained for a new block with the same session name:
    #+BEGIN_SRC scheme :session named-session-1
    (version)
    #+END_SRC


* output vs. value
  :PROPERTIES:
  :session:  output-value-session
  :END:
  #+BEGIN_SRC scheme :results output 
  (display "This test pases")
  "This test FAILS"
  #+END_SRC

  #+BEGIN_SRC scheme :results value
  (display "This test FAILS")
  "This test passes"
  #+END_SRC

  #+BEGIN_SRC scheme :results output
  (display "This is the first line.")
  (newline)
  (display "This is the second line.\n")
  (display "This is the third line.")
  "This test FAILS."
  #+END_SRC

  #+BEGIN_SRC scheme :results value
    (display "This test FAILS.")
    (string-join
     (list "This is the first line."
           "This is the second line."
           "This is the third line.")
     "\n")
  #+END_SRC

  #+BEGIN_SRC scheme :results output
  (display '(1 2 3 4 5 6))
  "This test FAILS"
  #+END_SRC

  #+BEGIN_SRC scheme :results value :wrap
  (display "This test FAILS")
  '(1 2 3 4 5 6)
  #+END_SRC

  #+BEGIN_SRC scheme :results output
  (display '((1 2 3)(4 5 6)(7 8 9)))
  "This test FAILS"
  #+END_SRC

  #+BEGIN_SRC scheme :results value
  (display "This test FAILS")
  '((1 2 3)(4 5 6)(7 8 9))
  #+END_SRC

* :var
  This block should return =64=:
  #+BEGIN_SRC scheme :results value :var x=8
  (* x x)
  #+END_SRC

  This block should return the string ="A B C D E"=:
  #+BEGIN_SRC scheme :results value :var y="E D C B A"
  (string-reverse y)
  #+END_SRC


  This block should return the list =(1 4 9 16 25)= (which org will display as a table).
  #+BEGIN_SRC scheme :results value :var z='(1 2 3 4 5) :wrap nil
  (map (lambda (x) (* x x)) z)
  #+END_SRC

* Tables
  :PROPERTIES:
  :wrap:     nil
  :session:  nil
  :END:
  Pass a table to scheme:
  #+NAME: data-table
  |       | A | B | C | D |  E |
  | Row 1 | 1 | 2 | 3 | 4 |  5 |
  | Row 2 | 6 | 7 | 8 | 9 | 10 |

  This block should show the table above:
  #+BEGIN_SRC scheme :scheme racket :results value :session :var x=data-table
  x
  #+END_SRC

  This block rerses the table left to right:
  #+BEGIN_SRC scheme :scheme racket :results value :session :var x=data-table
  (map reverse x)
  #+END_SRC

  This block will be passed to scheme with the column headers removed; the data
  and row labels will be reversed, but the column labels will not.
  #+BEGIN_SRC scheme :scheme guile :results value :session :var x=data-table :colnames t
  (map reverse x)
  #+END_SRC

  This block will be passed to scheme with the row headers removed; the data
  and column labels will be reversed, but the row labels will not.
  #+BEGIN_SRC scheme :scheme guile :results value :session :var x=data-table :rownames t
  (map reverse x)
  #+END_SRC

  This block will be passed to scheme with bothe the row and column headers
  removed; the data will be reversed, but the row and columns labels will not.
  #+BEGIN_SRC scheme :scheme guile :results value :session :var x=data-table :colnames nil :rownames t
  (map reverse x)
  #+END_SRC

  This block will adds a row of data; note that the column and row headers are lost:
  #+BEGIN_SRC scheme :scheme guile :results value :session :var t=data-table :colnames t :rownames t
    (let* ((row-1 (car t))
           (row-2 (cadr t))
           (total (map + row-1 row-2)))
    (append t (list total)))
  #+END_SRC

  This block adds a row of data, but handles the column and row headers in scheme:
  #+BEGIN_SRC scheme :scheme guile :results value :session :var t=data-table
    (let* ((col-labels (car t))
           (row-1 (cadr t))
           (row-2 (caddr t))
           (total (append
                   '(Total)
                   (map + (cdr row-1)  (cdr row-2)))))
        (append t (list total)))
  #+END_SRC


  
 

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 899 bytes --]

Re: [PATCH] Babel support for scheme using geiser

[Bastien]

Hi Michael,

Michael Gauland <mikelygee@no8wireless.co.nz> writes:

> Babel: User geiser for scheme interactions
>
> * lisp/ob-scheme.el Major rewrite to support geiser

thanks for the patch -- let's wait for FSF copyright assignment
process to be done.  In the meantime, please consider adding a 
commit ChangeLog for your patch, avoid dangling parentheses,
and don't overwrite the first line... we are in 2013 :-)

If you havn't already, please read this page:
  http://orgmode.org/worg/org-contribute.html#sec-5

Thanks for contributing!

-- 
 Bastien

Re: [PATCH] Babel support for scheme using geiser

[Michael Gauland]

Bastien <bzg <at> altern.org> writes:
> In the meantime, please consider adding a 
> commit ChangeLog for your patch, 

Most of the file has changed dramatically--would you like the changelog to list
all the functions that have been added or altered, or would a simple statement
that the file underwent a major re-write be more appropriate?

> ...avoid dangling parentheses,

Noted. That's a bad habit I've picked up somewhere (probably too many years of C
programming.)

> and don't overwrite the first line... we are in 2013 

Also noted. Part of my brain refuses to acknowledge the new year until I'm back
at work. Regrettably, that won't be a problem after tomorrow.

Kind Regards,
Mike

Re: [PATCH] Babel support for scheme using geiser

[Bastien]

Hi Michael,

Michael Gauland <mikelygee@no8wireless.co.nz> writes:

> Bastien <bzg <at> altern.org> writes:
>> In the meantime, please consider adding a 
>> commit ChangeLog for your patch, 
>
> Most of the file has changed dramatically--would you like the changelog to list
> all the functions that have been added or altered, or would a simple statement
> that the file underwent a major re-write be more appropriate?

Well, I'm afraid we'll have to go the clean way: just document
the deleted functions, the new ones, and the ones that have been
rewritten.  No need to go too much into details.  

Also let's rename `cleanse-org-babel-scheme-repl-map' to
`org-babel-scheme-cleanse-repl-map'.

>> ...avoid dangling parentheses,
>
> Noted. That's a bad habit I've picked up somewhere (probably too many years of C
> programming.)
>
>> and don't overwrite the first line... we are in 2013 
>
> Also noted. Part of my brain refuses to acknowledge the new year until I'm back
> at work. Regrettably, that won't be a problem after tomorrow.

Hehe, happy new year :)  

-- 
 Bastien

[PATCH] Use geiser for babel scheme evaluation.

[Michael Gauland]

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

On 06/01/13 19:56, Bastien wrote:
> Well, I'm afraid we'll have to go the clean way: just document the
> deleted functions, the new ones, and the ones that have been
> rewritten. No need to go too much into details. Also let's rename
> `cleanse-org-babel-scheme-repl-map' to
> `org-babel-scheme-cleanse-repl-map'.

I've done the rename, un-dangled the parentheses, and prepared a changelog:


Babel: Use geiser to manage scheme sessions

* lisp/ob-scheme.el: Load the geiser library
(run-scheme): Removed
(org-babel-scheme-eoe): Removed
(org-babel-scheme-cmd): Removed
(scheme-program-name): Removed
(org-babel-scheme-repl-map): Hash mapping session names to sessions.
(org-babel-scheme-cleanse-repl-map): Remove dead sessions from map.
(org-babel-scheme-get-session-buffer): Return buffer associated with a
session.
(org-babel-scheme-set-session-buffer): Record the buffer associated with
a session.
(org-babel-scheme-get-buffer-impl): Return the scheme implementation
geiser associates with a buffer.
(org-babel-scheme-get-repl): Switch to the scheme REPL buffer for a
session, creating it if it doesn't exist.
(org-bable-scheme-make-session-name): Generate a name for a session, if
one was not specified.
(org-babel-scheme-execute-with-geiser): Execute scheme code, creating
the REPL if necessary.
(org-babel-execute-scheme): Rewritten to use geiser.
(org-babel-prep-session:scheme): Removed
(org-babel-scheme-initiate-session): Removed

This uses geiser to evaluate babel scheme source blocks, and generally
improves scheme support.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Use-geiser-for-babel-scheme-evaluation.patch --]
[-- Type: text/x-diff; name="0001-Use-geiser-for-babel-scheme-evaluation.patch", Size: 9195 bytes --]

From bc33a46041086abd5d1fec321f104aa034823576 Mon Sep 17 00:00:00 2001
From: Michael Gauland <mike_gauland@stanfordalumni.org>
Date: Wed, 9 Jan 2013 12:41:13 +1300
Subject: [PATCH] Use geiser for babel scheme evaluation.

---
 lisp/ob-scheme.el |  192 ++++++++++++++++++++++++++++++++---------------------
 1 files changed, 117 insertions(+), 75 deletions(-)

diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index c9fa44a..31e0cad 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -2,7 +2,7 @@
 
 ;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
 
-;; Author: Eric Schulte
+;; Authors: Eric Schulte, Michael Gauland
 ;; Keywords: literate programming, reproducible research, scheme
 ;; Homepage: http://orgmode.org
 
@@ -33,27 +33,16 @@
 ;; - a working scheme implementation
 ;;   (e.g. guile http://www.gnu.org/software/guile/guile.html)
 ;;
-;; - for session based evaluation cmuscheme.el is required which is
-;;   included in Emacs
+;; - for session based evaluation geiser is required, which is available from
+;;   ELPA.
 
 ;;; Code:
 (require 'ob)
-(eval-when-compile (require 'cl))
-
-(declare-function run-scheme "ext:cmuscheme" (cmd))
+(load-library "geiser-impl")
 
 (defvar org-babel-default-header-args:scheme '()
   "Default header arguments for scheme code blocks.")
 
-(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
-  "String to indicate that evaluation has completed.")
-
-(defcustom org-babel-scheme-cmd "guile"
-  "Name of command used to evaluate scheme blocks."
-  :group 'org-babel
-  :version "24.1"
-  :type 'string)
-
 (defun org-babel-expand-body:scheme (body params)
   "Expand BODY according to PARAMS, return the expanded body."
   (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
@@ -65,70 +54,123 @@
                 ")\n" body ")")
       body)))
 
-(defvar scheme-program-name)
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+  "Map of scheme sessions to session names.")
+
+(defun org-babel-scheme-cleanse-repl-map ()
+  "Remove dead buffers from the REPL map."
+  (maphash
+   (lambda (x y)
+     (when (not (buffer-name y))
+       (remhash x org-babel-scheme-repl-map)))
+   org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-session-buffer (session-name)
+  "Look up the scheme buffer for a session; return nil if it doesn't exist."
+  (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions
+  (gethash session-name org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-set-session-buffer (session-name buffer)
+  "Record the scheme buffer used for a given session."
+  (puthash session-name buffer org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-buffer-impl (buffer)
+  "Returns the scheme implementation geiser associates with the buffer."
+  (with-current-buffer (set-buffer buffer)
+    geiser-impl--implementation))
+
+(defun org-babel-scheme-get-repl (impl name)
+  "Switch to a scheme REPL, creating it if it doesn't exist:"
+  (let ((buffer (org-babel-scheme-get-session-buffer name)))
+    (or buffer 
+    (progn
+      (run-geiser impl)
+      (if name
+	  (progn 
+	    (rename-buffer name t)
+	    (org-babel-scheme-set-session-buffer name (current-buffer))))
+      (current-buffer)))))
+
+(defun org-babel-scheme-make-session-name (buffer name impl)
+  "Generate a name for the session buffer.
+
+For a named session, the buffer name will be the session name.
+
+If the session is unnamed (nil), generate a name.
+
+If the session is 'none', use nil for the session name, and
+org-babel-scheme-execute-with-geiser will use a temporary session."
+  (let ((result 
+	 (cond ((not name)
+		(concat buffer " " (symbol-name impl) " REPL"))
+	       ((string= name "none") nil)
+	       (name))))
+    result))
+
+(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+  "Execute code in specified REPL. If the REPL doesn't exist, create it
+using the given scheme implementation.
+
+Returns the output of executing the code if the output parameter
+is true; otherwise returns the last value."
+  (let ((result nil))
+    (with-temp-buffer
+      (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
+      (newline)
+      (insert (if output
+		  (format "(with-output-to-string (lambda () %s))" code)
+		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)
+	(geiser-eval-region (point-min) (point-max))
+	(setq result
+	      (if (equal (substring (current-message) 0 3) "=> ")
+		  (replace-regexp-in-string "^=> " "" (current-message))
+		"\"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
+		       (read result)))))
+    result))
+
 (defun org-babel-execute:scheme (body params)
   "Execute a block of Scheme code with org-babel.
 This function is called by `org-babel-execute-src-block'"
-  (let* ((result-type (cdr (assoc :result-type params)))
-	 (org-babel-scheme-cmd (or (cdr (assoc :scheme params))
-				   org-babel-scheme-cmd))
-         (full-body (org-babel-expand-body:scheme body params)))
-    (read
-     (if (not (string= (cdr (assoc :session params)) "none"))
-         ;; session evaluation
-	 (let ((session (org-babel-prep-session:scheme
-			 (cdr (assoc :session params)) params)))
-	   (org-babel-comint-with-output
-	       (session (format "%S" org-babel-scheme-eoe) t body)
-	     (mapc
-	      (lambda (line)
-		(insert (org-babel-chomp line)) (comint-send-input nil t))
-	      (list body (format "%S" org-babel-scheme-eoe)))))
-       ;; external evaluation
-       (let ((script-file (org-babel-temp-file "scheme-script-")))
-         (with-temp-file script-file
-           (insert
-            ;; return the value or the output
-            (if (string= result-type "value")
-                (format "(display %s)" full-body)
-              full-body)))
-         (org-babel-eval
-	  (format "%s %s" org-babel-scheme-cmd
-		  (org-babel-process-file-name script-file)) ""))))))
-
-(defun org-babel-prep-session:scheme (session params)
-  "Prepare SESSION according to the header arguments specified in PARAMS."
-  (let* ((session (org-babel-scheme-initiate-session session))
-	 (vars (mapcar #'cdr (org-babel-get-header params :var)))
-	 (var-lines
-	  (mapcar
-	   (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
-	   vars)))
-    (when session
-      (org-babel-comint-in-buffer session
-	(sit-for .5) (goto-char (point-max))
-	(mapc (lambda (var)
-		(insert var) (comint-send-input nil t)
-		(org-babel-comint-wait-for-output session)
-		(sit-for .1) (goto-char (point-max))) var-lines)))
-    session))
-
-(defun org-babel-scheme-initiate-session (&optional session)
-  "If there is not a current inferior-process-buffer in SESSION
-then create.  Return the initialized session."
-  (require 'cmuscheme)
-  (unless (string= session "none")
-    (let ((session-buffer (save-window-excursion
-			    (run-scheme org-babel-scheme-cmd)
-			    (rename-buffer session)
-			    (current-buffer))))
-      (if (org-babel-comint-buffer-livep session-buffer)
-	  (progn (sit-for .25) session-buffer)
-        (sit-for .5)
-        (org-babel-scheme-initiate-session session)))))
+  (let* ((source-buffer (current-buffer))
+	 (source-buffer-name (replace-regexp-in-string ;; zap surrounding *
+	  "^ ?\\*\\([^*]+\\)\\*" "\\1" (buffer-name source-buffer))))
+    (save-excursion
+      (org-babel-reassemble-table
+       (let* ((result-type (cdr (assoc :result-type params)))
+	      (impl (or (when (cdr (assoc :scheme params))
+			  (intern (cdr (assoc :scheme params))))
+			geiser-default-implementation
+			(car geiser-active-implementations)))
+	      (session (org-babel-scheme-make-session-name source-buffer-name (cdr (assoc :session params)) impl))
+	    (full-body (org-babel-expand-body:scheme body params)))
+       (org-babel-scheme-execute-with-geiser full-body           ; code
+					     (string= result-type "output")	; output?
+					     impl ; implementation
+					     (and (not (string= session "none")) session)); session
+       )
+     (org-babel-pick-name (cdr (assoc :colname-names params))
+			  (cdr (assoc :colnames params)))
+    (org-babel-pick-name (cdr (assoc :rowname-names params))
+			 (cdr (assoc :rownames params)))))))
+  
 
 (provide 'ob-scheme)
 
-
-
 ;;; ob-scheme.el ends here
-- 
1.7.2.5


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 899 bytes --]

Re: [PATCH] Use geiser for babel scheme evaluation.

[Bastien]

Hi Michael,

Michael Gauland <mikelygee@no8wireless.co.nz> writes:

> I've done the rename, un-dangled the parentheses, and prepared a
> changelog:

Thanks Michael.   I ping'ed the FSF copyright clerk for some news, 
I hope he's not overwhelmed after Christmas holidays.

Best,

PS: Next time put the ChangeLog directly in the commit message,
that's even quicker for me.

-- 
 Bastien