Skip to content
Snippets Groups Projects
Commit a57bbc1c authored by rtoy's avatar rtoy
Browse files

Improve completion of Hangul syllables and CJK unified ideographs some

more and fix some bugs in previous change.
parent 119f21c7
No related branches found
No related tags found
No related merge requests found
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
;;; This code was written by Paul Foley and has been placed in the public ;;; This code was written by Paul Foley and has been placed in the public
;;; domain. ;;; domain.
;;; ;;;
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unidata.lisp,v 1.19 2010/09/19 23:07:46 rtoy Exp $") (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unidata.lisp,v 1.20 2010/09/20 00:59:22 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
(defconstant +unidata-path+ #p"ext-formats:unidata.bin") (defconstant +unidata-path+ #p"ext-formats:unidata.bin")
(defvar *unidata-version* "$Revision: 1.19 $") (defvar *unidata-version* "$Revision: 1.20 $")
(defstruct unidata (defstruct unidata
range range
...@@ -1274,62 +1274,45 @@ ...@@ -1274,62 +1274,45 @@
completions starting with Prefix. If there is no match, NIL is completions starting with Prefix. If there is no match, NIL is
returned." returned."
(let (names) (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) (multiple-value-bind (prefix-match next completep)
(unicode-complete-name prefix dict) (unicode-complete-name prefix dict)
(loop for x in next (loop for x in next
do (push (concatenate 'string prefix-match x) names)) do (push (concatenate 'string prefix-match x) names))
(when completep (when completep
(push prefix-match names)) (push prefix-match names))
;; Match prefix against Hangul and/or Hangul_syllable (flet ((han-or-cjk-completion (prefix-match prefix dictionary)
(cond ((search "Hangul_S" prefix-match (let* ((prefix-tail (subseq prefix-match
:end1 (min 8 (length prefix-match))) (min (length prefix)
;; Add syllable as possible completion, and then try to (length prefix-match))))
;; complete some more so that we don't end up with slime (full-prefix (concatenate 'string prefix prefix-tail)))
;; saying "Hangul_Syllable_" is the only completion. (multiple-value-bind (m suffixes)
(multiple-value-bind (m suffixes) (unicode-complete-name prefix-tail dictionary)
(unicode-complete-name (subseq prefix-match (min 16 (length prefix-match))) (declare (ignore m))
*hangul-syllable-dictionary*) (if suffixes
(declare (ignore m)) (loop for n in suffixes
(if suffixes do (push (concatenate 'string full-prefix n) names))
(loop for n in suffixes (push full-prefix names))))))
do (push (concatenate 'string "Hangul_Syllable_" n) names)) ;; Match prefix for Hangul syllables or CJK unified ideographs.
(push "Hangul_Syllable_" names)))) (cond ((char= (char prefix-match 0) #\H)
((or ;;(string= prefix-match "Cjk_") ;; Add "Hangul_Syllable_" as possible completion for
(search "Cjk_Unified_Ideograph-" prefix-match ;; anything beginning with "H".
:end1 (min 22 (length prefix-match)))) (push "Hangul_Syllable_" names)
;; Try to complete the first part so we don't get (when (<= (length names) 1)
;; "Cjk_Unified_Ideograph-" as the only completion. ;; Hangul_Syllable is the only match, so let's extend it.
(multiple-value-bind (m suffixes) (unless *hangul-syllable-dictionary*
(unicode-complete-name (subseq prefix-match (min 22 (length prefix-match))) (initialize-reverse-hangul-tables)
*cjk-unified-ideograph-dictionary*) (build-hangul-syllable-dictionary))
(declare (ignore m)) (han-or-cjk-completion prefix-match "Hangul_Syllable_"
(loop for n in suffixes *hangul-syllable-dictionary*)))
do (push (concatenate 'string "Cjk_Unified_Ideograph-" n) names))))) ((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)) (setf names (mapcar #'string-capitalize names))
;;(format t "Final names = ~S~%" names) ;;(format t "Final names = ~S~%" names)
names))) names)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment