[slime-cvs] CVS slime/contrib
CVS User trittweiler
trittweiler at common-lisp.net
Sat Oct 31 20:18:28 UTC 2009
Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv3963/contrib
Modified Files:
swank-c-p-c.lisp swank-arglists.lisp slime-c-p-c.el ChangeLog
Log Message:
* swank-c-p-c.lisp (completion-set): Split into
`symbol-completion-set', and `package-completion-set'.
(completions): Updated accordingly. Also: complete packages
"hyphenated" by dots.
(find-matching-packages): Heed readtable-case.
(make-compound-prefix-matcher): Make it possible to pass list of
delimeters.
(compound-prefix-match): Deleted.
* swank-arglists.lisp (completions-for-keyword): Adapted so it
does not use `compound-prefix-match'.
* slime-c-p-c.el (complete-symbol* [test]): New test case.
--- /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2008/11/22 12:19:26 1.3
+++ /project/slime/cvsroot/slime/contrib/swank-c-p-c.lisp 2009/10/31 20:18:28 1.4
@@ -41,29 +41,39 @@
PKG:FOO - Symbols with matching prefix and external in package PKG.
PKG::FOO - Symbols with matching prefix and accessible in package PKG.
"
- (let ((completion-set (completion-set string default-package-name
- #'compound-prefix-match)))
- (when completion-set
- (list completion-set (longest-compound-prefix completion-set)))))
+ (multiple-value-bind (name package-name package internal-p)
+ (parse-completion-arguments string default-package-name)
+ (let* ((symbol-set (symbol-completion-set
+ name package-name package internal-p
+ (make-compound-prefix-matcher #\-)))
+ (package-set (package-completion-set
+ name package-name package internal-p
+ (make-compound-prefix-matcher '(#\. #\-))))
+ (completion-set
+ (format-completion-set (nconc symbol-set package-set)
+ internal-p package-name)))
+ (when completion-set
+ (list completion-set (longest-compound-prefix completion-set))))))
+
;;;;; Find completion set
-(defun completion-set (string default-package-name matchp)
+(defun symbol-completion-set (name package-name package internal-p matchp)
"Return the set of completion-candidates as strings."
- (multiple-value-bind (name package-name package internal-p)
- (parse-completion-arguments string default-package-name)
- (let* ((symbols (mapcar (completion-output-symbol-converter name)
- (and package
- (mapcar #'symbol-name
- (find-matching-symbols name
- package
- (and (not internal-p)
- package-name)
- matchp)))))
- (packs (mapcar (completion-output-package-converter name)
- (and (not package-name)
- (find-matching-packages name matchp)))))
- (format-completion-set (nconc symbols packs) internal-p package-name))))
+ (mapcar (completion-output-symbol-converter name)
+ (and package
+ (mapcar #'symbol-name
+ (find-matching-symbols name
+ package
+ (and (not internal-p)
+ package-name)
+ matchp)))))
+
+(defun package-completion-set (name package-name package internal-p matchp)
+ (declare (ignore package internal-p))
+ (mapcar (completion-output-package-converter name)
+ (and (not package-name)
+ (find-matching-packages name matchp))))
(defun find-matching-symbols (string package external test)
"Return a list of symbols in PACKAGE matching STRING.
@@ -97,13 +107,13 @@
(defun find-matching-packages (name matcher)
"Return a list of package names matching NAME with MATCHER.
MATCHER is a two-argument predicate."
- (let ((to-match (string-upcase name)))
- (remove-if-not (lambda (x) (funcall matcher to-match x))
+ (let ((converter (completion-output-package-converter name)))
+ (remove-if-not (lambda (x)
+ (funcall matcher name (funcall converter x)))
(mapcar (lambda (pkgname)
(concatenate 'string pkgname ":"))
(loop for package in (list-all-packages)
- collect (package-name package)
- append (package-nicknames package))))))
+ nconcing (package-names package))))))
;; PARSE-COMPLETION-ARGUMENTS return table:
@@ -212,24 +222,23 @@
Viewing each of `prefix' and `target' as a series of substrings
delimited by DELIMETER, if each substring of `prefix' is a prefix
of the corresponding substring in `target' then we call `prefix'
-a compound-prefix of `target'."
- (lambda (prefix target)
- (declare (type simple-string prefix target))
- (loop for ch across prefix
- with tpos = 0
- always (and (< tpos (length target))
- (if (char= ch delimeter)
- (setf tpos (position #\- target :start tpos))
- (funcall test ch (aref target tpos))))
- do (incf tpos))))
-
-(defun compound-prefix-match (prefix target)
- "Examples:
-\(compound-prefix-match \"foo\" \"foobar\") => t
-\(compound-prefix-match \"m--b\" \"multiple-value-bind\") => t
-\(compound-prefix-match \"m-v-c\" \"multiple-value-bind\") => NIL
-"
- (funcall (make-compound-prefix-matcher #\-) prefix target))
+a compound-prefix of `target'.
+
+DELIMETER may be a character, or a list of characters."
+ (let ((delimeters (etypecase delimeter
+ (character (list delimeter))
+ (cons (assert (every #'characterp delimeter))
+ delimeter))))
+ (lambda (prefix target)
+ (declare (type simple-string prefix target))
+ (loop for ch across prefix
+ with tpos = 0
+ always (and (< tpos (length target))
+ (let ((delimeter (car (member ch delimeters :test test))))
+ (if delimeter
+ (setf tpos (position delimeter target :start tpos))
+ (funcall test ch (aref target tpos)))))
+ do (incf tpos)))))
;;;;; Extending the input string by completion
--- /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/10/31 19:38:28 1.35
+++ /project/slime/cvsroot/slime/contrib/swank-arglists.lisp 2009/10/31 20:18:28 1.36
@@ -1329,8 +1329,8 @@
(keyword-name
(tokenize-symbol keyword-string))
(matching-keywords
- (find-matching-symbols-in-list keyword-name keywords
- #'compound-prefix-match))
+ (find-matching-symbols-in-list
+ keyword-name keywords (make-compound-prefix-matcher #\-)))
(converter (completion-output-symbol-converter keyword-string))
(strings
(mapcar converter
--- /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2009/08/28 23:50:48 1.12
+++ /project/slime/cvsroot/slime/contrib/slime-c-p-c.el 2009/10/31 20:18:28 1.13
@@ -201,4 +201,22 @@
(while slime-c-p-c-init-undo-stack
(eval (pop slime-c-p-c-init-undo-stack))))
+(def-slime-test complete-symbol*
+ (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-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)))
+
(provide 'slime-c-p-c)
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2009/10/31 19:38:28 1.263
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2009/10/31 20:18:28 1.264
@@ -1,5 +1,21 @@
2009-10-31 Tobias C. Rittweiler <tcr at freebits.de>
+ * swank-c-p-c.lisp (completion-set): Split into
+ `symbol-completion-set', and `package-completion-set'.
+ (completions): Updated accordingly. Also: complete packages
+ "hyphenated" by dots.
+ (find-matching-packages): Heed readtable-case.
+ (make-compound-prefix-matcher): Make it possible to pass list of
+ delimeters.
+ (compound-prefix-match): Deleted.
+
+ * swank-arglists.lisp (completions-for-keyword): Adapted so it
+ does not use `compound-prefix-match'.
+
+ * slime-c-p-c.el (complete-symbol* [test]): New test case.
+
+2009-10-31 Tobias C. Rittweiler <tcr at freebits.de>
+
* swank-arglists.lisp (extra-keywords :around): Sort keyword
parameters such that implementation-internal stuff is shown last.
(compose): New helper.
More information about the slime-cvs
mailing list