guile/guile-core/emacs ChangeLog guile-emacs.sc...

[Keisuke Nishida]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Keisuke Nishida <address@hidden>        01/05/06 14:35:14

Modified files:
        guile-core/emacs: ChangeLog guile-emacs.scm guile-scheme.el 
                          guile.el 

Log message:
        New commands: guile-scheme-apropos, guile-scheme-describe,
        guile-scheme-kill-process.
        
        Bug fixed for GNU Emacs 20.7.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/emacs/ChangeLog.diff?cvsroot=OldCVS&tr1=1.7&tr2=1.8&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/emacs/guile-emacs.scm.diff?cvsroot=OldCVS&tr1=1.5&tr2=1.6&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/emacs/guile-scheme.el.diff?cvsroot=OldCVS&tr1=1.1&tr2=1.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/emacs/guile.el.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text

Patches:
Index: guile/guile-core/emacs/ChangeLog
diff -u guile/guile-core/emacs/ChangeLog:1.7 
guile/guile-core/emacs/ChangeLog:1.8
--- guile/guile-core/emacs/ChangeLog:1.7        Wed Apr 25 05:15:24 2001
+++ guile/guile-core/emacs/ChangeLog    Sun May  6 14:35:14 2001
@@ -1,3 +1,24 @@
+2001-05-06  Keisuke Nishida  <address@hidden>
+
+       * 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  <address@hidden>
 
        * guile.el, guile-scheme.el, guile-emacs.scm: New files.
Index: guile/guile-core/emacs/guile-emacs.scm
diff -u guile/guile-core/emacs/guile-emacs.scm:1.5 
guile/guile-core/emacs/guile-emacs.scm:1.6
--- guile/guile-core/emacs/guile-emacs.scm:1.5  Wed Apr 25 22:19:29 2001
+++ guile/guile-core/emacs/guile-emacs.scm      Sun May  6 14:35:14 2001
@@ -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) (string<? (car p1) (car p2)))))
 
+
+;;;
+;;; for guile-scheme-apropos
+;;;
+
+(define (guile-emacs-apropos regexp)
+  (with-output-to-string (lambda () (apropos regexp))))
+
+
+;;;
+;;; for guile-scheme-describe
+;;;
+
+(define (guile-emacs-describe sym)
+  (object-documentation (eval sym (current-module))))
+
+
 ;;;
 ;;; Guile 1.4 compatibility
 ;;;
Index: guile/guile-core/emacs/guile-scheme.el
diff -u guile/guile-core/emacs/guile-scheme.el:1.1 
guile/guile-core/emacs/guile-scheme.el:1.2
--- guile/guile-core/emacs/guile-scheme.el:1.1  Wed Apr 25 05:15:24 2001
+++ guile/guile-core/emacs/guile-scheme.el      Sun May  6 14:35:14 2001
@@ -90,7 +90,10 @@
 (unless guile-scheme-mode-map
   (let ((map (make-sparse-keymap "Guile-Scheme")))
     (setq guile-scheme-mode-map map)
-    (set-keymap-parent map lisp-mode-shared-map)
+    (cond ((boundp 'lisp-mode-shared-map)
+          (set-keymap-parent map lisp-mode-shared-map))
+         ((boundp 'shared-lisp-mode-map)
+          (set-keymap-parent map shared-lisp-mode-map)))
     (define-key map [menu-bar] (make-sparse-keymap))
     (define-key map [menu-bar guile-scheme] (cons "Guile-Scheme" map))
     (define-key map [uncomment-region]
@@ -108,6 +111,7 @@
     (define-key map "\C-c:" 'guile-scheme-eval-expression)
     (define-key map "\C-c\C-a" 'guile-scheme-apropos)
     (define-key map "\C-c\C-d" 'guile-scheme-describe)
+    (define-key map "\C-c\C-k" 'guile-scheme-kill-process)
 
     (put 'comment-region 'menu-enable 'mark-active)
     (put 'uncomment-region 'menu-enable 'mark-active)
@@ -179,11 +183,13 @@
 
 (defvar guile-scheme-command "guile")
 (defvar guile-scheme-adapter nil)
+(defvar guile-scheme-module nil)
 
 (defun guile-scheme-adapter ()
   (if (and (processp guile-scheme-adapter)
           (eq (process-status guile-scheme-adapter) 'run))
       guile-scheme-adapter
+    (setq guile-scheme-module nil)
     (setq guile-scheme-adapter
          (guile:make-adapter guile-scheme-command 'emacs-scheme-channel))))
 
@@ -192,14 +198,15 @@
 If there is a (define-module ...) form, evaluate it.
 Otherwise, choose module (guile-user)."
   (save-excursion
-    (guile:eval
-     (if (re-search-backward "^(define-module " nil t)
-        (let ((start (match-beginning 0)))
-          (goto-char start)
-          (forward-sexp)
-          (buffer-substring-no-properties start (point)))
-       "(define-module (emacs-user))")
-     (guile-scheme-adapter))))
+    (let ((module (if (re-search-backward "^(define-module " nil t)
+                     (let ((start (match-beginning 0)))
+                       (goto-char start)
+                       (forward-sexp)
+                       (buffer-substring-no-properties start (point)))
+                   "(define-module (emacs-user))")))
+      (unless (string= guile-scheme-module module)
+       (prog1 (guile:eval module (guile-scheme-adapter))
+         (setq guile-scheme-module module))))))
 
 (defun guile-scheme-eval-string (string)
   (guile-scheme-set-module)
@@ -244,9 +251,10 @@
 (defun guile-scheme-eval-print-last-sexp ()
   "Evaluate sexp before point; print value into current buffer."
   (interactive)
-  (insert "\n")
-  (guile-scheme-eval-last-sexp t)
-  (insert "\n"))
+  (let ((start (point)))
+    (guile-scheme-eval-last-sexp t)
+    (insert "\n")
+    (save-excursion (goto-char start) (insert "\n"))))
 
 (defun guile-scheme-eval-define ()
   (interactive)
@@ -259,10 +267,10 @@
   (guile-scheme-eval-string (format "(load %s)" (expand-file-name file)))
   (message "done"))
 
+(guile-import guile-emacs-complete-alist)
+
 (defun guile-scheme-complete-symbol ()
   (interactive)
-  (unless (boundp 'guile-emacs-complete-alist)
-    (guile-import guile-emacs-complete-alist))
   (let* ((end (point))
         (start (save-excursion (skip-syntax-backward "w_") (point)))
         (pattern (buffer-substring-no-properties start end))
@@ -281,45 +289,49 @@
             (with-output-to-temp-buffer "*Completions*"
               (display-completion-list alist))
             (message "Making completion list...done"))))))
+
+(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))
 
-;; (define-command (guile-scheme-apropos regexp)
-;;   (interactive "sGuile-Scheme apropos (regexp): ")
-;;   (guile-scheme-set-module)
-;;   (let ((old #^guile-scheme-output-buffer))
-;;     (dynamic-wind
-;;     (lambda () (set! #^guile-scheme-output-buffer #f))
-;;     (lambda ()
-;;       (with-output-to-temp-buffer "*Help*"
-;;         (lambda ()
-;;           (apropos regexp))))
-;;     (lambda () (set! #^guile-scheme-output-buffer old)))))
-;; 
-;; (define (guile-scheme-input-symbol prompt)
-;;   (let* ((symbol (thing-at-point 'symbol))
-;;      (table (map (lambda (sym) (list (symbol->string 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)
-;;   )
+(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))))
 
 
 ;;;
Index: guile/guile-core/emacs/guile.el
diff -u guile/guile-core/emacs/guile.el:1.4 guile/guile-core/emacs/guile.el:1.5
--- guile/guile-core/emacs/guile.el:1.4 Fri May  4 13:59:16 2001
+++ guile/guile-core/emacs/guile.el     Sun May  6 14:35:14 2001
@@ -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-use-module (name)
+  `(guile-lisp-eval '(use-modules ,name)))
+
+;;;###autoload
 (defmacro guile-import-module (name &rest opts)
-  `(guile-process-use-module ',name ',opts))
+  `(guile-process-import-module ',name ',opts))
 
-(defun guile-process-use-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)))