(module internat-mzgtk2 mzscheme
	(require (planet "roos.scm"  ("oesterholt" "roos.plt" 1 0)))
	(require (planet "array.scm" ("oesterholt" "datastructs.plt" 1 0)))
	(require (lib "mzgtk2.scm" "mzgtk2"))
	(require "internat.scm")
	(provide gtk-internat-edit-widget)


(def-class
  (this (internat-model . args))
  (supers 
    (gtk-list-model))
  (private
    (define sentences      (list->array (internat-keys)))
    (define state          'view-state)
    (define view           #f)
    (define trans-renderer #f)
    (define trans-column   #f)
    (define parent         (=> 'parent args))
    )
  (public
    (define (get-#columns)         2)
    (define (get-#rows)            (if (eq? state 'reset-state)
				       0
				       (array-length sentences)))
    (define (get-column-type col)  "string")

    (define (get-value row col)    
      (let ((sentence (array-ref sentences row)))
	(if (not (eq? trans-renderer #f))
	    (for-each (lambda (r)
			(if (equal? sentence (internat-get sentence))
			    (-> r background (gdk-color "#F1F66F"))
			    (-> r background (gdk-color "#ffffff"))))
		      (vector->list trans-renderer)))

	(if (= col 0)
	    sentence
	    (internat-get sentence))))

    (define (set-translation widget row new-value)
      (let ((r (string->number row)))
	(let ((sentence (array-ref sentences r)))
	  (internat-translate sentence
			      new-value)))
      #t)

    (define (check-delete widget type key state time)
      (display (format "key release: ~a ~a ~a ~a ~a ~%" widget type key state time))
      (if (null? state)
	  (if (eq? key 'delete) 
	      (let ((cursor   (-> view get-cursor)))
		(display cursor)(newline)
		(if (not (eq? cursor #f))
		    (let ((row (car cursor))
			  (col (cadr cursor)))
		      (if (not (or (eq? col #f) (eq? col trans-column)))
			  (if (not (eq? row #f))
			      (let ((index (car row)))
				(if (eq? (gtk-message-dialog parent 
							     'question 
							     'yes-no 
							     (_ "Are you sure you want to delete this sentence?"))
					 'yes)
				    (let ((sentence (array-ref sentences index)))
				      (internat-remove!  sentence)
				      (array-remove!     sentences index)
				      (-> this refresh)
				      #t))))))))))
      #f
      )
    
    (define widget #f)

    (define (refresh) 
      (display (format "reset called~%"))
      (set! state 'reset-state)
      (-> supers refresh)
      (set! state 'view-state)
      (-> supers refresh))
    )
  (constructor
    (let* ((renderer0         (gtk-cell-renderer-text))
	   (sentence-col      (gtk-tree-view-column 'title    (_ "Sentence")
						    'renderer renderer0
						    'column   0
						    'model    this
						    ))
	   (renderer          (gtk-cell-renderer-text 'editable #t
						      'closure  set-translation))
	   (translation-col   (gtk-tree-view-column 'title    (_ "Translation")
						    'renderer renderer
						    'column   1
						    'model    this
						    ))
	   
	   (tv                (gtk-tree-view 'model this 
					     'widgets (list sentence-col translation-col)))
	   (sw                (gtk-scrolled-window 'widgets tv
						   'policy  '(never always)))
	   (frame             (gtk-frame           'widgets sw)))

      (set! widget         frame)
      (set! view           tv)
      (set! trans-renderer (vector renderer0 renderer))
      (set! trans-column   translation-col)

      (-> tv connect "key-release-event" check-delete)
      )
    )
  )
  

(def-class
  (this (gtk-internat-edit-widget . args))
  (supers
    (apply gtk-vbox   args)
    )
  (private
    (define language-label   #f)
    (define dialog           #f)
    (define translations     #f)

    (define (set-language widget)
      (let* ((label (gtk-label 'label (_ "Language: ")))
	     (entry (gtk-entry 'text  (internat-language)
			       'activates-default #t))
	     (hbox  (gtk-hbox 'widgets (list label entry)))
	     (dlg   (gtk-dialog 'name 'language
				'parent parent
				'title (_ "Set language")
				'buttons (list 
					  (list 'cancel (lambda () 'cancel))
					  (list 'ok (lambda () 'ok) 'default))
				'widgets hbox)))

	(if (eq? (-> dlg run) 'ok)
	    (begin
	      (internat-language! (-> entry text))
	      (-> language-label label (internat-language))
	      (-> translations refresh)))
	      
	(-> dlg destroy)
	#t))

    (define parent (=> 'parent args))
    )
  (public)
  (constructor
    (let* ((label   (gtk-label 'label   (_ "Language :")))
	   (entry   (gtk-label 'label   (internat-language)))
	   (button  (gtk-button 'label  (_ "_Set language")
				'closure set-language))
	   (hbox    (gtk-hbox  'widgets (list label entry button)
			       'expand  #f))
	   (model   (internat-model 'parent parent)))
      
      (set! language-label entry)
      (set! translations   model)
      (-> this add hbox (-> model widget)))
    
    )
  )


)