1
;;; slime-c-p-c.el --- ILISP style Compound Prefix Completion
3
;; Authors: Luke Gorrie <luke@synap.se>
4
;; Edi Weitz <edi@agharta.de>
5
;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de>
6
;; Tobias C. Rittweiler <tcr@freebits.de>
9
;; License: GNU GPL (same license as Emacs)
13
;; Add this to your .emacs:
15
;; (add-to-list 'load-path "<directory-of-this-file>")
16
;; (add-hook 'slime-load-hook (lambda () (require 'slime-c-p-c)))
22
(require 'slime-parse)
23
(require 'slime-editing-commands)
25
(defcustom slime-c-p-c-unambiguous-prefix-p t
26
"If true, set point after the unambigous prefix.
27
If false, move point to the end of the inserted text."
31
(defcustom slime-complete-symbol*-fancy nil
32
"Use information from argument lists for DWIM'ish symbol completion."
36
(defun slime-complete-symbol* ()
37
"Expand abbreviations and complete the symbol at point."
38
;; NB: It is only the name part of the symbol that we actually want
39
;; to complete -- the package prefix, if given, is just context.
40
(or (slime-maybe-complete-as-filename)
41
(slime-expand-abbreviations-and-complete)))
44
(defun slime-expand-abbreviations-and-complete ()
45
(let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
46
(beg (move-marker (make-marker) (slime-symbol-start-pos)))
47
(prefix (buffer-substring-no-properties beg end))
48
(completion-result (slime-contextual-completions beg end))
49
(completion-set (first completion-result))
50
(completed-prefix (second completion-result)))
51
(if (null completion-set)
52
(progn (slime-minibuffer-respecting-message
53
"Can't find completion for \"%s\"" prefix)
55
(slime-complete-restore-window-configuration))
56
;; some XEmacs issue makes this distinction necessary
57
(cond ((> (length completed-prefix) (- end beg))
59
(insert-and-inherit completed-prefix)
60
(delete-region beg end)
61
(goto-char (+ beg (length completed-prefix))))
63
(cond ((and (member completed-prefix completion-set)
64
(slime-length= completion-set 1))
65
(slime-minibuffer-respecting-message "Sole completion")
66
(when slime-complete-symbol*-fancy
67
(slime-complete-symbol*-fancy-bit))
68
(slime-complete-restore-window-configuration))
71
(when (member completed-prefix completion-set)
72
(slime-minibuffer-respecting-message
73
"Complete but not unique"))
74
(when slime-c-p-c-unambiguous-prefix-p
75
(let ((unambiguous-completion-length
76
(loop for c in completion-set
77
minimizing (or (mismatch completed-prefix c)
78
(length completed-prefix)))))
79
(goto-char (+ beg unambiguous-completion-length))))
80
(slime-display-or-scroll-completions completion-set
81
completed-prefix))))))
83
(defun slime-complete-symbol*-fancy-bit ()
84
"Do fancy tricks after completing a symbol.
85
\(Insert a space or close-paren based on arglist information.)"
86
(let ((arglist (slime-get-arglist (slime-symbol-name-at-point))))
89
;; Don't intern these symbols
90
(let ((obarray (make-vector 10 0)))
91
(cdr (read arglist))))
92
(function-call-position-p
95
(equal (char-before) ?\())))
96
(when function-call-position-p
98
(insert-and-inherit ")")
99
(insert-and-inherit " ")
100
(when (and slime-space-information-p
101
(slime-background-activities-enabled-p)
102
(not (minibuffer-window-active-p (minibuffer-window))))
103
(slime-echo-arglist))))))))
105
(defun slime-get-arglist (symbol-name)
106
"Return the argument list for SYMBOL-NAME."
107
(slime-eval `(swank:arglist-for-echo-area (quote (,symbol-name)))))
109
(defun* slime-contextual-completions (beg end)
110
"Return a list of completions of the token from BEG to END in the
112
(let ((token (buffer-substring-no-properties beg end)))
114
((and (< beg (point-max))
115
(string= (buffer-substring-no-properties beg (1+ beg)) ":"))
116
;; Contextual keyword completion
117
(multiple-value-bind (operator-names arg-indices points)
120
(slime-enclosing-form-specs))
123
(slime-completions-for-keyword operator-names token
125
(when (first completions)
126
(return-from slime-contextual-completions completions))
127
;; If no matching keyword was found, do regular symbol
131
(string= (buffer-substring-no-properties (- beg 2) beg) "#\\"))
132
;; Character name completion
133
(return-from slime-contextual-completions
134
(slime-completions-for-character token))))
135
;; Regular symbol completion
136
(slime-completions token)))
138
(defun slime-completions (prefix)
139
(slime-eval `(swank:completions ,prefix ',(slime-current-package))))
141
(defun slime-completions-for-keyword (operator-designator prefix
143
(slime-eval `(swank:completions-for-keyword ',operator-designator
147
(defun slime-completions-for-character (prefix)
148
(slime-eval `(swank:completions-for-character ,prefix)))
153
(defun slime-complete-form ()
154
"Complete the form at point.
155
This is a superset of the functionality of `slime-insert-arglist'."
157
;; Find the (possibly incomplete) form around point.
158
(let ((form-string (slime-incomplete-form-at-point)))
159
(let ((result (slime-eval `(swank:complete-form ',form-string))))
160
(if (eq result :not-available)
161
(error "Could not generate completion for the form `%s'" form-string)
165
;; SWANK:COMPLETE-FORM always returns a closing
166
;; parenthesis; but we only want to insert one if it's
167
;; really necessary (thinking especially of paredit.el.)
168
(insert (substring result 0 -1))
169
(let ((slime-close-parens-limit 1))
170
(slime-close-all-parens-in-sexp)))
177
(defvar slime-c-p-c-init-undo-stack nil)
179
(defun slime-c-p-c-init ()
180
;; save current state for unload
183
(setq slime-complete-symbol-function ',slime-complete-symbol-function)
184
(remove-hook 'slime-connected-hook 'slime-c-p-c-on-connect)
185
(define-key slime-mode-map "\C-c\C-s"
186
',(lookup-key slime-mode-map "\C-c\C-s"))
187
(define-key slime-repl-mode-map "\C-c\C-s"
188
',(lookup-key slime-repl-mode-map "\C-c\C-s")))
189
slime-c-p-c-init-undo-stack)
190
(setq slime-complete-symbol-function 'slime-complete-symbol*)
191
(add-hook 'slime-connected-hook 'slime-c-p-c-on-connect)
192
(define-key slime-mode-map "\C-c\C-s" 'slime-complete-form)
193
(define-key slime-repl-mode-map "\C-c\C-s" 'slime-complete-form))
195
(defun slime-c-p-c-on-connect ()
196
(slime-eval-async '(swank:swank-require :swank-arglists)))
198
(defun slime-c-p-c-unload ()
199
(while slime-c-p-c-init-undo-stack
200
(eval (pop slime-c-p-c-init-undo-stack))))
202
(provide 'slime-c-p-c)
added
removed
contrib/slime-c-p-c.el
