;;;
;;; 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.
;;;;

; Comment should be written in English, UTF-8.
;
(require "util.scm")

;; config
(define enable-im-switch #f)
(define default-im-name #f)

;; preedit attributes: should be moved to another file
(define preedit-none 0)
(define preedit-underline 1)
(define preedit-reverse 2)
(define preedit-cursor 4)
(define preedit-separator 8)
(define preedit-attr?
  (lambda (attr)
    (or
     (= attr preedit-none)
     (= attr preedit-underline)
     (= attr preedit-reverse)
     (= attr preedit-cursor)
     (= attr preedit-separator))))

;;
;; im-management
;;
(define current-im #f)
(define im-list ())

;; accessors
(define im-name
  (lambda (im)
    (cdr (assq 'name im))))
(define im-init-arg
  (lambda (im)
    (cdr (assq 'init-arg im))))
(define im-init-handler
  (lambda (im)
    (cdr (assq 'init-handler im))))
(define im-release-handler
  (lambda (im)
    (cdr (assq 'release-handler im))))
(define im-key-press-handler
  (lambda (im)
    (cdr (assq 'key-press-handler im))))
(define im-encoding
  (lambda (im)
    (cdr (assq 'encoding im))))
(define im-key-release-handler
  (lambda (im)
    (cdr (assq 'key-release-handler im))))
(define im-reset-handler
  (lambda (im)
    (cdr (assq 'reset-handler im))))
;; invalid and unused
;(define im-get-candidate
;  (lambda (im)
;    (cdr (assq 'get-candidate im))))
(define im-mode-handler
  (lambda (im)
    (cdr (assq 'mode-handler im))))
(define im-get-candidate-handler
  (lambda (im)
    (cdr (assq 'get-candidate-handler im))))
(define im-set-candidate-index-handler
  (lambda (im)
    (cdr (assq 'set-candidate-index-handler im))))
(define im-prop-handler
  (lambda (im)
    (cdr (assq 'prop-handler im))))

(define make-im
  (lambda (name lang encoding init-arg init-context release-context
		mode key-press key-release reset
		get-candidate set-candidate-index prop)
    (let ((im ()))
      (set! im (cons (cons 'name name) im))
      (set! im (cons (cons 'lang lang) im))
      (set! im (cons (cons 'encoding encoding) im))
      (set! im (cons (cons 'init-arg init-arg) im))
      (set! im (cons (cons 'init-handler init-context) im))
      (set! im (cons (cons 'release-handler release-context) im))
      (set! im (cons (cons 'mode-handler mode) im))
      (set! im (cons (cons 'key-press-handler key-press) im))
      (set! im (cons (cons 'key-release-handler key-release) im))
      (set! im (cons (cons 'reset-handler reset) im))
      (set! im (cons (cons 'get-candidate-handler get-candidate) im))
      (set! im (cons (cons 'set-candidate-index-handler set-candidate-index) im))
      (set! im (cons (cons 'prop-handler prop) im))
      im)))

(define register-im
  (lambda (name lang encoding init-arg init release
		mode key-press key-release reset
		get-candidate set-candidate-index prop)
    (let
	((im
	  (make-im name lang encoding init-arg init release
		   mode key-press key-release reset
		   get-candidate set-candidate-index prop)))
      (set! current-im im)
      (im-register-im name lang encoding)
      (if (assq name im-list)
	  (delq name im-list))
      (set! im-list
	    (cons
	     (cons name im) im-list)))))

;; find im by name and lang
;; 'select' is bad name because it sounds as 'switch' although some
;; computer cultures are using 'select' as 'pick up'. I think
;; 'find-im' is better -- 2004-05-26 YamaKen
(define select-im
  (lambda (name lang)
    (let ((res #f))
      ;; use default, if exsits.
      (if default-im-name
	  (set! res
		(assq default-im-name im-list)))
      ;; specified name
      (let ((i (assq name im-list)))
	(if i
	    (set! res (cdr i))))
      (if (not res)
	  (set! res current-im))
      res)))

;;
;; im-switching
;;
(define find-im-by-name-rec
  (lambda (name lst)
    (if (not (null? lst))
	(if (eq? (caar lst) name)
	    lst
	    (find-im-by-name-rec name (cdr lst)))
	#f)))

(define next-im
  (lambda (name)
    (let ((im-rest (find-im-by-name-rec name im-list)))
      (if (and im-rest
               (not (null? (cdr im-rest))))
        (caar (cdr im-rest))
        (caar im-list)))))

(define switch-im
  (lambda (id name)
    (release-context id)
    (create-context id #f (next-im name))))

;;
;; context-management
;;
; context := ((id im.data) ...)
(define context-list ())
;; accessors
(define context-id
 (lambda (c)
   (car c)))
(define context-im
 (lambda (c)
   (cadr c)))
(define context-data
  (lambda (c)
    (cddr c)))
(define set-context-data!
  (lambda (c d)
    (set-cdr! (cdr c) d)))

(define find-context
  (lambda (id)
    (let ((c (assv id context-list)))
      c)))

(define remove-context-rec
  (lambda (lst id)
    (if (not (null? lst))
	(if (= (caar lst) id)
	    (remove-context-rec (cdr lst) id)
	    (cons (car lst)
		  (remove-context-rec (cdr lst) id)))
	())))

(define remove-context
  (lambda (id)
    (set! context-list
	  (remove-context-rec context-list id))))

(define add-context
  (lambda (id im)
    (set! context-list
	  (cons
	   (cons
	    id
	    (cons im #f))
	   context-list))))

(define create-context
  (lambda (id lang name)
    (let* ((im (select-im name lang))
	   (handler (and im (im-init-handler im)))
	   (arg (and im (im-init-arg im))))
      (if (find-context id)
	  (remove-context id))
      (im-set-encoding id
		       (im-encoding im))
      (add-context id im)
      (update-style uim-color-spec (symbol-value uim-color))
      (handler id arg))))

(define release-context
  (lambda (id)
    (let* ((c (find-context id))
	   (im (and c (context-im c)))
	   (handler (and im (im-release-handler im))))
      (if handler
	  (handler id))
      (remove-context id)
      #f)))

;;
;; dispatchers
;;
;; Don't discard unnecessary key events. They are necessary for
;; proper GUI widget handling. More correction over entire uim
;; codes is needed.
(define key-press-handler
  (lambda (id key state)
    (let*
	((c (find-context id))
	 (im (context-im c))
	 (handler (im-key-press-handler im)))
      (and
       (if (and
	    enable-im-switch
	    (switch-im-key? key state))
	   (begin
	     (switch-im id (im-name im))
	     #f)
	   #t)
       (if (modifier-key? key state)
	   (begin
	     ;; don't discard modifier press/release edge for apps
	     (im-commit-raw id)
	     #t)
	   (begin
	     (handler id key state)
	     #f))))))
;
(define key-release-handler
  (lambda (id key state)
    (let*
	((c (find-context id))
	 (im (context-im c))
	 (handler (im-key-release-handler im)))
      (if (modifier-key? key state)
	  ;; don't discard modifier press/release edge for apps
	  (im-commit-raw id)
	  (handler id key state)))))

(define reset-handler
  (lambda (id)
    (let*
	((c (find-context id))
	 (im (context-im c))
	 (handler (im-reset-handler im)))
      (handler id))))

(define mode-handler
  (lambda (id mode)
    (let*
	((c (find-context id))
	 (im (context-im c))
	 (handler (im-mode-handler im)))
      (handler id mode))))

;; TODO: enable per-im handler registration
(define im-prop-handler-alist
  '((prop-update-custom . custom-prop-update-custom-handler)
    (prop-activate      . #f)))

(define prop-handler
  (lambda args
    (let* ((id (car args))
	   (prop (cadr args))
	   (prop-args (cddr args))
	   (c (find-context id))
	   (im (context-im c))
	   (handler-pair (assq prop im-prop-handler-alist))
	   (handler (or (and handler-pair
			     (symbol? (cdr handler-pair))
			     (symbol-value (cdr handler-pair)))
			(im-prop-handler im))))  ;; prop_activate handler
      (apply handler (cons id prop-args)))))

(define get-candidate
  (lambda (id idx accel-enum-hint)
    (let*
	((c (find-context id))
	 (im (context-im c))
	 (handler (im-get-candidate-handler im)))
      (im-return-str-list (handler id idx accel-enum-hint)))))

(define set-candidate-index
  (lambda (id idx)
    (let*
	((c (find-context id))
	 (im (context-im c))
	 (handler (im-set-candidate-index-handler im)))
      (handler id idx))))

;;
;; default-im
;;
(define default-push-back-mode
  (lambda (id lst)
    (if (car lst)
	(begin
	  (im-pushback-mode-list id (caar lst))
	  (default-push-back-mode id (cdr lst))))))
(define default-init-handler
  (lambda (id)
    (im-clear-mode-list id)
    (default-push-back-mode id im-list)
    (im-update-mode-list id)
    (im-update-mode id (- (length im-list) 1))
    ()))
(define default-release-handler
  (lambda (id)()))
(define default-key-press-handler
  (lambda (id key state)
    (let ((c (find-context id)))
      (im-commit-raw id))))
(define default-key-release-handler
  (lambda (id key state)()))
(define default-reset-handler
  (lambda (id)()))
(define default-mode-handler
  (lambda (id mode)
    (create-context id #f (car (nth mode im-list)))))

(define default-get-candidate-handler
  (lambda (id idx)()))
(define default-set-candidate-index-handler
  (lambda (id idx)()))
(define default-prop-handler
  (lambda (id prop) ()))

(register-im
 'default
 "*"
 "UTF-8"
 #f
 default-init-handler
 default-release-handler
 default-mode-handler
 default-key-press-handler
 default-key-release-handler
 default-reset-handler
 default-get-candidate-handler
 default-set-candidate-index-handler
 default-prop-handler)

(require "key.scm")
