branch: elpa/slime
commit ca3b367b0094a4c8c46fd637cb4d06ba7483610b
Author: Stas Boukarev <stass...@gmail.com>
Commit: Stas Boukarev <stass...@gmail.com>
slime-c-p-c: don't use its own completion UI.
Seems broken, doesn't work with other completion UIs.
For slime-fuzzy, add `slime-fuzzy-default-completion-ui', when set to
T will use the default Emacs UI.
---
contrib/slime-c-p-c.el | 184 ++-----------------------------------------------
contrib/slime-fuzzy.el | 55 ++++++++++-----
slime.el | 21 ++++--
3 files changed, 58 insertions(+), 202 deletions(-)
diff --git a/contrib/slime-c-p-c.el b/contrib/slime-c-p-c.el
index 22a267b1715..8f0cd1dd21b 100644
--- a/contrib/slime-c-p-c.el
+++ b/contrib/slime-c-p-c.el
@@ -32,128 +32,7 @@
(:on-unload
(while slime-c-p-c-init-undo-stack
(eval (pop slime-c-p-c-init-undo-stack)))))
-
-(defcustom slime-c-p-c-unambiguous-prefix-p t
- "If true, set point after the unambigous prefix.
-If false, move point to the end of the inserted text."
- :type 'boolean
- :group 'slime-ui)
-
-(defcustom slime-complete-symbol*-fancy nil
- "Use information from argument lists for DWIM'ish symbol completion."
- :group 'slime-mode
- :type 'boolean)
-
-;; FIXME: this is the old code to display completions. Remove it once
-;; `slime-complete-symbol*' and `slime-fuzzy-complete-symbol' can be
-;; used together with `completion-at-point'.
-
-(defvar slime-completions-buffer-name "*Completions*")
-
-;; FIXME: can probably use quit-window instead
-(make-variable-buffer-local
- (defvar slime-complete-saved-window-configuration 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 slime-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 `slime-complete-saved-window-configuration'."))
-
-(defun slime-complete-maybe-save-window-configuration ()
- "Maybe save the current window configuration.
-Return true if the configuration was saved."
- (unless (or slime-complete-saved-window-configuration
- (get-buffer-window slime-completions-buffer-name))
- (setq slime-complete-saved-window-configuration
- (current-window-configuration))
- t))
-
-(defun slime-complete-delay-restoration ()
- (add-hook 'pre-command-hook
- 'slime-complete-maybe-restore-window-configuration
- 'append
- 'local))
-
-(defun slime-complete-forget-window-configuration ()
- (setq slime-complete-saved-window-configuration nil)
- (setq slime-completions-window nil))
-
-(defun slime-complete-restore-window-configuration ()
- "Restore the window config if available."
- (remove-hook 'pre-command-hook
- 'slime-complete-maybe-restore-window-configuration)
- (when (and slime-complete-saved-window-configuration
- (slime-completion-window-active-p))
- (save-excursion (set-window-configuration
- slime-complete-saved-window-configuration))
- (setq slime-complete-saved-window-configuration nil)
- (when (buffer-live-p slime-completions-buffer-name)
- (kill-buffer slime-completions-buffer-name))))
-
-(defun slime-complete-maybe-restore-window-configuration ()
- "Restore the window configuration, if the following command
-terminates a current completion."
- (remove-hook 'pre-command-hook
- 'slime-complete-maybe-restore-window-configuration)
- (condition-case err
- (cond ((cl-find last-command-event "()\"'`,# \r\n:")
- (slime-complete-restore-window-configuration))
- ((not (slime-completion-window-active-p))
- (slime-complete-forget-window-configuration))
- (t
- (slime-complete-delay-restoration)))
- (error
- ;; Because this is called on the pre-command-hook, we mustn't let
- ;; errors propagate.
- (message "Error in slime-complete-restore-window-configuration: %S"
- err))))
-
-(defun slime-completion-window-active-p ()
- "Is the completion window currently active?"
- (and (window-live-p slime-completions-window)
- (equal (buffer-name (window-buffer slime-completions-window))
- slime-completions-buffer-name)))
-
-(defun slime-display-completion-list (completions start end)
- (let ((savedp (slime-complete-maybe-save-window-configuration)))
- (with-output-to-temp-buffer slime-completions-buffer-name
- (display-completion-list completions)
- (with-current-buffer standard-output
- (setq completion-base-position (list start end))
- (set-syntax-table lisp-mode-syntax-table)))
- (when savedp
- (setq slime-completions-window
- (get-buffer-window slime-completions-buffer-name)))))
-
-(defun slime-display-or-scroll-completions (completions start end)
- (cond ((and (eq last-command this-command)
- (slime-completion-window-active-p))
- (slime-scroll-completions))
- (t
- (slime-display-completion-list completions start end)))
- (slime-complete-delay-restoration))
-
-(defun slime-scroll-completions ()
- (let ((window slime-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))))))
-
-(defun slime-minibuffer-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 slime-maybe-complete-as-filename ()
"If point is at a string starting with \", complete it as filename.
Return nil if point is not at filename."
@@ -169,73 +48,20 @@ terminates a current completion."
"Expand abbreviations and complete the symbol at point."
;; NB: It is only the name part of the symbol that we actually want
;; to complete -- the package prefix, if given, is just context.
- (or (slime-maybe-complete-as-filename)
+ (if (slime-maybe-complete-as-filename)
+ nil
(slime-expand-abbreviations-and-complete)))
(defun slime-c-p-c-completion-at-point ()
- #'slime-complete-symbol*)
+ (slime-complete-symbol*))
-;; FIXME: factorize
(defun slime-expand-abbreviations-and-complete ()
(let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
(beg (move-marker (make-marker) (slime-symbol-start-pos)))
(prefix (buffer-substring-no-properties beg end))
(completion-result (slime-contextual-completions beg end))
- (completion-set (cl-first completion-result))
- (completed-prefix (cl-second completion-result)))
- (if (null completion-set)
- (progn (slime-minibuffer-respecting-message
- "Can't find completion for \"%s\"" prefix)
- (ding)
- (slime-complete-restore-window-configuration))
- ;; some XEmacs issue makes this distinction necessary
- (cond ((> (length completed-prefix) (- end beg))
- (goto-char end)
- (insert-and-inherit completed-prefix)
- (delete-region beg end)
- (goto-char (+ beg (length completed-prefix))))
- (t nil))
- (cond ((and (member completed-prefix completion-set)
- (slime-length= completion-set 1))
- (slime-minibuffer-respecting-message "Sole completion")
- (when slime-complete-symbol*-fancy
- (slime-complete-symbol*-fancy-bit))
- (slime-complete-restore-window-configuration))
- ;; Incomplete
- (t
- (when (member completed-prefix completion-set)
- (slime-minibuffer-respecting-message
- "Complete but not unique"))
- (when slime-c-p-c-unambiguous-prefix-p
- (let ((unambiguous-completion-length
- (cl-loop for c in completion-set
- minimizing (or (cl-mismatch completed-prefix c)
- (length completed-prefix)))))
- (goto-char (+ beg unambiguous-completion-length))))
- (slime-display-or-scroll-completions completion-set
- beg
- (max (point) end)))))))
-
-(defun slime-complete-symbol*-fancy-bit ()
- "Do fancy tricks after completing a symbol.
-\(Insert a space or close-paren based on arglist information.)"
- (let ((arglist (slime-retrieve-arglist (slime-symbol-at-point))))
- (unless (eq arglist :not-available)
- (let ((args
- ;; Don't intern these symbols
- (let ((obarray (make-vector 10 0)))
- (cdr (read arglist))))
- (function-call-position-p
- (save-excursion
- (backward-sexp)
- (equal (char-before) ?\())))
- (when function-call-position-p
- (if (null args)
- (execute-kbd-macro ")")
- (execute-kbd-macro " ")
- (when (and (slime-background-activities-enabled-p)
- (not (minibuffer-window-active-p
(minibuffer-window))))
- (slime-echo-arglist))))))))
+ (completion-set (cl-first completion-result)))
+ (list beg end completion-set)))
(cl-defun slime-contextual-completions (beg end)
"Return a list of completions of the token from BEG to END in the
diff --git a/contrib/slime-fuzzy.el b/contrib/slime-fuzzy.el
index 2ce38ec9b1b..06029c0b6e5 100644
--- a/contrib/slime-fuzzy.el
+++ b/contrib/slime-fuzzy.el
@@ -265,29 +265,48 @@ most recently enclosed macro or function."
;; FIXME: use `comint-filename-completion' when dropping emacs23
(funcall (if (>= emacs-major-version 24)
'comint-filename-completion
- 'comint-dynamic-complete-as-filename))))
+ 'comint-dynamic-complete-as-filename)))
+ nil)
(let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
(beg (move-marker (make-marker) (slime-symbol-start-pos)))
(prefix (buffer-substring-no-properties beg end)))
(cl-destructuring-bind (completion-set interrupted-p)
(slime-fuzzy-completions prefix)
- (if (null completion-set)
- (progn (slime-minibuffer-respecting-message
- "Can't find completion for \"%s\""
prefix)
- (ding)
- (slime-fuzzy-done))
- (goto-char end)
- (cond ((slime-length= completion-set 1)
- ;; insert completed string
- (insert-and-inherit (caar
completion-set))
- (delete-region beg end)
- (goto-char (+ beg (length (caar
completion-set))))
- (slime-minibuffer-respecting-message
"Sole completion")
- (slime-fuzzy-done))
- ;; Incomplete
- (t
- (slime-fuzzy-choices-buffer
completion-set interrupted-p
- beg
end))))))))
+ (if slime-fuzzy-default-completion-ui
+ (list beg end
+ (cl-loop for (symbol-name score
chunks classification-string) in completion-set
+ collect (propertize
symbol-name
+
'slime-fuzzy-kind
+
classification-string))
+ :company-kind (lambda (x)
+ (let ((prop
(get-text-property 0 'slime-fuzzy-kind x)))
+ (when prop
+ (cl-loop for
(char kind) in '((?g method)
+
(?m macro)
+
(?f function)
+
(?b variable)
+
(?c class)
+
(?t class)
+
(?p module))
+ when
(cl-find char prop)
+ return
kind)))))
+ (if (null completion-set)
+ (progn
(slime-minibuffer-respecting-message
+ "Can't find completion for
\"%s\"" prefix)
+ (ding)
+ (slime-fuzzy-done))
+ (goto-char end)
+ (cond ((slime-length= completion-set 1)
+ ;; insert completed string
+ (insert-and-inherit (caar
completion-set))
+ (delete-region beg end)
+ (goto-char (+ beg (length (caar
completion-set))))
+
(slime-minibuffer-respecting-message "Sole completion")
+ (slime-fuzzy-done))
+ ;; Incomplete
+ (t
+ (slime-fuzzy-choices-buffer
completion-set interrupted-p
+ beg
end)))))))))
(defun slime-get-fuzzy-buffer ()
diff --git a/slime.el b/slime.el
index 497ca882f72..9730fa3650f 100644
--- a/slime.el
+++ b/slime.el
@@ -270,6 +270,11 @@ argument."
:type '(choice (const :tag "Compound" slime-complete-symbol*)
(const :tag "Fuzzy" slime-fuzzy-complete-symbol)))
+(defcustom slime-fuzzy-default-completion-ui nil
+ "*When true, use the default emacs completion UI."
+ :type 'boolean
+ :group 'slime-mode)
+
(make-obsolete-variable 'slime-complete-symbol-function
'slime-completion-at-point-functions
"2015-10-18")
@@ -3611,11 +3616,17 @@ more than one space."
;; have to set `completion-at-point-functions' in every slime-like
;; buffer.
(defun slime--completion-at-point ()
- (cond (slime-complete-symbol-function
- slime-complete-symbol-function)
- (t
- (run-hook-with-args-until-success
- 'slime-completion-at-point-functions))))
+ (let ((fun
+ (cond (slime-complete-symbol-function
+ slime-complete-symbol-function)
+ (t
+ (run-hook-with-args-until-success
+ 'slime-completion-at-point-functions)))))
+ (if (and slime-fuzzy-default-completion-ui
+ fun
+ (symbolp fun))
+ (funcall fun)
+ fun)))
(defun slime-setup-completion ()
(add-hook 'completion-at-point-functions #'slime--completion-at-point nil t))
