diff --git a/emacs/guile-emacs.scm b/emacs/guile-emacs.scm index 08e56500e..fa61ddbf2 100644 --- a/emacs/guile-emacs.scm +++ b/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)) - (if (guile-tokenp _t) - (cadr _t) - (list 'quote _t)))) - (delq '&rest (delq '&optional args))))) + (args (delq '&rest (delq '&optional args)))) (if restp - `(list 'apply ',name ,@args) - `(list ',name ,@args)))) + `('apply ',name ,@args) + `(',name ,@args)))) - (let ((name (procedure-name proc)) - (args (procedure-args proc)) - (docs (object-documentation proc))) + (let ((args (procedure-args proc)) + (docs (and 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) - (guile-emacs-export-procedure (module-ref (current-module) proc-name))) +(define (guile-emacs-export proc-name func-name docs) + (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)))) diff --git a/emacs/guile.el b/emacs/guile.el index 267613440..743c10cd8 100644 --- a/emacs/guile.el +++ b/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 - "-q" "-l" gulie-emacs-file))) + (libs (if gulie-channel-file (list "-l" gulie-channel-file) nil)) + (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) - (guile:eval (format "%s" (guile-lisp-convert exp)) (guile-lisp-adapter))) +;;;###autoload +(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) - `(guile-process-import ',name)) +(defmacro guile-import (name &optional new-name &rest opts) + `(guile-process-import ',name ',new-name ',opts)) -(defun guile-process-import (name) - (eval (guile-lisp-eval `(guile-emacs-export ',name)))) +(defun guile-process-import (name new-name opts) + (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) - `(guile-process-use-modules ',name-list)) +(defmacro guile-import-module (name &rest opts) + `(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)) - (mapc (lambda (name) (eval (guile-emacs-export-procedures name))) list)) + (let ((docs (if (memq :with-docs opts) true false))) + (guile-lisp-eval `(use-modules ,name)) + (eval (guile-emacs-export-procedures name docs)) + name)) ;;;