From 5a7373cd2da209e8a58b35060c0b29bd18398957 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 18 Aug 2009 06:16:57 +0200
Subject: Yet another deklugdification: locals scanning moved to elisp.

... and say goodbye to the ugly parse partial sexp, reducing not only
sloppy code, but also duplication and data transfers.
---
 scheme/guile/geiser/completion.scm | 25 +++----------------------
 scheme/plt/geiser/completions.ss   | 27 ++++-----------------------
 2 files changed, 7 insertions(+), 45 deletions(-)

(limited to 'scheme')

diff --git a/scheme/guile/geiser/completion.scm b/scheme/guile/geiser/completion.scm
index f4342bb..564b8f5 100644
--- a/scheme/guile/geiser/completion.scm
+++ b/scheme/guile/geiser/completion.scm
@@ -31,28 +31,9 @@
   #:use-module (ice-9 session)
   #:use-module (ice-9 regex))
 
-(define (completions prefix . context)
-  (let ((context (and (not (null? context)) (car context)))
-        (prefix (string-append "^" (regexp-quote prefix))))
-    (append (filter (lambda (s) (string-match prefix s))
-                    (map symbol->string (local-bindings context)))
-            (sort! (map symbol->string (apropos-internal prefix)) string<?))))
-
-(define (local-bindings form)
-  (define (body f) (if (> (length f) 2) (cddr f) '()))
-  (let loop ((form form) (bindings '()))
-    (cond ((not (pair? form)) bindings)
-          ((list? (car form))
-           (loop (cdr form) (append (local-bindings (car form)) bindings)))
-          ((and (list? form) (< (length form) 2)) bindings)
-          ((memq (car form) '(define define* lambda))
-           (loop (body form) (append (pair->list (cadr form)) bindings)))
-          ((and (memq (car form) '(let let* letrec letrec*))
-                (list? (cadr form)))
-           (loop (body form) (append (map car (cadr form)) bindings)))
-          ((and (eq? 'let (car form)) (symbol? (cadr form)))
-           (loop (cons 'let (body form)) (cons (cadr form) bindings)))
-          (else (loop (cdr form) bindings)))))
+(define (completions prefix)
+  (let ((prefix (string-append "^" (regexp-quote prefix))))
+    (sort! (map symbol->string (apropos-internal prefix)) string<?)))
 
 (define (module-completions prefix)
   (let* ((prefix (string-append "^" (regexp-quote prefix)))
diff --git a/scheme/plt/geiser/completions.ss b/scheme/plt/geiser/completions.ss
index 4537feb..15bc081 100644
--- a/scheme/plt/geiser/completions.ss
+++ b/scheme/plt/geiser/completions.ss
@@ -35,29 +35,10 @@
   (filter (lambda (s) (string-prefix? prefix s))
           (if sort? (sort lst string<?) lst)))
 
-(define (symbol-completions prefix (context #f))
-  (append (filter-prefix prefix
-                         (map symbol->string (local-bindings context))
-                         #f)
-          (filter-prefix prefix
-                         (map symbol->string (namespace-mapped-symbols))
-                         #t)))
-
-(define (local-bindings form)
-  (define (body f) (if (> (length f) 2) (cddr f) '()))
-  (let loop ((form form) (bindings '()))
-    (cond ((not (pair? form)) bindings)
-          ((list? (car form))
-           (loop (cdr form) (append (local-bindings (car form)) bindings)))
-          ((and (list? form) (< (length form) 2)) bindings)
-          ((memq (car form) '(define define* lambda))
-           (loop (body form) (append (pair->list (cadr form)) bindings)))
-          ((and (memq (car form) '(let let* letrec letrec*))
-                (list? (cadr form)))
-           (loop (body form) (append (map car (cadr form)) bindings)))
-          ((and (eq? 'let (car form)) (symbol? (cadr form)))
-           (loop (cons 'let (body form)) (cons (cadr form) bindings)))
-          (else (loop (cdr form) bindings)))))
+(define (symbol-completions prefix)
+  (filter-prefix prefix
+                 (map symbol->string (namespace-mapped-symbols))
+                 #t))
 
 (define (module-completions prefix)
   (filter-prefix prefix (module-list) #f))
-- 
cgit v1.2.3