geiser-completion.el (5550B)
1 ;;; geiser-completion.el -- tab completion -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2012, 2018, 2020-2022 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 13 ;;; Code: 14 15 (require 'geiser-impl) 16 (require 'geiser-eval) 17 (require 'geiser-log) 18 (require 'geiser-syntax) 19 (require 'geiser-base) 20 21 (require 'comint) 22 (require 'minibuffer) 23 24 25 ;;; Minibuffer maps: 26 27 (defvar geiser-completion--minibuffer-map 28 (let ((map (make-keymap))) 29 (set-keymap-parent map minibuffer-local-completion-map) 30 (define-key map "?" 'self-insert-command) 31 map)) 32 33 (defvar geiser-completion--module-minibuffer-map 34 (let ((map (make-keymap))) 35 (set-keymap-parent map minibuffer-local-completion-map) 36 (define-key map " " 'self-insert-command) 37 (define-key map "?" 'self-insert-command) 38 map)) 39 40 41 ;;; Completion functionality: 42 43 (defvar geiser-completion--binding-forms nil) 44 (geiser-impl--register-local-variable 45 'geiser-completion--binding-forms 'binding-forms nil 46 "A list of forms introducing local bindings, a la let or lambda.") 47 48 (defvar geiser-completion--binding-forms* nil) 49 (geiser-impl--register-local-variable 50 'geiser-completion--binding-forms* 'binding-forms* nil 51 "A list of forms introducing nested local bindings, a la let*.") 52 53 (defsubst geiser-completion--locals () 54 (geiser-syntax--locals-around-point geiser-completion--binding-forms 55 geiser-completion--binding-forms*)) 56 57 (defun geiser-completion--symbol-list (prefix) 58 (geiser--del-dups 59 (append (all-completions prefix (geiser-completion--locals)) 60 (geiser-eval--send/result `(:eval (:ge completions ,prefix)))))) 61 62 (defsubst geiser-completion--module-list (prefix) 63 (geiser-eval--send/result `(:eval (:ge module-completions ,prefix)))) 64 65 (defvar geiser-completion-module-list-func 66 (completion-table-dynamic 'geiser-completion--module-list t)) 67 68 (defvar geiser-completion-symbol-list-func 69 (completion-table-dynamic 'geiser-completion--symbol-list t)) 70 71 (defun geiser-completion--complete (prefix modules) 72 (if modules 73 (geiser-completion--module-list prefix) 74 (geiser-completion--symbol-list prefix))) 75 76 (defvar geiser-completion--symbol-history nil) 77 78 (defun geiser-completion--read-symbol (prompt &optional default history) 79 (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map)) 80 (make-symbol (completing-read prompt 81 geiser-completion-symbol-list-func 82 nil nil nil 83 (or history 84 geiser-completion--symbol-history) 85 (or default 86 (symbol-name (geiser--symbol-at-point))))))) 87 88 (defvar geiser-completion--module-history nil) 89 90 (defun geiser-completion--read-module (&optional prompt default history) 91 (let ((minibuffer-local-completion-map geiser-completion--module-minibuffer-map)) 92 (completing-read (or prompt "Module name: ") 93 geiser-completion-module-list-func 94 nil nil nil 95 (or history geiser-completion--module-history) 96 default))) 97 98 (defvar geiser-completion--symbol-begin-function nil) 99 100 (defun geiser-completion--def-symbol-begin (_module) 101 (save-excursion (skip-syntax-backward "^-()>") (point))) 102 103 (geiser-impl--register-local-method 104 'geiser-completion--symbol-begin-function 'find-symbol-begin 105 'geiser-completion--def-symbol-begin 106 "An optional function finding the position of the beginning of 107 the identifier around point. Takes a boolean, indicating whether 108 we're looking for a module name.") 109 110 (defun geiser-completion--symbol-begin (module) 111 (funcall geiser-completion--symbol-begin-function module)) 112 113 (defun geiser-completion--module-at-point () 114 (save-excursion 115 (goto-char (geiser-completion--symbol-begin t)) 116 (ignore-errors (thing-at-point 'sexp)))) 117 118 (defsubst geiser-completion--prefix (module) 119 (buffer-substring-no-properties (geiser-completion--symbol-begin module) 120 (point))) 121 122 (defsubst geiser-completion--prefix-end (beg mod) 123 (unless (or (eq beg (point-max)) 124 (member (char-syntax (char-after beg)) 125 (if mod '(?\" ?\)) '(?\" ?\( ?\))))) 126 (let ((pos (point))) 127 (condition-case nil 128 (save-excursion 129 (goto-char beg) 130 (forward-sexp 1) 131 (when (>= (point) pos) 132 (point))) 133 (scan-error pos))))) 134 135 136 ;;; Smart tab mode: 137 138 (defvar-local geiser-smart-tab-mode-string " SmartTab" 139 "Modeline indicator for geiser-smart-tab-mode") 140 141 (define-minor-mode geiser-smart-tab-mode 142 "Toggle smart tab mode. 143 With no argument, this command toggles the mode. 144 Non-null prefix argument turns on the mode. 145 Null prefix argument turns off the mode. 146 147 When this mode is enable, TAB will indent if at point is at 148 beginning of line or after a white space or closing parenthesis, 149 and will try completing symbol at point otherwise." 150 :init-value nil 151 :lighter geiser-smart-tab-mode-string 152 :group 'geiser-mode 153 (set (make-local-variable 'tab-always-indent) 154 (if geiser-smart-tab-mode 155 'complete 156 (default-value 'tab-always-indent)))) 157 158 159 (provide 'geiser-completion)