sbcl stuff

This commit is contained in:
Ian Keane 2020-01-20 14:13:08 -05:00
parent 1d1dbc34df
commit 5d91dbb667
335 changed files with 119806 additions and 1 deletions

View file

@ -0,0 +1,140 @@
(require 'slime-c-p-c)
(require 'slime-tests)
(def-slime-test completions
(prefix expected-completions)
"Find the completions of a symbol-name prefix."
'(("cl:compile" (("cl:compile" "cl:compile-file" "cl:compile-file-pathname"
"cl:compiled-function" "cl:compiled-function-p"
"cl:compiler-macro" "cl:compiler-macro-function")
"cl:compile"))
("cl:foobar" nil)
("swank::compile-file" (("swank::compile-file"
"swank::compile-file-for-emacs"
"swank::compile-file-if-needed"
"swank::compile-file-output"
"swank::compile-file-pathname")
"swank::compile-file"))
("cl:m-v-l" (("cl:multiple-value-list" "cl:multiple-values-limit") "cl:multiple-value"))
("common-lisp" (("common-lisp-user:" "common-lisp:") "common-lisp")))
(let ((completions (slime-completions prefix)))
(slime-test-expect "Completion set" expected-completions completions)))
(def-slime-test complete-symbol*
(buffer-sexp wished-completion &optional chosen-completion fancy unambiguous)
"Ensure that completions are correctly inserted."
'(("cl:and" "cl:and")
("(cl:and" "(cl:and")
("(cl:and)" "(cl:and)")
("(cl:and)" "(cl:and)" nil nil t)
;; Fancy completion of a form that accepts arguments should
;; insert a space after the completed form.
("(cl:and)" "(cl:and )" nil t)
;; ...but only for symbols in the funcall position.
("cl:and" "cl:and" nil t)
;; Fancy completion of a form without arguments should insert a
;; closing paren.
("(cl:get-internal-run-time" "(cl:get-internal-run-time)" nil t)
;; ...but only for symbols in the funcall position.
("cl:get-internal-run-time" "cl:get-internal-run-time" nil t)
("cl:m-v-b" "cl:multiple-value-bind")
("cl:m-v-l" "cl:multiple-value-list" "cl:multiple-value-list")
;; Fancy completion is only done for unique completions. This is
;; not a hard requirement, and might change in the future. This
;; test is included merely to document the current behavior.
("(cl:m-v-l)" "(cl:multiple-value-list)" "cl:multiple-value-list" t)
("cl:mult" "cl:multiple-value-call" "cl:multiple-value-call")
("cl:multiple-value" "cl:multiple-value-setq" "cl:multiple-value-setq")
("cl:compile" "cl:compile" "cl:compile")
("cl:compile" "cl:compile-file" "cl:compile-file")
("cl:f-o" "cl:force-output" "cl:force-output")
;; When `slime-c-p-c-unambiguous-prefix-p' is non nil,
;; `slime-complete-symbol*' will move point back to the
;; unambiguous portion of the prefix; however, the final result
;; after choosing a completion candidate should be the same.
("cl:f-o" "cl:force-output" "cl:force-output" nil t)
("(cl:f-o)" "(cl:force-output)" "cl:force-output" nil t)
;; Character completions
("#\\N" "#\\Newline")
("#\\R" "#\\Return" "#\\Return")
("#\\R" "#\\Rubout" "#\\Rubout" nil t)
;; Keyword completions
("(cl:find 'x '() :)" "(cl:find 'x '() :START)" ":START")
("(cl:find 'x '() :S)" "(cl:find 'x '() :START)")
("(cl:find 'x '() :s)" "(cl:find 'x '() :start)")
("(cl:find 'x '() :s)" "(cl:find 'x '() :start)" nil t)
("(cl:find 'x '() :t)" "(cl:find 'x '() :test)" ":test")
("(cl:find 'x '() :t)" "(cl:find 'x '() :test-not)" ":test-not" nil t))
(slime-check-top-level)
(save-window-excursion
(with-temp-buffer
(lisp-mode)
(setq slime-buffer-package "SWANK")
(insert buffer-sexp)
(when (eq (char-before) ?\))
(backward-char))
(let ((slime-c-p-c-unambiguous-prefix-p unambiguous)
(slime-complete-symbol*-fancy fancy))
(if (not fancy)
(slime-complete-symbol*)
;; `slime-complete-symbol*-fancy-bit' may call
;; `execute-kbd-macro', which ultimately operates on the
;; buffer associated with the selected window, not
;; necessarily the current buffer. Call `pop-to-buffer' to
;; ensure that the current buffer is in the selected window
;; before calling `slime-complete-symbol*'. Fancy completion
;; might also kick off a `slime-eval-async' in
;; `slime-echo-arglist', so ensure the output is consumed
;; with `slime-sync-to-top-level' before continuing.
(pop-to-buffer (current-buffer))
(slime-complete-symbol*)
(slime-sync-to-top-level 1)))
(when chosen-completion
(with-selected-window slime-completions-window
(goto-char (point-min))
(search-forward chosen-completion)
(choose-completion)))
(slime-check-completed-form buffer-sexp wished-completion))))
(def-slime-test complete-form
(buffer-sexpr wished-completion &optional skip-trailing-test-p)
""
'(("(defmethod arglist-dispatch *HERE*"
"(defmethod arglist-dispatch (operator arguments) body...)")
("(with-struct *HERE*"
"(with-struct (conc-name names...) obj body...)")
("(with-struct *HERE*"
"(with-struct (conc-name names...) obj body...)")
("(with-struct (*HERE*"
"(with-struct (conc-name names...)" t)
("(with-struct (foo. bar baz *HERE*"
"(with-struct (foo. bar baz names...)" t))
(slime-check-top-level)
(with-temp-buffer
(lisp-mode)
(setq slime-buffer-package "SWANK")
(insert buffer-sexpr)
(search-backward "*HERE*")
(delete-region (match-beginning 0) (match-end 0))
(slime-complete-form)
(slime-check-completed-form buffer-sexpr wished-completion)
;; Now the same but with trailing `)' for paredit users...
(unless skip-trailing-test-p
(erase-buffer)
(insert buffer-sexpr)
(search-backward "*HERE*")
(delete-region (match-beginning 0) (match-end 0))
(insert ")") (backward-char)
(slime-complete-form)
(slime-check-completed-form (concat buffer-sexpr ")") wished-completion))
))
(defun slime-check-completed-form (buffer-sexpr wished-completion)
(slime-test-expect (format "Completed form for `%s' is as expected"
buffer-sexpr)
wished-completion
(buffer-string)
'equal))
(provide 'slime-c-p-c-tests)