summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-09-07 00:17:12 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-09-07 00:17:12 +0200
commit3a80af06f2b9272db379fed3b5b659ecfeeceb70 (patch)
treeaf04cbe37abec51cbf4106f06a497445904dc7a6
parent8d534314354d6858ec72f483b3e37cc50daaf8d8 (diff)
downloadgeiser-chez-3a80af06f2b9272db379fed3b5b659ecfeeceb70.tar.gz
geiser-chez-3a80af06f2b9272db379fed3b5b659ecfeeceb70.tar.bz2
Scheme reader improvements: #<>, #||# and other bits.
-rw-r--r--elisp/geiser-syntax.el62
1 files changed, 44 insertions, 18 deletions
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 13cab62..ca218c8 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -101,32 +101,52 @@
(defsubst geiser-syntax--read/elisp ()
(ignore-errors (read (current-buffer))))
+(defun geiser-syntax--read/matching (open close)
+ (let ((count 1)
+ (p (1+ (point))))
+ (while (and (> count 0)
+ (geiser-syntax--read/next-char))
+ (cond ((looking-at-p open) (setq count (1+ count)))
+ ((looking-at-p close) (setq count (1- count)))))
+ (buffer-substring-no-properties p (point))))
+
+(defsubst geiser-syntax--read/unprintable ()
+ (geiser-syntax--read/token
+ (cons 'unprintable (geiser-syntax--read/matching "<" ">"))))
+
+(defun geiser-syntax--read/skip-comment ()
+ (while (and (geiser-syntax--read/next-char)
+ (nth 8 (syntax-ppss))))
+ (geiser-syntax--read/next-token))
+
(defun geiser-syntax--read/next-token ()
(skip-syntax-forward "->")
(if (geiser-syntax--read/eos) '(eob)
(case (char-after)
- (\;
- (skip-syntax-forward "^>")
- (geiser-syntax--read/next-token))
+ (?\; (geiser-syntax--read/skip-comment))
((?\( ?\[) (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)))))
+ (?\# (case (geiser-syntax--read/next-char)
+ ('nil '(eob))
+ (?| (geiser-syntax--read/skip-comment))
+ (?: (if (geiser-syntax--read/next-char)
+ (cons 'kwd (geiser-syntax--read/elisp))
+ '(eob)))
+ (?\\ (cons 'char (geiser-syntax--read/elisp)))
+ (?\( (geiser-syntax--read/token 'vectorb))
+ (?\< (geiser-syntax--read/unprintable))
+ (t (let ((tok (geiser-syntax--read/elisp)))
+ (if tok (cons 'atom (intern (format "#%s" tok)))
+ (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))
+ (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))))))
@@ -157,8 +177,10 @@
(eob nil)
(lparen (geiser-syntax--read/list))
(vectorb (apply 'vector (geiser-syntax--read/list)))
- ((quote backquote unquote splice) (list (cdr token) (geiser-syntax--read)))
+ ((quote backquote unquote splice) (list (cdr token)
+ (geiser-syntax--read)))
(kwd `(:keyword . ,(cdr token)))
+ (unprintable (format "#<%s>" (cdr token)))
((char string atom) (cdr token))
(t (error "Reading scheme syntax: unexpected token: %s" token)))))
@@ -185,12 +207,15 @@
(while (not (zerop (geiser-syntax--nesting-level)))
(let ((boundary (1+ (point))))
(backward-up-list)
- (let ((form (nth-value 0 (geiser-syntax--form-after-point boundary))))
+ (let ((form
+ (nth-value 0 (geiser-syntax--form-after-point boundary))))
(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 prev (geiser-syntax--read/keyword-value prev))))
- (push `(,(car form) ,len-1 ,@(and prev (symbolp prev) (list prev)))
+ (prev (and prev
+ (geiser-syntax--read/keyword-value prev))))
+ (push `(,(car form)
+ ,len-1 ,@(and prev (symbolp prev) (list prev)))
path))))))
(nreverse path))))
@@ -204,7 +229,8 @@
(t
(let* ((head (car form))
(name (if-symbol (cadr form)))
- (names (if name (if-list (caddr form)) (if-list (cadr form))))
+ (names (if name (if-list (caddr form))
+ (if-list (cadr form))))
(rest (if name (cdddr form) (cddr form)))
(use-names (or (eq head 'let*) (not partial) rest)))
(when name (push name locals))