diff options
| -rw-r--r-- | elisp/geiser-completion.el | 225 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 2 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 3 |
3 files changed, 229 insertions, 1 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) |