*** empty log message ***

emacs/guile-emacs.scm

@@ -58,7 +58,7 @@
 ;;; for guile-import and guile-use-modules
 ;;;
 
-(define (guile-emacs-export-procedure proc)
+(define (guile-emacs-export-procedure name proc docs)
   (define (procedure-arity proc)
     (assq-ref (procedure-properties proc) 'arity))
 
@@ -84,32 +84,29 @@
 
   (define (procedure-call name args)
     (let ((restp (memq '&rest args))
-	  (args (map (lambda (a) `(let ((_t ,a))
+	  (args (delq '&rest (delq '&optional args))))
-				    (if (guile-tokenp _t)
-				      (cadr _t)
-				      (list 'quote _t))))
-		     (delq '&rest (delq '&optional args)))))
       (if restp
-	`(list 'apply ',name ,@args)
+	`('apply ',name ,@args)
-	`(list ',name ,@args))))
+	`(',name ,@args))))
 
-  (let ((name (procedure-name proc))
+  (let ((args (procedure-args proc))
-	(args (procedure-args proc))
+	(docs (and docs (object-documentation proc))))
-	(docs (object-documentation proc)))
     `(defun ,name ,args
        ,@(if docs (list docs) '())
-       (guile-lisp-eval ,(procedure-call name args)))))
+       (guile-lisp-flat-eval ,@(procedure-call name args)))))
 
-(define (guile-emacs-export proc-name)
+(define (guile-emacs-export proc-name func-name docs)
-  (guile-emacs-export-procedure (module-ref (current-module) proc-name)))
+  (let ((proc (module-ref (current-module) proc-name)))
+    (guile-emacs-export-procedure func-name proc docs)))
 
-(define (guile-emacs-export-procedures module-name)
+(define (guile-emacs-export-procedures module-name docs)
   (define (module-public-procedures name)
     (hash-fold (lambda (s v d)
 		 (let ((val (variable-ref v)))
-		   (if (procedure? val) (cons val d) d)))
+		   (if (procedure? val) (acons s val d) d)))
 	       '() (module-obarray (resolve-interface name))))
-  `(progn ,@(map guile-emacs-export-procedure
+  `(progn ,@(map (lambda (n+p)
+		   (guile-emacs-export-procedure (car n+p) (cdr n+p) docs))
 		 (module-public-procedures module-name))))
 
 

emacs/guile.el

@@ -31,10 +31,22 @@
 	  load-path)
     (error "Cannot find guile-emacs.scm")))
 
+(defvar gulie-channel-file
+  (catch 'return
+    (mapc (lambda (dir)
+	    (let ((file (expand-file-name "channel.scm" dir)))
+	      (if (file-exists-p file) (throw 'return file))))
+	  load-path)))
+
+(defvar guile-libs
+  (nconc (if gulie-channel-file (list "-l" gulie-channel-file) '())
+	 (list "-l" gulie-emacs-file)))
+
+;;;###autoload
 (defun guile:make-adapter (command channel)
   (let* ((buff (generate-new-buffer " *guile object channel*"))
-	 (proc (start-process "guile-oa" buff command
+	 (libs (if gulie-channel-file (list "-l" gulie-channel-file) nil))
-			      "-q" "-l" gulie-emacs-file)))
+	 (proc (apply 'start-process "guile-oa" buff command "-q" guile-libs)))
     (process-kill-without-query proc)
     (accept-process-output proc)
     (guile-process-require proc (format "(%s)\n" channel) "channel> ")
@@ -47,6 +59,7 @@
 
 (defun guile-tokenp (x) (and (consp x) (eq (car x) guile-token-tag)))
 
+;;;###autoload
 (defun guile:eval (string adapter)
   (let ((output (guile-process-require adapter (concat "eval " string "\n")
 				       "channel> ")))
@@ -91,6 +104,7 @@
   (cond
    ((or (eq x true) (eq x false)) x)
    ((null x) "'()")
+   ((keywordp x) (concat "#" (prin1-to-string x)))
    ((stringp x) (prin1-to-string x))
    ((guile-tokenp x) (cadr x))
    ((consp x)
@@ -99,25 +113,36 @@
       (cons (guile-lisp-convert (car x)) (guile-lisp-convert (cdr x)))))
    (t x)))
 
-(defun guile-lisp-eval (exp)
+;;;###autoload
-  (guile:eval (format "%s" (guile-lisp-convert exp)) (guile-lisp-adapter)))
+(defun guile-lisp-eval (form)
+  (guile:eval (format "%s" (guile-lisp-convert form)) (guile-lisp-adapter)))
+
+(defun guile-lisp-flat-eval (&rest form)
+  (let ((args (mapcar (lambda (x)
+			(if (guile-tokenp x) (cadr x) (list 'quote x)))
+		      (cdr form))))
+    (guile-lisp-eval (cons (car form) args))))
 
 ;;;###autoload
-(defmacro guile-import (name)
+(defmacro guile-import (name &optional new-name &rest opts)
-  `(guile-process-import ',name))
+  `(guile-process-import ',name ',new-name ',opts))
 
-(defun guile-process-import (name)
+(defun guile-process-import (name new-name opts)
-  (eval (guile-lisp-eval `(guile-emacs-export ',name))))
+  (let ((real (or new-name name))
+	(docs (if (memq :with-docs opts) true false)))
+    (eval (guile-lisp-eval `(guile-emacs-export ',name ',real ,docs)))))
 
 ;;;###autoload
-(defmacro guile-use-modules (&rest name-list)
+(defmacro guile-import-module (name &rest opts)
-  `(guile-process-use-modules ',name-list))
+  `(guile-process-use-module ',name ',opts))
 
-(defun guile-process-use-modules (list)
+(defun guile-process-use-module (name opts)
   (unless (boundp 'guile-emacs-export-procedures)
     (guile-import guile-emacs-export-procedures))
-  (guile-lisp-eval `(use-modules ,@list))
+  (let ((docs (if (memq :with-docs opts) true false)))
-  (mapc (lambda (name) (eval (guile-emacs-export-procedures name))) list))
+    (guile-lisp-eval `(use-modules ,name))
+    (eval (guile-emacs-export-procedures name docs))
+    name))
 
 
 ;;;