Hiroyuki Komatsu
komat****@users*****
2004年 12月 23日 (木) 06:52:10 JST
Index: prime/uim/prime.scm
diff -u prime/uim/prime.scm:1.1.2.10 prime/uim/prime.scm:1.1.2.11
--- prime/uim/prime.scm:1.1.2.10 Wed Dec 22 03:23:33 2004
+++ prime/uim/prime.scm Thu Dec 23 06:52:09 2004
@@ -95,6 +95,8 @@
(define-key prime-typing-mode-hankana-key? "F8")
(define-key prime-typing-mode-wideascii-key? "F9")
(define-key prime-typing-mode-ascii-key? "F10")
+(define-key prime-expand-segment-key? '("<Control>o" "<Shift>right"))
+(define-key prime-shrink-segment-key? '("<Control>i" "<Shift>left"))
(define-key prime-space-key? '(" "))
(define-key prime-altspace-key? '("<Control> " "<Alt> "))
@@ -281,6 +283,10 @@
(prime-cancel-key? . prime-command-conv-cancel)
(prime-backspace-key? . prime-command-conv-cancel)
(prime-commit-key? . prime-command-conv-commit)
+ (prime-go-left-edge-key? . prime-command-modify-cursor-left-edge)
+ (prime-go-right-edge-key? . prime-command-modify-cursor-right-edge)
+ (prime-go-left-key? . prime-command-modify-cursor-left)
+ (prime-go-right-key? . prime-command-modify-cursor-right)
(prime-cand-select-key? . prime-command-conv-select)
;; Typing mode key bindings
(prime-typing-mode-hiragana-key? . prime-command-mode-hiragana)
@@ -312,6 +318,47 @@
(prime-any-key? . prime-command-register-conv-input)
))
+(define prime-keymap-modify-state
+ '(
+; (prime-register-key? . prime-command-register-mode)
+ (prime-begin-conv-key? . prime-command-modify-convert)
+ (prime-next-candidate-key? . prime-command-modify-convert)
+ (prime-prev-candidate-key? . prime-command-modify-convert-reversely)
+ (prime-cancel-key? . prime-command-conv-cancel)
+; (prime-backspace-key? . prime-command-conv-cancel)
+ (prime-commit-key? . prime-command-modify-commit)
+ (prime-go-left-edge-key? . prime-command-modify-cursor-left-edge)
+ (prime-go-right-edge-key? . prime-command-modify-cursor-right-edge)
+ (prime-go-left-key? . prime-command-modify-cursor-left)
+ (prime-go-right-key? . prime-command-modify-cursor-right)
+ (prime-expand-segment-key? . prime-command-modify-cursor-expand)
+ (prime-shrink-segment-key? . prime-command-modify-cursor-shrink)
+; ;; Typing mode key bindings
+; (prime-typing-mode-hiragana-key? . prime-command-mode-hiragana)
+; (prime-typing-mode-katakana-key? . prime-command-mode-katakana)
+; (prime-typing-mode-hankana-key? . prime-command-mode-hankana)
+; (prime-typing-mode-wideascii-key? . prime-command-mode-wideascii)
+; (prime-typing-mode-ascii-key? . prime-command-mode-ascii)
+; (prime-symbol-key? . prime-command-pass)
+; (prime-with-control-key? . prime-command-pass)
+ (prime-any-key? . prime-command-pass)
+ ))
+
+(define prime-keymap-segment-state
+ '(
+ (prime-cancel-key? . prime-command-segment-cancel)
+ (prime-commit-key? . prime-command-segment-commit)
+ (prime-next-candidate-key? . prime-command-segment-next)
+ (prime-prev-candidate-key? . prime-command-segment-prev)
+ (prime-go-left-edge-key? . prime-command-modify-cursor-left-edge)
+ (prime-go-right-edge-key? . prime-command-modify-cursor-right-edge)
+ (prime-go-left-key? . prime-command-modify-cursor-left)
+ (prime-go-right-key? . prime-command-modify-cursor-right)
+ (prime-expand-segment-key? . prime-command-modify-cursor-expand)
+ (prime-shrink-segment-key? . prime-command-modify-cursor-shrink)
+ (prime-any-key? . prime-command-pass)
+ ))
+
;;;; ------------------------------------------------------------
(define prime-mode-latin 0)
@@ -322,19 +369,20 @@
(append
context-rec-spec
(list
- (list 'state 'prime-state-no-preedit)
- (list 'learning-word #f)
- (list 'nth 0)
- (list 'candidates ())
- (list 'mode prime-mode-latin)
- (list 'last-word "") ;;PRIMEやPOBoxの用語でいうContext
- (list 'session "") ; the actual value is -default or -register.
- (list 'session-default "")
- (list 'session-register "")
- (list 'register-line '(() . ()))
- ;; history = (prev-status, prev-preedition, prev-register-preedtion
- ;; index-of-candidate)
- (list 'history '(prime-state-no-preedit ("" "" "") (() . ()) 0)))))
+ (list 'state 'prime-state-no-preedit)
+ (list 'learning-word #f)
+ (list 'nth 0)
+ (list 'candidates ())
+ (list 'mode prime-mode-latin)
+ (list 'last-word "") ;; PRIMEやPOBoxの用語でいうContext
+ (list 'session "") ; the actual value is -default or -register.
+ (list 'session-default "")
+ (list 'session-register "")
+ (list 'modification '("" "" ""))
+ (list 'segment-nth 0)
+ (list 'segment-candidates ())
+ (list 'register-line '(() . ()))
+ (list 'history ()))))
(define-record 'prime-context prime-context-rec-spec)
(define prime-context-new-internal prime-context-new)
@@ -347,29 +395,49 @@
(prime-context-set-session! context session1)
(prime-context-set-session-default! context session1)
(prime-context-set-session-register! context session2)
+ (prime-context-history-update! context)
context)))
-(define prime-context-history-set!
+(define prime-context-history-update!
(lambda (context)
- (prime-context-set-history! context (list
- (prime-context-state context)
- (prime-context-copy-preedit-line context)
- (prime-context-copy-register-line context)
- (prime-context-nth context)))))
-(define prime-context-history-get prime-context-history)
+ (let* ((state (prime-context-state context))
+ (selected-index (if (= state 'prime-state-segment)
+ (prime-context-segment-nth context)
+ (prime-context-nth context))))
+ (prime-context-set-history!
+ context
+ (list (list 'state state)
+ (list 'preedit-line (prime-context-copy-preedit-line context))
+ (list 'register-line (prime-context-copy-register-line context))
+ (list 'selected-index selected-index)
+ (list 'conversion-line (copy-list
+ (prime-context-modification context)))
+ )))))
+
(define prime-context-history-compare
(lambda (context)
(print "prime-context-history-compare")
- (let ((prev-data (prime-context-history-get context)))
+ (let* ((prev-data (prime-context-history context))
+ (state (prime-context-state context))
+ (selected-index (if (= state 'prime-state-segment)
+ (prime-context-segment-nth context)
+ (prime-context-nth context))))
(cond
- ((not (equal? (prime-context-state context) (nth 0 prev-data)))
+ ((not (equal? state
+ (cadr (assoc 'state prev-data))))
'state)
- ((not (equal? (prime-context-get-preedit-line context) (nth 1 prev-data)))
+ ((not (equal? (prime-context-get-preedit-line context)
+ (cadr (assoc 'preedit-line prev-data))))
'preedit)
- ((not (equal? (prime-context-get-register-line context) (nth 2 prev-data)))
+ ((not (equal? (prime-context-get-register-line context)
+ (cadr (assoc 'register-line prev-data))))
'cursor)
- ((not (equal? (prime-context-nth context) (nth 3 prev-data)))
+ ((not (equal? selected-index
+ (cadr (assoc 'selected-index prev-data))))
'nth)
+ ((not (equal? (prime-context-modification context)
+ (cadr (assoc 'conversion-line prev-data))))
+ 'cursor)
))))
@@ -402,16 +470,6 @@
(lambda (context)
(prime-engine-edit-get-preedition (prime-context-session context))))
-
-(define prime-send-command
- (lambda (command)
- (let ((result (prime-lib-send-command command)))
- (let loop ((res result))
- (if (string=? res "")
- (loop (prime-lib-send-command ""))
- res
- )))))
-
(define prime-preedit-reset!
(lambda (context)
(print "prime-preedit-reset!")
@@ -428,25 +486,6 @@
#f
(car (nth n (prime-context-candidates context))))))
-;; This returns the data sepecified by key of the N th word.
-;; This is called by prime-get-nth-usage and prime-get-nth-annotation.
-(define prime-get-nth-word-data
- (lambda (context n key)
- (if (> n (prime-get-nr-candidates context))
- #f
- (cadr (assoc key
- (nth 1 (nth n (prime-context-candidates context))))))))
-
-(define prime-get-nth-usage
- (lambda (context n)
- (print "prime-get-nth-usage")
- (prime-get-nth-word-data context n "usage")))
-
-(define prime-get-nth-annotation
- (lambda (context n)
- (print "prime-get-nth-annotation")
- (prime-get-nth-word-data context n "annotation")))
-
(define prime-get-nr-candidates
(lambda (context)
(length (prime-context-candidates context))))
@@ -456,27 +495,6 @@
(print "prime-get-current-candidate")
(prime-get-nth-candidate context (prime-context-nth context))))
-;; DELETEME: obsolete
-(define prime-get-candidates! ;;もうちょっと関数名をどうにかしたい
- (lambda (context preedit prime-context)
- (print "prime-get-candidates!")
- (prime-engine-set-context prime-context)
- (prime-context-set-candidates!
- context
- (prime-engine-lookup prime-engine-command-lookup preedit))
- ))
-
-;; DELETEME: obsolete
-(define prime-get-all-candidates! ;;これももうちょっと関数名をどうにかしたい
- (lambda (context preedit prime-context)
- (prime-engine-set-context prime-context)
- (prime-context-set-candidates!
- context
- (prime-engine-lookup prime-engine-command-lookup-all preedit))
- ))
-
-
-
;;;; ------------------------------------------------------------
;;;; prime-util: General purpose functions
;;;; ------------------------------------------------------------
@@ -516,6 +534,21 @@
(set! result (cons node-string result))
(reverse result))))
+(define prime-util-string-to-integer
+ (lambda (string)
+ (let ((integer 0)
+ (figure 1))
+ (mapcar
+ (lambda (digit-string)
+ (if (string=? digit-string "-")
+ (set! integer (- integer))
+ (set! integer (+ integer (* (- (string->charcode digit-string)
+ (string->charcode "0"))
+ figure))))
+ (set! figure (* figure 10)))
+ (string-to-list string))
+ integer)))
+
;;;; ------------------------------------------------------------
;;;; prime-uim:
;;;; ------------------------------------------------------------
@@ -532,49 +565,49 @@
;;;; prime-engine: Functions to connect with a prime server.
;;;; ------------------------------------------------------------
+(define prime-send-command
+ (lambda (command)
+ (let ((result (prime-lib-send-command command)))
+ (let loop ((buffer result))
+ (if (string=? buffer "")
+ (loop (prime-lib-send-command ""))
+ buffer)))))
+
(define prime-engine-send-command
(lambda (arg-list)
- (cdr
- (string-split
- (prime-send-command
- (string-append (prime-util-string-concat arg-list "\t") "\n"))
- "\n"))))
-
-;; DELETEME: Obsolete function.
-(define prime-engine-lookup
- (lambda (command string)
- (print "prime-engine-lookup")
- (mapcar
- (lambda (string-line)
- (let ((word-data (prime-util-string-split string-line "\t")))
- (list (nth 0 word-data) ; reading
- (nth 1 word-data) ; literal
- (prime-util-assoc-list (nthcdr 2 word-data)))))
- (prime-engine-send-command (list command string)))))
+ (cdr (string-split
+ (prime-send-command
+ (string-append (prime-util-string-concat arg-list "\t") "\n"))
+ "\n"))))
(define prime-engine-conv-predict
(lambda (prime-session)
- (prime-engine-conv-convert-internal prime-session "conv_predict")))
+ (print "prime-engine-conv-predict")
+ (cdr (prime-engine-conv-convert-internal prime-session "conv_predict"))))
(define prime-engine-conv-convert
(lambda (prime-session)
- (prime-engine-conv-convert-internal prime-session "conv_convert")))
+ (print "prime-engine-conv-convert")
+ (cdr (prime-engine-conv-convert-internal prime-session "conv_convert"))))
(define prime-engine-conv-convert-internal
(lambda (prime-session command)
+ (print "prime-engine-conv-convert-internal")
(let* ((result
(prime-engine-send-command (list command prime-session)))
- (index (car result))
- (words (cdr result)))
- (mapcar
- (lambda (string-line)
- (let ((word-data (prime-util-string-split string-line "\t")))
- (list (car word-data) ; literal
- (prime-util-assoc-list (cdr word-data)))))
- words))))
+ (index (prime-util-string-to-integer (car result)))
+ (words (mapcar
+ (lambda (string-line)
+ (let ((word-data (prime-util-string-split string-line
+ "\t")))
+ (list (car word-data) ; literal
+ (prime-util-assoc-list (cdr word-data)))))
+ (cdr result))))
+ (cons index words))))
(define prime-engine-conv-select
(lambda (prime-session index-no)
+ (print "prime-engine-conv-select")
(prime-engine-send-command (list "conv_select"
prime-session
(digit->string index-no)))))
@@ -585,6 +618,46 @@
(lambda (prime-session)
(car (prime-engine-send-command (list "conv_commit" prime-session)))))
+(define prime-engine-modify-cursor-internal
+ (lambda (prime-session command)
+ (prime-util-string-split
+ (car (prime-engine-send-command (list command prime-session)))
+ "\t")))
+
+(define prime-engine-modify-cursor-right
+ (lambda (prime-session)
+ (prime-engine-modify-cursor-internal prime-session "modify_cursor_right")))
+(define prime-engine-modify-cursor-left
+ (lambda (prime-session)
+ (prime-engine-modify-cursor-internal prime-session "modify_cursor_left")))
+(define prime-engine-modify-cursor-right-edge
+ (lambda (prime-session)
+ (prime-engine-modify-cursor-internal prime-session
+ "modify_cursor_right_edge")))
+(define prime-engine-modify-cursor-left-edge
+ (lambda (prime-session)
+ (prime-engine-modify-cursor-internal prime-session
+ "modify_cursor_left_edge")))
+(define prime-engine-modify-cursor-expand
+ (lambda (prime-session)
+ (prime-engine-modify-cursor-internal prime-session
+ "modify_cursor_expand")))
+(define prime-engine-modify-cursor-shrink
+ (lambda (prime-session)
+ (prime-engine-modify-cursor-internal prime-session
+ "modify_cursor_shrink")))
+
+(define prime-engine-segment-select
+ (lambda (prime-session index-no)
+ (prime-util-string-split
+ (car (prime-engine-send-command (list "segment_select"
+ prime-session
+ (digit->string index-no))))
+ "\t")))
+
+(define prime-engine-segment-reconvert
+ (lambda (prime-session)
+ (prime-engine-conv-convert-internal prime-session "segment_reconvert")))
(define prime-engine-set-context
(lambda (prime-context)
@@ -796,7 +869,7 @@
(define prime-command-register-conv-next
(lambda (context key key-state)
- (prime-context-set-nth! context (+ 1 (prime-context-nth context)))
+ (prime-context-set-nth! context (+ (prime-context-nth context) 1))
(cond
((prime-get-current-candidate context)
#f)
@@ -807,10 +880,10 @@
(define prime-command-conv-prev
(lambda (context key key-state)
(if (> (prime-context-nth context) 0)
- (prime-context-set-nth! context
- (- (prime-context-nth context) 1))
- (prime-context-set-nth! context
- (- (prime-get-nr-candidates context) 1)))
+ (prime-convert-selection-move context
+ (- (prime-context-nth context) 1))
+ (prime-convert-selection-move context
+ (- (prime-get-nr-candidates context) 1)))
))
(define prime-command-conv-cancel
@@ -820,7 +893,8 @@
(define prime-command-conv-commit
(lambda (context key key-state)
(print "prime-command-conv-commit")
- (prime-commit-candidate context (prime-context-nth context))
+ (prime-commit-conversion context)
+; (prime-commit-candidate context (prime-context-nth context))
))
(define prime-command-register-conv-commit
@@ -864,11 +938,129 @@
(define prime-command-register-conv-input
(lambda (context key key-state)
(print "prime-command-register-conv-input")
- (prime-commit-to-register-buffer context (prime-get-current-candidate context))
+ (prime-commit-to-register-buffer context
+ (prime-get-current-candidate context))
(prime-push-key context key key-state)
))
;;;; ------------------------------------------------------------
+;;;; prime-command-modify: User commands in a modification state.
+;;;; ------------------------------------------------------------
+
+(define prime-command-modify-commit
+ (lambda (context key key-state)
+ (print "prime-command-modify-commit")
+ (prime-commit-conversion context)))
+
+(define prime-command-modify-convert
+ (lambda (context key key-state)
+ (print "prime-command-modify-convert")
+ (prime-context-set-state! context 'prime-state-segment)
+ (let ((conversion (prime-engine-segment-reconvert
+ (prime-context-session context))))
+ (prime-context-set-segment-nth! context (car conversion))
+ (prime-context-set-segment-candidates! context (cdr conversion)))))
+
+(define prime-command-modify-convert-reversely
+ (lambda (context key key-state)
+ (print "prime-command-modify-convert-reversely")
+ (prime-command-modify-convert context key key-state)
+ (prime-command-segment-prev context key key-state)))
+
+(define prime-command-modify-cursor-right
+ (lambda (context key key-state)
+ (print "prime-command-modify-cursor-right")
+ (prime-modify-reset! context)
+ (prime-context-set-modification!
+ context
+ (prime-engine-modify-cursor-right (prime-context-session context)))
+ ))
+
+(define prime-command-modify-cursor-left
+ (lambda (context key key-state)
+ (prime-modify-reset! context)
+ (prime-context-set-modification!
+ context
+ (prime-engine-modify-cursor-left (prime-context-session context)))
+ ))
+
+(define prime-command-modify-cursor-right-edge
+ (lambda (context key key-state)
+ (prime-modify-reset! context)
+ (prime-context-set-modification!
+ context
+ (prime-engine-modify-cursor-right-edge (prime-context-session context)))
+ ))
+
+(define prime-command-modify-cursor-left-edge
+ (lambda (context key key-state)
+ (prime-modify-reset! context)
+ (prime-context-set-modification!
+ context
+ (prime-engine-modify-cursor-left-edge (prime-context-session context)))
+ ))
+
+(define prime-command-modify-cursor-expand
+ (lambda (context key key-state)
+ (prime-modify-reset! context)
+ (prime-context-set-modification!
+ context
+ (prime-engine-modify-cursor-expand (prime-context-session context)))
+ ))
+
+(define prime-command-modify-cursor-shrink
+ (lambda (context key key-state)
+ (prime-modify-reset! context)
+ (prime-context-set-modification!
+ context
+ (prime-engine-modify-cursor-shrink (prime-context-session context)))
+ ))
+
+(define prime-modify-reset!
+ (lambda (context)
+ (prime-context-set-state! context 'prime-state-modifying)
+ (prime-context-set-segment-nth! context 0)
+ (prime-context-set-segment-candidates! context ())))
+
+;;;; ------------------------------------------------------------
+;;;; prime-command-segment: User commands in a segment state.
+;;;; ------------------------------------------------------------
+(define prime-command-segment-cancel
+ (lambda (context key key-state)
+ (prime-modify-reset! context)))
+
+(define prime-command-segment-commit
+ (lambda (context key key-state)
+ (prime-commit-segment context)))
+
+(define prime-command-segment-next
+ (lambda (context key key-state)
+ (prime-segment-selection-move context
+ (+ (prime-context-segment-nth context) 1))))
+
+(define prime-command-segment-prev
+ (lambda (context key key-state)
+ (prime-segment-selection-move context
+ (- (prime-context-segment-nth context) 1))))
+
+(define prime-segment-selection-move
+ (lambda (context selection-index)
+ (print "prime-segment-selection-move")
+ (if (or (< selection-index 0)
+ (>= selection-index (prime-segment-get-candidates-length context)))
+ (set! selection-index 0))
+ (prime-context-set-segment-nth! context selection-index)
+ (prime-context-set-modification! context
+ (prime-engine-segment-select
+ (prime-context-session-default context)
+ selection-index))
+ ))
+
+(define prime-segment-get-candidates-length
+ (lambda (context)
+ (length (prime-context-segment-candidates context))))
+
+;;;; ------------------------------------------------------------
;;;; prime-command-preedit: User commands in a preedit state.
;;;; ------------------------------------------------------------
@@ -952,12 +1144,12 @@
(define prime-command-preedit-convert
(lambda (context key key-state)
(print "prime-command-preedit-convert")
- (prime-begin-conversion context)
+ (prime-convert-start context)
))
(define prime-command-preedit-convert-reversely
(lambda (context key key-state)
- (prime-begin-conversion-reversely context)
+ (prime-convert-start-reversely context)
))
;;;; ------------------------------------------------------------
@@ -1066,8 +1258,13 @@
(learning-word (prime-context-learning-word context))
(keymap))
(cond
+ ((= state 'prime-state-segment)
+ (set! keymap prime-keymap-segment-state))
+
+ ((= state 'prime-state-modifying)
+ (set! keymap prime-keymap-modify-state))
+
((= state 'prime-state-converting)
- (print ":prime-push-key: converting")
(if learning-word
(set! keymap prime-keymap-register-conv-state)
(set! keymap prime-keymap-conv-state)))
@@ -1218,36 +1415,49 @@
(prime-context-set-last-word! context "")
))
+(define prime-commit-string
+ (lambda (context string)
+ (print "prime-commit-string")
+ (im-commit context string)
+ (prime-preedit-reset! context)))
+
;; obsolete
(define prime-commit-word-data
(lambda (context word-data)
(print "prime-commit-word-data")
- (im-commit context
- (string-append (or (cadr (assoc "base" word-data)) "")
- (or (cadr (assoc "conjugation" word-data)) "")
- (or (cadr (assoc "suffix" word-data)) "")))
(prime-learn-word context word-data)
- (prime-preedit-reset! context)))
+ (prime-commit-string
+ context
+ (string-append (or (cadr (assoc "base" word-data)) "")
+ (or (cadr (assoc "conjugation" word-data)) "")
+ (or (cadr (assoc "suffix" word-data)) "")))))
(define prime-commit-preedition
(lambda (context)
(print "prime-commit-preedition")
- (let* ((prime-session (prime-context-session-default context))
- (commited-string (prime-engine-edit-commit prime-session)))
- (im-commit context commited-string)
- (prime-preedit-reset! context))))
+ (let ((commited-string (prime-engine-edit-commit
+ (prime-context-session-default context))))
+ (prime-commit-string context commited-string))))
+
+(define prime-commit-conversion
+ (lambda (context)
+ (print "prime-commit-conversion")
+ (let ((commited-string (prime-engine-conv-commit
+ (prime-context-session-default context))))
+ (prime-commit-string context commited-string))))
+
+(define prime-commit-segment
+ (lambda (context)
+ (print "prime-commit-segment")
+; (prime-engine-modify-commit (prime-context-session-default context))
+ (prime-context-set-state! context 'prime-state-modifying)))
(define prime-commit-candidate
(lambda (context index-no)
(print "prime-commit-candidate")
- (let* ((prime-session (prime-context-session-default context))
- (commited-string (begin
- (prime-engine-conv-select prime-session index-no)
- (prime-engine-conv-commit prime-session))))
- (im-commit context commited-string)
- (prime-preedit-reset! context))))
-; (let ((word-data (nth 1 (nth n (prime-context-candidates context)))))
-; (prime-commit-word-data context word-data))))
+ (prime-engine-conv-select (prime-context-session-default context)
+ index-no)
+ (prime-commit-conversion context)))
(define prime-commit-to-register-buffer
(lambda (context word)
@@ -1274,14 +1484,48 @@
(string-append value suffix rest))
)))
+
+;;;; ------------------------------------------------------------
+;;;; prime-convert
+;;;; ------------------------------------------------------------
+
+(define prime-convert-start
+ (lambda (context)
+ (prime-convert-start-internal context 0)))
+
+(define prime-convert-start-reversely
+ (lambda (context)
+ (let ((last-idx (- (prime-get-nr-candidates context)
+ 1)))
+ (prime-convert-start-internal context last-idx))))
+
+(define prime-convert-start-internal
+ (lambda (context init-idx)
+ (print "prime-convert-start-internal")
+ (let ((res))
+ (prime-convert-get-conversion context)
+ (set! res (prime-get-nth-candidate context init-idx))
+ (if res
+ (begin
+ (prime-context-set-nth! context init-idx)
+ (prime-context-set-state! context 'prime-state-converting))
+ )
+ (prime-convert-selection-move context init-idx)
+ )))
+
+
;; This function moves the cursor of candidate words. If the cursor is out of
;; the range and the variable prime-auto-register-mode? is #t, the mode is
;; changed to register-mode.
(define prime-convert-selection-move
(lambda (context selection-index)
+ (print "prime-convert-selection-move")
(prime-context-set-nth! context selection-index)
(if (prime-get-current-candidate context)
- #f
+ ;; If the selection-index is a valid number, sends the number
+ ;; to the server.
+ (prime-engine-conv-select (prime-context-session-default context)
+ selection-index)
(if prime-auto-register-mode?
(prime-register-mode-on context)
(prime-context-set-nth! context 0)))
@@ -1310,31 +1554,6 @@
context
(prime-engine-conv-convert (prime-context-session-default context)))))
-(define prime-begin-conversion-internal
- (lambda (context init-idx)
- (print "prime-begin-conversion-internal")
- (let ((res))
- (prime-convert-get-conversion context)
- (set! res (prime-get-nth-candidate context init-idx))
- (if res
- (begin
- (prime-context-set-nth! context init-idx)
- (prime-context-set-state! context 'prime-state-converting))
- )
- (prime-convert-selection-move context init-idx)
- )))
-
-(define prime-begin-conversion-reversely
- (lambda (context)
- (let ((last-idx (- (prime-get-nr-candidates context)
- 1)))
- (prime-begin-conversion-internal context last-idx))))
-
-(define prime-begin-conversion
- (lambda (context)
- (prime-begin-conversion-internal context 0)))
-
-
;;;; ------------------------------------------------------------
;;;; prime-commit
;;;; ------------------------------------------------------------
@@ -1342,7 +1561,6 @@
(define prime-update
(lambda (context)
(print "prime-update")
- (print (prime-context-state context))
(prime-update-state context)
(prime-update-prediction context)
@@ -1356,15 +1574,81 @@
(define prime-update-state
(lambda (context)
(if (not (prime-preedit-exist? context))
- (begin
- (print " prime-update-state: set-state no-preedit")
- (prime-context-set-state! context 'prime-state-no-preedit)))
- ))
+ (prime-context-set-state! context 'prime-state-no-preedit))))
(define prime-update-history
(lambda (context)
(print "prime-update-history")
- (prime-context-history-set! context)))
+ (prime-context-history-update! context)))
+
+(define prime-update-prediction
+ (lambda (context)
+ (print "prime-update-prediction")
+ (let ((diff (prime-context-history-compare context)))
+ (cond
+ ((= diff 'state)
+ (let ((state (prime-context-state context))
+ (last-word (prime-context-last-word context)))
+ (cond
+ ((= state 'prime-state-preedit)
+ (prime-convert-get-prediction context))
+ ((= state 'prime-state-converting)
+ ;; Do nothing. (prime-convert-get-conversion context) had been
+ ;; already executed at prime-convert-start-internal
+ )
+ ((= state 'prime-state-no-preedit)
+ (prime-context-set-candidates! context '()))
+ )))
+ ((= diff 'preedit)
+ (prime-convert-get-prediction context))
+ ))))
+
+(define prime-update-candidate-window
+ (lambda (context)
+ (print "prime-update-candidate-window")
+ (let ((diff (prime-context-history-compare context)))
+ (cond
+ ((= diff 'state)
+ (let ((state (prime-context-state context)))
+ (cond
+ ((= state 'prime-state-no-preedit)
+ (im-deactivate-candidate-selector context))
+
+ ((= state 'prime-state-preedit)
+ (if (> (prime-get-nr-candidates context) 0)
+ (im-activate-candidate-selector
+ context
+ (prime-get-nr-candidates context)
+ 3)))
+; prime-nr-candidate-max)))
+
+ ((= state 'prime-state-converting)
+ (im-activate-candidate-selector
+ context (prime-get-nr-candidates context) prime-nr-candidate-max)
+ (im-select-candidate context (prime-context-nth context)))
+
+ ((= state 'prime-state-modifying)
+ (im-deactivate-candidate-selector context))
+
+ ((= state 'prime-state-segment)
+ (im-activate-candidate-selector
+ context
+ (prime-segment-get-candidates-length context)
+ prime-nr-candidate-max)
+ (im-select-candidate context (prime-context-segment-nth context)))
+ )))
+
+ ((= diff 'nth)
+ (if (= (prime-context-state context) 'prime-state-segment)
+ (im-select-candidate context (prime-context-segment-nth context))
+ (im-select-candidate context (prime-context-nth context))))
+
+ ((= diff 'preedit)
+ (if (> (prime-get-nr-candidates context) 0)
+ (im-activate-candidate-selector
+ context (prime-get-nr-candidates context) prime-nr-candidate-max)
+ (im-deactivate-candidate-selector context)))
+ ))))
(define prime-update-preedit
(lambda (context)
@@ -1390,49 +1674,56 @@
(register-left (prime-editor-get-left line))
(register-right (reverse (prime-editor-get-right line))))
(append
- (list
- (cons 'register-label "単語登録")
- (cons 'register-border "[")
- (cons 'register-word learning-word)
- (cons 'register-border "|")
- (cons 'committed (string-list-concat register-left)))
-
+ (list (cons 'register-label "単語登録")
+ (cons 'register-border "[")
+ (cons 'register-word learning-word)
+ (cons 'register-border "|")
+ (cons 'committed (string-list-concat register-left)))
(prime-preedit-state-update-preedit context)
- (list
- (cons 'committed (string-list-concat register-right))
- (cons 'register-border "]"))))))
+ (list (cons 'committed (string-list-concat register-right))
+ (cons 'register-border "]"))))))
(define prime-preedit-state-update-preedit
(lambda (context)
(print "prime-preedit-state-update-preedit")
- (let* ((state (prime-context-state context))
- (line (prime-context-get-preedit-line context))
- (left (car line))
- (right (apply string-append (cdr line)))
- )
+ (let* ((state (prime-context-state context)))
(cond
((= state 'prime-state-converting)
- (list (cons 'converting (prime-get-current-candidate context))))
+ (list (cons 'converting (prime-get-current-candidate context))
+ (cons 'cursor "")))
+
+ ((or (= state 'prime-state-modifying)
+ (= state 'prime-state-segment))
+ (let* ((line (prime-context-modification context)))
+ (list (cons 'segment (nth 0 line))
+ (cons 'segment-highlight (nth 1 line))
+ (cons 'cursor "")
+ (cons 'segment (nth 2 line)))))
((prime-preedit-exist? context)
- (list (cons 'preedit left)
- (cons 'cursor "")
- (cons 'preedit right)))
+ (let* ((line (prime-context-get-preedit-line context))
+ (left (car line))
+ (right (apply string-append (cdr line))))
+ (list (cons 'preedit left)
+ (cons 'cursor "")
+ (cons 'preedit right))))
+
(else
(list (cons 'cursor "")))))))
(define prime-display-preedit-format
- (list (cons 'committed preedit-none)
- (cons 'cursor preedit-cursor)
- (cons 'pseude-cursor preedit-reverse)
- (cons 'preedit preedit-underline)
- (cons 'converting preedit-reverse)
- (cons 'register-border preedit-reverse)
- (cons 'register-label preedit-reverse)
- (cons 'register-word preedit-reverse)
+ (list (cons 'committed preedit-none)
+ (cons 'cursor preedit-cursor)
+ (cons 'pseude-cursor preedit-reverse)
+ (cons 'preedit preedit-underline)
+ (cons 'converting preedit-underline)
+ (cons 'segment preedit-underline)
+ (cons 'segment-highlight preedit-reverse)
+ (cons 'register-border preedit-reverse)
+ (cons 'register-label preedit-reverse)
+ (cons 'register-word preedit-reverse)
))
-
(define prime-display-preedit
(lambda (context preedit-list)
(if preedit-list
@@ -1460,57 +1751,6 @@
" "))
))
-(define prime-update-prediction
- (lambda (context)
- (print "prime-update-prediction")
- (let ((diff (prime-context-history-compare context)))
- (cond
- ((= diff 'state)
- (let ((state (prime-context-state context))
- (last-word (prime-context-last-word context)))
- (cond
- ((= state 'prime-state-preedit)
- (prime-convert-get-prediction context))
- ((= state 'prime-state-converting)
- (prime-convert-get-conversion context))
- ((= state 'prime-state-no-preedit)
- (prime-context-set-candidates! context '()))
- )))
- ((= diff 'preedit)
- (prime-convert-get-prediction context))
- ))))
-
-(define prime-update-candidate-window
- (lambda (context)
- (print "prime-update-candidate-window")
- (let ((diff (prime-context-history-compare context)))
- (cond
- ((= diff 'state)
- (let ((state (prime-context-state context)))
- (cond
- ((= state 'prime-state-no-preedit)
- (im-deactivate-candidate-selector context))
- ((= state 'prime-state-preedit)
- (if (> (prime-get-nr-candidates context) 0)
- (im-activate-candidate-selector
- context
- (prime-get-nr-candidates context)
- 3)))
-; prime-nr-candidate-max)))
- ((= state 'prime-state-converting)
- (im-activate-candidate-selector
- context (prime-get-nr-candidates context) prime-nr-candidate-max)
- (im-select-candidate context (prime-context-nth context)))
- )))
- ((= diff 'nth)
- (im-select-candidate context (prime-context-nth context)))
- ((= diff 'preedit)
- (if (> (prime-get-nr-candidates context) 0)
- (im-activate-candidate-selector
- context (prime-get-nr-candidates context) prime-nr-candidate-max)
- (im-deactivate-candidate-selector context)))
- ))))
-
;;;; ------------------------------------------------------------
(define prime-register-mode-on
@@ -1590,26 +1830,48 @@
()))
(define prime-get-candidate-handler
- (lambda (context idx accel-enum-hint)
- (let* ((cand (prime-get-nth-candidate context idx))
- (usage (prime-get-nth-usage context idx))
- (annotation (prime-get-nth-annotation context idx)))
+ (lambda (context index-no accel-enum-hint)
+ (print "prime-get-candidate-handler")
+ (let ((candidate
+ (if (= (prime-context-state context) 'prime-state-segment)
+ (nth index-no (prime-context-segment-candidates context))
+ (nth index-no (prime-context-candidates context)))))
+ ;; The return value is a list with a candidate string and the next index.
+ (list (prime-candidate-combine-string context candidate)
+ (digit->string (+ index-no 1))))))
+
+(define prime-candidate-combine-string
+ (lambda (context candidate)
+ (print "prime-candidate-combine-string")
+ (let ((string (prime-candidate-get-literal candidate))
+ (usage (prime-candidate-get-data candidate "usage"))
+ (annotation (prime-candidate-get-data candidate "annotation")))
(if (and prime-char-annotation?
annotation
- (= (prime-context-state context) 'prime-state-converting))
- (set! cand (string-append cand " (" annotation ")")))
+ (or (= (prime-context-state context) 'prime-state-converting)
+ (= (prime-context-state context) 'prime-state-segment)))
+ (set! string (string-append string " (" annotation ")")))
(if (and prime-custom-display-usage?
usage
- (= (prime-context-state context) 'prime-state-converting))
- (set! cand (string-append cand "\t▽" usage)))
-
- ;; The return value is a list with a candidate string and the next index.
- (list cand (digit->string (+ idx 1))))))
+ (or (= (prime-context-state context) 'prime-state-converting)
+ (= (prime-context-state context) 'prime-state-segment)))
+ (set! string (string-append string "\t▽" usage)))
+ string)))
+
+(define prime-candidate-get-literal
+ (lambda (candidate)
+ (car candidate)))
+
+(define prime-candidate-get-data
+ (lambda (candidate key)
+ (cadr (assoc key (nth 1 candidate)))))
(define prime-set-candidate-index-handler
(lambda (context selection-index)
(print "prime-set-candidate-index-handler")
- (prime-convert-selection-move context selection-index)
+ (if (= (prime-context-state context) 'prime-state-segment)
+ (prime-segment-selection-move context selection-index)
+ (prime-convert-selection-move context))
(prime-update context)
))
Index: prime/uim/ChangeLog
diff -u prime/uim/ChangeLog:1.1.2.10 prime/uim/ChangeLog:1.1.2.11
--- prime/uim/ChangeLog:1.1.2.10 Wed Dec 22 03:23:33 2004
+++ prime/uim/ChangeLog Thu Dec 23 06:52:09 2004
@@ -1,3 +1,8 @@
+2004-12-23 Hiroyuki Komatsu <komat****@taiya*****>
+
+ * prime.scm:
+ Implementing functions for the PRIME2 protocol (for PRIME 0.9.4).
+
2004-12-22 Hiroyuki Komatsu <komat****@taiya*****>
* prime.scm: