From 4e7c148fef58281345c1d4d0815732e27977da71 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Mon, 9 Feb 2009 01:29:26 +0100
Subject: Basic region/definition/sexp evaluation and autodoc mode working.

---
 scheme/geiser/emacs.scm         | 32 ++++++++++++++++++++
 scheme/geiser/eval.scm          | 16 +++++-----
 scheme/geiser/introspection.scm | 65 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 106 insertions(+), 7 deletions(-)
 create mode 100644 scheme/geiser/emacs.scm
 create mode 100644 scheme/geiser/introspection.scm

(limited to 'scheme')

diff --git a/scheme/geiser/emacs.scm b/scheme/geiser/emacs.scm
new file mode 100644
index 0000000..014c44a
--- /dev/null
+++ b/scheme/geiser/emacs.scm
@@ -0,0 +1,32 @@
+;; emacs.scm -- procedures for emacs interaction
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Comentary:
+
+;; Re-exports of procedures used by Emacs.
+
+;;; Code:
+
+(define-module (geiser emacs)
+  #:re-export (proc-args var-metadata)
+  #:use-module (geiser introspection))
+
+
+;;; emacs.scm ends here
diff --git a/scheme/geiser/eval.scm b/scheme/geiser/eval.scm
index 450221a..e6fa0cf 100644
--- a/scheme/geiser/eval.scm
+++ b/scheme/geiser/eval.scm
@@ -38,13 +38,13 @@ 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 () (set! result (eval form module))))))
-               (list (cons 'result result) (cons 'output output))))
-           (lambda (key . args)
-             (list (cons 'error (apply parse-error (cons key args))))))))
+      (lambda ()
+        (let* ((result #f)
+               (output (with-output-to-string
+                         (lambda () (set! result (compile form module))))))
+          (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))
@@ -57,4 +57,6 @@ SUBR, MSG and REST."
           (cons 'msg (if msg (apply format (cons #f (cons msg margs))) '()))
           (cons 'rest (or rest '())))))
 
+(define (test-geiser) 4)
+
 ;;; eval.scm ends here
diff --git a/scheme/geiser/introspection.scm b/scheme/geiser/introspection.scm
new file mode 100644
index 0000000..eff9573
--- /dev/null
+++ b/scheme/geiser/introspection.scm
@@ -0,0 +1,65 @@
+;; introspection.scm -- name says it all
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Comentary:
+
+;; Procedures introspecting on scheme objects and their properties.
+
+;;; Code:
+
+(define-module (geiser introspection)
+  #:export (proc-args var-metadata)
+  #:use-module (system vm program)
+  #: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)))))
+
+(define (procedure-args proc)
+  (let* ((arity (procedure-property proc 'arity))
+         (req (first arity))
+         (opt (third arity)))
+    (format-args (map (lambda (n)
+                        (string->symbol (format "arg~A" n)))
+                      (iota req))
+                 (and opt 'rest))))
+
+(define (macro-args macro)
+  (format-args '(...) #f))
+
+(define (format-args args opt)
+  (list (cons 'required args)
+        (cons 'optional (or opt '()))))
+
+;;; introspection.scm ends here
-- 
cgit v1.2.3