diff options
author | mathieu2em <math.per@hotmail.com> | 2019-07-31 13:18:28 -0400 |
---|---|---|
committer | mathieu2em <math.per@hotmail.com> | 2019-08-20 15:31:38 -0400 |
commit | 6381b39aab1cdbac16184a963d542acf33875753 (patch) | |
tree | 662b7d99307399544f4c8bf49937d563b6fcbb45 | |
parent | 47e462db1a8875c362479d609c3efd5e82b0f782 (diff) | |
download | geiser-guile-6381b39aab1cdbac16184a963d542acf33875753.tar.gz geiser-guile-6381b39aab1cdbac16184a963d542acf33875753.tar.bz2 |
better indent , gsi opening param using module if > version 4.9.3
-rw-r--r-- | INSTALL | 2 | ||||
-rw-r--r-- | elisp/geiser-gambit.el | 32 | ||||
-rw-r--r-- | scheme/gambit/geiser/gambit.scm | 51 |
3 files changed, 34 insertions, 51 deletions
@@ -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")) |