Date: Sunday, September 19, 2010 @ 20:59:22 Author: rtoy Path: /project/cmucl/cvsroot/src/code
Modified: unidata.lisp
Improve completion of Hangul syllables and CJK unified ideographs some more and fix some bugs in previous change.
--------------+ unidata.lisp | 87 ++++++++++++++++++++++----------------------------------- 1 file changed, 35 insertions(+), 52 deletions(-)
Index: src/code/unidata.lisp diff -u src/code/unidata.lisp:1.19 src/code/unidata.lisp:1.20 --- src/code/unidata.lisp:1.19 Sun Sep 19 19:07:46 2010 +++ src/code/unidata.lisp Sun Sep 19 20:59:22 2010 @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.19 2010-09-19 23:07:46 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/unidata.lisp,v 1.20 2010-09-20 00:59:22 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -18,7 +18,7 @@
(defconstant +unidata-path+ #p"ext-formats:unidata.bin")
-(defvar *unidata-version* "$Revision: 1.19 $") +(defvar *unidata-version* "$Revision: 1.20 $")
(defstruct unidata range @@ -1274,62 +1274,45 @@ completions starting with Prefix. If there is no match, NIL is returned." (let (names) - (cond ((search "Hangul_Syllable_" prefix) - (initialize-reverse-hangul-tables) - (unless *hangul-syllable-dictionary* - (build-hangul-syllable-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 16) - *hangul-syllable-dictionary*) - (loop for x in next - do (push (concatenate 'string "Hangul_Syllable_" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Hangul_Syllable_" prefix-match) - names)))) - ((search "Cjk_Unified_Ideograph-" prefix) - (unless *cjk-unified-ideograph-dictionary* - (build-cjk-unified-ideograph-dictionary)) - (multiple-value-bind (prefix-match next completep) - (unicode-complete-name (subseq prefix 22) - *cjk-unified-ideograph-dictionary*) - (loop for x in next - do (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match x) - names)) - (when completep - (push (concatenate 'string "Cjk_Unified_Ideograph-" prefix-match) - names))))) (multiple-value-bind (prefix-match next completep) (unicode-complete-name prefix dict) (loop for x in next do (push (concatenate 'string prefix-match x) names)) (when completep (push prefix-match names)) - ;; Match prefix against Hangul and/or Hangul_syllable - (cond ((search "Hangul_S" prefix-match - :end1 (min 8 (length prefix-match))) - ;; Add syllable as possible completion, and then try to - ;; complete some more so that we don't end up with slime - ;; saying "Hangul_Syllable_" is the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) - *hangul-syllable-dictionary*) - (declare (ignore m)) - (if suffixes - (loop for n in suffixes - do (push (concatenate 'string "Hangul_Syllable_" n) names)) - (push "Hangul_Syllable_" names)))) - ((or ;;(string= prefix-match "Cjk_") - (search "Cjk_Unified_Ideograph-" prefix-match - :end1 (min 22 (length prefix-match)))) - ;; Try to complete the first part so we don't get - ;; "Cjk_Unified_Ideograph-" as the only completion. - (multiple-value-bind (m suffixes) - (unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) - *cjk-unified-ideograph-dictionary*) - (declare (ignore m)) - (loop for n in suffixes - do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) + (flet ((han-or-cjk-completion (prefix-match prefix dictionary) + (let* ((prefix-tail (subseq prefix-match + (min (length prefix) + (length prefix-match)))) + (full-prefix (concatenate 'string prefix prefix-tail))) + (multiple-value-bind (m suffixes) + (unicode-complete-name prefix-tail dictionary) + (declare (ignore m)) + (if suffixes + (loop for n in suffixes + do (push (concatenate 'string full-prefix n) names)) + (push full-prefix names)))))) + ;; Match prefix for Hangul syllables or CJK unified ideographs. + (cond ((char= (char prefix-match 0) #\H) + ;; Add "Hangul_Syllable_" as possible completion for + ;; anything beginning with "H". + (push "Hangul_Syllable_" names) + (when (<= (length names) 1) + ;; Hangul_Syllable is the only match, so let's extend it. + (unless *hangul-syllable-dictionary* + (initialize-reverse-hangul-tables) + (build-hangul-syllable-dictionary)) + (han-or-cjk-completion prefix-match "Hangul_Syllable_" + *hangul-syllable-dictionary*))) + ((char= (char prefix-match 0) #\C) + ;; Add "Cjk_Unified_Ideograph-" as possible completion + ;; for anything beginning with "C". + (push "Cjk_Unified_Ideograph-" names) + (when (<= (length names) 1) + (unless *cjk-unified-ideograph-dictionary* + (build-cjk-unified-ideograph-dictionary)) + (han-or-cjk-completion prefix-match "Cjk_Unified_Ideograph-" + *cjk-unified-ideograph-dictionary*))))) (setf names (mapcar #'string-capitalize names)) ;;(format t "Final names = ~S~%" names) names)))