ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

lisp/ob-scheme.el: Fix mit-scheme evaluation 

* lisp/ob-scheme.el (org-babel-scheme-execute-with-geiser): Do not
sent top comment when evaluating code block.  mit-scheme has problems
processing it for some reason.
This commit is contained in:
Ihor Radchenko 2024-05-19 15:38:45 +02:00
parent c0b66bf9c1
commit bf71c8c597
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 44 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
lisp/ob-scheme.el
View File

@ -182,46 +182,51 @@ is true; otherwise returns the last value."
(with-temp-buffer (with-temp-buffer
(insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
(newline) (newline)
(insert code) (let ((beg (point)))
(geiser-mode) (insert code)
(let ((geiser-repl-window-allow-split nil) (geiser-mode)
(geiser-repl-use-other-window nil)) (let ((geiser-repl-window-allow-split nil)
(let ((repl-buffer (save-current-buffer (geiser-repl-use-other-window nil))
(org-babel-scheme-get-repl impl repl host port)))) (let ((repl-buffer (save-current-buffer
(when (not (eq impl (org-babel-scheme-get-buffer-impl (org-babel-scheme-get-repl impl repl host port))))
(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)
(org-babel-scheme-get-buffer-impl (current-buffer)) (org-babel-scheme-get-buffer-impl (current-buffer))
(symbolp (org-babel-scheme-get-buffer-impl (symbolp (org-babel-scheme-get-buffer-impl
(current-buffer))))) (current-buffer)))))
(setq geiser-repl--repl repl-buffer) (setq geiser-repl--repl repl-buffer)
(setq geiser-impl--implementation nil) (setq geiser-impl--implementation nil)
(let ((geiser-debug-jump-to-debug-p nil) (let ((geiser-debug-jump-to-debug-p nil)
(geiser-debug-show-debug-p nil)) (geiser-debug-show-debug-p nil))
;; `geiser-eval-region/wait' was introduced to await the ;; `geiser-eval-region/wait' was introduced to await the
;; result of async evaluation in geiser version 0.22. ;; result of async evaluation in geiser version 0.22.
(let ((ret (funcall (if (fboundp 'geiser-eval-region/wait) (let ((ret (funcall (if (fboundp 'geiser-eval-region/wait)
#'geiser-eval-region/wait #'geiser-eval-region/wait
#'geiser-eval-region) #'geiser-eval-region)
(point-min) ;; Do not include top comment into evaluation.
(point-max)))) ;; Apparently, mit-scheme has
(let ((err (geiser-eval--retort-error ret))) ;; problems with the top comment we add:
(setq result (cond ;; "Unexpected read restart on: #[textual-i/o-port 27 for console]"
(output beg
(or (geiser-eval--retort-output ret) (point-max))))
"Geiser Interpreter produced no output")) (let ((err (geiser-eval--retort-error ret)))
(err nil) (setq result (cond
(t (geiser-eval--retort-result-str ret "")))) (output
(when (not repl) (or (geiser-eval--retort-output ret)
(save-current-buffer (set-buffer repl-buffer) "Geiser Interpreter produced no output"))
(geiser-repl-exit)) (err nil)
(set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) (t (geiser-eval--retort-result-str ret ""))))
(kill-buffer repl-buffer)) (when (not repl)
(when err (save-current-buffer (set-buffer repl-buffer)
(let ((msg (geiser-eval--error-msg err))) (geiser-repl-exit))
(org-babel-eval-error-notify (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
nil (kill-buffer repl-buffer))
(concat (if (listp msg) (car msg) msg) "\n")))))))))) (when err
(let ((msg (geiser-eval--error-msg err)))
(org-babel-eval-error-notify
nil
(concat (if (listp msg) (car msg) msg) "\n")))))))))))
result)) result))
(defun org-babel-scheme--table-or-string (results) (defun org-babel-scheme--table-or-string (results)