elisp/geiser-completion.el

   1 ;;; geiser-completion.el -- tab completion
   2
   3 ;; Copyright (C) 2009, 2010, 2011, 2012, 2018 Jose Antonio Ortega Ruiz
   4
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the Modified BSD License. You should
   7 ;; have received a copy of the license along with this program. If
   8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
   9
  10 ;; Start date: Mon Feb 09, 2009 22:21
  11
  12 \f
  13
  14 (require 'geiser-impl)
  15 (require 'geiser-eval)
  16 (require 'geiser-log)
  17 (require 'geiser-syntax)
  18 (require 'geiser-base)
  19
  20 (require 'comint)
  21 (require 'minibuffer)
  22
  23 \f
  24 ;;; Minibuffer maps:
  25
  26 (defvar geiser-completion--minibuffer-map
  27   (let ((map (make-keymap)))
  28     (set-keymap-parent map minibuffer-local-completion-map)
  29     (define-key map "?" 'self-insert-command)
  30     map))
  31
  32 (defvar geiser-completion--module-minibuffer-map
  33   (let ((map (make-keymap)))
  34     (set-keymap-parent map minibuffer-local-completion-map)
  35     (define-key map " " 'self-insert-command)
  36     (define-key map "?" 'self-insert-command)
  37     map))
  38
  39 \f
  40 ;;; Completion functionality:
  41
  42 (defvar geiser-completion--binding-forms nil)
  43 (geiser-impl--register-local-variable
  44  'geiser-completion--binding-forms 'binding-forms nil
  45  "A list of forms introducing local bindings, a la let or lambda.")
  46
  47 (defvar geiser-completion--binding-forms* nil)
  48 (geiser-impl--register-local-variable
  49  'geiser-completion--binding-forms* 'binding-forms* nil
  50  "A list of forms introducing nested local bindings, a la let*.")
  51
  52 (defsubst geiser-completion--locals ()
  53   (geiser-syntax--locals-around-point geiser-completion--binding-forms
  54                                       geiser-completion--binding-forms*))
  55
  56 (defun geiser-completion--symbol-list (prefix)
  57   (geiser--del-dups
  58    (append (all-completions prefix (geiser-completion--locals))
  59            (geiser-eval--send/result `(:eval (:ge completions ,prefix))))))
  60
  61 (defsubst geiser-completion--module-list (prefix)
  62   (geiser-eval--send/result `(:eval (:ge module-completions ,prefix))))
  63
  64 (defvar geiser-completion--symbol-list-func
  65   (if (< emacs-major-version 25)
  66       (completion-table-dynamic 'geiser-completion--symbol-list)
  67     (completion-table-dynamic 'geiser-completion--symbol-list t)))
  68
  69 (defvar geiser-completion--module-list-func
  70   (if (< emacs-major-version 25)
  71       (completion-table-dynamic 'geiser-completion--module-list)
  72     (completion-table-dynamic 'geiser-completion--module-list t)))
  73
  74 (defun geiser-completion--complete (prefix modules)
  75   (if modules (geiser-completion--module-list prefix)
  76     (geiser-completion--symbol-list prefix)))
  77
  78 (defvar geiser-completion--symbol-history nil)
  79
  80 (defun geiser-completion--read-symbol (prompt &optional default history)
  81   (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map))
  82     (make-symbol (completing-read prompt
  83                                   geiser-completion--symbol-list-func
  84                                   nil nil nil
  85                                   (or history
  86                                       geiser-completion--symbol-history)
  87                                   (or default (geiser--symbol-at-point))))))
  88
  89 (defvar geiser-completion--module-history nil)
  90
  91 (defun geiser-completion--read-module (&optional prompt default history)
  92   (let ((minibuffer-local-completion-map
  93          geiser-completion--module-minibuffer-map))
  94     (completing-read (or prompt "Module name: ")
  95                      geiser-completion--module-list-func
  96                      nil nil nil
  97                      (or history geiser-completion--module-history)
  98                      default)))
  99
 100 (defvar geiser-completion--symbol-begin-function nil)
 101
 102 (defun geiser-completion--def-symbol-begin (module)
 103   (save-excursion (skip-syntax-backward "^-()>") (point)))
 104
 105 (geiser-impl--register-local-method
 106  'geiser-completion--symbol-begin-function 'find-symbol-begin
 107  'geiser-completion--def-symbol-begin
 108  "An optional function finding the position of the beginning of
 109 the identifier around point. Takes a boolean, indicating whether
 110 we're looking for a module name.")
 111
 112 (defun geiser-completion--symbol-begin (module)
 113   (funcall geiser-completion--symbol-begin-function module))
 114
 115 (defun geiser-completion--module-at-point ()
 116   (save-excursion
 117     (goto-char (geiser-completion--symbol-begin t))
 118     (ignore-errors (thing-at-point 'sexp))))
 119
 120 (defsubst geiser-completion--prefix (module)
 121   (buffer-substring-no-properties (geiser-completion--symbol-begin module)
 122                                   (point)))
 123
 124 (defsubst geiser-completion--prefix-end (beg mod)
 125   (unless (or (eq beg (point-max))
 126               (member (char-syntax (char-after beg))
 127                       (if mod '(?\" ?\)) '(?\" ?\( ?\)))))
 128     (let ((pos (point)))
 129       (condition-case nil
 130           (save-excursion
 131             (goto-char beg)
 132             (forward-sexp 1)
 133             (when (>= (point) pos)
 134               (point)))
 135         (scan-error pos)))))
 136
 137 (defun geiser-completion--thing-at-point (module &optional predicate)
 138   (with-syntax-table scheme-mode-syntax-table
 139     (let* ((beg (geiser-completion--symbol-begin module))
 140            (end (or (geiser-completion--prefix-end beg module) beg))
 141            (prefix (and (> end beg) (buffer-substring-no-properties beg end)))
 142            (prefix (and prefix
 143                         (if (string-match "\\([^-]+\\)-" prefix)
 144                             (match-string 1 prefix)
 145                           prefix)))
 146            (cmps (and prefix (geiser-completion--complete prefix module))))
 147       (and cmps (list beg end cmps)))))
 148
 149 (defun geiser-completion--for-symbol (&optional predicate)
 150   (geiser-completion--thing-at-point nil predicate))
 151
 152 (defun geiser-completion--for-module (&optional predicate)
 153   (geiser-completion--thing-at-point t predicate))
 154
 155 (defun geiser-completion--for-filename ()
 156   (when (geiser-syntax--in-string-p)
 157     (let ((comint-completion-addsuffix "\""))
 158       (comint-dynamic-complete-filename))))
 159
 160 (defun geiser-completion--setup (enable)
 161   (set (make-local-variable 'completion-at-point-functions)
 162        (if enable
 163            '(geiser-completion--for-symbol
 164              geiser-completion--for-module
 165              geiser-completion--for-filename)
 166          (default-value 'completion-at-point-functions))))
 167
 168 (defun geiser-completion--complete-module ()
 169   "Complete module name at point."
 170   (interactive)
 171   (let ((completion-at-point-functions '(geiser-completion--for-module)))
 172     (call-interactively 'completion-at-point)))
 173
 174 \f
 175 ;;; Smart tab mode:
 176
 177 (make-variable-buffer-local
 178  (defvar geiser-smart-tab-mode-string " SmartTab"
 179    "Modeline indicator for geiser-smart-tab-mode"))
 180
 181 (define-minor-mode geiser-smart-tab-mode
 182   "Toggle smart tab mode.
 183 With no argument, this command toggles the mode.
 184 Non-null prefix argument turns on the mode.
 185 Null prefix argument turns off the mode.
 186
 187 When this mode is enable, TAB will indent if at point is at
 188 beginning of line or after a white space or closing parenthesis,
 189 and will try completing symbol at point otherwise."
 190   :init-value nil
 191   :lighter geiser-smart-tab-mode-string
 192   :group 'geiser-mode
 193   (set (make-local-variable 'tab-always-indent)
 194        (if geiser-smart-tab-mode
 195            'complete
 196          (default-value 'tab-always-indent))))
 197
 198 \f
 199 (provide 'geiser-completion)