From b3aaa30d9a655028d6b39c477f1b1a92a872415a Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Sun, 30 Aug 2009 11:52:15 +0200
Subject: Tagging keywords as such in the scheme reader, for later spotting of
 active argument in autodoc.

---
 elisp/geiser-syntax.el | 59 +++++++++++++++++++++++++++-----------------------
 1 file changed, 32 insertions(+), 27 deletions(-)

diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 5cfbc32..91993be 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -104,32 +104,32 @@
 (defun geiser-syntax--read/next-token ()
   (skip-syntax-forward "->")
   (if (geiser-syntax--read/eos) '(eob)
-    (let ((c (char-after)))
-      (cond ((not c) '(eob))
-            ((eq c '\;)
-             (skip-syntax-forward "^>")
-             (geiser-syntax--read/next-token))
-            ((memq c '(?\( ?\[)) (geiser-syntax--read/token 'lparen))
-            ((memq c '(?\) ?\])) (geiser-syntax--read/token 'rparen))
-            ((eq c ?.)
-             (if (memq (syntax-after (1+ (point))) '(0 11 12))
-                 (geiser-syntax--read/token 'dot)
-               (cons 'atom (geiser-syntax--read/elisp))))
-            ((eq c ?\#)
-             (let ((c (geiser-syntax--read/next-char)))
-               (cond ((not c) '(eob))
-                     ((eq c ?\\) (cons 'char (geiser-syntax--read/elisp)))
-                     ((eq c ?\() (geiser-syntax--read/token 'vectorb))
-                     (t (geiser-syntax--read/next-token)))))
-            ((eq c ?\') (geiser-syntax--read/token '(quote . quote)))
-            ((eq c ?\`) (geiser-syntax--read/token
-                         `(backquote . ,backquote-backquote-symbol)))
-            ((eq c ?,) (if (eq (geiser-syntax--read/next-char) ?@)
-                           (geiser-syntax--read/token
-                            `(splice . ,backquote-splice-symbol))
-                         `(unquote . ,backquote-unquote-symbol)))
-            ((eq c ?\") (cons 'string (geiser-syntax--read/elisp)))
-            (t (cons 'atom (geiser-syntax--read/elisp)))))))
+    (case (char-after)
+      (\;
+       (skip-syntax-forward "^>")
+       (geiser-syntax--read/next-token))
+      ((?\( ?\[) (geiser-syntax--read/token 'lparen))
+      ((?\) ?\]) (geiser-syntax--read/token 'rparen))
+      (?. (if (memq (syntax-after (1+ (point))) '(0 11 12))
+              (geiser-syntax--read/token 'dot)
+            (cons 'atom (geiser-syntax--read/elisp))))
+      (?\# (let ((c (geiser-syntax--read/next-char)))
+             (cond ((not c) '(eob))
+                   ((eq c ?:)
+                    (if (geiser-syntax--read/next-char)
+                        (cons 'kwd (geiser-syntax--read/elisp))
+                      '(eob)))
+                   ((eq c ?\\) (cons 'char (geiser-syntax--read/elisp)))
+                   ((eq c ?\() (geiser-syntax--read/token 'vectorb))
+                   (t (geiser-syntax--read/next-token)))))
+      (?\' (geiser-syntax--read/token '(quote . quote)))
+      (?\` (geiser-syntax--read/token
+            `(backquote . ,backquote-backquote-symbol)))
+      (?, (if (eq (geiser-syntax--read/next-char) ?@)
+              (geiser-syntax--read/token `(splice . ,backquote-splice-symbol))
+            `(unquote . ,backquote-unquote-symbol)))
+      (?\" (cons 'string (geiser-syntax--read/elisp)))
+      (t (cons 'atom (geiser-syntax--read/elisp))))))
 
 (defsubst geiser-syntax--read/match (&rest tks)
   (let ((token (geiser-syntax--read/next-token)))
@@ -158,9 +158,13 @@
       (lparen (geiser-syntax--read/list))
       (vectorb (apply 'vector (geiser-syntax--read/list)))
       ((quote backquote unquote splice) (list (cdr token) (geiser-syntax--read)))
+      (kwd `(:keyword . ,(cdr token)))
       ((char string atom) (cdr token))
       (t (error "Reading scheme syntax: unexpected token: %s" token)))))
 
+(defsubst geiser-syntax--read/keyword-value (s)
+  (and (consp s) (eq (car s) :keyword) (cdr s)))
+
 
 ;;; Code parsing:
 
@@ -180,7 +184,8 @@
           (let ((form (save-excursion (geiser-syntax--read))))
             (when (and (listp form) (car form) (symbolp (car form)))
               (let* ((len-1 (1- (length form)))
-                     (prev (and (> len-1 1) (nth (1- len-1) form))))
+                     (prev (and (> len-1 1) (nth (1- len-1) form)))
+                     (prev (and prev (geiser-syntax--read/keyword-value prev))))
                 (push `(,(car form) ,len-1 ,@(and prev (symbolp prev) (list prev)))
                       path))))))
       (nreverse path))))
-- 
cgit v1.2.3