From e48d59af292ca82e77733070cf3444ac2e0ba7df Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Tue, 10 Feb 2009 23:33:21 +0100 Subject: Guile scheme files moved to scheme/guile. --- elisp/geiser-eval.el | 5 ++- elisp/geiser-repl.el | 2 +- scheme/geiser/emacs.scm | 32 -------------- scheme/geiser/eval.scm | 65 ---------------------------- scheme/geiser/introspection.scm | 79 ----------------------------------- scheme/guile/geiser/emacs.scm | 37 ++++++++++++++++ scheme/guile/geiser/eval.scm | 69 ++++++++++++++++++++++++++++++ scheme/guile/geiser/introspection.scm | 79 +++++++++++++++++++++++++++++++++++ 8 files changed, 190 insertions(+), 178 deletions(-) delete mode 100644 scheme/geiser/emacs.scm delete mode 100644 scheme/geiser/eval.scm delete mode 100644 scheme/geiser/introspection.scm create mode 100644 scheme/guile/geiser/emacs.scm create mode 100644 scheme/guile/geiser/eval.scm create mode 100644 scheme/guile/geiser/introspection.scm diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 38b1f7f..7a729cf 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -39,7 +39,7 @@ ((eq code :t) "#t") ((listp code) (cond ((eq (car code) :gs) (geiser-eval--gs (cdr code))) - ((eq (car code) :ge) (format "(@ (geiser emacs) %s)" (cadr code))) + ((eq (car code) :ge) (geiser-eval--ge (cadr code))) ((eq (car code) :scm) (cadr code)) (t (concat "(" (mapconcat 'geiser-eval--scheme-str code " ") ")")))) ((symbolp code) (format "%s" code)) @@ -54,6 +54,9 @@ (geiser-syntax--buffer-module)) "))")) +(defsubst geiser-eval--ge (proc) + (format "(@ (geiser emacs) ge:%s)" proc)) + ;;; Code sending: diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 96743f4..fcc0daa 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -76,7 +76,7 @@ the Geiser REPL buffer." (current-buffer) guile nil - "-L" geiser-scheme-dir "-q") + "-L" (concat geiser-scheme-dir "/guile/") "-q") (geiser-repl--wait-for-prompt 10000) (geiser-con--setup-connection (current-buffer)))) diff --git a/scheme/geiser/emacs.scm b/scheme/geiser/emacs.scm deleted file mode 100644 index ea74220..0000000 --- a/scheme/geiser/emacs.scm +++ /dev/null @@ -1,32 +0,0 @@ -;; emacs.scm -- procedures for emacs interaction - -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz - -;; Author: Jose Antonio Ortega Ruiz -;; Start date: Sun Feb 08, 2009 18:39 - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3 of the License, or -;; (at your option) any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Comentary: - -;; Re-exports of procedures used by Emacs. - -;;; Code: - -(define-module (geiser emacs) - #:re-export (proc-args completions) - #:use-module (geiser introspection)) - - -;;; emacs.scm ends here diff --git a/scheme/geiser/eval.scm b/scheme/geiser/eval.scm deleted file mode 100644 index b7c5eef..0000000 --- a/scheme/geiser/eval.scm +++ /dev/null @@ -1,65 +0,0 @@ -;; eval.scm -- evaluation procedures - -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz - -;; Author: Jose Antonio Ortega Ruiz -;; Start date: Fri Feb 06, 2009 22:54 - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3 of the License, or -;; (at your option) any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Comentary: - -;; Module defining evaluation procedures called from the Emacs side. - -;;; Code: - -(define-module (geiser eval) - #:export (eval-in) - #:use-module (srfi srfi-1)) - -(define (eval-in form module-name) - "Evals FORM in the module designated by MODULE-NAME. -If MODULE-NAME is #f or resolution fails, the current module is used instead. -The result is a list of the form ((RESULT . ) (OUTPUT . )) -if no evaluation error happens, or ((ERROR (KEY . ) ...)) -in case of errors. Each error arg is a cons (NAME . VALUE), where NAME includes -SUBR, MSG and REST." - (let ((module (or (and module-name (resolve-module module-name)) - (current-module)))) - (catch #t - (lambda () - (let* ((result #f) - (output - (with-output-to-string - (lambda () - (save-module-excursion - (lambda () - (set-current-module module) - (set! result (compile form)))))))) - (list (cons 'result result) (cons 'output output)))) - (lambda (key . args) - (list (cons 'error (apply parse-error (cons key args)))))))) - -(define (parse-error key . args) - (let* ((len (length args)) - (subr (and (> len 0) (first args))) - (msg (and (> len 1) (second args))) - (margs (and (> len 2) (third args))) - (rest (and (> len 3) (fourth args)))) - (list (cons 'key key) - (cons 'subr (or subr '())) - (cons 'msg (if msg (apply format (cons #f (cons msg margs))) '())) - (cons 'rest (or rest '()))))) - -;;; eval.scm ends here diff --git a/scheme/geiser/introspection.scm b/scheme/geiser/introspection.scm deleted file mode 100644 index 4565464..0000000 --- a/scheme/geiser/introspection.scm +++ /dev/null @@ -1,79 +0,0 @@ -;; introspection.scm -- name says it all - -;; Copyright (C) 2009 Jose Antonio Ortega Ruiz - -;; Author: Jose Antonio Ortega Ruiz -;; Start date: Sun Feb 08, 2009 18:44 - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3 of the License, or -;; (at your option) any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Comentary: - -;; Procedures introspecting on scheme objects and their properties. - -;;; Code: - -(define-module (geiser introspection) - #:export (proc-args completions) - #:use-module (system vm program) - #:use-module (ice-9 session) - #:use-module (srfi srfi-1)) - -(define (proc-args proc) - (let ((proc (and (symbol? proc) - (module-bound? (current-module) proc) - (eval proc (current-module))))) - (cond ((not proc) #f) - ((program? proc) (program-args proc)) - ((procedure? proc) (procedure-args proc)) - ((macro? proc) (macro-args proc)) - (else #f)))) - -(define (program-args program) - (let* ((arity (program-arity program)) - (arg-no (first arity)) - (opt (> (second arity) 0)) - (args (map first (take (program-bindings program) arg-no)))) - (format-args (if opt (drop-right args 1) args) - (and opt (last args)) - (program-module program)))) - -(define (procedure-args proc) - (let* ((arity (procedure-property proc 'arity)) - (req (first arity)) - (opt (third arity)) - (env (procedure-environment proc))) - (format-args (map (lambda (n) - (string->symbol (format "arg~A" (+ 1 n)))) - (iota req)) - (and opt 'rest) - (and (not (null? env)) env)))) - -(define (macro-args macro) - (let ((prog (macro-transformer macro))) - (if prog - (program-args prog) - (format-args '(...) #f #f)))) - -(define (format-args args opt module) - (list (cons 'required args) - (cons 'optional (or opt '())) - (cons 'module (if module (module-name module) '())))) - -(define (completions prefix) - (sort! (map symbol->string - (apropos-internal (string-append "^" prefix))) - string +;; Start date: Sun Feb 08, 2009 18:39 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Comentary: + +;; Re-exports of procedures used by Emacs. + +;;; Code: + +(define-module (geiser emacs) + #:re-export (ge:proc-args + ge:completions + ge:compile-file) + #:use-module ((geiser introspection) + :renamer (symbol-prefix-proc 'ge:)) + #:use-module ((geiser eval) + :select ((comp-file . ge:compile-file)))) + + +;;; emacs.scm ends here diff --git a/scheme/guile/geiser/eval.scm b/scheme/guile/geiser/eval.scm new file mode 100644 index 0000000..7d82f7d --- /dev/null +++ b/scheme/guile/geiser/eval.scm @@ -0,0 +1,69 @@ +;; eval.scm -- evaluation procedures + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Fri Feb 06, 2009 22:54 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Comentary: + +;; Module defining evaluation procedures called from the Emacs side. + +;;; Code: + +(define-module (geiser eval) + #:export (eval-in comp-file) + #:use-module (srfi srfi-1)) + +(define (eval-in form module-name) + "Evals @var{form} in the module designated by @var{module-name}. +If @var{module-name} is @var{#f} or resolution fails, the current module is used instead. +The result is a list of the form ((RESULT . ) (OUTPUT . )) +if no evaluation error happens, or ((ERROR (KEY . ) ...)) +in case of errors. Each error arg is a cons (NAME . VALUE), where NAME includes +SUBR, MSG and REST." + (let ((module (or (and module-name (resolve-module module-name)) + (current-module)))) + (catch #t + (lambda () + (let* ((result #f) + (output + (with-output-to-string + (lambda () + (save-module-excursion + (lambda () + (set-current-module module) + (set! result (compile form)))))))) + (list (cons 'result result) (cons 'output output)))) + (lambda (key . args) + (list (cons 'error (apply parse-error (cons key args)))))))) + +(define (parse-error key . args) + (let* ((len (length args)) + (subr (and (> len 0) (first args))) + (msg (and (> len 1) (second args))) + (margs (and (> len 2) (third args))) + (rest (and (> len 3) (fourth args)))) + (list (cons 'key key) + (cons 'subr (or subr '())) + (cons 'msg (if msg (apply format (cons #f (cons msg margs))) '())) + (cons 'rest (or rest '()))))) + +(define (comp-file path) + "Compile and load file, given its full @var{path}." + (compile-file path)) + +;;; eval.scm ends here diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm new file mode 100644 index 0000000..4565464 --- /dev/null +++ b/scheme/guile/geiser/introspection.scm @@ -0,0 +1,79 @@ +;; introspection.scm -- name says it all + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Sun Feb 08, 2009 18:44 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Comentary: + +;; Procedures introspecting on scheme objects and their properties. + +;;; Code: + +(define-module (geiser introspection) + #:export (proc-args completions) + #:use-module (system vm program) + #:use-module (ice-9 session) + #:use-module (srfi srfi-1)) + +(define (proc-args proc) + (let ((proc (and (symbol? proc) + (module-bound? (current-module) proc) + (eval proc (current-module))))) + (cond ((not proc) #f) + ((program? proc) (program-args proc)) + ((procedure? proc) (procedure-args proc)) + ((macro? proc) (macro-args proc)) + (else #f)))) + +(define (program-args program) + (let* ((arity (program-arity program)) + (arg-no (first arity)) + (opt (> (second arity) 0)) + (args (map first (take (program-bindings program) arg-no)))) + (format-args (if opt (drop-right args 1) args) + (and opt (last args)) + (program-module program)))) + +(define (procedure-args proc) + (let* ((arity (procedure-property proc 'arity)) + (req (first arity)) + (opt (third arity)) + (env (procedure-environment proc))) + (format-args (map (lambda (n) + (string->symbol (format "arg~A" (+ 1 n)))) + (iota req)) + (and opt 'rest) + (and (not (null? env)) env)))) + +(define (macro-args macro) + (let ((prog (macro-transformer macro))) + (if prog + (program-args prog) + (format-args '(...) #f #f)))) + +(define (format-args args opt module) + (list (cons 'required args) + (cons 'optional (or opt '())) + (cons 'module (if module (module-name module) '())))) + +(define (completions prefix) + (sort! (map symbol->string + (apropos-internal (string-append "^" prefix))) + string