diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 025a0cd53..2b02bf87f 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,24 @@ +2001-05-06 Keisuke Nishida + + * guile.el (guile:eval): Propagate user interrupt. + (keywordp): Define it if not defined yet. + (guile-use-module): New macro. + (guile-process-import-module): Renamed from guile-process-use-module. + + * guile-emacs.scm (guile-emacs-apropos, guile-emacs-describe): + New procedures. + + * guile-scheme.el (guile-scheme-mode-map): Use + `shared-lisp-mode-map' as the parent keymap if + `lisp-mode-shared-map' is not defined. + (guile-scheme-module): New variable. + (guile-scheme-set-module): Set module only when necessary. + (guile-scheme-eval-print-last-sexp): Insert newline after eval. + (guile-scheme-complete-table): New variable. + (guile-scheme-input-symbol): New function. + (guile-scheme-apropos, guile-scheme-describe, + guile-scheme-kill-process): New commands. + 2001-04-25 Keisuke Nishida * guile.el, guile-scheme.el, guile-emacs.scm: New files. diff --git a/emacs/guile-emacs.scm b/emacs/guile-emacs.scm index 995d0d6eb..78b897e31 100644 --- a/emacs/guile-emacs.scm +++ b/emacs/guile-emacs.scm @@ -55,7 +55,7 @@ ;;; -;;; for guile-import and guile-use-modules +;;; for guile-import and guile-import-module ;;; (define (guile-emacs-export-procedure name proc docs) @@ -111,7 +111,7 @@ ;;; -;;; for guile-emacs-complete-symbol +;;; for guile-scheme-complete-symbol ;;; (define (guile-emacs-complete-alist str) @@ -125,6 +125,23 @@ apropos-fold-all) (lambda (p1 p2) (stringstring sym))) -;; (apropos-list ""))) -;; (default (if (assoc symbol table) -;; (string-append " (default " symbol ")") -;; ""))) -;; (string->symbol (completing-read (string-append prompt default ": ") -;; table #f #t #f #f symbol)))) -;; -;; (define-command (guile-scheme-describe symbol) -;; "Display the value and documentation of SYMBOL." -;; (interactive (list (guile-scheme-input-symbol "Describe Guile-Scheme variable"))) -;; (guile-scheme-set-module) -;; (let ((old #^guile-scheme-output-buffer)) -;; (dynamic-wind -;; (lambda () (set! #^guile-scheme-output-buffer #f)) -;; (lambda () -;; (begin-with-output-to-temp-buffer "*Help*" -;; (describe symbol))) -;; (lambda () (set! #^guile-scheme-output-buffer old))))) -;; -;; (define-command (guile-scheme-find-definition symbol) -;; (interactive (list (guile-scheme-input-symbol "Guile-Scheme find definition"))) -;; (guile-scheme-set-module) -;; ) +(guile-import guile-emacs-apropos) + +(defun guile-scheme-apropos (regexp) + (interactive "sGuile Scheme apropos (regexp): ") + (guile-scheme-set-module) + (with-output-to-temp-buffer "*Help*" + (princ (guile-emacs-apropos regexp)))) + +(guile-import guile-emacs-describe) + +(defun guile-scheme-describe (symbol) + (interactive (list (guile-scheme-input-symbol "Describe Guile variable"))) + (guile-scheme-set-module) + (with-output-to-temp-buffer "*Help*" + (princ (guile-emacs-describe symbol)))) + +(defun guile-scheme-kill-process () + (interactive) + (if guile-scheme-adapter + (guile-process-kill guile-scheme-adapter)) + (setq guile-scheme-adapter nil)) + + +;;; +;;; Internal functions +;;; + +(guile-import apropos-internal guile-apropos-internal) + +(defvar guile-scheme-complete-table (make-vector 151 nil)) + +(defun guile-scheme-input-symbol (prompt) + (mapc (lambda (sym) + (if (symbolp sym) + (intern (symbol-name sym) guile-scheme-complete-table))) + (guile-apropos-internal "")) + (let* ((str (thing-at-point 'symbol)) + (default (if (intern-soft str guile-scheme-complete-table) + (concat " (default " str ")") + ""))) + (intern (completing-read (concat prompt default ": ") + guile-scheme-complete-table nil t nil nil str)))) ;;; diff --git a/emacs/guile.el b/emacs/guile.el index 3bf1463ab..efd91fd69 100644 --- a/emacs/guile.el +++ b/emacs/guile.el @@ -63,26 +63,30 @@ ;;;###autoload (defun guile:eval (string adapter) - (let ((output (guile-process-require adapter (concat "eval " string "\n") - "channel> "))) - (cond - ((string= output "") nil) - ((string-match "^\\(\\(value\\)\\|\\(token\\)\\|\\(exception\\)\\) = " - output) - (cond - ;; value - ((match-beginning 2) - (car (read-from-string (substring output (match-end 0))))) - ;; token - ((match-beginning 3) - (cons guile-token-tag - (car (read-from-string (substring output (match-end 0)))))) - ;; exception - ((match-beginning 4) - (signal 'guile-error - (car (read-from-string (substring output (match-end 0)))))))) - (t - (error "Unsupported result" output))))) + (condition-case error + (let ((output (guile-process-require adapter (concat "eval " string "\n") + "channel> "))) + (cond + ((string= output "") nil) + ((string-match "^\\(\\(value\\)\\|\\(token\\)\\|\\(exception\\)\\) = " + output) + (cond + ;; value + ((match-beginning 2) + (car (read-from-string (substring output (match-end 0))))) + ;; token + ((match-beginning 3) + (cons guile-token-tag + (car (read-from-string (substring output (match-end 0)))))) + ;; exception + ((match-beginning 4) + (signal 'guile-error + (car (read-from-string (substring output (match-end 0)))))))) + (t + (error "Unsupported result" output)))) + (quit + (signal-process (process-id adapter) 'SIGINT) + (signal 'quit nil)))) ;;; @@ -95,6 +99,9 @@ (defvar true "#t") (defvar false "#f") +(unless (boundp 'keywordp) + (defun keywordp (x) (and (symbolp x) (eq (aref (symbol-name x) 0) ?:)))) + (defun guile-lisp-adapter () (if (and (processp guile-lisp-adapter) (eq (process-status guile-lisp-adapter) 'run)) @@ -135,10 +142,14 @@ (eval (guile-lisp-eval `(guile-emacs-export ',name ',real ,docs))))) ;;;###autoload -(defmacro guile-import-module (name &rest opts) - `(guile-process-use-module ',name ',opts)) +(defmacro guile-use-module (name) + `(guile-lisp-eval '(use-modules ,name))) -(defun guile-process-use-module (name opts) +;;;###autoload +(defmacro guile-import-module (name &rest opts) + `(guile-process-import-module ',name ',opts)) + +(defun guile-process-import-module (name opts) (unless (boundp 'guile-emacs-export-procedures) (guile-import guile-emacs-export-procedures)) (let ((docs (if (memq :with-docs opts) true false)))