[slime-cvs] CVS slime/contrib
CVS User sboukarev
sboukarev at common-lisp.net
Sat Feb 2 09:48:51 UTC 2013
Update of /project/slime/cvsroot/slime/contrib
In directory tiger.common-lisp.net:/tmp/cvs-serv11653
Modified Files:
ChangeLog swank-fuzzy.lisp
Log Message:
* swank-fuzzy.lisp: Allow NIL to be completed, don't confuse with
it package:
--- /project/slime/cvsroot/slime/contrib/ChangeLog 2013/02/01 20:43:13 1.567
+++ /project/slime/cvsroot/slime/contrib/ChangeLog 2013/02/02 09:48:51 1.568
@@ -1,3 +1,8 @@
+2013-02-02 Stas Boukarev <stassats at gmail.com>
+
+ * swank-fuzzy.lisp: Allow NIL to be completed, don't confuse with
+ it package:
+
2013-02-01 Stas Boukarev <stassats at gmail.com>
* slime-asdf.el (slime-determine-asdf-system): Don't call
--- /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2011/12/01 16:48:22 1.13
+++ /project/slime/cvsroot/slime/contrib/swank-fuzzy.lisp 2013/02/02 09:48:51 1.14
@@ -17,7 +17,8 @@
;;; For nomenclature of the fuzzy completion section, please read
;;; through the following docstring.
-(defslimefun fuzzy-completions (string default-package-name &key limit time-limit-in-msec)
+(defslimefun fuzzy-completions (string default-package-name
+ &key limit time-limit-in-msec)
"Returns a list of two values:
An (optionally limited to LIMIT best results) list of fuzzy
@@ -62,7 +63,8 @@
;; that purpose, to be able to distinguish between "no time limit
;; alltogether" and "current time limit already exhausted." So we've
;; got to canonicalize its value at first:
- (let* ((no-time-limit-p (or (not time-limit-in-msec) (zerop time-limit-in-msec)))
+ (let* ((no-time-limit-p (or (not time-limit-in-msec)
+ (zerop time-limit-in-msec)))
(time-limit (if no-time-limit-p nil time-limit-in-msec)))
(multiple-value-bind (completion-set interrupted-p)
(fuzzy-completion-set string default-package-name :limit limit
@@ -78,55 +80,63 @@
;;; object that will be sent back to Emacs, as described above.
(defstruct (fuzzy-matching (:conc-name fuzzy-matching.)
- (:predicate fuzzy-matching-p)
- (:constructor %make-fuzzy-matching))
- symbol ; The symbol that has been found to match.
- package-name ; The name of the package where SYMBOL was found in.
+ (:predicate fuzzy-matching-p)
+ (:constructor %make-fuzzy-matching))
+ symbol ; The symbol that has been found to match.
+ symbol-p ; To deffirentiate between completeing
+ ; package: and package:nil
+ package-name ; The name of the package where SYMBOL was found in.
; (This is not necessarily the same as the home-package
; of SYMBOL, because the SYMBOL can be internal to
; lots of packages; also think of package nicknames.)
- score ; The higher the better SYMBOL is a match.
+ score ; The higher the better SYMBOL is a match.
package-chunks ; Chunks pertaining to the package identifier of SYMBOL.
symbol-chunks) ; Chunks pertaining to SYMBOL's name.
-(defun make-fuzzy-matching (symbol package-name score package-chunks symbol-chunks)
+(defun make-fuzzy-matching (symbol package-name score package-chunks
+ symbol-chunks &key (symbol-p t))
(declare (inline %make-fuzzy-matching))
(%make-fuzzy-matching :symbol symbol :package-name package-name :score score
- :package-chunks package-chunks
- :symbol-chunks symbol-chunks))
+ :package-chunks package-chunks
+ :symbol-chunks symbol-chunks
+ :symbol-p symbol-p))
(defun %fuzzy-extract-matching-info (fuzzy-matching user-input-string)
(multiple-value-bind (_ user-package-name __ input-internal-p)
(parse-completion-arguments user-input-string nil)
(declare (ignore _ __))
- (with-struct (fuzzy-matching. score symbol package-name package-chunks symbol-chunks)
- fuzzy-matching
+ (with-struct (fuzzy-matching. score symbol package-name package-chunks
+ symbol-chunks symbol-p)
+ fuzzy-matching
(let (symbol-name real-package-name internal-p)
- (cond (symbol ; symbol fuzzy matching?
- (setf symbol-name (symbol-name symbol))
- (setf internal-p input-internal-p)
- (setf real-package-name (cond ((keywordp symbol) "")
- ((not user-package-name) nil)
- (t package-name))))
- (t ; package fuzzy matching?
- (setf symbol-name "")
- (setf real-package-name package-name)
- ;; If no explicit package name was given by the user
- ;; (e.g. input was "asdf"), we want to append only
- ;; one colon ":" to the package names.
- (setf internal-p (if user-package-name input-internal-p nil))))
- (values symbol-name
- real-package-name
- (if user-package-name internal-p nil)
- (completion-output-symbol-converter user-input-string)
- (completion-output-package-converter user-input-string))))))
+ (cond (symbol-p ; symbol fuzzy matching?
+ (setf symbol-name (symbol-name symbol))
+ (setf internal-p input-internal-p)
+ (setf real-package-name (cond ((keywordp symbol) "")
+ ((not user-package-name) nil)
+ (t package-name))))
+ (t ; package fuzzy matching?
+ (setf symbol-name "")
+ (setf real-package-name package-name)
+ ;; If no explicit package name was given by the user
+ ;; (e.g. input was "asdf"), we want to append only
+ ;; one colon ":" to the package names.
+ (setf internal-p (if user-package-name input-internal-p nil))))
+ (values symbol-name
+ real-package-name
+ (if user-package-name internal-p nil)
+ (completion-output-symbol-converter user-input-string)
+ (completion-output-package-converter user-input-string))))))
(defun fuzzy-format-matching (fuzzy-matching user-input-string)
"Returns the completion (\"foo:bar\") that's represented by FUZZY-MATCHING."
- (multiple-value-bind (symbol-name package-name internal-p symbol-converter package-converter)
+ (multiple-value-bind (symbol-name package-name internal-p
+ symbol-converter package-converter)
(%fuzzy-extract-matching-info fuzzy-matching user-input-string)
- (setq symbol-name (and symbol-name (funcall symbol-converter symbol-name)))
- (setq package-name (and package-name (funcall package-converter package-name)))
+ (setq symbol-name (and symbol-name
+ (funcall symbol-converter symbol-name)))
+ (setq package-name (and package-name
+ (funcall package-converter package-name)))
(let ((result (untokenize-symbol package-name internal-p symbol-name)))
;; We return the length of the possibly added prefix as second value.
(values result (search symbol-name result)))))
@@ -137,21 +147,27 @@
issues, and adds information (as a string) describing if the symbol is
bound, fbound, a class, a macro, a generic-function, a
special-operator, or a package."
- (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks) fuzzy-matching
+ (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks
+ symbol-p)
+ fuzzy-matching
(multiple-value-bind (name added-length)
- (fuzzy-format-matching fuzzy-matching user-input-string)
+ (fuzzy-format-matching fuzzy-matching user-input-string)
(list name
(format nil "~,2f" score)
- (append package-chunks
- (mapcar #'(lambda (chunk)
- ;; Fix up chunk positions to account for possible
- ;; added package identifier.
- (let ((offset (first chunk)) (string (second chunk)))
- (list (+ added-length offset) string)))
- symbol-chunks))
- (symbol-classification-string symbol)))))
+ (append package-chunks
+ (mapcar (lambda (chunk)
+ ;; Fix up chunk positions to account for possible
+ ;; added package identifier.
+ (let ((offset (first chunk))
+ (string (second chunk)))
+ (list (+ added-length offset) string)))
+ symbol-chunks))
+ (if symbol-p
+ (symbol-classification-string symbol)
+ "-------p")))))
-(defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec)
+(defun fuzzy-completion-set (string default-package-name
+ &key limit time-limit-in-msec)
"Returns two values: an array of completion objects, sorted by
their score, that is how well they are a match for STRING
according to the fuzzy completion algorithm. If LIMIT is set,
@@ -159,7 +175,8 @@
is returned that indicates whether or not TIME-LIMIT-IN-MSEC was
exhausted."
(check-type limit (or null (integer 0 #.(1- most-positive-fixnum))))
- (check-type time-limit-in-msec (or null (integer 0 #.(1- most-positive-fixnum))))
+ (check-type time-limit-in-msec
+ (or null (integer 0 #.(1- most-positive-fixnum))))
(multiple-value-bind (matchings interrupted-p)
(fuzzy-generate-matchings string default-package-name time-limit-in-msec)
(when (and limit
@@ -169,92 +186,106 @@
(setf (fill-pointer matchings) limit)
(setf matchings (make-array limit :displaced-to matchings))))
(map-into matchings #'(lambda (m)
- (fuzzy-convert-matching-for-emacs m string))
- matchings)
+ (fuzzy-convert-matching-for-emacs m string))
+ matchings)
(values matchings interrupted-p)))
-(defun fuzzy-generate-matchings (string default-package-name time-limit-in-msec)
+(defun fuzzy-generate-matchings (string default-package-name
+ time-limit-in-msec)
"Does all the hard work for FUZZY-COMPLETION-SET. If
TIME-LIMIT-IN-MSEC is NIL, an infinite time limit is assumed."
- (multiple-value-bind (parsed-symbol-name parsed-package-name package internal-p)
+ (multiple-value-bind (parsed-symbol-name parsed-package-name
+ package internal-p)
(parse-completion-arguments string default-package-name)
(flet ((fix-up (matchings parent-package-matching)
- ;; The components of each matching in MATCHINGS have been computed
- ;; relatively to PARENT-PACKAGE-MATCHING. Make them absolute.
- (let* ((p parent-package-matching)
- (p.name (fuzzy-matching.package-name p))
- (p.score (fuzzy-matching.score p))
- (p.chunks (fuzzy-matching.package-chunks p)))
- (map-into matchings
- #'(lambda (m)
- (let ((m.score (fuzzy-matching.score m)))
- (setf (fuzzy-matching.package-name m) p.name)
- (setf (fuzzy-matching.package-chunks m) p.chunks)
- (setf (fuzzy-matching.score m)
- (if (equal parsed-symbol-name "")
- ;; (Make package matchings be sorted before all the
- ;; relative symbol matchings while preserving over
- ;; all orderness.)
- (/ p.score 100)
- (+ p.score m.score)))
- m))
- matchings)))
- (find-symbols (designator package time-limit &optional filter)
- (fuzzy-find-matching-symbols designator package
- :time-limit-in-msec time-limit
- :external-only (not internal-p)
- :filter (or filter #'identity)))
- (find-packages (designator time-limit)
- (fuzzy-find-matching-packages designator :time-limit-in-msec time-limit)))
+ ;; The components of each matching in MATCHINGS have been computed
+ ;; relatively to PARENT-PACKAGE-MATCHING. Make them absolute.
+ (let* ((p parent-package-matching)
+ (p.name (fuzzy-matching.package-name p))
+ (p.score (fuzzy-matching.score p))
+ (p.chunks (fuzzy-matching.package-chunks p)))
+ (map-into
+ matchings
+ (lambda (m)
+ (let ((m.score (fuzzy-matching.score m)))
+ (setf (fuzzy-matching.package-name m) p.name)
+ (setf (fuzzy-matching.package-chunks m) p.chunks)
+ (setf (fuzzy-matching.score m)
+ (if (equal parsed-symbol-name "")
+ ;; Make package matchings be sorted before all
+ ;; the relative symbol matchings while preserving
+ ;; over all orderness.
+ (/ p.score 100)
+ (+ p.score m.score)))
+ m))
+ matchings)))
+ (find-symbols (designator package time-limit &optional filter)
+ (fuzzy-find-matching-symbols designator package
+ :time-limit-in-msec time-limit
+ :external-only (not internal-p)
+ :filter (or filter #'identity)))
+ (find-packages (designator time-limit)
+ (fuzzy-find-matching-packages designator
+ :time-limit-in-msec time-limit)))
(let ((time-limit time-limit-in-msec) (symbols) (packages) (results))
- (cond ((not parsed-package-name) ; E.g. STRING = "asd"
- ;; We don't know if user is searching for a package or a symbol
- ;; within his current package. So we try to find either.
- (setf (values packages time-limit) (find-packages parsed-symbol-name time-limit))
- (setf (values symbols time-limit) (find-symbols parsed-symbol-name package time-limit)))
- ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo"
- (setf (values symbols time-limit) (find-symbols parsed-symbol-name package time-limit)))
- (t ; E.g. STRING = "asd:" or "asd:foo"
- ;; Find fuzzy matchings of the denoted package identifier part.
- ;; After that, find matchings for the denoted symbol identifier
- ;; relative to all the packages found.
- (multiple-value-bind (found-packages rest-time-limit)
- (find-packages parsed-package-name time-limit-in-msec)
- ;; We want to traverse the found packages in the order of their score,
- ;; since those with higher score presumably represent better choices.
- ;; (This is important because some packages may never be looked at if
- ;; time limit exhausts during traversal.)
- (setf found-packages (sort found-packages #'fuzzy-matching-greaterp))
- (loop
- for package-matching across found-packages
- for package = (find-package (fuzzy-matching.package-name package-matching))
- while (or (not time-limit) (> rest-time-limit 0)) do
- (multiple-value-bind (matchings remaining-time)
- ;; The duplication filter removes all those symbols which are
- ;; present in more than one package match. Specifically if such a
- ;; package match represents the home package of the symbol, it's
- ;; the one kept because this one is deemed to be the best match.
- (find-symbols parsed-symbol-name package rest-time-limit
- (%make-duplicate-symbols-filter
- (remove package-matching found-packages)))
- (setf matchings (fix-up matchings package-matching))
- (setf symbols (concatenate 'vector symbols matchings))
- (setf rest-time-limit remaining-time)
- (let ((guessed-sort-duration (%guess-sort-duration (length symbols))))
- (when (<= rest-time-limit guessed-sort-duration)
- (decf rest-time-limit guessed-sort-duration)
- (loop-finish))))
- finally
- (setf time-limit rest-time-limit)
- (when (equal parsed-symbol-name "") ; E.g. STRING = "asd:"
- (setf packages found-packages))))))
- ;; Sort by score; thing with equal score, sort alphabetically.
- ;; (Especially useful when PARSED-SYMBOL-NAME is empty, and all possible
- ;; completions are to be returned.)
- (setf results (concatenate 'vector symbols packages))
- (setf results (sort results #'fuzzy-matching-greaterp))
- (values results (and time-limit (<= time-limit 0)))))))
+ (cond ((not parsed-package-name) ; E.g. STRING = "asd"
+ ;; We don't know if user is searching for a package or a symbol
+ ;; within his current package. So we try to find either.
+ (setf (values packages time-limit)
+ (find-packages parsed-symbol-name time-limit))
+ (setf (values symbols time-limit)
+ (find-symbols parsed-symbol-name package time-limit)))
+ ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo"
+ (setf (values symbols time-limit)
+ (find-symbols parsed-symbol-name package time-limit)))
+ (t ; E.g. STRING = "asd:" or "asd:foo"
+ ;; Find fuzzy matchings of the denoted package identifier part.
+ ;; After that, find matchings for the denoted symbol identifier
+ ;; relative to all the packages found.
+ (multiple-value-bind (symbol-packages rest-time-limit)
+ (find-packages parsed-package-name time-limit-in-msec)
+ ;; We want to traverse the found packages in the order of
+ ;; their score, since those with higher score presumably
+ ;; represent better choices. (This is important because some
+ ;; packages may never be looked at if time limit exhausts
+ ;; during traversal.)
+ (setf symbol-packages
+ (sort symbol-packages #'fuzzy-matching-greaterp))
+ (loop
+ for package-matching across symbol-packages
+ for package = (find-package (fuzzy-matching.package-name
+ package-matching))
+ while (or (not time-limit) (> rest-time-limit 0)) do
+ (multiple-value-bind (matchings remaining-time)
+ ;; The duplication filter removes all those symbols
+ ;; which are present in more than one package
+ ;; match. Specifically if such a package match
+ ;; represents the home package of the symbol, it's the
+ ;; one kept because this one is deemed to be the best
+ ;; match.
+ (find-symbols parsed-symbol-name package rest-time-limit
+ (%make-duplicate-symbols-filter
+ (remove package-matching
+ symbol-packages)))
+ (setf matchings (fix-up matchings package-matching))
+ (setf symbols (concatenate 'vector symbols matchings))
+ (setf rest-time-limit remaining-time)
+ (let ((guessed-sort-duration
+ (%guess-sort-duration (length symbols))))
+ (when (<= rest-time-limit guessed-sort-duration)
+ (decf rest-time-limit guessed-sort-duration)
+ (loop-finish))))
+ finally
+ (setf time-limit rest-time-limit)
+ (when (equal parsed-symbol-name "") ; E.g. STRING = "asd:"
+ (setf packages symbol-packages))))))
+ ;; Sort by score; thing with equal score, sort alphabetically.
+ ;; (Especially useful when PARSED-SYMBOL-NAME is empty, and all
+ ;; possible completions are to be returned.)
+ (setf results (concatenate 'vector symbols packages))
+ (setf results (sort results #'fuzzy-matching-greaterp))
+ (values results (and time-limit (<= time-limit 0)))))))
(defun %guess-sort-duration (length)
;; These numbers are pretty much arbitrary, except that they're
@@ -264,17 +295,17 @@
(if (zerop length)
0
(let ((comparasions (* 3.8 (* length (log length 2)))))
- (* 1000 (* comparasions (expt 10 -7)))))) ; msecs
+ (* 1000 (* comparasions (expt 10 -7)))))) ; msecs
(defun %make-duplicate-symbols-filter (fuzzy-package-matchings)
;; Returns a filter function that takes a symbol, and which returns T
;; if and only if /no/ matching in FUZZY-PACKAGE-MATCHINGS represents
;; the home-package of the symbol passed.
(let ((packages (mapcar #'(lambda (m)
- (find-package (fuzzy-matching.package-name m)))
- (coerce fuzzy-package-matchings 'list))))
+ (find-package (fuzzy-matching.package-name m)))
+ (coerce fuzzy-package-matchings 'list))))
#'(lambda (symbol)
- (not (member (symbol-package symbol) packages)))))
+ (not (member (symbol-package symbol) packages)))))
(defun fuzzy-matching-greaterp (m1 m2)
"Returns T if fuzzy-matching M1 should be sorted before M2.
@@ -283,18 +314,18 @@
equal, the one which comes alphabetically first wins."
(declare (type fuzzy-matching m1 m2))
(let ((score1 (fuzzy-matching.score m1))
- (score2 (fuzzy-matching.score m2)))
+ (score2 (fuzzy-matching.score m2)))
(cond ((> score1 score2) t)
- ((< score1 score2) nil) ; total order
- (t
- (let ((name1 (symbol-name (fuzzy-matching.symbol m1)))
- (name2 (symbol-name (fuzzy-matching.symbol m2))))
- (string< name1 name2))))))
+ ((< score1 score2) nil) ; total order
+ (t
+ (let ((name1 (symbol-name (fuzzy-matching.symbol m1)))
+ (name2 (symbol-name (fuzzy-matching.symbol m2))))
+ (string< name1 name2))))))
(declaim (ftype (function () (integer 0)) get-real-time-msecs))
(defun get-real-time-in-msecs ()
(let ((units-per-msec (max 1 (floor internal-time-units-per-second 1000))))
- (values (floor (get-internal-real-time) units-per-msec)))) ; return just one value!
+ (values (floor (get-internal-real-time) units-per-msec))))
(defun fuzzy-find-matching-symbols
(string package &key (filter #'identity) external-only time-limit-in-msec)
@@ -310,7 +341,7 @@
[261 lines skipped]
More information about the slime-cvs
mailing list