summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-09 23:33:24 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-09 23:33:24 +0100
commitc225b4606809739b6d408c915694841ca1aa45c0 (patch)
tree2d99a3510407553691ec6b70e976633067d003ff
parentcb1c7c38f4dbc5af1e4fed7cb9e01897a2cf458e (diff)
downloadgeiser-chez-c225b4606809739b6d408c915694841ca1aa45c0.tar.gz
geiser-chez-c225b4606809739b6d408c915694841ca1aa45c0.tar.bz2
TAB-completion for symbols in Scheme and REPL buffers.
-rw-r--r--elisp/geiser-completion.el225
-rw-r--r--elisp/geiser-mode.el2
-rw-r--r--elisp/geiser-repl.el3
-rw-r--r--scheme/geiser/emacs.scm2
-rw-r--r--scheme/geiser/introspection.scm6
5 files changed, 235 insertions, 3 deletions
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
new file mode 100644
index 0000000..8b58b2b
--- /dev/null
+++ b/elisp/geiser-completion.el
@@ -0,0 +1,225 @@
+;; geiser-completion.el -- tab completion
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Mon Feb 09, 2009 22:21
+
+;; This file 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This file 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Comentary:
+
+;; Utilities for completing symbol at point in Guile buffers.
+
+;;; Code:
+
+(require 'geiser-eval)
+(require 'geiser-log)
+(require 'geiser-base)
+
+
+;;; Minibuffer map:
+
+(defvar geiser-completion--minibuffer-map
+ (let ((map (make-keymap)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ (define-key map "?" 'self-insert-command)
+ map))
+
+
+;;; Modules dictionary:
+
+;; (defvar geiser-completion--modules nil)
+
+;; (defun geiser-completion--modules (&optional reload)
+;; (when (or reload (not geiser-completion--modules))
+;; (geiser--respecting-message "Retrieving modules list")
+;; (let ((geiser-log--inhibit-p t))
+;; (setq geiser-completion--modules
+;; (geiser-eval--retort-result
+;; (geiser-eval--send/wait '(:gs (:ge (module-list :t)))))))
+;; geiser-completion--modules)
+
+;; (defun geiser-completion--read-module (&optional reload init-input history)
+;; (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map)
+;; (modules (geiser-completion--modules reload)))
+;; (completing-read "Module name: " modules nil nil init-input history)))
+
+;; (defsubst geiser-completion--module-list (prefix)
+;; (geiser-eval--retort-result
+;; (geiser-eval--send/wait `(:gs (:ge (module-list ,prefix))))))
+
+;; (defvar geiser-completion--module-history nil)
+
+;; (defun geiser-completion--read-module (refresh)
+;; (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map)
+;; (modules (geiser-completion--modules refresh))
+;; (prompt "Module name: "))
+;; (if modules
+;; (completing-read prompt modules nil nil nil geiser-completion--module-history)
+;; (read-string prompt nil geiser-completion--module-history))))
+
+
+;;; Completions window handling, heavily inspired in slime's:
+
+(defvar geiser-completion--comp-buffer "*Completions*")
+
+(make-variable-buffer-local
+ (defvar geiser-completion--window-cfg nil
+ "Window configuration before we show the *Completions* buffer.
+This is buffer local in the buffer where the completion is
+performed."))
+
+(make-variable-buffer-local
+ (defvar geiser-completion--completions-window nil
+ "The window displaying *Completions* after saving window configuration.
+If this window is no longer active or displaying the completions
+buffer then we can ignore `geiser-completion--window-cfg'."))
+
+(defun geiser-completion--save-window-cfg ()
+ "Maybe save the current window configuration.
+Return true if the configuration was saved."
+ (unless (or geiser-completion--window-cfg
+ (get-buffer-window geiser-completion--comp-buffer))
+ (setq geiser-completion--window-cfg
+ (current-window-configuration))
+ t))
+
+(defun geiser-completion--delay-restoration ()
+ (add-hook 'pre-command-hook
+ 'geiser-completion--maybe-restore-window-cfg
+ nil t))
+
+(defun geiser-completion--forget-window-cfg ()
+ (setq geiser-completion--window-cfg nil)
+ (setq geiser-completion--completions-window nil))
+
+(defun geiser-completion--restore-window-cfg ()
+ "Restore the window config if available."
+ (remove-hook 'pre-command-hook
+ 'geiser-completion--maybe-restore-window-cfg)
+ (when (and geiser-completion--window-cfg
+ (geiser-completion--window-active-p))
+ (save-excursion
+ (set-window-configuration geiser-completion--window-cfg))
+ (setq geiser-completion--window-cfg nil)
+ (when (buffer-live-p geiser-completion--comp-buffer)
+ (kill-buffer geiser-completion--comp-buffer))))
+
+(defun geiser-completion--maybe-restore-window-cfg ()
+ "Restore the window configuration, if the following command
+terminates a current completion."
+ (remove-hook 'pre-command-hook
+ 'geiser-completion--maybe-restore-window-cfg)
+ (condition-case err
+ (cond ((find last-command-char "()\"'`,# \r\n:")
+ (geiser-completion--restore-window-cfg))
+ ((not (geiser-completion--window-active-p))
+ (geiser-completion--forget-window-cfg))
+ (t (geiser-completion--delay-restoration)))
+ (error
+ ;; Because this is called on the pre-command-hook, we mustn't let
+ ;; errors propagate.
+ (message "Error in geiser-completion--restore-window-cfg: %S" err))))
+
+(defun geiser-completion--window-active-p ()
+ "Is the completion window currently active?"
+ (and (window-live-p geiser-completion--completions-window)
+ (equal (buffer-name (window-buffer geiser-completion--completions-window))
+ geiser-completion--comp-buffer)))
+
+(defun geiser-completion--display-comp-list (completions base)
+ (let ((savedp (geiser-completion--save-window-cfg)))
+ (with-output-to-temp-buffer geiser-completion--comp-buffer
+ (display-completion-list completions base)
+ (let ((offset (- (point) 1 (length base))))
+ (with-current-buffer standard-output
+ (setq completion-base-size offset)
+ (set-syntax-table scheme-mode-syntax-table))))
+ (when savedp
+ (setq geiser-completion--completions-window
+ (get-buffer-window geiser-completion--comp-buffer)))))
+
+(defun geiser-completion--display-or-scroll (completions base)
+ (cond ((and (eq last-command this-command) (geiser-completion--window-active-p))
+ (geiser-completion--scroll-completions))
+ (t (geiser-completion--display-comp-list completions base)))
+ (geiser-completion--delay-restoration))
+
+(defun geiser-completion--scroll-completions ()
+ (let ((window geiser-completion--completions-window))
+ (with-current-buffer (window-buffer window)
+ (if (pos-visible-in-window-p (point-max) window)
+ (set-window-start window (point-min))
+ (save-selected-window
+ (select-window window)
+ (scroll-up))))))
+
+
+;;; Completion functionality:
+
+(defun geiser-completion--symbol-list (prefix)
+ (geiser-eval--retort-result
+ (geiser-eval--send/wait `(:gs ((:ge completions) ,prefix)))))
+
+(defvar geiser-completion--symbol-list-func
+ (completion-table-dynamic 'geiser-completion--symbol-list))
+
+(defun geiser-completion--complete (prefix modules)
+ (let* ((symbols (if modules nil ;; (geiser-completion--modules)
+ (geiser-completion--symbol-list prefix)))
+ (completions (all-completions prefix symbols))
+ (partial (try-completion prefix symbols))
+ (partial (if (eq partial t) prefix partial)))
+ (cons completions partial)))
+
+(defun geiser-completion--read-symbol (prompt &optional default history)
+ (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map))
+ (completing-read prompt
+ geiser-completion--symbol-list-func
+ nil nil nil
+ history
+ (or default (symbol-at-point)))))
+
+(defun geiser--respecting-message (format &rest format-args)
+ "Display TEXT as a message, without hiding any minibuffer contents."
+ (let ((text (format " [%s]" (apply #'format format format-args))))
+ (if (minibuffer-window-active-p (minibuffer-window))
+ (minibuffer-message text)
+ (message "%s" text))))
+
+(defun geiser-completion--complete-symbol ()
+ "Complete the symbol at point.
+Perform completion similar to Emacs' complete-symbol."
+ (interactive)
+ (let* ((end (point))
+ (beg (save-excursion (beginning-of-sexp) (point)))
+ (prefix (buffer-substring-no-properties beg end))
+ (result (geiser-completion--complete prefix nil))
+ (completions (car result))
+ (partial (cdr result)))
+ (cond ((null completions)
+ (geiser--respecting-message "Can't find completion for %S" prefix)
+ (geiser-completion--restore-window-cfg))
+ (t (insert-and-inherit (substring partial (length prefix)))
+ (cond ((= (length completions) 1)
+ (geiser--respecting-message "Sole completion")
+ (geiser-completion--restore-window-cfg))
+ (t (geiser--respecting-message "Complete but not unique")
+ (geiser-completion--display-or-scroll completions
+ partial)))))))
+
+
+(provide 'geiser-completion)
+;;; geiser-completion.el ends here
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index 2b6778b..b5abfca 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -25,6 +25,7 @@
;;; Code:
+(require 'geiser-completion)
(require 'geiser-autodoc)
(require 'geiser-eval)
(require 'geiser-popup)
@@ -135,6 +136,7 @@ interacting with the Geiser REPL is at your disposal.
;;; Keys:
+(define-key geiser-mode-map (kbd "M-TAB") 'geiser-completion--complete-symbol)
(define-key geiser-mode-map "\M-\C-x" 'geiser-send-definition)
(define-key geiser-mode-map "\C-c\C-a" 'geiser-autodoc-mode)
(define-key geiser-mode-map "\C-x\C-e" 'geiser-send-last-sexp)
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index e39284b..96743f4 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -147,11 +147,12 @@ the Geiser REPL buffer."
(define-key geiser-repl-mode-map "\C-c\M-p" 'comint-previous-input)
(define-key geiser-repl-mode-map "\C-c\M-n" 'comint-next-input))
+(define-key geiser-repl-mode-map (kbd "TAB") 'geiser-completion--complete-symbol)
+
;; (define-key geiser-repl-mode-map "\C-ch" 'geiser-help)
;; (define-key geiser-repl-mode-map "\C-cp" 'geiser-apropos)
;; (define-key geiser-repl-mode-map "\M-." 'geiser-edit-word-at-point)
;; (define-key geiser-repl-mode-map "\C-ck" 'geiser-compile-file)
-;; (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-completion--complete-symbol)
(provide 'geiser-repl)
diff --git a/scheme/geiser/emacs.scm b/scheme/geiser/emacs.scm
index 014c44a..ea74220 100644
--- a/scheme/geiser/emacs.scm
+++ b/scheme/geiser/emacs.scm
@@ -25,7 +25,7 @@
;;; Code:
(define-module (geiser emacs)
- #:re-export (proc-args var-metadata)
+ #:re-export (proc-args completions)
#:use-module (geiser introspection))
diff --git a/scheme/geiser/introspection.scm b/scheme/geiser/introspection.scm
index 0c759d5..ffa2c73 100644
--- a/scheme/geiser/introspection.scm
+++ b/scheme/geiser/introspection.scm
@@ -25,8 +25,9 @@
;;; Code:
(define-module (geiser introspection)
- #:export (proc-args var-metadata)
+ #:export (proc-args completions)
#:use-module (system vm program)
+ #:use-module (ice-9 session)
#:use-module (srfi srfi-1))
(define (proc-args proc)
@@ -62,4 +63,7 @@
(list (cons 'required args)
(cons 'optional (or opt '()))))
+(define (completions prefix)
+ (map symbol->string (apropos-internal (string-append "^" prefix))))
+
;;; introspection.scm ends here