ob-scheme: Allow ob-scheme to accept a remote connection

* lisp/org/ob-scheme.el (org-babel-scheme-get-repl): Introduce two
optional arguments: host and port.  If these are not given, just run
Geiser as before.  In the case when both are given, connect to the
remotely running Scheme process.
* lisp/org/ob-scheme (org-babel-scheme-execute-with-geiser,
org-babel-execute:scheme): Take these  optional arguments into account.
* lisp/org/ob-scheme.el (org-babel-header-args:scheme): Define host
and port header arguments for completion.

TINYCHANGE
This commit is contained in:
Hunter Jozwiak 2024-01-28 21:48:05 -05:00 committed by Ihor Radchenko
parent da9ac6da1d
commit 86c4038da6
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 18 additions and 7 deletions

View File

@ -54,7 +54,7 @@
(defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el (defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el
(defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el (defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el
(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el (defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el
(declare-function geiser-connect "ext:geiser-repl" (impl &optional host port))
(declare-function run-geiser "ext:geiser-repl" (impl)) (declare-function run-geiser "ext:geiser-repl" (impl))
(declare-function geiser "ext:geiser-repl" (impl)) (declare-function geiser "ext:geiser-repl" (impl))
(declare-function geiser-mode "ext:geiser-mode" ()) (declare-function geiser-mode "ext:geiser-mode" ())
@ -78,6 +78,9 @@
(defvar org-babel-default-header-args:scheme '() (defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.") "Default header arguments for scheme code blocks.")
(defconst org-babel-header-args:scheme '((host . :any)
(port . :any))
"Header arguments supported in Scheme.")
(defun org-babel-scheme-expand-header-arg-vars (vars) (defun org-babel-scheme-expand-header-arg-vars (vars)
"Expand :var header arguments given as VARS." "Expand :var header arguments given as VARS."
@ -121,13 +124,17 @@
(with-current-buffer (set-buffer buffer) (with-current-buffer (set-buffer buffer)
geiser-impl--implementation)) geiser-impl--implementation))
(defun org-babel-scheme-get-repl (impl name) (defun org-babel-scheme-get-repl (impl name &optional host port)
"Switch to a scheme REPL, creating it if it doesn't exist." "Switch to a Scheme REPL, creating it if it doesn't exist.
If the variables HOST and PORT are set, connect to the running Scheme REPL."
(let ((buffer (org-babel-scheme-get-session-buffer name))) (let ((buffer (org-babel-scheme-get-session-buffer name)))
(or buffer (or buffer
(progn (progn
(if (fboundp 'geiser) (if (fboundp 'geiser)
(geiser impl) (if (and host port)
(geiser-connect impl host port)
(geiser impl))
;; Obsolete since Geiser 0.26. ;; Obsolete since Geiser 0.26.
(run-geiser impl)) (run-geiser impl))
(when name (when name
@ -164,7 +171,7 @@ org-babel-scheme-execute-with-geiser will use a temporary session."
,@body ,@body
(current-message)))) (current-message))))
(defun org-babel-scheme-execute-with-geiser (code output impl repl) (defun org-babel-scheme-execute-with-geiser (code output impl repl &optional host port)
"Execute code in specified REPL. "Execute code in specified REPL.
If the REPL doesn't exist, create it using the given scheme If the REPL doesn't exist, create it using the given scheme
implementation. implementation.
@ -180,7 +187,7 @@ is true; otherwise returns the last value."
(let ((geiser-repl-window-allow-split nil) (let ((geiser-repl-window-allow-split nil)
(geiser-repl-use-other-window nil)) (geiser-repl-use-other-window nil))
(let ((repl-buffer (save-current-buffer (let ((repl-buffer (save-current-buffer
(org-babel-scheme-get-repl impl repl)))) (org-babel-scheme-get-repl impl repl host port))))
(when (not (eq impl (org-babel-scheme-get-buffer-impl (when (not (eq impl (org-babel-scheme-get-buffer-impl
(current-buffer)))) (current-buffer))))
(message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
@ -244,6 +251,8 @@ This function is called by `org-babel-execute-src-block'."
geiser-scheme-implementation geiser-scheme-implementation
geiser-default-implementation geiser-default-implementation
(car geiser-active-implementations))) (car geiser-active-implementations)))
(host (cdr (assq :host params)))
(port (cdr (assq :port params)))
(session (org-babel-scheme-make-session-name (session (org-babel-scheme-make-session-name
source-buffer-name (cdr (assq :session params)) impl)) source-buffer-name (cdr (assq :session params)) impl))
(full-body (org-babel-expand-body:scheme body params)) (full-body (org-babel-expand-body:scheme body params))
@ -253,7 +262,9 @@ This function is called by `org-babel-execute-src-block'."
full-body ; code full-body ; code
(string= result-type "output") ; output? (string= result-type "output") ; output?
impl ; implementation impl ; implementation
(and (not (string= session "none")) session)))) ; session (and (not (string= session "none")) session) ; session
host ; REPL host
port))) ; REPL port
(let ((table (let ((table
(org-babel-reassemble-table (org-babel-reassemble-table
result result