;;; 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))
(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))))
\f
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> ")
(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> ")))
(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)
(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))
\f
;;;