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@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@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