;;----------;;
;; kinput.l ;;
;;----------;;

(defun read-string-from-kinput (win)

  (let* ((display (window-display win))
	 (kinput-win (selection-owner display "JAPANESE_CONVERSION")))
    (cond ((null kinput-win)
	   (print 'kinput-is-dead)
	   (let ((prompt "kinput> "))
	     (string (read))))
	  (t
	   (let* ((string nil)
		  (japanese-conversion 
		   (find-atom display "JAPANESE_CONVERSION"))
		  (compound-text
		   (find-atom display "COMPOUND_TEXT"))
		  (conversion-request
		   (find-atom display "CONVERSION_REQUEST"))
		  (conversion-notify
		   (find-atom display "CONVERSION_NOTIFY"))
		  (conversion-end-request
		   (find-atom display "CONVERSION_END_REQUEST")))

	     (delete-property win :JAPANESE_CONVERSION)

	     (send-event kinput-win
			 :client-message 
			 nil
			 :window kinput-win
			 :format 32 
			 :type :CONVERSION_REQUEST
			 :data 
			 (list japanese-conversion
			       (window-id win)
			       compound-text
			       japanese-conversion
			       0))
	     (let ((end? nil))
	       (loop 
		(event-case (display)
		  (:client-message
		   (window type format data)
		   (print (list 'client-message window type format data))
		   (pr data)
		   (if (eq window win) (setq end? t))
		   t)
		  (otherwise
		   ()
		   t))
		(if end? (exit))))
	     
	     (print 'kinput-acknowledge)

	     (let ((end? nil))
	       (loop
		(event-case (display)
		  (:property-notify
		   (window atom state time)
		   (print (list 'property-notify window atom state time))
		   (if (eq window win)
		       (setq string (first (get-property 
					    win 
					    ':JAPANESE_CONVERSION 
					    :result-type 'string))))
		   (if string (setq end? t))
		   t)
		  (otherwise
		   ()
		   t))
		(if end? (exit))))
	     
	     (send-event kinput-win
			 :client-message 
			 nil
			 :window kinput-win
			 :format 32 
			 :type :CONVERSION_END_REQUEST
			 :data 
			 (list japanese-conversion
			       (window-id win)
			       0
			       0
			       0))

	     (display-force-output display)

	     (if (and (>= (string-length string) 1) 
		      (= (sref string (1- (string-length string))) 10))
		 (setq string 
		       (substring string 0 (1- (string-length string)))))
	     
	     (if (and (>= (string-length string) 4)
		      (string-equal (substring string 0 4) "$)B"))
		 (setq string (substring string 4)))

	     string
	     )))))