;;; guile-scheme.el --- Guile Scheme editing mode
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
;;; Commentary:
(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]
(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)
(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))))
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)
(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)
(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))
(display-completion-list alist))
(message "Making completion list...done"))))))
-;; (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)
-;; )
+(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))
+
+\f
+;;;
+;;; 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))))
\f
;;;
HCoop / bpt / guile.git / blobdiff