From 4e16a7a00ffdc62d46143f614055d7aaf191ad9e Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Mon, 9 Feb 2009 21:59:23 +0100
Subject: Better preparation of Scheme results for the Elisp reader.

---
 elisp/geiser-connection.el |  9 ++-------
 elisp/geiser-syntax.el     | 17 ++++++++++++++++-
 2 files changed, 18 insertions(+), 8 deletions(-)

(limited to 'elisp')

diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el
index 060ab7b..c18e7b2 100644
--- a/elisp/geiser-connection.el
+++ b/elisp/geiser-connection.el
@@ -26,6 +26,7 @@
 ;;; Code:
 
 (require 'geiser-log)
+(require 'geiser-syntax)
 (require 'geiser-base)
 
 (require 'comint)
@@ -156,15 +157,9 @@
 (defsubst geiser-con--comint-buffer ()
   (get-buffer-create " *geiser connection retort*"))
 
-(defun geiser-con--cleaunp-result-str ()
-  (goto-char (point-min))
-  (while (re-search-forward "#(" nil t) (replace-match "(vector "))
-  (goto-char (point-min))
-  (while (re-search-forward "#" nil t) (replace-match "\\\\#")))
-
 (defun geiser-con--comint-buffer-form ()
   (with-current-buffer (geiser-con--comint-buffer)
-    (geiser-con--cleaunp-result-str)
+    (geiser-syntax--prepare-scheme-for-elisp-reader)
     (goto-char (point-min))
     (condition-case nil
         (let ((form (read (current-buffer))))
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index fa8e9b2..5e45470 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -53,7 +53,7 @@
 ;;; Code parsing:
 
 (defsubst geiser-syntax--end-of-thing ()
-  (let ((sc (syntax-class (syntax-after (point)))))
+  (let ((sc (or (syntax-class (syntax-after (point))) 0)))
     (when (= sc 7) (forward-char))
     (cond ((nth 3 (syntax-ppss))
            (skip-syntax-forward "^\"")
@@ -77,6 +77,21 @@
           (when (< (point) p) (setq arg-no (1+ arg-no))))
         (cons proc arg-no)))))
 
+(defun geiser-syntax--prepare-scheme-for-elisp-reader ()
+  (goto-char (point-min))
+  (while (re-search-forward "#\<\\([^>]*?\\)\>" nil t)
+    (let ((from (match-beginning 1))
+          (to (match-end 1)))
+      (goto-char from)
+      (while (re-search-forward "\\([() ;'`]\\)" to t)
+        (replace-match "\\\\\\1"))
+      (goto-char to)))
+  (goto-char (point-min))
+  (while (re-search-forward "#(" nil t) (replace-match "(vector "))
+  (goto-char (point-min))
+  (while (re-search-forward "#" nil t) (replace-match "\\\\#")))
+
+
 
 ;;; Fontify strings as Scheme code:
 
-- 
cgit v1.2.3