From 1e74164f7fd9f208cc5db0987855110a1669f9bc Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 9 Feb 2009 23:33:24 +0100 Subject: TAB-completion for symbols in Scheme and REPL buffers. --- elisp/geiser-completion.el | 225 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 225 insertions(+) create mode 100644 elisp/geiser-completion.el (limited to 'elisp/geiser-completion.el') 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 +;; 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 . + +;;; 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 -- cgit v1.2.3