From 377d6d19debce5572052727323931f1b8306226b Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 8 Feb 2009 01:09:07 +0100 Subject: Basic Guile/Emacs connection and evaluation working. --- elisp/geiser-eval.el | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 112 insertions(+) create mode 100644 elisp/geiser-eval.el (limited to 'elisp/geiser-eval.el') diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el new file mode 100644 index 0000000..74c9b29 --- /dev/null +++ b/elisp/geiser-eval.el @@ -0,0 +1,112 @@ +;; geiser-eval.el -- sending scheme code for evaluation + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Sat Feb 07, 2009 22:35 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Comentary: + +;; Functions, building on top of geiser-connection, to evaluate scheme +;; code. + +;;; Code: + +(require 'geiser-connection) +(require 'geiser-log) +(require 'geiser-base) + + +;;; Code formatting: + +(defun geiser-eval--scheme-str (code) + (cond ((null code) "'()") + ((eq code :f) "#f") + ((eq code :t) "#t") + ((listp code) + (cond ((eq (car code) :gs) (concat "((@ (geiser eval) eval-in) (quote " + (geiser-eval--scheme-str (nth 1 code)) + ") " + (or (nth 2 code) + (geiser-eval--buffer-module)) + ")")) + ((eq (car code) :scm) (cadr code)) + (t (concat "(" (mapconcat 'geiser-eval--scheme-str code " ") ")")))) + (t (format "%S" code)))) + + +;;; Current module: + +(defun geiser-eval--buffer-module (&optional buffer) + (let ((buffer (or buffer (current-buffer)))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (if (re-search-forward "(define-module +\\(([^)]+)\\)" nil t) + (match-string-no-properties 1) + "#f"))))) + + +;;; Code sending: + +(defvar geiser-eval--default-proc-function nil) + +(defsubst geiser-eval--default-proc () + (and geiser-eval--default-proc-function + (funcall geiser-eval--default-proc-function))) + +(defvar geiser-eval--proc nil) + +(defsubst geiser-eval--proc () + (or geiser-eval--proc (geiser-eval--default-proc))) + +(defsubst geiser-eval--log (s) + (geiser-log--info "RETORT: %S" s) + s) + +(defsubst geiser-eval--code-str (code) + (if (stringp code) code (geiser-eval--scheme-str code))) + +(defvar geiser-eval--sync-retort nil) +(defun geiser-eval--set-sync-retort (s) + (setq geiser-eval--sync-retort (geiser-eval--log s))) + +(defun geiser-eval--send/wait (code &optional timeout buffer) + (setq geiser-eval--sync-retort nil) + (geiser-con--send-string/wait (geiser-eval--proc) + (geiser-eval--code-str code) + 'geiser-eval--set-sync-retort + timeout + buffer) + geiser-eval--sync-retort) + +(defsubst geiser-eval--send (code cont &optional buffer) + (geiser-con--send-string (geiser-eval--proc) + (geiser-eval--code-str code) + `(lambda (s) (,cont (geiser-eval--log s))) + buffer)) + + +;;; Retort parsing: + +(defsubst geiser-eval--retort-p (ret) + (and (listp ret) (or (assoc 'error ret) (assoc 'result ret)))) +(defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret))) +(defsubst geiser-eval--retort-result (ret) (cdr (assoc 'result ret))) + + +(provide 'geiser-eval) +;;; geiser-eval.el ends here -- cgit v1.2.3