summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormathieu2em <math.per@hotmail.com>2019-07-31 13:18:28 -0400
committermathieu2em <math.per@hotmail.com>2019-08-20 15:31:38 -0400
commit6381b39aab1cdbac16184a963d542acf33875753 (patch)
tree662b7d99307399544f4c8bf49937d563b6fcbb45
parent47e462db1a8875c362479d609c3efd5e82b0f782 (diff)
downloadgeiser-guile-6381b39aab1cdbac16184a963d542acf33875753.tar.gz
geiser-guile-6381b39aab1cdbac16184a963d542acf33875753.tar.bz2
better indent , gsi opening param using module if > version 4.9.3
-rw-r--r--INSTALL2
-rw-r--r--elisp/geiser-gambit.el32
-rw-r--r--scheme/gambit/geiser/gambit.scm51
3 files changed, 34 insertions, 51 deletions
diff --git a/INSTALL b/INSTALL
index 404e8f9..104eb9c 100644
--- a/INSTALL
+++ b/INSTALL
@@ -68,7 +68,7 @@ package-install-file.
-Configure Gambit correctly to have access to the (##decompile method)
this is required for dynamic autodoc of users defined methods and ## starting methods
- $ cd ~/[YOUR GAMBIT FILES]
+ $ cd ~/[YOUR GAMBIT DIRECTORY]
$ ./configure --enable-single-host --enable-debug --enable-rtlib-debug-source
$ make bootstrap
$ make bootclean
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"))