[nongnu] elpa/geiser-gambit c44a145 13/34: better indent , gsi opening param using module if > version 4.9.3

[Philip Kaludercic]

branch: elpa/geiser-gambit
commit c44a145fab966851ddd2a6d864dddc07b78f0d92
Author: mathieu2em <math.per@hotmail.com>
Commit: mathieu2em <math.per@hotmail.com>

    better indent , gsi opening param using module if > version 4.9.3
---
 elisp/geiser-gambit.el          | 32 +++++++++++++++-----------
 scheme/gambit/geiser/gambit.scm | 51 ++++++++++++-----------------------------
 2 files changed, 33 insertions(+), 50 deletions(-)

diff --git a/elisp/geiser-gambit.el b/elisp/geiser-gambit.el
index b7ac830..cd68e46 100644
--- a/elisp/geiser-gambit.el
+++ b/elisp/geiser-gambit.el
@@ -32,7 +32,7 @@
 (eval-when-compile (require 'cl))
 
  (defconst geiser-gambit--builtin-keywords
-   '("##debug-repl" "##import"))
+   '("##debug-repl" "##import" "define-macro" "##symbol-table" "##decompile"))
 
 ;;; Customization
 
@@ -97,10 +97,6 @@ this variable to t."
       (car geiser-gambit-binary)
     geiser-gambit-binary))
 
-(defun geiser-gambit--parameters ()
-  "Return a list with all parameters needed to start Gambit Scheme."
-  `( ,(expand-file-name "gambit/geiser/gambit.scm" geiser-scheme-dir) "-" ))
-
 (defconst geiser-gambit--prompt-regexp "> ")
 
 (defconst geiser-gambit--debugger-prompt-regexp "[0-9]+> ")
@@ -122,7 +118,8 @@ If `t', Geiser will use `next-error' to jump to the error's 
location."
   :type 'boolean
   :group 'geiser-gambit)
 
-;;; Evaluation support:
+;;; evaluation support when module loaded at opening
+;;; the gambit/geiser# is the namespace of geiser module for gambit
 (defun geiser-gambit--geiser-procedure (proc &rest args)
   (case proc
     ((eval compile)
@@ -134,15 +131,15 @@ If `t', Geiser will use `next-error' to jump to the 
error's location."
                            (concat "'" (car args)))
                           (t
                            "#f")))
-            (cmd (format "(geiser:eval %s '%s)" module form)))
+            (cmd (format "(gambit/geiser#geiser:eval %s '%s)" module form)))
        cmd))
     ((load-file compile-file)
-     (format "(geiser:load-file %s)" (car args)))
+     (format "(gambit/geiser#geiser:load-file %s)" (car args)))
     ((no-values)
-     "(geiser:no-values)")
+     "(gambit/geiser#geiser:no-values)")
     (t
      (let ((form (mapconcat 'identity args " ")))
-       (format "(geiser:%s %s)" proc form)))))
+       (format "(gambit/geiser#geiser:%s %s)" proc form)))))
 
 ;;(defconst geiser-gambit--module-re
 ;;  "( *module +\\(([^)]+)\\|[^ ]+\\)\\|( *define-library +\\(([^)]+)\\|[^ 
]+\\)")
@@ -184,9 +181,6 @@ If `t', Geiser will use `next-error' to jump to the error's 
location."
 (defun geiser-gambit--symbol-begin (module)
   (save-excursion (skip-syntax-backward "^-()> ") (point)))
 
-(defun geiser-gambit--version (binary)
-  (car (process-lines binary "-c" "(display (version))")))
-
 (defun connect-to-gambit ()
   "Start a gambit REPL connected to a remote process."
   (interactive)
@@ -285,7 +279,6 @@ If `t', Geiser will use `next-error' to jump to the error's 
location."
  (define-record 1)
  (define-specialization 1)
  (define-type 1)
- (with-input-from-pipe 1)
  (select 1)
  (functor 3)
  (define-interface 1)
@@ -299,6 +292,17 @@ If `t', Geiser will use `next-error' to jump to the 
error's location."
   (shell-command-to-string (format "%s -e \"(display 
(##system-version-string))\""
                                    binary)))
 
+(defun geiser-gambit--parameters ()
+  "Return a list with all parameters needed to start Gambit Scheme."
+  ;; if your version of gambit support modules we directly load geiser module
+  ;; else we go load the file in geiser
+  (let* ((v (geiser-gambit--version (geiser-gambit--binary)))
+         (gambit-version (substring v 1 (string-width v))))
+    (if (version< gambit-version "4.9.3")
+        `( ,(expand-file-name "gambit/geiser/gambit" geiser-scheme-dir) "-" )
+      `( "gambit/geiser" "-"))))
+    
+
 (defun connect-to-gambit ()
   "Start a Gambit REPL connected to a remote process."
   (interactive)
diff --git a/scheme/gambit/geiser/gambit.scm b/scheme/gambit/geiser/gambit.scm
index e3e7dae..8efab7b 100644
--- a/scheme/gambit/geiser/gambit.scm
+++ b/scheme/gambit/geiser/gambit.scm
@@ -1,5 +1,9 @@
 ;; scheme
 ;;; gambit.scm gambit geiser interaction
+(##namespace ("gambit/geiser#")) ;; in gambit/geiser#
+(##include "~~lib/_prim#.scm")   ;; map fx+ to ##fx+, etc
+(##include "~~lib/_gambit#.scm") ;; for macro-check-string,
+;; macro-absent-obj, etc
 
 (define-macro (geiser:capture-output x . xs)
   (let ((out (gensym))
@@ -28,8 +32,8 @@
 
 ;; search for a procedure in gambit-procedures
 ;; returns the procedure symbol if it finds it
-(define (##procedure-search elem)
-  (or (assq elem ##gambit-procedures) '()))
+(define (procedure-search elem)
+  (or (assq elem gambit-procedures) '()))
 
 (define (geiser:autodoc ids . rest)
   (cond ((null? ids) '())
@@ -43,47 +47,29 @@
 
 ;; (cadr (##decompile method)) format is
 ;;(#!optional (param1 (macro-absent-obj)) (param2 (macro-absent-obj)) #!rest 
others)
-;; !! method-name -> procedure
-
-;;
+;;the autodoc verify if (##decompile method) gives a acceptable result and 
else use the scraped list gambit-procedures
 (define (geiser:new-autodoc method-name)
   (define (get-required lst)
     (let loop ((lst lst)
                (result '()))
       (cond ((not (pair? lst))
-             ;;(pp (cons (reverse result) '()))
-             ;;(pp "-----NEXT1-- not pair--")
              (cons (reverse result) '()))
             ((eq? (car lst) #!optional)
-             ;;(pp (cons (reverse result) (cdr lst)))
-             ;;(pp "-----NEXT1---opt--")
              (cons (reverse result) (cdr lst)))
             ((eq? (car lst) #!key)
-             ;;(pp (cons (reverse result) lst))
-             ;;(pp "-----NEXT1--key---")
              (cons (reverse result) lst))
             (else (loop (cdr lst) (cons (car lst) result))))))
 
   (define (get-optional lst)
-    ;;(pp "getopt")
-    ;;(pp lst)
-    ;;(pp "----")
     (let loop ((lst lst)
                (result '()))
       (cond ((or (not (pair? lst))
                  (eq? (car lst) #!key))
-             ;;(pp (cons (reverse result)
-             ;;      (if (pair? lst)
-             ;;          (cdr lst)
-             ;;          '())))
-             ;;(pp "------next2----key or emptylist--")
              (cons (reverse result)
                    (if (pair? lst)
                        (cdr lst)
                        '())))
             ((eq? (car lst) #!rest)
-             ;;(pp (cons (reverse (cons '... result)) '()))
-             ;;(pp "-------next2---- rest--")
              (cons (reverse (cons '... result)) '()))
             (else
              (loop (cdr lst) (cons (if (pair? (car lst)) (caar lst) (car lst)) 
result))))))
@@ -101,8 +87,6 @@
   (let ((proc (##global-var-ref (##make-global-var method-name))))
     (if (procedure? proc)
         (let ((method-tester (##decompile proc)))
-          ;;(pp (cadr method-tester))
-          ;;(pp "---NEXT---")
           (if (pair? method-tester)
               (let* ((method (cadr method-tester))
                      (required (get-required method))
@@ -113,8 +97,8 @@
                                  ("optional" ,@(car optional))
                                  ("key"      ,@key)))
                         ("module"))))
-              (list (##procedure-search method-name))))
-        (list (##procedure-search method-name)))))
+              (list (procedure-search method-name))))
+        (list (procedure-search method-name)))))
 
 (define (geiser:module-completions prefix . rest)
 
@@ -127,14 +111,14 @@
             (let ((sym (vector-ref sym-tab i)))
               (loop (+ i 1)
                     (if (symbol? sym)
-                        (let loop2 ((sym-list (if (and (##string-prefix? 
prefix sym)
+                        (let loop2 ((sym-list (if (and (string-prefix? prefix 
sym)
                                                        (procedure? 
(##global-var-ref (##make-global-var sym))))
                                                   (cons (symbol->string sym) 
symbols-list)
                                                   symbols-list))
                                     (vect sym))
                           (let ((sym2 (##vector-ref vect 2)))
                             (if (symbol? sym2)
-                                (if (and (##string-prefix? prefix sym2)
+                                (if (and (string-prefix? prefix sym2)
                                          (procedure? (##global-var-ref 
(##make-global-var sym))))
                                     (loop2 (cons (symbol->string sym2) 
sym-list) sym2)
                                     (loop2 sym-list sym2))
@@ -142,18 +126,13 @@
                         symbols-list)))
             symbols-list))))
 
-  (##sort-list (environment-symbols) string-ci<?))
-
- ;; (##sort-list (filter (lambda (el)
- ;;                        (##string-prefix? prefix el)) ;; eviter le map -> 
symbol->string externe
- ;;                      (map symbol->string (environment-symbols)))
- ;;              string-ci<?))
+  (sort-list (environment-symbols) string-ci<?))
 
 (define (geiser:completions prefix . rest)
   rest)
 
 ;; string-prefix function
-(define (##string-prefix? pref str)
+(define (string-prefix? pref str)
   (let* ((str (if (string? str) str (symbol->string str)))
          (str-len (string-length str))
          (pref (if (string? pref) pref (symbol->string pref)))
@@ -168,7 +147,7 @@
   (fold-right (lambda (e r) (if (f e) (cons e r) r)) '() lst))
 
 ;; sorting algorithms
-(define (##sort-list l <?)
+(define (sort-list l <?)
 
    (define (mergesort l)
 
@@ -195,7 +174,7 @@
    (mergesort l))
 
 ;; the majority of gambit and r5rs procedures correctly formatted
-(define ##gambit-procedures
+(define gambit-procedures
   '((* ("args" (("required") ("optional" [z1  ...]) ("key")))("module"))
     (+ ("args" (("required" z1  [...]) ("optional") ("key")))("module"))
     (- ("args" (("required" z1 z2) ("optional") ("key")))("module"))