From 707d0afb8c443f1c6e624d6d432b21ca44636937 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Sun, 28 Nov 2010 16:07:42 +0100
Subject: Avoiding keyword internalisation

We were still internalizing scheme _keywords_ in the elisp reader.
---
 elisp/geiser-syntax.el | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

(limited to 'elisp')

diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 17e0999..ce5a7af 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -159,15 +159,17 @@ implementation-specific entries for font-lock-keywords.")
              ('nil '(eob))
              (?| (geiser-syntax--read/skip-comment))
              (?: (if (geiser-syntax--read/next-char)
-                     (cons 'kwd (geiser-syntax--read/elisp))
+                     (cons 'kwd (geiser-syntax--read/symbol))
                    '(eob)))
              (?\\ (cons 'char (geiser-syntax--read/elisp)))
              (?\( (geiser-syntax--read/token 'vectorb))
              (?\< (geiser-syntax--read/unprintable))
              ((?' ?` ?,) (geiser-syntax--read/next-token))
              (t (let ((tok (geiser-syntax--read/symbol)))
-                  (if tok (cons 'atom (intern (format "#%s" tok)))
-                    (geiser-syntax--read/next-token))))))
+                  (cond ((equal (symbol-name tok) "t") '(boolean . :t))
+                        ((equal (symbol-name tok) "f") '(boolean . :f))
+                        (tok (cons 'atom (make-symbol (format "#%s" tok))))
+                        (t (geiser-syntax--read/next-token)))))))
       (?\' (geiser-syntax--read/token '(quote . quote)))
       (?\` (geiser-syntax--read/token
             `(backquote . ,backquote-backquote-symbol)))
@@ -214,9 +216,10 @@ implementation-specific entries for font-lock-keywords.")
       (vectorb (apply 'vector (geiser-syntax--read/list)))
       ((quote backquote unquote splice) (list (cdr token)
                                               (geiser-syntax--read)))
-      (kwd (intern (format ":%s" (cdr token))))
+      (kwd (make-symbol (format ":%s" (cdr token))))
       (unprintable (format "#<%s>" (cdr token)))
       ((char string atom) (cdr token))
+      (boolean (cdr token))
       (t (error "Reading scheme syntax: unexpected token: %s" token)))))
 
 (defun geiser-syntax--read-from-string (string &optional start end)
@@ -268,6 +271,12 @@ implementation-specific entries for font-lock-keywords.")
                       ((not (equal "." s)) (push (make-symbol s) elems)))))))
         (nreverse elems)))))
 
+(defsubst geiser-syntax--keywordp (s)
+  (and s (symbolp s) (string-match "^:.+" (symbol-name s))))
+
+(defsubst geiser-syntax--symbol-eq (s0 s1)
+  (and (symbolp s0) (symbolp s1) (equal (symbol-name s0) (symbol-name s1))))
+
 (defun geiser-syntax--scan-sexps (&optional begin)
   (let* ((fst (geiser-syntax--symbol-at-point))
          (smth (or fst (not (looking-at-p "[\s \s)\s>\s<\n]"))))
@@ -282,9 +291,10 @@ implementation-specific entries for font-lock-keywords.")
               (let* ((len (geiser-syntax--pair-length form))
                      (pos (if smth (1- len) (progn (setq smth t) len)))
                      (prev (and (> pos 1) (nth (1- pos) form)))
-                     (prev (and (keywordp prev) (list prev))))
+                     (prev (and (geiser-syntax--keywordp prev)
+                                (list prev))))
                 (push `(,(car form) ,pos ,@prev) path)))))))
-    (mapcar (lambda (e) (cons (format "%s" (car e)) (cdr e)))
+    (mapcar (lambda (e) (cons (format "%S" (car e)) (cdr e)))
             (nreverse path))))
 
 (defsubst geiser-syntax--binding-form-p (bfs sbfs f)
-- 
cgit v1.2.3