;;;
;;; Copyright (c) 2003,2004 uim Project http://uim.freedesktop.org/
;;;
;;; All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; 1. Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above copyright
;;; notice, this list of conditions and the following disclaimer in the
;;; documentation and/or other materials provided with the distribution.
;;; 3. Neither the name of authors nor the names of its contributors
;;; may be used to endorse or promote products derived from this software
;;; without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.
;;;;
;;¥â¡¼¥É°ìÍ÷
;; ÆüËܸìÆþÎϥ⡼¥É(¥«¥¿¥«¥ÊÆüËܸìÆþÎϥ⡼¥É¤âɬÍס©)
;; ±Ñ¿ô¥â¡¼¥É
;; Á´³Ñ±Ñ¿ô¥â¡¼¥É
;;
;;¥¹¥Æ¡¼¥È°ìÍ÷
;; *ÆüËܸìÆþÎϥ⡼¥É
;; ÂÔµ¡¾õÂÖ,ÆþÎϾõÂÖ,ÊÑ´¹¾õÂÖ
;; *ñ¸ìÅÐÏ¿¥â¡¼¥É
;; ÆɤßÆþÎϾõÂÖ,ñ¸ìÆþÎϾõÂÖ
;;
(require "util.scm")
(require "japanese.scm")
(require-custom "generic-key-custom.scm")
(require-custom "prime-custom.scm")
(require-custom "prime-key-custom.scm")
;; configs
;; If #t a candidate window displays comments of candidate words.
(define prime-custom-display-comment? #t)
;; If #t a candidate window displays forms of candidate words such as
;; 'l (small L)', 'I (large i)'.
(define prime-custom-display-form? #t)
(define prime-always-number-selection? #f)
;; config function
;; should be replaced with boolean custom variable -- YamaKen 2005-01-15
(define prime-dont-use-numeral-key-to-select-cand
(lambda ()
(set! prime-cand-select-key?
(lambda (key key-state)
(and (numeral-char? key)
(control-key-mask key-state))))))
;; key
(define-key prime-language-toggle-key? "F11")
(define-key prime-expand-segment-key? '("<Control>o" "<Shift>right"))
(define-key prime-shrink-segment-key? '("<Control>i" "<Shift>left"))
(define-key prime-escape-key? '("escape" "<Control>["))
(define-key prime-space-key? '(" "))
(define-key prime-altspace-key? '("<Control> " "<Alt> "))
(define-key prime-english-next-candidate-key? '("<Control>i" "tab"
generic-next-candidate-key?))
(define-key prime-english-direct-key? '("." "," ":" ";" "(" ")" "\"" "'"
"!" "?"))
;;;; If you're a Vi user, modify the lines below.
;; Default
(define-key prime-app-mode-start-key? #f)
(define prime-app-mode-end-stroke-list #f)
;; For Vi users
;(define-key prime-app-mode-start-key? prime-escape-key?)
;(define prime-app-mode-end-stroke-list
; '("i" "I" "a" "A" "o" "O" "C" "s" "S" ("c" . ("l" "w" "e" "c" "G"))))
(define prime-cand-select-key?
(lambda (key key-state)
(numeral-char? key)))
(define prime-symbol-key?
(lambda (key key-state)
(symbol? key)))
(define prime-with-control-key?
(lambda (key key-state)
(control-key-mask key-state)))
(define prime-command-key?
(lambda (key key-state)
(and (modifier-key-mask key-state)
;; Pressing a shift key only is not a command key.
(not (= (cdr (assoc 'Shift_key key-state-alist)) key-state)))))
(define prime-normal-key?
(lambda (key key-state)
(not (or (prime-command-key? key key-state)
(prime-symbol-key? key key-state)))))
(define prime-any-key?
(lambda (key key-state)
#t))
(define prime-capital-key?
(lambda (key key-state)
(and (shift-key-mask key-state)
(alphabet-char? key))))
(define prime-ja-direct-key?
(lambda (key key-state)
(ja-direct (charcode->string key))))
;;;; ------------------------------------------------------------
;;;; prime-keymap: Keymaps binding a key stroke to a command.
;;;; ------------------------------------------------------------
(define prime-keymap-get-keymap
(lambda (context key key-state)
(let ((mode (prime-context-mode context))
(keymap))
(cond
((= mode prime-mode-latin)
(set! keymap prime-keymap-latin-mode))
((= mode prime-mode-hiragana)
(set! keymap (prime-keymap-get-keymap-hiragana context key key-state)))
((= mode prime-mode-wide-latin)
(set! keymap prime-keymap-wide-latin-mode))
((= mode prime-mode-application)
(set! keymap prime-keymap-app-mode)))
keymap)))
(define prime-keymap-get-keymap-hiragana
(lambda (context key key-state)
(let ((state (prime-context-state context))
(language (prime-context-language 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)
(if (string=? language "Japanese")
(set! keymap prime-keymap-conv-state)
(set! keymap prime-keymap-english-conv-state)))
((= state 'prime-state-preedit)
(if (string=? language "Japanese")
(set! keymap prime-keymap-preedit-state)
(set! keymap prime-keymap-english-preedit-state)))
((= state 'prime-state-fund)
(if (string=? language "Japanese")
(if (prime-context-parent-context context)
(set! keymap prime-keymap-child-fund-state)
(set! keymap prime-keymap-fund-state)))))
keymap)))
(define prime-keymap-get-command
(lambda (keymap key key-state)
(let ((command-key? (car (car keymap)))
(command (cdr (car keymap))))
(if ((symbol-value command-key?) key key-state)
command
(if (null? (cdr keymap))
#f
(prime-keymap-get-command (cdr keymap) key key-state))
))))
(define prime-keymap-latin-mode
'(
(prime-on-key? . prime-command-japanese-mode)
(prime-app-mode-start-key? . prime-command-app-mode-start)
(prime-any-key? . prime-command-commit-raw)
))
(define prime-subkeymap-child-context
'(
(prime-prev-candidate-key? . prime-command-fund-cancel)
(prime-next-candidate-key? . prime-command-fund-cancel)
(prime-backspace-key? . prime-command-fund-backspace)
(prime-delete-key? . prime-command-fund-delete)
(prime-cancel-key? . prime-command-fund-cancel)
(prime-commit-key? . prime-command-child-commit)
(prime-go-left-key? . prime-command-fund-cursor-left)
(prime-go-right-key? . prime-command-fund-cursor-right)
(prime-go-left-edge-key? . prime-command-fund-cursor-left-edge)
(prime-go-right-edge-key? . prime-command-fund-cursor-right-edge)
(prime-space-key? . prime-command-fund-space)
(prime-altspace-key? . prime-command-fund-altspace)
(prime-with-control-key? . prime-command-pass)
(prime-ja-direct-key? . prime-command-fund-commit-ja-direct)
(prime-symbol-key? . prime-command-pass)
(prime-any-key? . prime-command-commit)
))
(define prime-keymap-wide-latin-mode
'(
(prime-on-key? . prime-command-japanese-mode)
(prime-app-mode-start-key? . prime-command-app-mode-start)
(prime-normal-key? . prime-command-wide-latin-input)
(prime-any-key? . prime-command-commit-raw)
))
(define prime-keymap-app-mode
'((prime-any-key? . prime-command-app-mode)))
(define prime-keymap-fund-state
'(
(prime-wide-latin-key? . prime-command-wide-latin-mode)
(prime-latin-key? . prime-command-latin-mode)
(prime-app-mode-start-key? . prime-command-app-mode-start)
;; 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-language-toggle-key? . prime-command-language-toggle)
(prime-space-key? . prime-command-fund-space)
(prime-altspace-key? . prime-command-fund-altspace)
(prime-with-control-key? . prime-command-commit-raw)
(prime-ja-direct-key? . prime-command-fund-commit-ja-direct)
(prime-symbol-key? . prime-command-commit-raw)
(prime-any-key? . prime-command-fund-input)
))
(define prime-keymap-child-fund-state
'(
(prime-wide-latin-key? . prime-command-wide-latin-mode)
(prime-latin-key? . prime-command-latin-mode)
(prime-app-mode-start-key? . prime-command-app-mode-start)
;; 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-prev-candidate-key? . prime-command-fund-cancel)
(prime-next-candidate-key? . prime-command-fund-cancel)
(prime-backspace-key? . prime-command-fund-backspace)
(prime-delete-key? . prime-command-fund-delete)
(prime-cancel-key? . prime-command-fund-cancel)
(prime-commit-key? . prime-command-child-finish)
(prime-go-left-key? . prime-command-fund-cursor-left)
(prime-go-right-key? . prime-command-fund-cursor-right)
(prime-go-left-edge-key? . prime-command-fund-cursor-left-edge)
(prime-go-right-edge-key? . prime-command-fund-cursor-right-edge)
(prime-space-key? . prime-command-fund-space)
(prime-altspace-key? . prime-command-fund-altspace)
(prime-with-control-key? . prime-command-pass)
(prime-ja-direct-key? . prime-command-fund-commit-ja-direct)
(prime-symbol-key? . prime-command-pass)
(prime-any-key? . prime-command-fund-input)
))
(define prime-keymap-preedit-state
'(
(prime-register-key? . prime-command-register-mode)
(prime-begin-conv-key? . prime-command-preedit-convert)
(prime-next-candidate-key? . prime-command-preedit-convert)
(prime-prev-candidate-key? . prime-command-preedit-convert-reversely)
(prime-delete-key? . prime-command-preedit-delete)
(prime-cancel-key? . prime-command-preedit-cancel)
(prime-backspace-key? . prime-command-preedit-backspace)
(prime-commit-key? . prime-command-preedit-commit)
(prime-go-left-edge-key? . prime-command-preedit-cursor-left-edge)
(prime-go-right-edge-key? . prime-command-preedit-cursor-right-edge)
(prime-go-left-key? . prime-command-preedit-cursor-left)
(prime-go-right-key? . prime-command-preedit-cursor-right)
(prime-cand-select-key? . prime-command-preedit-commit-candidate)
;; 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-command-key? . prime-command-pass)
(prime-symbol-key? . prime-command-pass)
(prime-any-key? . prime-command-preedit-input)
))
(define prime-keymap-conv-state
'(
(prime-register-key? . prime-command-register-mode)
(prime-next-candidate-key? . prime-command-conv-next)
(prime-prev-candidate-key? . prime-command-conv-prev)
(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-expand-segment-key? . prime-command-modify-cursor-right)
(prime-shrink-segment-key? . prime-command-modify-cursor-left)
(prime-cand-select-key? . prime-command-conv-select)
;; 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-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-modify-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)
))
;; Keymaps for English
(define prime-keymap-english-fund-state
'(
(prime-space-key? . prime-command-commit-raw)
(prime-english-direct-key? . prime-command-commit-raw)
(prime-wide-latin-key? . prime-command-wide-latin-mode)
(prime-latin-key? . prime-command-latin-mode)
(prime-app-mode-start-key? . prime-command-app-mode-start)
(prime-language-toggle-key? . prime-command-language-toggle)
(prime-with-control-key? . prime-command-commit-raw)
(prime-symbol-key? . prime-command-commit-raw)
(prime-any-key? . prime-command-fund-input)
))
(define prime-keymap-english-preedit-state
'(
(prime-space-key? . prime-command-preedit-commit-and-space)
(prime-english-direct-key? . prime-command-preedit-commit-and-commit-raw)
(prime-begin-conv-key? . prime-command-preedit-convert)
(prime-english-next-candidate-key? . prime-command-preedit-convert)
(prime-prev-candidate-key? . prime-command-preedit-convert-reversely)
(prime-delete-key? . prime-command-preedit-delete)
(prime-cancel-key? . prime-command-preedit-cancel)
(prime-backspace-key? . prime-command-preedit-backspace)
(prime-commit-key? . prime-command-preedit-commit)
(prime-go-left-edge-key? . prime-command-preedit-cursor-left-edge)
(prime-go-right-edge-key? . prime-command-preedit-cursor-right-edge)
(prime-go-left-key? . prime-command-preedit-cursor-left)
(prime-go-right-key? . prime-command-preedit-cursor-right)
(prime-cand-select-key? . prime-command-preedit-commit-candidate)
(prime-command-key? . prime-command-pass)
(prime-symbol-key? . prime-command-pass)
(prime-any-key? . prime-command-preedit-input)
))
(define prime-keymap-english-conv-state
'(
(prime-space-key? . prime-command-conv-commit-and-space)
(prime-english-direct-key? . prime-command-conv-commit-and-commit-raw)
(prime-english-next-candidate-key? . prime-command-conv-next)
(prime-prev-candidate-key? . prime-command-conv-prev)
(prime-cancel-key? . prime-command-conv-cancel)
(prime-backspace-key? . prime-command-conv-cancel)
(prime-commit-key? . prime-command-conv-commit)
(prime-cand-select-key? . prime-command-conv-select)
(prime-symbol-key? . prime-command-pass)
(prime-with-control-key? . prime-command-pass)
(prime-any-key? . prime-command-conv-input)
))
;;;; ------------------------------------------------------------
;;; Implementations
(define prime-mode-latin 0)
(define prime-mode-hiragana 1)
(define prime-mode-wide-latin 2)
(define prime-mode-application 3)
(register-action 'action_prime_mode_latin
(lambda (context)
'(figure_prime_mode_latin
"p[--]"
"Ä̾ïÆþÎÏ"
"PRIME¤ò¥ª¥Õ"))
(lambda (context)
(= (prime-context-mode context)
prime-mode-latin))
(lambda (context)
(prime-mode-set context prime-mode-latin)))
(register-action 'action_prime_mode_hiragana
(lambda (context)
'(figure_prime_mode_hiragana
"P[¤¢]"
"ÆüËܸì"
"PRIME¤ò¥ª¥ó"))
(lambda (context)
(= (prime-context-mode context)
prime-mode-hiragana))
(lambda (context)
(prime-mode-set context prime-mode-hiragana)))
(register-action 'action_prime_mode_wide_latin
(lambda (context)
'(figure_prime_mode_wide_latin
"P[£Á]"
"Á´³Ñ±Ñ¿ô"
"Á´³Ñ¤òÆþÎÏ"))
(lambda (context)
(= (prime-context-mode context)
prime-mode-wide-latin))
(lambda (context)
(prime-mode-set context prime-mode-wide-latin)))
(register-action 'action_prime_mode_application
(lambda (context)
'(figure_prime_mode_application
"P[¡ª]"
"Æüì"
"¥¢¥×¥ê¥±¡¼¥·¥ç¥ó°Í¸"))
(lambda (context)
(= (prime-context-mode context)
prime-mode-application))
(lambda (context)
(prime-mode-set context prime-mode-application)))
;; Update widget definitions based on action configurations. The
;; procedure is needed for on-the-fly reconfiguration involving the
;; custom API
(define prime-configure-widgets
(lambda ()
(register-widget 'widget_prime_input_mode
(activity-indicator-new prime-input-mode-actions)
(actions-new prime-input-mode-actions))
(context-list-replace-widgets! 'prime prime-widgets)))
(define prime-context-rec-spec
(append
context-rec-spec
(list
;; Upper level context which is used for registering a word.
(list 'parent-context #f)
(list 'display-head '())
(list 'display-tail '())
(list 'fund-line '(() . ()))
(list 'preedit-line '("" "" ""))
(list 'state 'prime-state-fund)
(list 'nth 0)
(list 'candidates ())
(list 'mode prime-mode-latin)
(list 'last-word "") ;; PRIME¤äPOBox¤ÎÍѸì¤Ç¤¤¤¦Context
(list 'session #f) ; the actual value is -default or -register.
(list 'language "Japanese") ; language of the current session.
(list 'lang-session-list ()) ; session data of each language
(list 'modification '("" "" ""))
(list 'segment-nth 0)
(list 'segment-candidates ())
(list 'history ())
(list 'previous-mode prime-mode-latin)
(list 'app-mode-key-list ())
)))
(define-record 'prime-context prime-context-rec-spec)
(define prime-context-new-internal prime-context-new)
(define prime-context-new
(lambda (id im)
(let ((context (prime-context-new-internal id im)))
(prime-context-set-widgets! context prime-widgets)
context)))
(define prime-context-new2
(lambda (id im)
(let ((context (prime-context-new-internal id im)))
(prime-context-initialize! context)
context)))
;; This initializes an empty context, and also initializes the prime server.
;; This returns context.
(define prime-context-initialize!
(lambda (context)
(print "prime-context-initialize!")
(if (null? (prime-context-session context))
(begin
;; The prime server is initialized here.
(prime-lib-init prime-use-unixdomain?)
(let ((session (prime-engine-session-start)))
(prime-custom-init)
(prime-context-set-fund-line! context (cons (list) (list)))
(prime-context-set-session! context session)
(prime-context-set-lang-session-list!
context
(list (cons (prime-engine-session-language-get session) session)))
(prime-context-history-update! context))))
context))
;; This function pushs the current context-data to the stack of
;; uim-contexts and create a new context-data.
(define prime-context-push
(lambda (context)
(print "prime-context-push")
(let* ((im (prime-context-im context))
(id (prime-context-id context))
(new-context (prime-context-new2 (prime-context-id context) im)))
(prime-context-set-history! new-context (prime-context-history context))
(set-cdr! (assoc 'state (prime-context-history new-context))
'prime-state-pushed)
(prime-context-set-parent-context! new-context (cons id (cdr context)))
(set-cdr! (find-context id) (cdr new-context))
new-context)))
;; This function destories the current context-data and pops the tail
;; context-data from the stack of uim-contexts.
(define prime-context-pop
(lambda (context)
(let ((parent-context (prime-context-parent-context context)))
(mapcar
(lambda (lang-pair)
(prime-engine-session-end (cdr lang-pair)))
(prime-context-lang-session-list context))
(if parent-context
(begin
(prime-context-set-history! context
(prime-context-history parent-context))
(set-cdr! (assoc 'state (prime-context-history context))
'prime-state-poped)
(set-cdr! (find-context (prime-context-id context))
(cdr parent-context))
))
parent-context)))
(define prime-context-history-update!
(lambda (context)
(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 (cons 'state state)
(cons 'preedit-line (prime-context-copy-preedit-line context))
(cons 'fund-line (prime-context-copy-fund-line context))
(cons 'selected-index selected-index)
(cons 'conversion-line (copy-list
(prime-context-modification context)))
)))))
(define prime-context-history-compare
(lambda (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? state
(cdr (assoc 'state prev-data))))
'state)
((not (equal? (prime-context-get-preedit-line context)
(cdr (assoc 'preedit-line prev-data))))
'preedit)
((not (equal? (prime-context-fund-line context)
(cdr (assoc 'fund-line prev-data))))
'cursor)
((not (equal? selected-index
(cdr (assoc 'selected-index prev-data))))
'nth)
((not (equal? (prime-context-modification context)
(cdr (assoc 'conversion-line prev-data))))
'cursor)
))))
(define prime-context-reset-fund-line!
(lambda (context)
(prime-editor-set-left (prime-context-fund-line context) '())
(prime-editor-set-right (prime-context-fund-line context) '())
))
(define prime-context-copy-fund-line
(lambda (context)
(let ((line (prime-context-fund-line context)))
(cons (copy-list (car line)) (copy-list (cdr line)))
)))
(define prime-context-reset-preedit-line!
(lambda (context)
(prime-engine-edit-erase (prime-context-session context))))
;; This returns a duplicated list of the current preedition.
(define prime-context-copy-preedit-line
(lambda (context)
(copy-list (prime-context-get-preedit-line context))))
;; This returns a list of the current preedition.
;; The structure of the list is [left, cursor, right]. ex. ["ab", "c", "de"].
(define prime-context-get-preedit-line
(lambda (context)
(prime-context-preedit-line context)))
(define prime-preedit-reset!
(lambda (context)
(prime-context-set-state! context 'prime-state-fund)
(prime-context-reset-preedit-line! context)
(prime-context-set-nth! context 0)
))
(define prime-get-nth-candidate
(lambda (context n)
(if (>= n (prime-get-nr-candidates context))
#f
(car (nth n (prime-context-candidates context))))))
(define prime-get-nr-candidates
(lambda (context)
(length (prime-context-candidates context))))
(define prime-get-current-candidate
(lambda (context)
(prime-get-nth-candidate context (prime-context-nth context))))
;;;; ------------------------------------------------------------
;;;; prime-util: General purpose functions
;;;; ------------------------------------------------------------
(define prime-util-string-concat
(lambda (string-list glue)
(if (null? (cdr string-list))
(car string-list)
(string-append (car string-list)
glue
(prime-util-string-concat (cdr string-list) glue))
)))
(define prime-util-assoc-list
(lambda (lst)
(mapcar
(lambda (str)
(string-split str "="))
lst)))
;; This splits the string by the separator. The difference from string-split
;; is the result of spliting "\t\t" by "\t".
;; (string-split "\t\t" "\t") => ().
;; (prime-util-string-split "\t\t" "\t") => ("" "" "").
;; The second argument separator must be a single character string.
(define prime-util-string-split
(lambda (string separator)
(let ((result (list))
(node-string ""))
(map (lambda (target)
(if (equal? target separator)
(begin
(set! result (cons node-string result))
(set! node-string ""))
(set! node-string (string-append node-string target))))
(reverse (string-to-list string)))
(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)))
;; This returns #t, if the argument command like "<Control>j" reflects
;; a pair of key and key-state. The type of both key and key-stae is integer.
(define prime-util-command-match?
(lambda (command key key-state)
((make-key-predicate (modify-key-strs-implicitly command)) key key-state)))
;;;; ------------------------------------------------------------
;;;; prime-uim:
;;;; ------------------------------------------------------------
(define prime-uim-candwin-get-range
(lambda (context)
(let* ((beginning (* (/ (prime-context-nth context) prime-nr-candidate-max)
prime-nr-candidate-max))
(end (min (+ beginning prime-nr-candidate-max)
(prime-get-nr-candidates context))))
(cons beginning end))))
;;;; ------------------------------------------------------------
;;;; 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)))))
;; Don't append "\n" to arg-list in this function. That will cause a
;; problem with unix domain socket.
(define prime-engine-send-command
(lambda (arg-list)
(cdr
(string-split
(prime-send-command
(prime-util-string-concat arg-list "\t"))
"\n"))))
(define prime-engine-conv-predict
(lambda (prime-session)
(cdr (prime-engine-conv-convert-internal prime-session "conv_predict"))))
(define prime-engine-conv-convert
(lambda (prime-session)
(cdr (prime-engine-conv-convert-internal prime-session "conv_convert"))))
(define prime-engine-conv-convert-internal
(lambda (prime-session command)
(let* ((result
(prime-engine-send-command (list command prime-session)))
(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)
(prime-engine-send-command (list "conv_select"
prime-session
(digit->string index-no)))))
;; This sends a conv_commit command to the server and returns the commited
;; string.
(define prime-engine-conv-commit
(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-context-reset
(lambda (prime-session)
(prime-engine-send-command (list "context_reset" prime-session))))
;; session operations
(define prime-engine-session-start
(lambda ()
(car (prime-engine-send-command (list "session_start")))))
(define prime-engine-session-end
(lambda (prime-session)
(prime-engine-send-command (list "session_end" prime-session))))
(define prime-engine-session-language-set
(lambda (language)
(car (prime-engine-send-command (list "session_start" language)))))
(define prime-engine-session-language-get
(lambda (prime-session)
(nth 1 (prime-util-string-split
(car (prime-engine-send-command
(list "session_get_env" prime-session "language")))
"\t"))))
;; composing operations
(define prime-engine-edit-insert
(lambda (prime-session string)
(prime-engine-send-command (list "edit_insert" prime-session string))))
(define prime-engine-edit-delete
(lambda (prime-session)
(prime-engine-send-command (list "edit_delete" prime-session))))
(define prime-engine-edit-backspace
(lambda (prime-session)
(prime-engine-send-command (list "edit_backspace" prime-session))))
(define prime-engine-edit-erase
(lambda (prime-session)
(prime-engine-send-command (list "edit_erase" prime-session))))
;; This sends a edit_commit command to the server and returns the commited
;; string.
(define prime-engine-edit-commit
(lambda (prime-session)
(car (prime-engine-send-command (list "edit_commit" prime-session)))))
;; cursor operations
(define prime-engine-edit-cursor-left
(lambda (prime-session)
(prime-engine-send-command (list "edit_cursor_left" prime-session))))
(define prime-engine-edit-cursor-right
(lambda (prime-session)
(prime-engine-send-command (list "edit_cursor_right" prime-session))))
(define prime-engine-edit-cursor-left-edge
(lambda (prime-session)
(prime-engine-send-command (list "edit_cursor_left_edge" prime-session))))
(define prime-engine-edit-cursor-right-edge
(lambda (prime-session)
(prime-engine-send-command (list "edit_cursor_right_edge" prime-session))))
;; preedition-getting operations
(define prime-engine-edit-get-preedition
(lambda (prime-session)
(prime-util-string-split (car (prime-engine-send-command
(list "edit_get_preedition" prime-session)))
"\t")))
(define prime-engine-edit-get-query-string
(lambda (prime-session)
(car (prime-engine-send-command
(list "edit_get_query_string" prime-session)))))
;; mode operations
(define prime-engine-edit-set-mode
(lambda (prime-session mode)
(prime-engine-send-command (list "edit_set_mode" prime-session mode))))
(define prime-engine-preedit-convert-input
(lambda (string)
(if (string=? string "")
'("")
(let ((conversion (car (prime-engine-send-command
(list "preedit_convert_input" string)))))
(cond
;; counversion could be (), in case a suikyo table is broken.
((not conversion)
'(""))
;; Check the charcode of the beginning char of conversion
(else
(prime-util-string-split conversion "\t")))))))
(define prime-engine-learn-word
(lambda (pron literal pos context suffix rest)
(prime-engine-send-command (list "learn_word"
pron literal pos context suffix rest))))
;; This returns a version string of the PRIME server.
(define prime-engine-get-version
(lambda ()
(car (prime-engine-send-command '("get_version")))))
(define prime-engine-get-env
(lambda (env-name)
(let* ((result (prime-util-string-split
(car (prime-engine-send-command (list "get_env" env-name)))
"\t"))
(result-type (car result)))
(cond
((string=? result-type "nil")
'nil)
((string=? result-type "string")
(nth 1 result))
((string=? result-type "array")
(prime-util-string-split (cdr result) "\t"))
((string=? result-type "boolean")
(string=? (nth 1 result) "true"))
(t
'unknown))
)))
(define prime-engine-get-env-typing-method
(lambda ()
(prime-engine-get-env "typing_method")
))
;;;; ------------------------------------------------------------
;;;; prime-command: User commands for general purpose.
;;;; ------------------------------------------------------------
(define prime-command-pass
(lambda (context key key-state)
#t))
(define prime-command-commit
(lambda (context key key-state)
(prime-commit-without-learning context (charcode->string key))))
(define prime-command-commit-raw
(lambda (context key key-state)
(if (prime-context-parent-context context)
(prime-proc-call-command prime-subkeymap-child-context
context key key-state)
(prime-commit-raw context))))
;;;; prime-command: modes
;; This changes the typing mode specified by mode-string.
(define prime-mode-set-mode
(lambda (context mode-string)
(if (= (prime-context-state context) 'prime-state-converting)
(prime-convert-cancel context))
(prime-engine-edit-set-mode (prime-context-session context) mode-string)))
;; This sets the typing mode to the default/Hiragana mode.
(define prime-command-mode-hiragana
(lambda (context key key-state)
(prime-mode-set-mode context "default")))
;; This sets the typing mode to the Katakana mode.
(define prime-command-mode-katakana
(lambda (context key key-state)
(prime-mode-set-mode context "katakana")))
;; This sets the typing mode to the hankaku(half-width) Katakana mode.
(define prime-command-mode-hankana
(lambda (context key key-state)
(prime-mode-set-mode context "half_katakana")))
;; This sets the typing mode to the zenkaku(wide-width) ASCII mode.
(define prime-command-mode-wideascii
(lambda (context key key-state)
(prime-mode-set-mode context "wide_ascii")))
;; This sets the typing mode to the raw/ASCII mode.
(define prime-command-mode-ascii
(lambda (context key key-state)
(prime-mode-set-mode context "raw")))
(define prime-command-language-toggle
(lambda (context key key-state)
(let ((next-language (if (string=? (prime-context-language context)
"English")
"Japanese" "English")))
(prime-mode-language-set context next-language))))
(define prime-command-japanese-mode
(lambda (context key key-state)
(prime-context-initialize! context)
(prime-mode-set context prime-mode-hiragana)))
(define prime-command-wide-latin-mode
(lambda (context key key-state)
(prime-mode-set context prime-mode-wide-latin)))
(define prime-command-latin-mode
(lambda (context key key-state)
(prime-mode-set context prime-mode-latin)))
(define prime-command-register-mode
(lambda (context key key-state)
(print "prime-command-register-mode")
(prime-register-mode-on context)))
;;;; ------------------------------------------------------------
;;;; prime-command-wide-latin: User commands in a wide-latin-mode
;;;; ------------------------------------------------------------
(define prime-command-wide-latin-input
(lambda (context key key-state)
(let ((wide-char (ja-wide (charcode->string key))))
(if wide-char
(prime-commit-without-learning context wide-char)
(prime-command-commit-raw context key key-state)))))
;;;; ------------------------------------------------------------
;;;; prime-command-conv: User commands in a conversion state
;;;; ------------------------------------------------------------
(define prime-command-conv-next
(lambda (context key key-state)
(prime-convert-selection-move context (+ 1 (prime-context-nth context)))
))
(define prime-command-conv-prev
(lambda (context key key-state)
(if (> (prime-context-nth context) 0)
(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
(lambda (context key key-state)
(prime-convert-cancel context)))
(define prime-command-conv-commit
(lambda (context key key-state)
(prime-commit-conversion context)))
(define prime-command-conv-commit-and-commit-raw
(lambda (context key key-state)
(prime-commit-conversion context)
(prime-command-commit-raw context key key-state)))
(define prime-command-conv-commit-and-space
(lambda (context key key-state)
(prime-commit-conversion context)
(prime-commit-string context " ")))
(define prime-command-conv-select
(lambda (context key key-state)
(let* ((nth0 (number->candidate-index (numeral-char->number key)))
(cand-range (prime-uim-candwin-get-range context))
(nth (min (+ (car cand-range) nth0) (cdr cand-range)))
(cand (prime-get-nth-candidate context nth)))
(if cand
(prime-commit-candidate context nth))
)))
(define prime-command-conv-input
(lambda (context key key-state)
(prime-commit-candidate context (prime-context-nth context))
(prime-command-fund-input context key key-state)
))
;;;; ------------------------------------------------------------
;;;; prime-command-modify: User commands in a modification state.
;;;; ------------------------------------------------------------
(define prime-command-modify-commit
(lambda (context key key-state)
(prime-commit-conversion context)))
(define prime-command-modify-convert
(lambda (context key key-state)
(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)
(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)
(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))))
;; TODO: Add a auto-register-mode function.
;; TODO: (2005-01-12) <Hiroyuki Komatsu>
(define prime-segment-selection-move
(lambda (context selection-index)
(cond
((< selection-index 0)
(set! selection-index (- (prime-segment-get-candidates-length context)
1)))
((>= 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 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.
;;;; ------------------------------------------------------------
(define prime-command-preedit-cancel
(lambda (context key key-state)
(prime-engine-edit-erase (prime-context-session context))))
(define prime-command-preedit-backspace
(lambda (context key key-state)
(prime-engine-edit-backspace (prime-context-session context))))
(define prime-command-preedit-delete
(lambda (context key key-state)
(prime-engine-edit-delete (prime-context-session context))))
(define prime-command-preedit-commit
(lambda (context key key-state)
(prime-commit-preedition context)))
(define prime-command-preedit-commit-and-commit-raw
(lambda (context key key-state)
(prime-commit-preedition context)
(prime-command-commit-raw context key key-state)))
(define prime-command-preedit-commit-and-space
(lambda (context key key-state)
(prime-commit-preedition context)
(prime-commit-string context " ")))
(define prime-command-preedit-cursor-left-edge
(lambda (context key key-state)
(prime-engine-edit-cursor-left-edge (prime-context-session context))))
(define prime-command-preedit-cursor-right-edge
(lambda (context key key-state)
(prime-engine-edit-cursor-right-edge (prime-context-session context))))
(define prime-command-preedit-cursor-left
(lambda (context key key-state)
(prime-engine-edit-cursor-left (prime-context-session context))))
(define prime-command-preedit-cursor-right
(lambda (context key key-state)
(prime-engine-edit-cursor-right (prime-context-session context))))
(define prime-command-preedit-input
(lambda (context key key-state)
(prime-engine-edit-insert (prime-context-session context)
(charcode->string key))))
(define prime-command-preedit-commit-candidate
(lambda (context key key-state)
(if prime-always-number-selection?
(let* ((nth (number->candidate-index (numeral-char->number key)))
(cand (prime-get-nth-candidate context nth)))
(if cand
(prime-commit-candidate context nth))
)
(if (prime-normal-key? key key-state)
(prime-command-preedit-input context key key-state))
)))
(define prime-command-preedit-convert
(lambda (context key key-state)
(prime-convert-start context)
))
(define prime-command-preedit-convert-reversely
(lambda (context key key-state)
(prime-convert-start-reversely context)
))
;;;; ------------------------------------------------------------
;;;; prime-command-fund: User commands in a fundamental state.
;;;; ------------------------------------------------------------
(define prime-command-fund-input
(lambda (context key key-state)
(prime-context-set-state! context 'prime-state-preedit)
(prime-command-preedit-input context key key-state)
))
(define prime-command-fund-space
(lambda (context key key-state)
(cond
((string=? (prime-context-language context) "Japanese")
(let ((space (ja-direct " ")))
(prime-commit-without-learning context space)))
(t
(prime-commit-without-learning context " ")))))
(define prime-command-fund-altspace
(lambda (context key key-state)
(cond
((string=? (prime-context-language context) "Japanese")
(let ((space (if (string=? (ja-direct " ") " ") "¡¡" " ")))
(prime-commit-without-learning context space)))
(t
(prime-commit-without-learning context " ")))))
(define prime-command-fund-commit-ja-direct
(lambda (context key key-state)
(let ((direct (ja-direct (charcode->string key))))
(prime-commit-without-learning context direct)
)))
;;;; ------------------------------------------------------------
;;;; prime-command-register-fund: User commands in a register fundamental state
;;;; ------------------------------------------------------------
(define prime-command-fund-backspace
(lambda (context key key-state)
(prime-editor-backspace-char (prime-context-fund-line context))
))
(define prime-command-fund-delete
(lambda (context key key-state)
(prime-editor-delete-char (prime-context-fund-line context))
))
(define prime-command-fund-cancel
(lambda (context key key-state)
(prime-context-pop context)
))
(define prime-command-child-finish
(lambda (context key key-state)
(let ((parent-context (prime-context-parent-context context)))
(if parent-context
(let* ((reading (prime-preedit-get-string-label parent-context))
(literal (prime-fund-get-line-string context))
(word-data (list (list "basekey" reading)
(list "base" literal))))
(prime-commit-word-data parent-context word-data)
(prime-context-pop context)))
)))
(define prime-command-fund-cursor-left-edge
(lambda (context key key-state)
(prime-editor-cursor-move-left-edge
(prime-context-fund-line context))))
(define prime-command-fund-cursor-right-edge
(lambda (context key key-state)
(prime-editor-cursor-move-right-edge
(prime-context-fund-line context))))
(define prime-command-fund-cursor-left
(lambda (context key key-state)
(prime-editor-cursor-move (prime-context-fund-line context) -1)))
(define prime-command-fund-cursor-right
(lambda (context key key-state)
(prime-editor-cursor-move (prime-context-fund-line context) 1)))
;; ------------------------------------------------------------
;; prime-command-app: commands for specific applications
;; ------------------------------------------------------------
(define prime-command-app-mode-start
(lambda (context key key-state)
(print "prime-command-app-mode-start")
(prime-context-set-previous-mode! context (prime-context-mode context))
(prime-context-set-app-mode-key-list! context
prime-app-mode-end-stroke-list)
(prime-mode-set context prime-mode-application)
(prime-commit-raw context)))
(define prime-command-app-mode-end
(lambda (context key key-state)
(prime-mode-set context (prime-context-previous-mode context))
(prime-context-set-previous-mode! context prime-mode-latin)))
(define prime-command-app-mode
(lambda (context key key-state)
(prime-command-app-mode-internal
context key key-state
(prime-context-app-mode-key-list context))))
(define prime-command-app-mode-internal
(lambda (context key key-state key-list)
(let ((key-data (car key-list)))
(cond
;; there's no speficied command then pressed key is passed.
((= key-list '())
(prime-context-set-app-mode-key-list! context
prime-app-mode-end-stroke-list)
(prime-commit-raw context))
;; key-data is a string like "i" then this app-mode ends.
((and (string? key-data)
(prime-util-command-match? key-data key key-state))
(prime-command-app-mode-end context key key-state)
(prime-commit-raw context))
;; key-data is a stroke of keys like ("c" . ("l" "w" ...))
;; then the key-list data goes to a next stage.
((and (list? key-data)
(prime-util-command-match? (car key-data) key key-state))
(prime-context-set-app-mode-key-list! context (cdr key-data))
(prime-commit-raw context))
;; call this command recursively.
(t
(prime-command-app-mode-internal context
key key-state (cdr key-list)))))))
;;;; ------------------------------------------------------------
;;;; prime-proc: procedure
;;;; ------------------------------------------------------------
(define prime-proc-call-command
(lambda (keymap context key key-state)
(let ((command (prime-keymap-get-command keymap key key-state)))
(if command
(begin
((symbol-value command) context key key-state)
#t)
#f))))
;;;; ------------------------------------------------------------
;;;; prime-preedit:
;;;; ------------------------------------------------------------
(define prime-editor-get-left (lambda (line) (car line)))
(define prime-editor-set-left (lambda (line new-line-left)
(set-car! line new-line-left)))
(define prime-editor-get-left-string
(lambda (line)
(string-list-concat (prime-editor-get-left line))))
(define prime-editor-get-right (lambda (line) (cdr line)))
(define prime-editor-set-right (lambda (line new-line-right)
(set-cdr! line new-line-right)))
(define prime-editor-get-right-string
(lambda (line)
(string-list-concat (reverse (prime-editor-get-right line)))))
(define prime-editor-get-line
(lambda (line)
(append
(reverse (prime-editor-get-right line))
(prime-editor-get-left line))))
(define prime-editor-get-line-string
(lambda (line)
(string-list-concat (prime-editor-get-line line))))
(define prime-editor-cursor-move-right-edge
(lambda (line)
(let ((new-line-left (prime-editor-get-line line)))
(prime-editor-set-right line '())
(prime-editor-set-left line new-line-left))))
(define prime-editor-cursor-move-left-edge
(lambda (line)
(let ((new-line-right (reverse (prime-editor-get-line line))))
(prime-editor-set-right line new-line-right)
(prime-editor-set-left line '()))))
(define prime-editor-cursor-move
(lambda (line motion-arg)
(cond
;; right motion
((and (> motion-arg 0)
(not (null? (cdr line))))
(let ((line-left (cons (car (prime-editor-get-right line))
(prime-editor-get-left line)))
(line-right (cdr (prime-editor-get-right line))))
(prime-editor-set-left line line-left)
(prime-editor-set-right line line-right))
(prime-editor-cursor-move line (- motion-arg 1)))
;; left motion
((and (< motion-arg 0)
(not (null? (car line))))
(let ((line-left (cdr (prime-editor-get-left line)))
(line-right (cons (car (prime-editor-get-left line))
(prime-editor-get-right line))))
(prime-editor-set-left line line-left)
(prime-editor-set-right line line-right))
(prime-editor-cursor-move line (+ motion-arg 1)))
(else line))))
(define prime-editor-insert-char
(lambda (line char)
(prime-editor-set-left line (cons char (prime-editor-get-left line)))))
(define prime-editor-backspace-char
(lambda (line)
(prime-editor-set-left line (cdr (prime-editor-get-left line)))))
(define prime-editor-delete-char
(lambda (line)
(prime-editor-set-right line (cdr (prime-editor-get-right line)))))
;; This returns a preediting string.
(define prime-preedit-get-string-label
(lambda (context)
(apply string-append (prime-context-preedit-line context))))
;; This returns #t if the preediting string is not empty. Or #f.
(define prime-preedit-exist?
(lambda (context)
(> (length (prime-preedit-get-string-label context)) 0)))
;; This returns a query string for PRIME server.
(define prime-preedit-get-string-raw
(lambda (context)
(prime-engine-edit-get-query-string (prime-context-session context))))
;; This returns a commited string of register mode.
(define prime-fund-get-line-string
(lambda (context)
(let ((line (prime-context-fund-line context)))
(prime-editor-get-line-string line))))
;;;; ------------------------------------------------------------
;;;; prime-custom
;;;; ------------------------------------------------------------
(define prime-custom-init
(lambda ()
(let ((typing-method (prime-engine-get-env-typing-method)))
(cond
((string=? typing-method "kana")
(prime-dont-use-numeral-key-to-select-cand))
((string=? typing-method "tcode")
(prime-dont-use-numeral-key-to-select-cand)
(set! prime-mask-pending-preedit? #t)
)
))
))
;;;; ------------------------------------------------------------
;;;; prime-commit
;;;; ------------------------------------------------------------
(define prime-commit-raw
(lambda (context)
(if (= (prime-context-mode context) prime-mode-latin)
(im-commit-raw context)
(begin
;; Reset the current prime-context
(prime-engine-context-reset (prime-context-session context))
(im-commit-raw context)
(prime-context-set-last-word! context "")
(prime-preedit-reset! context)
))))
(define prime-commit-without-learning
(lambda (context string)
;; Reset the current prime-context
(prime-engine-context-reset (prime-context-session context))
(if (prime-context-parent-context context)
(prime-commit-to-fund-line context string)
(im-commit context string))
(prime-context-set-last-word! context "")
))
(define prime-commit-string
(lambda (context string)
(if (prime-context-parent-context context)
(prime-commit-to-fund-line context string)
(im-commit context string))
(prime-preedit-reset! context)))
;; obsolete
(define prime-commit-word-data
(lambda (context word-data)
(prime-learn-word context word-data)
(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)
(let ((commited-string (prime-engine-edit-commit
(prime-context-session context))))
(prime-commit-string context commited-string))))
(define prime-commit-conversion
(lambda (context)
(let ((commited-string (prime-engine-conv-commit
(prime-context-session context))))
(prime-commit-string context commited-string))))
(define prime-commit-segment
(lambda (context)
; (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)
(prime-engine-conv-select (prime-context-session context) index-no)
(prime-commit-conversion context)))
(define prime-commit-to-fund-line
(lambda (context word)
(let ((line (prime-context-fund-line context)))
(prime-editor-set-left line (append (string-to-list word)
(prime-editor-get-left line)))
)))
;;;; ------------------------------------------------------------
(define prime-learn-word
(lambda (context assoc-list)
(let ((key (or (cadr (assoc "basekey" assoc-list)) ""))
(value (or (cadr (assoc "base" assoc-list)) ""))
(part (or (cadr (assoc "part" assoc-list)) ""))
(prime-context (or (prime-context-last-word context) ""))
(suffix (or (cadr (assoc "conjugation" assoc-list)) ""))
(rest (or (cadr (assoc "suffix" assoc-list)) "")))
(prime-engine-learn-word key value part prime-context suffix rest)
(prime-context-set-last-word! context
(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)
(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)
(prime-context-set-nth! context selection-index)
(if (prime-get-current-candidate context)
;; If the selection-index is a valid number, sends the number
;; to the server.
(prime-engine-conv-select (prime-context-session context)
selection-index)
(begin
(prime-context-set-nth! context 0)
(if prime-auto-register-mode?
(prime-register-mode-on context))))))
;; This resets the converting mode and goes to the preediting mode.
(define prime-convert-cancel
(lambda (context)
(prime-context-set-state! context 'prime-state-preedit)
(prime-context-set-nth! context 0)))
;; This executes 'conv_predict' to predict candidate words and stores them.
(define prime-convert-get-prediction
(lambda (context)
(prime-context-set-candidates! ;; FIXME: candidates -> conversions
context
(prime-engine-conv-predict (prime-context-session context)))))
;; This executes 'conv_convert' to get candidate words and stores them.
(define prime-convert-get-conversion
(lambda (context)
(prime-context-set-candidates! ;; FIXME: candidates -> conversions
context
(prime-engine-conv-convert (prime-context-session context)))))
;;;; ------------------------------------------------------------
;;;; prime-commit
;;;; ------------------------------------------------------------
(define prime-update
(lambda (context)
(prime-update-key-press context)
(prime-update-key-release context)))
(define prime-update-key-press
(lambda (context)
(let ((session (prime-context-session context)))
(cond
((null? session)
#f) ;; Do nothing.
(#t
;; Store the current preedition into the context
(prime-context-set-preedit-line!
context
(prime-engine-edit-get-preedition session))
(prime-update-state context)
(prime-update-preedit context)
)))))
(define prime-update-key-release
(lambda (context)
(let ((session (prime-context-session context)))
(cond
((null? session)
#f) ;; Do nothing.
(#t
(prime-update-prediction context)
(prime-update-candidate-window context)
(prime-update-history context)
)))))
(define prime-update-state
(lambda (context)
(if (not (prime-preedit-exist? context))
(prime-context-set-state! context 'prime-state-fund))))
(define prime-update-history
(lambda (context)
(prime-context-history-update! context)))
(define prime-update-prediction
(lambda (context)
(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-fund)
(prime-context-set-candidates! context '()))
)))
((= diff 'preedit)
(prime-convert-get-prediction context))
))))
(define prime-update-candidate-window
(lambda (context)
(let ((diff (prime-context-history-compare context)))
(cond
((= diff 'state)
(let ((state (prime-context-state context)))
(cond
((= state 'prime-state-fund)
(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)
(if (prime-context-history-compare context)
(begin
(im-clear-preedit context)
(prime-display-preedit context
(prime-update-preedit-internal context))
(im-update-preedit context)
))))
(define prime-update-preedit-internal
(lambda (context)
(let* ((line (prime-context-fund-line context))
(line-left (prime-editor-get-left-string line))
(line-right (prime-editor-get-right-string line)))
(append
(prime-context-display-head context)
(if line-left (list (cons 'committed line-left)))
(prime-preedit-state-update-preedit context)
(if line-right (list (cons 'committed line-right)))
(prime-context-display-tail context)))))
(define prime-preedit-state-update-preedit
(lambda (context)
(let* ((state (prime-context-state context)))
(cond
((= state 'prime-state-converting)
(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)
(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 'pseudo-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
(let ((type (car (car preedit-list)))
(string (cdr (car preedit-list))))
(cond
((eq? type 'cursor)
(prime-display-preedit-cursor context))
((not (string=? string ""))
(im-pushback-preedit
context (cdr (assoc type prime-display-preedit-format)) string))
)
(prime-display-preedit context (cdr preedit-list))))))
(define prime-display-preedit-cursor
(lambda (context)
(im-pushback-preedit
context (cdr (assoc 'cursor prime-display-preedit-format)) "")
(if (and prime-pseudo-mode-cursor?
(= (prime-context-mode context) prime-mode-hiragana)
(eq? (prime-context-state context) 'prime-state-fund))
(im-pushback-preedit context
(cdr (assoc 'pseudo-cursor
prime-display-preedit-format))
" "))
))
;;;; ------------------------------------------------------------
(define prime-register-mode-on
(lambda (context)
(print "prime-register-mode-on")
(let* ((reading (prime-preedit-get-string-label context))
;; Header and footer strings for a preedition line.
(current-display-head (prime-context-display-head context))
(current-display-tail (prime-context-display-tail context))
;; Committed line in the current session.
(current-line (prime-context-fund-line context))
(current-line-left (prime-editor-get-left-string current-line))
(current-line-right (prime-editor-get-right-string current-line))
(new-context (prime-context-push context)))
(prime-context-set-display-head!
new-context
(append current-display-head
(if current-line-left
(list (cons 'committed current-line-left)))
(list (cons 'register-label "ñ¸ìÅÐÏ¿")
(cons 'register-border "[")
(cons 'register-word reading)
(cons 'register-border "|"))))
(prime-context-set-display-tail!
new-context
(append (list (cons 'register-border "]"))
(if current-line-right
(list (cons 'committed current-line-right)))
current-display-tail))
;; Go to Japanese mode immediately.
(prime-mode-set context prime-mode-hiragana)
)))
;; This just returns the empty context between this client and a prime
;; server. However the prime server may not be initialized yet. The
;; server will be initialized in prime-context-initialize! after a
;; user turn on the prime mode.
(define prime-init-handler
(lambda (id im arg)
(prime-context-new id im)))
(define prime-release-handler
(lambda (context)
(print "prime-release-handler")
(let ((session (prime-context-session context)))
(if session
(prime-engine-session-end session)))
))
(define prime-press-key-handler
(lambda (context key key-state)
(if (control-char? key)
(im-commit-raw context)
(let ((keymap (prime-keymap-get-keymap context key key-state)))
(prime-proc-call-command keymap context key key-state)
(prime-update-key-press context)
))))
(define prime-release-key-handler
(lambda (context key key-state)
(print "prime-release-key-handler")
(if (or (control-char? key)
(= (prime-context-mode context)
prime-mode-latin))
(im-commit-raw context)
;; else
;; FIXME: update candidate words.
(prime-update-key-release context)
)))
(define prime-reset-handler
(lambda (context)
(print "prime-reset-handler")
))
(define prime-mode-set
(lambda (context mode)
(prime-context-set-mode! context mode)
;; FIXME: I don't wanna use prime-context-session here.
;; FIXME: (2005-02-25) <Hiroyuki Komatsu>
;; If the session is #f, the PRIME mode has never been turned on.
(if (prime-context-session context)
(begin
(prime-preedit-reset! context)
(prime-update context)
))
))
(define prime-mode-language-set
(lambda (context language)
(let* ((lang-session-list (prime-context-lang-session-list context))
(session (cdr (assoc language lang-session-list))))
(if (not session)
(begin
(set! session (prime-engine-session-language-set language))
(prime-context-set-lang-session-list!
context
(cons (cons language session) lang-session-list))))
(prime-context-set-language! context language)
(prime-context-set-session! context session))))
(define prime-get-candidate-handler
(lambda (context index-no accel-enum-hint)
(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)
(let ((string (prime-candidate-get-literal candidate))
(usage (prime-candidate-get-data candidate "usage"))
(comment (prime-candidate-get-data candidate "comment"))
(form (prime-candidate-get-data candidate "form"))
(state (prime-context-state context)))
(if (and prime-custom-display-form?
form
(or (= state 'prime-state-converting)
(= state 'prime-state-segment)))
(set! string (string-append string " (" form ")")))
(if (and prime-custom-display-usage?
usage
(or (= state 'prime-state-converting)
(= state 'prime-state-segment)))
(set! string (string-append string "\t¢¦" usage)))
(if (and prime-custom-display-comment?
comment
(or (= state 'prime-state-converting)
(= state 'prime-state-segment)))
(set! string (string-append string "\t<" comment ">")))
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")
(if (= (prime-context-state context) 'prime-state-segment)
(prime-segment-selection-move context selection-index)
(prime-convert-selection-move context))
(prime-update context)
))
(prime-configure-widgets)
(register-im
'prime ;; name
"ja" ;; lang
"EUC-JP" ;; encoding
prime-im-name-label ;; name-label
prime-im-short-desc ;; short-dest
#f ;; init-arg
prime-init-handler ;; init
prime-release-handler ;; release
context-mode-handler ;; mode
prime-press-key-handler ;; key-press
prime-release-key-handler ;; key-release
prime-reset-handler ;; reset
prime-get-candidate-handler ;; get-candidate
prime-set-candidate-index-handler ;; set-candidate-index
context-prop-activate-handler ;; prop
)
