[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-01-22-g53cb30a
Raymond Toy
rtoy at common-lisp.net
Wed Feb 1 05:22:49 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via 53cb30ad0335c33c70c24779aa964b775404680e (commit)
via 768d6a348cbad25cfe57d664a3784e639b3878e7 (commit)
from 3073cc1fcd6e00759421a1a9b9373c140155efa6 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 53cb30ad0335c33c70c24779aa964b775404680e
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Jan 31 21:22:41 2012 -0800
Minor fix from Paul: avoid capitalizing mid-name in the completions
list.
diff --git a/src/code/unidata.lisp b/src/code/unidata.lisp
index 91b5bda..e0442d8 100644
--- a/src/code/unidata.lisp
+++ b/src/code/unidata.lisp
@@ -1286,7 +1286,7 @@
(let* ((base (mip result))
(node (search-dictionary base dict)))
(values (str base)
- (sort (mapcar (lambda (x) (str (subseq x (length base))))
+ (sort (mapcar (lambda (x) (subseq (str x) (length base)))
(delete base result :test #'string=))
#'string<)
(and node (completep node)))))))
commit 768d6a348cbad25cfe57d664a3784e639b3878e7
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Jan 31 19:34:14 2012 -0800
Fix ticket:52.
Thanks to Paul Foley for rewriting {{{UNICODE-COMPLETE-NAME}}} to make
it work.
diff --git a/src/code/unidata.lisp b/src/code/unidata.lisp
index 4f94684..91b5bda 100644
--- a/src/code/unidata.lisp
+++ b/src/code/unidata.lisp
@@ -1231,98 +1231,65 @@
Three values are returned: (1) The best match of prefix, (2) a list
of possible completions, (3) a boolean indicating whether the best
match is a complete unicode name. "
-
(unless dict
- ;; Load the names dictionary, if needed.
- (unless (unidata-name+ *unicode-data*)
- (load-names))
+ (load-names)
(setf dict (unidata-name+ *unicode-data*)))
- (let ((prefix (nsubstitute #\Space #\_ (string-upcase prefix)))
- completep)
- (multiple-value-bind (n p)
- (search-dictionary prefix dict)
- (when n
- (setq completep (> (aref (dictionary-codev dict) n) -1)))
- #+(or debug-uc)
- (progn
- (format t "n,p,complete = ~S ~S ~S~%" n p completep)
- (when n (format t "match = ~S~%" (subseq prefix 0 p))))
- (cond ((not p)
- (values (%str prefix) nil nil))
- ((= p (length prefix))
- ;; The prefix is an exact match to something in the code
- ;; book. Try to find possible completions of this
- ;; prefix.
- (let ((x (node-next n dict))
- (suffix ""))
- #+(or debug-uc)
- (format t "init x = ~S~%" x)
- (when (= (length x) 1)
- ;; There was only one possible extension. Try to
- ;; extend from there.
- #+(or debug-uc)
- (format t "extending~%")
- (setq suffix (caar x)
- n (cdar x)
- x (node-next (cdar x) dict)))
- #+(or debug-uc)
- (progn
- (format t "x = ~S~%" x)
- (format t "suffix = ~S~%" suffix))
- (when (<= (length x) 1)
- (setq prefix (concatenate 'string prefix suffix))
- (setf suffix ""))
- (values (%str prefix)
- (sort (mapcar #'(lambda (e)
- (%str (concatenate 'string suffix (car e))))
- x)
- #'string<)
- (or (> (aref (dictionary-codev dict) n) -1)
- completep))))
- (t
- ;; The prefix was not an exact match of some entry in the
- ;; codebook. Try to find some completions from there.
- (let* ((nodex (node-next n dict))
- (x (remove-if-not (lambda (x)
- (%match (car x) prefix p))
- nodex)))
- #+(or debug-uc)
- (progn
- (format t "nodex = ~S~%" nodex)
- (format t "x = ~S~%" x))
- (setq prefix (subseq prefix 0 p))
- (cond ((= (length x) 1)
- ;; Only one possible completion. Try to extend
- ;; the completions from there.
- (setq prefix (concatenate 'string prefix (caar x))
- n (cdar x)
- x (node-next (cdar x) dict))
- (values (%str prefix)
- (sort (mapcar #'%strx x) #'string<)
- (> (aref (dictionary-codev dict) n) -1)))
- (t
- ;; There's more than one possible completion.
- ;; Try to extend each of those completions one
- ;; more step, but we still want to keep the
- ;; original completions.
- (let* ((p (append (mapcar #'car x)
- (mapcan #'(lambda (ex)
- (let ((next (node-next (cdr ex) dict)))
- (if next
- (mapcar #'(lambda (n)
- (concatenate 'string (car ex) (car n)))
- (node-next (cdr ex) dict))
- (list (car ex)))))
- x)))
- (q (%mip p)))
- (setq prefix (concatenate 'string prefix q))
-
- (do ((tmp p (cdr tmp)))
- ((endp tmp))
- (setf (car tmp) (subseq (car tmp) (length q))))
- (values (%str prefix)
- (sort (mapcar #'%str p) #'string<)
- nil))))))))))
+ (let* ((prefix (nsubstitute #\Space #\_ (string-upcase prefix)))
+ (result nil))
+ (labels ((keybase (node)
+ (ash (aref (dictionary-nextv dict) node) -18))
+ (keylen (base)
+ (aref (dictionary-keyl dict) base))
+ (keystr (base offset)
+ (aref (dictionary-cdbk dict)
+ (aref (dictionary-keyv dict) (+ base offset))))
+ (next (node keypos)
+ (+ (logand (aref (dictionary-nextv dict) node) #x3FFFF)
+ keypos))
+ (completep (node)
+ (> (aref (dictionary-codev dict) node) -1))
+ (match (part prefix posn)
+ (let ((s1 (search part prefix :start2 posn))
+ (s2 (search prefix part :start1 posn)))
+ (or (and s1 (= s1 posn))
+ (and s2 (zerop s2)))))
+ (rec (node posn)
+ (let ((keyv (keybase node)))
+ (dotimes (i (keylen keyv))
+ (let* ((str (keystr keyv i)) (len (length str)))
+ (when (match str prefix posn)
+ (cond ((<= (+ len posn) (length prefix))
+ (rec (next node i) (+ posn len)))
+ (t
+ (push (fillout (concatenate 'string (subseq prefix 0 posn)
+ str)
+ (next node i))
+ result))))))))
+ (fillout (string node)
+ (let ((keyv (keybase node)))
+ (if (and (= (keylen keyv) 1) (not (completep node)))
+ (fillout (concatenate 'string string (keystr keyv 0))
+ (next node 0))
+ string)))
+ (mip (strings)
+ (let* ((first (first strings))
+ (posn (length first)))
+ (dolist (string (rest strings))
+ (let ((n (mismatch first string :end1 posn)))
+ (when n (setq posn n))))
+ (subseq first 0 posn)))
+ (str (x) (nsubstitute #\_ #\Space (string-capitalize x))))
+ (rec 0 0)
+ (unless (cdr result)
+ (setq prefix (car result))
+ (rec 0 0))
+ (let* ((base (mip result))
+ (node (search-dictionary base dict)))
+ (values (str base)
+ (sort (mapcar (lambda (x) (str (subseq x (length base))))
+ (delete base result :test #'string=))
+ #'string<)
+ (and node (completep node)))))))
;; Like unicode-complete-name, but we also try to handle the names
;; that can be computed algorithmically like the Hangul syllables and
-----------------------------------------------------------------------
Summary of changes:
src/code/unidata.lisp | 147 +++++++++++++++++++------------------------------
1 files changed, 57 insertions(+), 90 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list