;; TODOO
;; sobald funktinalität getestet
;; und abgesegnet ->
;; mach's klein! mach's schnell!...
;;===============================================================================
;; record input-field:

(define-record-type input-field :input-field
  (really-make-input-field default-text
			   edit-lines
			   window
			   behavior
			   insert-active
			   x-loc      y-loc
			   x-dim      y-dim
			   x-pos      y-pos
			   x-edit-pos y-edit-pos
			   x-offset   y-offset
			   x-scroll   y-scroll)
  input-field?
  (default-text  if-default-text)
  (edit-lines    if-edit-lines    set-if-edit-lines!)
  (window        if-window        set-if-window!)
  (behavior      if-behavior      set-if-behavior!)
  (insert-active if-insert-active set-if-insert-active!)
  (x-loc         if-x-loc         set-if-x-loc!)
  (y-loc         if-y-loc         set-if-y-loc!)
  (x-dim         if-x-dim         set-if-x-dim!)
  (y-dim         if-y-dim         set-if-y-dim!)
  (x-pos         if-x-pos         set-if-x-pos!)
  (y-pos         if-y-pos         set-if-y-pos!)
  (x-edit-pos    if-x-edit-pos    set-if-x-edit-pos!)
  (y-edit-pos    if-y-edit-pos    set-if-y-edit-pos!)
  (x-offset      if-x-offset      set-if-x-offset!)
  (y-offset      if-y-offset      set-if-y-offset!)
  (x-scroll      if-x-scroll      set-if-x-scroll!)
  (y-scroll      if-y-scroll      set-if-y-scroll!))

(define-record-discloser :input-field
  (lambda (i-f)
    (list 'input-field
	  (if-default-text i-f))))

;; record input-field END
;;===============================================================================

;;===============================================================================
;; "basics"

; ----------------------------------------------------------------------------
;; "basics" - make-input-field

(define make-input-field
  (lambda (x-dim y-dim . args)
    (let* ((args-len (length args))
	   (default-text (if (> args-len 0)
			     (car args)
			     ""))
	   (behavior (if (> args-len 1)
			 (cadr args)
			 standard-behavior))
	   (insert-active (if (> args-len 2)
			      (caddr args)
			      #t))
	   (x-scroll (if (> args-len 3)
			 (cadddr args)
			 #f))
	   (y-scroll (if (> args-len 4)
			 (caddddr args)
			 #f)))
      (let ((i-f (really-make-input-field default-text
					  #f
					  #f
					  behavior
					  insert-active
					  #f       #f
					  x-dim    y-dim
					  0        0
					  0        0
					  0        0
					  x-scroll y-scroll)))
	(set-if-edit-lines! i-f
			    (string->if-edit-lines i-f
						   default-text))
	i-f))))

;; "basics" - make-input-field END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; "basics" - remove / install-input-field & cursor-over-input-field?
  
;; FIXIT: sollte jemand auf die idee kommen ein input-field in mehrere
;;        fenster zu installieren, müsste man hier noch was tun :-(

;; --------------------------------------------
;; input-field-lookup-list
;; für die zentrale verwaltung der input-fields
;; --------------------------------------------
(define input-fields-lookup-list '())

;; --------------------------------------------------
;; install-input-field ordnet einem input-field ein
;; window zu und trägt das input-field in die 
;; look-up-liste als weak-pointer ein
;; ---------------------------------------------------
(define install-input-field
  (lambda (i-f window x y)
    (set-if-window! i-f window)
    (set-if-y-loc! i-f y)
    (set-if-x-loc! i-f x)
    (set! input-fields-lookup-list
	  (cons (make-weak-pointer i-f)
		(util-filter (lambda (x) x)
			     input-fields-lookup-list)))
    (refresh-all i-f)
    (wrefresh window)))

(define make&install-input-field
  (lambda (win x-loc y-loc x-dim y-dim . args)
    (install-input-field (apply make-input-field 
				x-dim y-dim 
				args)
			 win
			 x-loc y-loc)))

(define remove-input-field
  (lambda (i-f)
    (set! input-fields-lookup-list 
	  (let loop ((input-fields input-fields-lookup-list))
	    (if (null? input-fields)
		'()
		(let ((first (car input-fields)))
		  (if (eq? i-f first)
		      (cdr input-fields)
		      (cons first
			    (loop (cdr input-fields))))))))))

;; --------------------------------------------------------
;; cursor-over-input-field? schaut nach, ob ein input-field
;; in das übergebene window eingetragen ist und ob 
;; sich der cursor über diesem befindet
;; --------------------------------------------------------
(define cursor-over-input-field?
  (lambda (window)
    (let ((x (getx window))
	  (y (gety window)))
      (let loop ((i-f-lst input-fields-lookup-list))
	(if (null? i-f-lst)
	    #f
	    (let* ((i-f (weak-pointer-ref (car i-f-lst)))
		   (win (if i-f 
			    (if-window i-f)
			    #f)))
	      (if (eq? window win)
		  (or (cursor-over-this-input-field? x y i-f)
		      (loop (cdr i-f-lst)))
		  (loop (cdr i-f-lst)))))))))

(define cursor-over-this-input-field?
  (lambda (cursor-x cursor-y  i-f)
    (let* ((upper-left-x (if-x-loc i-f))
	   (upper-left-y (if-y-loc i-f))
	   (lower-right-x (- (+ upper-left-x
				(if-x-dim i-f))
			     1))
	   (lower-right-y (- (+ upper-left-y
				(if-y-dim i-f))
			     1)))
      (if (and (>= cursor-y upper-left-y)
	       (<= cursor-y lower-right-y)
	       (>= cursor-x upper-left-x)
	       (<= cursor-x lower-right-x))
	  i-f
	  #f))))
;; "basics" - remove / install-input-field & cursor-over-input-field END
;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; "basics" - selectors

;; TODOO - vielleicht gibt's sowas wie "export-as"

(define input-field-default-text if-default-text)
(define input-field-x-location   if-x-loc)
(define input-field-y-location   if-y-loc)
(define input-field-x-size       if-x-dim)
(define input-field-y-size       if-y-dim)
(define input-field-column       if-x-edit-pos)
(define input-field-line         if-y-edit-pos)
(define input-field-x-scroll     if-x-scroll)
(define input-field-y-scroll     if-y-scroll)
(define input-field-insert       if-insert-active)

(define input-field-text
  (lambda (i-f)
    (list->string (cat (if-edit-lines i-f)))))

;(define input-field-edit-pos
;  (lambda (i-f)
;    (values (if-x-edit-pos i-f)
;	    (if-y-edit-pos i-f))))

;; "basics" - selectors END
;; ---------------------------------------------------------------------------

;; ---------------------------------------------------------------------------
;; "basics" - clear/reset

(define input-field-clear
  (lambda (i-f)
    (set-if-x-offset!   i-f 0)
    (set-if-y-offset!   i-f 0)
    (set-if-x-pos!      i-f 0)
    (set-if-y-pos!      i-f 0)
    (set-if-x-edit-pos! i-f 0)
    (set-if-y-edit-pos! i-f 0)
    (set-if-edit-lines! i-f '(()))
    (refresh-all i-f)))

(define input-field-reset
  (lambda (i-f)
    (set-if-x-offset!   i-f 0)
    (set-if-y-offset!   i-f 0)
    (set-if-x-pos!      i-f 0)
    (set-if-y-pos!      i-f 0)
    (set-if-x-edit-pos! i-f 0)
    (set-if-y-edit-pos! i-f 0)
    (set-if-edit-lines! i-f
			(string->if-edit-lines i-f
					       (if-default-text i-f)))
    (refresh-all i-f)))

;; "basics" - clear/reset END
;; ---------------------------------------------------------------------------

;; "basics" END
;;===============================================================================


;;===============================================================================
;; draw/refresh functions

(define paint-black
  (lambda (i-f)
    (let ((x-dim (if-x-dim i-f))
	  (y-dim (if-y-dim i-f))
	  (x-loc (if-x-loc i-f))
	  (y-loc (if-y-loc i-f))
	  (win (if-window i-f)))
      (let loop ((dy 0)
		 (strings (map list->string
			       (fill-up '()
					y-dim
					(fill-up '()
						 x-dim
						 #\space)))))
	(if (null? strings)
	    #t
	    (begin 
	      (mvwaddstr win 
			 (+ y-loc dy) x-loc
			 (car strings))
	      (loop (+ dy 1)
		    (cdr strings))))))))



;;; TODOOOO (performance):
;;; funktionen geben zurück welcher
;;; refresh notwendig ist z.b.:
;;;     'position
;;;     'current-line
;;;     'from-current-line ...
;;; if-refresh ruft dann das richtige auf

(define if-refresh
  (lambda (i-f msg)
    (if msg
	(refresh-all i-f)
	(values #t #f))))

(define refresh-position
  (lambda (i-f)
    (wmove (if-window i-f)
	   (+ (if-y-loc i-f)
	      (if-y-pos i-f))
	   (+ (if-x-loc i-f)
	      (if-x-pos i-f)))
    (values #t #t)))

(define refresh-from-position
  (lambda (i-f)
    #f))

(define refresh-all
  (lambda (i-f)
    (let ((x-loc (if-x-loc i-f))
	  (y-loc (if-y-loc i-f))
	  (x-dim (if-x-dim i-f))
	  (y-dim (if-y-dim i-f))
	  (x-offset (if-x-offset i-f))
	  (y-offset (if-y-offset i-f))
	  (win (if-window i-f)))
      (let* ((if-lines (map (lambda (if-line)
			      (util-filter (lambda (char)
					     (not (char=? char #\newline)))
					   if-line))
			    (cat (map (lambda (edit-line)
					(edit-line->if-lines i-f
							     edit-line))
				      (if-edit-lines i-f)))))
	     (if-lines-cut (take (drop (map (lambda (if-line)
					      (take (drop if-line
							  x-offset)
						    x-dim))
					    if-lines)
				       y-offset)
				 y-dim))
	     (if-lines-filled (map (lambda (if-line)
				     (fill-up if-line
					      x-dim
					      #\space))
				   (fill-up if-lines-cut
					    y-dim
					    '()))))
	(let loop ((lines if-lines-filled)
		   (y-ofst 0))
	  (if (null? lines)
	      (refresh-position i-f)
	      (begin
		(mvwaddstr win 
			   (+ y-loc y-ofst)
			   x-loc
			   (list->string (car lines)))
		(loop (cdr lines)
		      (+ y-ofst 1)))))))))
		
(define refresh-current-line
  (lambda (i-f)
    #f))

;; draw/refresh functions END
;;===============================================================================


;;===============================================================================
;; send-input-field

(define send-input-field
  (lambda (i-f msg . args)
    (if (integer? msg)
	(cond ((get-behavior i-f msg) =>
	       (lambda (method)
		 (apply really-send-input-field i-f method args)))
	      (else (apply really-send-input-field i-f msg args)))
	(values #f #f))))

(define really-send-input-field
  (lambda (i-f msg . args)
    (cond ((and (number? msg)
		(or (and (> msg 31)
			 (< msg 127))
		    (= msg 10)
		    (= msg 13)))
	   (if-refresh i-f (insert-char i-f 
				    (if (= msg 13)
					#\newline
					(ascii->char msg)))))
	  ((eq? msg 'move-prev-line)
	   (if-refresh i-f (move-prev-line i-f)))
	  ((eq? msg 'move-next-line)
	   (if-refresh i-f (move-next-line i-f)))
	  ((eq? msg 'move-left)
	   (if-refresh i-f (move-left i-f)))
	  ((eq? msg 'move-right)
	   (if-refresh i-f (move-right i-f)))
	  ((eq? msg 'delete-right)
	   (if-refresh i-f (delete-right i-f)))
	  ((eq? msg 'move-forward)
	   (if-refresh i-f (move-forward i-f)))
	  ((eq? msg 'move-backward)
	   (if-refresh i-f (move-backward i-f)))
	  ((eq? msg 'delete-left)
	   (if-refresh i-f (delete-left i-f)))
	  ((eq? msg 'delete-all-right)
	   (if-refresh i-f (delete-all-right i-f)))
	  ((eq? msg 'delete-all-left)
	   (if-refresh i-f (delete-all-left i-f)))
	  ((eq? msg 'delete-line)
	   (if-refresh i-f (delete-line i-f)))
	  ((eq? msg 'goto-begin-of-line)
	   (if-refresh i-f (goto-begin-of-line i-f)))
	  ((eq? msg 'goto-end-of-line)
	   (if-refresh i-f (goto-end-of-line i-f)))
	  ((eq? msg 'goto-begin-of-first-line)
	   (if-refresh i-f (goto-begin-of-first-line i-f)))
	  ((eq? msg 'goto-begin-of-last-line)
	   (if-refresh i-f (goto-begin-of-last-line i-f)))
	  ((eq? msg 'goto-begin-of-word-forward)
	   (if-refresh i-f (goto-begin-of-word-forward i-f)))
	  ((eq? msg 'goto-begin-of-word-backward)
	   (if-refresh i-f (goto-begin-of-word-backward i-f)))
	  ((eq? msg 'goto-end-of-word-forward)
	   (if-refresh i-f (goto-begin-of-word-forward i-f)))
	  ((eq? msg 'goto-end-of-word-backward)
	   (if-refresh i-f (goto-begin-of-word-backward i-f)))
;	  ((eq? msg 'input-field-move-up)
;	   (if-refresh i-f (input-field-move-up i-f)))
;	  ((eq? msg 'input-field-move-down)
;	   (if-refresh i-f (input-field-move-down i-f)))
;	  ((eq? msg 'input-field-move-left)
;	   (if-refresh i-f (input-field-move-left i-f)))
;	  ((eq? msg 'input-field-move-right)
;	   (if-refresh i-f (input-field-move-right i-f)))
	  ((eq? msg 'refresh-all)
	   (refresh-all i-f))
	  ((eq? msg 'toggle-insert)
	   (toggle-insert i-f))
	  ((eq? msg 'restore)
	   (restore-input-field i-f))
	  ((list? msg)
	   (for-each (lambda (msg-single)
		       (send-input-field i-f 
					 msg-single))
		     msg)
	   (values #t #t))
	  (else (values #f #f)))))

;; send-input-field END
;;===============================================================================

;;===============================================================================
;; behavior lists

(define standard-behavior
  (list (cons key-up 
	      'move-prev-line)
	(cons key-down
	      'move-next-line)
	(cons key-left
	      'move-left)
	(cons key-right
	      'move-right)
	(cons key-backspace
	      'delete-left)
	(cons key-dc
	      'delete-right)
	(cons key-home
	      'goto-begin-of-line)
	(cons key-end
	      'goto-end-of-line)))

(define standard-behavior-pro
  (append standard-behavior
	  (list (cons 2  ;; C-b
		      'move-left)
		(cons 6  ;; C-f
		      'move-right)
		(cons 16 ;; C-p
		      'move-prev-line)
		(cons 14 ;; C-n
		      'move-next-line)
		(cons 1  ;; C-a
		      'goto-begin-of-line)
		(cons 5  ;; C-e
		      'goto-end-of-line)
		(cons 4  ;; C-d
		      'delete-right)
		(cons 11 ;; C-k
		      'delete-all-right))))

;; behavior lists END
;;===============================================================================
;;===============================================================================
;; behavior methods

(define get-behavior
  (lambda (i-f msg)
    (let loop ((behavior (if-behavior i-f)))
      (if (null? behavior)
	  #f
	  (if (eq? msg (caar behavior))
	      (cdar behavior)
	      (loop (cdr behavior)))))))

;; ----------------------------------------------------------------------------
;; move

(define move-prev-line
  (lambda (i-f)
    (if (first-line? i-f)
	#f
	(begin
	  (set-if-y-edit-pos! i-f (- (if-y-edit-pos i-f)
				     1))
	  (sync-if-edit-pos i-f)))))

(define move-next-line
  (lambda (i-f)
    (if (last-line? i-f)
	#f
	(begin 
	  (set-if-y-edit-pos! i-f (+ (if-y-edit-pos i-f)
				     1))
	  (sync-if-edit-pos i-f)))))

(define move-left
  (lambda (i-f)
    (if (begin-of-line? i-f)
	#f
	(begin 
	  (set-if-x-edit-pos! i-f (- (if-x-edit-pos i-f)
				     1))
	  (sync-if-edit-pos i-f)))))

(define move-right
  (lambda (i-f)
    (if (or (end-of-line? i-f)
	    (and (right-border? i-f)
		 (lower-border? i-f)
		 (not (if-y-scroll i-f))
		 (not (if-x-scroll i-f))))
	#f
	(begin 
	 (set-if-x-edit-pos! i-f (+ (if-x-edit-pos i-f)
				    1))	
	 (sync-if-edit-pos i-f)))))

(define move-forward
  (lambda (i-f)
    (if (move-right i-f)
	#t
	(if (move-next-line i-f)
	    (goto-begin-of-line i-f)
	    #f))))

(define move-backward
  (lambda (i-f)
    (if (move-left i-f)
	#t
	(if (move-prev-line i-f)
	    (goto-end-of-line i-f)
	    #f))))

(define sync-if-edit-pos
  (lambda (i-f)
    (call-with-values 
	(lambda ()
	  (edit-pos->if-pos i-f
			    (if-x-edit-pos i-f)
			    (if-y-edit-pos i-f)))
      (lambda (x-pos y-pos)
	(set-if-x-pos! i-f (- x-pos (if-x-offset i-f)))
	(set-if-y-pos! i-f (- y-pos (if-y-offset i-f)))))
    (legalize-position i-f)
    (if (not (legal-offsets? i-f))
	(legalize-offsets i-f)
	#t)))

;; move END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; scroll

(define scroll-up
  (lambda (i-f)
    (set-if-y-offset! i-f 
		      (- (if-y-offset i-f)
			 1))
    #t))

(define scroll-down
  (lambda (i-f)
    (set-if-y-offset! i-f 
		      (+ (if-y-offset i-f)
			 1))
    #t))

(define scroll-left
  (lambda (i-f)
    (set-if-x-offset! i-f 
		      (- (if-x-offset i-f)
			 1))
    #t))

(define scroll-right
  (lambda (i-f)
   (set-if-x-offset! i-f 
		     (+ (if-x-offset i-f)
			1))
   #t))
;; scroll END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; insert

(define insert-char
  (lambda (i-f char)
    (let* ((y-edit-pos (if-y-edit-pos i-f))
	   (edit-lines (if-edit-lines i-f))
	   (current-line (list-ref edit-lines
				   y-edit-pos))
	   (new-lines-tmp (string->edit-lines
			   (list->string 
			    ((if (or (char=? char #\newline)
				     (if-insert-active i-f))
				 insert
				 replace)
			     current-line
			     (if-x-edit-pos i-f)
			     char))))
	   (new-lines (if (and (= (+ y-edit-pos 1)
				  (length edit-lines))
			       (end-of-line? i-f)
			       (char=? char #\newline))
			  (append new-lines-tmp '(()))
			  new-lines-tmp))
	   (new-edit-lines (append (take edit-lines
					 y-edit-pos)
				   new-lines
				   (drop edit-lines
					 (+ y-edit-pos 1)))))
     (if (or (if-y-scroll i-f)
	      (= (length (edit-lines->if-lines i-f new-lines))
		 (length (edit-line->if-lines i-f current-line)))
	      (<= (length (edit-lines->if-lines i-f new-edit-lines))
		  (if-y-dim i-f)))
	  (begin (set-if-edit-lines! i-f new-edit-lines)
		 (if (char=? char #\newline)
		     (begin (set-if-x-edit-pos! i-f 0)
			    (set-if-y-edit-pos! i-f (+ (if-y-edit-pos i-f)
						       1))
			    (sync-if-edit-pos i-f))
		     (move-right i-f))
		 #t)
	  #f))))	    

;; insert END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; delete

(define delete-right
  (lambda (i-f)
    (let* ((x-edit-pos (if-x-edit-pos i-f))
	   (y-edit-pos (if-y-edit-pos i-f))
	   (edit-lines (if-edit-lines i-f))
	   (current-line (list-ref edit-lines
				   y-edit-pos))
	   (current-line-len (length current-line)))
      (if (and (< x-edit-pos current-line-len) 
	       (not (char=? (list-ref current-line
				      x-edit-pos)
			    #\newline)))
	  (let ((new-line (remove current-line 
				  x-edit-pos)))
	    (set-if-edit-lines! i-f (replace edit-lines
					     y-edit-pos
					     new-line))
	    #t)
	  #f))))

(define delete-left
  (lambda (i-f)
    (if (move-left i-f)
	(delete-right i-f)
	#f)))

(define delete-all-left
  (lambda (i-f)
    (let* ((x-edit-pos (if-x-edit-pos i-f))
	   (y-edit-pos (if-y-edit-pos i-f))
	   (edit-lines (if-edit-lines i-f))
	   (current-line (list-ref edit-lines
				   y-edit-pos)))
      (if (not (zero? x-edit-pos))
	  (begin
	    (set-if-edit-lines! i-f (replace edit-lines
					     y-edit-pos
					     (drop current-line
						   x-edit-pos)))
	    (set-if-x-edit-pos! i-f 0)
	    (sync-if-edit-pos i-f)
	    #t)
	  #f))))

(define delete-all-right
  (lambda (i-f)
    (let* ((x-edit-pos (if-x-edit-pos i-f))
	   (y-edit-pos (if-y-edit-pos i-f))
	   (edit-lines (if-edit-lines i-f))
	   (current-line (list-ref edit-lines
				   y-edit-pos)))
      (if (and (end-of-line? i-f)
	       (not (last-line? i-f)))
	  (begin
	    (set-if-edit-lines! i-f
				(append (take edit-lines
					      y-edit-pos)
					(list 
					 (append
					  (reverse (cdr (reverse current-line)))
					  (list-ref edit-lines
						    (+ y-edit-pos 1))))
					(drop edit-lines
					      (+ y-edit-pos 2))))
	    #t)
	  (begin
	    (set-if-edit-lines! i-f 
				(replace edit-lines
					 y-edit-pos
					 (let ((new-line (take current-line
							       x-edit-pos)))
					   (if (char=? (last current-line)
						       #\newline)
					       (append new-line
						       (list #\newline))
					       new-line))))
	    #t)))))

(define delete-line
  (lambda (i-f)
    (let* ((x-edit-pos (if-x-edit-pos i-f))
	   (y-edit-pos (if-y-edit-pos i-f))
	   (edit-lines (if-edit-lines i-f))
	   (edit-lines-len (length edit-lines))
	   (current-line (list-ref edit-lines
				   y-edit-pos)))
      (if (= edit-lines-len 1)
	  (begin 
	    (set-if-edit-lines! i-f '(()))
	    (set-if-x-edit-pos! i-f 0)
	    (sync-if-edit-pos i-f))
	  (begin
	    (set-if-edit-lines! i-f (remove edit-lines
					    y-edit-pos))
	    (set-if-x-edit-pos! i-f 0)
	    (set-if-y-edit-pos! i-f (min y-edit-pos
					 (- edit-lines-len 2)))
	    (sync-if-edit-pos i-f))))))

;; delete END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; goto

;; TODOO - fertig machen... (siehe #f)

(define goto-begin-of-word-forward
  (lambda (i-f)
    (goto-next-forward i-f #\space #\newline)
    (goto-next-not-forward i-f #\space #\newline)
    #t))


(define goto-end-of-word-forward
  (lambda (i-f)
    #f))


(define goto-begin-of-word-backward
  (lambda (i-f)
    (if (and (goto-next-not-backward i-f #\space #\newline)
	     (goto-next-backward i-f #\space #\newline))
	(move-forward i-f))
    #t))

(define goto-end-of-word-backward
  (lambda (i-f)
    #f))

(define goto-begin-of-line
  (lambda (i-f)
    (set-if-x-edit-pos! i-f 0)
    (sync-if-edit-pos i-f)))

(define goto-end-of-line
  (lambda (i-f)
    (let ((x-edit-pos (if-x-edit-pos i-f))
	  (y-edit-pos (if-y-edit-pos i-f)))
      (call-with-values
	  (lambda ()
	    (let* ((current-line (list-ref (if-edit-lines i-f)
					   y-edit-pos)))
	      (if (null? current-line)
		  (set-if-x-edit-pos! i-f 0)
		  (let ((len (length current-line))
			(end-char (last current-line)))
		    (set-if-x-edit-pos! i-f (if (char=? end-char #\newline)
						(- len 1)
						len))))
	      (edit-pos->if-pos i-f 
				(if-x-edit-pos i-f)
				y-edit-pos)))
	(lambda (x-pos y-pos)
	  (set-if-x-pos! i-f (- x-pos (if-x-offset i-f)))
	  (set-if-y-pos! i-f (- y-pos (if-y-offset i-f)))
	  (sync-if-edit-pos i-f))))))

(define goto-begin-of-first-line
  (lambda (i-f)
    (set-if-x-edit-pos! i-f 0)
    (set-if-y-edit-pos! i-f 0)
    (sync-if-edit-pos i-f)))

(define goto-end-of-first-line
  (lambda (i-f)
    #f))

(define goto-begin-of-last-line
  (lambda (i-f)
    (set-if-x-edit-pos! i-f 0)
    (set-if-y-edit-pos! i-f (- (length (if-edit-lines i-f))
			       1))
    (sync-if-edit-pos i-f)))

(define goto-end-of-last-line
  (lambda (i-f)
    #f))

;; ------------------------------------------------------------------
; wozu eigentlich?
;(define goto-end-of-if-line
;  (lambda (i-f)
;    #f))

;; ------------------------------------------------------------------

(define goto-next-forward
  (lambda (i-f . chars)
    (if (move-forward i-f)
	(let loop ()
	  (let ((sign (sign-under-cursor i-f)))
	    (if (and sign
		     (memq sign chars))
		#t
		(if (move-forward i-f)
		    (loop)
		    #f))))
	#f)))

(define goto-next-not-forward
  (lambda (i-f . chars)
    (if (move-forward i-f)
	(let loop ()
	  (let ((sign (sign-under-cursor i-f)))
	    (if (and sign
		     (not (memq sign chars)))
		#t
		(if (move-forward i-f)
		    (loop)
		    #f))))
	#f)))

(define goto-next-backward
  (lambda (i-f . chars)
    (if (move-backward i-f)
	(let loop ()
	  (let ((sign (sign-under-cursor i-f)))
	    (if (and sign
		     (memq sign chars))
		#t
		(if (move-backward i-f)
		    (loop)
		    #f))))
	#f)))

(define goto-next-not-backward
  (lambda (i-f . chars)
    (if (move-backward i-f)
	(let loop ()
	  (let ((sign (sign-under-cursor i-f)))
	    (if (and sign
		     (not (memq sign chars)))
		#t
		(if (move-backward i-f)
		    (loop)
		    #f))))
	#f)))

;; goto END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; others
(define toggle-insert
  (lambda (i-f)
    (set-if-insert-active! i-f 
			   (not (if-insert-active i-f)))
    (values #t #f)))
;; others END
;; ----------------------------------------------------------------------------

;; behavior methods END
;;===============================================================================

;;===============================================================================
;; "mutate" functions and few others

(define input-field-refresh
  (lambda (i-f)
    (really-send-input-field i-f 'refresh-all)))

;(define input-field-move-up
;  (lambda (i-f)
;    (let ((y-loc (if-y-loc i-f)))
;      (if (> y-loc 1)
;	  (begin
;	    (paint-black i-f)
;	    (set-if-y-loc! i-f (- y-loc
;				  1))
;	    #t)
;	  #f))))

;(define input-field-move-down
;  (lambda (i-f)
;    (let ((y-loc (if-y-loc i-f)))
;      (if (< (+ y-loc (if-y-dim i-f))
;	     (- (getmaxy (if-window i-f))
;		1))
;	  (begin
;	    (paint-black i-f)
;	    (set-if-y-loc! i-f (+ y-loc
;				  1))
;	    #t)
;	  #f))))

;(define input-field-move-left
;  (lambda (i-f)
;    (let ((x-loc (if-x-loc i-f)))
;      (if (> x-loc 1)
;	  (begin
;	    (paint-black i-f)
;	    (set-if-x-loc! i-f (- x-loc
;				  1))
;	    #t)
;	  #f))))

;(define input-field-move-right
;  (lambda (i-f)
;    (let ((x-loc (if-x-loc i-f)))
;      (if (< (+ x-loc (if-x-dim i-f))
;	     (- (getmaxx (if-window i-f))
;		1))
;	  (begin
;	    (paint-black i-f)
;	    (set-if-x-loc! i-f (+ x-loc
;				  1))
;	    #t)
;	  #f))))

(define input-field-move
  (lambda (i-f x y)
    (let ((win (if-window i-f)))
      (if (and (> x 1)
	       (> y 1)
	       (< (+ x (if-x-dim i-f))
		  (getmaxx win))
	       (< (+ y (if-y-dim i-f))
		  (getmaxy win)))
	  (begin
	    (paint-black i-f)
	    (set-if-x-loc! i-f x)
	    (set-if-y-loc! i-f y)
	    (refresh-all i-f))
	  #f))))

(define input-field-resize
  (lambda (i-f x y)
    (let ((win (if-window i-f)))
      (if (and (> x 0)
	       (> y 0)
	       (< (+ x (if-x-loc i-f))
		  (getmaxx win))
	       (< (+ y (if-y-loc i-f))
		  (getmaxy win)))
	  (begin
	    (paint-black i-f)
	    (set-if-x-offset!   i-f 0)
	    (set-if-y-offset!   i-f 0)
	    (set-if-x-pos!      i-f 0)
	    (set-if-y-pos!      i-f 0)
	    (set-if-x-edit-pos! i-f 0)
	    (set-if-y-edit-pos! i-f 0)	    
	    (set-if-x-dim!      i-f x)
	    (set-if-y-dim!      i-f y)
	    (set-if-edit-lines! i-f 
				(string->if-edit-lines i-f
						       (input-field-text i-f)))
	    (refresh-all i-f))
	  #f))))
		 
(define input-field-toggle-x-scroll
  (lambda (i-f)
    (paint-black i-f)
    (set-if-x-offset!   i-f 0)
    (set-if-y-offset!   i-f 0)
    (set-if-x-pos!      i-f 0)
    (set-if-y-pos!      i-f 0)
    (set-if-x-edit-pos! i-f 0)
    (set-if-y-edit-pos! i-f 0)
    (set-if-x-scroll!   i-f (not (if-x-scroll i-f)))
    (set-if-edit-lines! i-f 
				(string->if-edit-lines i-f
						       (input-field-text i-f)))
    (refresh-all i-f)))

(define input-field-toggle-y-scroll
  (lambda (i-f)
    (paint-black i-f)
    (set-if-x-offset!   i-f 0)
    (set-if-y-offset!   i-f 0)
    (set-if-x-pos!      i-f 0)
    (set-if-y-pos!      i-f 0)
    (set-if-x-edit-pos! i-f 0)
    (set-if-y-edit-pos! i-f 0)
    (set-if-y-scroll!   i-f (not (if-y-scroll i-f)))
    (set-if-edit-lines! i-f 
			(string->if-edit-lines i-f
					       (input-field-text i-f)))
    (refresh-all i-f)))

(define restore-input-field
  (lambda (i-f)
    (set-if-edit-lines! i-f 
			(string->if-edit-lines i-f
					       (input-field-text i-f)))
    (sync-if-edit-pos i-f)
    (refresh-all i-f)))

;; mutate-functions END
;;===============================================================================


;;===============================================================================
;; helpfunctions (converter, predicates...)


(define string->edit-lines
  (lambda (str)
    (let loop ((chars (string->list str)))
      (if (null? chars)
	  '()
	  (call-with-values
	      (lambda ()
		(split-after-first-newline chars))
	    (lambda (line chars)
	      (cons line
		    (loop chars))))))))

(define string->edit-lines-with-null
  (lambda (str)
    (let* ((edit-lines (let loop ((chars (string->list str)))
			 (if (null? chars)
			     '()
			     (call-with-values
				 (lambda ()
				   (split-after-first-newline chars))
			       (lambda (line chars)
				 (cons line
				       (loop chars)))))))
	   (last-line (if (null? edit-lines)
			  #f
			  (last edit-lines))))
      (if (and last-line
	       (not (null? last-line))
	       (char=? (last last-line)
		       #\newline))	     
	  (append edit-lines '(()))
	  edit-lines))))

(define split-after-first-newline
  (lambda (chars)
    (let loop ((line '())
	       (chars chars))
      (if (null? chars)
	  (values (reverse line) chars)
	  (let ((char (car chars))
		(rest (cdr chars)))
	    (if (char=? char #\newline)
		(values (reverse (cons char line))
			rest)
		(loop (cons char line)
		      rest)))))))

(define edit-line->if-lines
  (lambda (i-f edit-line)
    (let ((x-dim (if-x-dim i-f))
	  (x-scroll (if-x-scroll i-f)))
      (if (or x-scroll
	      (null? edit-line))
	  (list edit-line)
	  (let loop ((edit-line edit-line))
	    (if (null? edit-line)
		'()
		(call-with-values
		    (lambda ()
		      (split-if-line-from-edit-line x-dim edit-line))
		  (lambda (if-line edit-line)
		    (cons if-line
			  (loop edit-line))))))))))

(define edit-lines->if-lines
  (lambda (i-f edit-lines)
    (cat (map (lambda (edit-line)
		(edit-line->if-lines i-f edit-line))
	      edit-lines))))

(define split-if-line-from-edit-line
  (lambda (x-dim edit-line)
    (let loop ((if-line '())
	       (rest edit-line)
	       (space-left x-dim))
      (if (null? rest)
	  (values (reverse if-line)
		  rest)
	  (let ((char (car rest)))
	    (cond ((char=? char #\newline)
		   (values (reverse (cons char
					  if-line))
			   (cdr rest)))
		  ((zero? space-left)
		   (values (reverse if-line)
			   rest))
		  (else
		   (loop (cons char if-line)
			 (cdr rest)
			 (- space-left 1)))))))))

(define if-lines->edit-lines
  (lambda (if-lines)
    (let loop ((rest if-lines))
      (if (null? rest)
	  '()
	  (call-with-values 
	      (lambda ()
		(split-edit-line-from-if-lines rest))
	    (lambda (edit-line rest)
	      (cons edit-line
		    (loop rest))))))))

(define split-edit-line-from-if-lines
  (lambda (if-lines)
    (let loop ((edit-line '())
	       (rest if-lines))
      (if (null? rest)
	  (values (reverse edit-line) '())
	  (let ((rev-line (reverse (car rest))))
	    (if (null? rev-line)
		(values '() (cdr rest))
		(if (char=? (car rev-line)
			    #\newline)
		    (values (reverse (append rev-line
					     edit-line))
			    (cdr rest))
		    (loop (append  rev-line 
				   edit-line)
			  (cdr rest)))))))))

(define string->if-edit-lines
 (lambda (i-f string)
    (let* ((edit-lines (string->edit-lines-with-null string))
	   (if-lines (edit-lines->if-lines i-f edit-lines))
	   (if-lines-cut (if (if-y-scroll i-f)
			     if-lines
			     (take if-lines
				   (if-y-dim i-f)))))
      (if-lines->edit-lines if-lines-cut))))

(define if->edit-pos
  (lambda (i-f)
    (let ((x-pos (+ (if-x-offset i-f)
		    (if-x-pos i-f)))
	  (y-pos (+ (if-y-offset i-f)
		    (if-y-pos i-f)))
	  (x-scroll (if-x-scroll i-f)))
      (if x-scroll
	  (values x-pos y-pos)
	  (let loop ((edit-lines (if-edit-lines i-f))
		     (y-edit-pos 0)
		     (y-pos y-pos))
	    (if (null? edit-lines)
		(let ((y-edit-pos (- y-edit-pos 1)))
		  (values (length (list-ref (if-edit-lines i-f)
					    y-edit-pos))
			  y-edit-pos))
		(let* ((edit-line (car edit-lines))
		       (num-if-lines (length 
				      (edit-line->if-lines i-f edit-line))))
		  (if (< y-pos num-if-lines)
		      (values (+ (* y-pos 
				    (if-x-dim i-f))
				 x-pos)
			      y-edit-pos)
		      (loop (cdr edit-lines)
			    (+ y-edit-pos 1)
			    (- y-pos num-if-lines))))))))))

(define edit-pos->if-pos
  (lambda (i-f x-edit-pos y-edit-pos)
    (if (if-x-scroll i-f)
	(values x-edit-pos y-edit-pos)
	(let loop ((edit-lines (if-edit-lines i-f))
		   (y-edit-pos y-edit-pos)
		   (y-pos 0))
	  (if (null? edit-lines)
	      'error--edit-pos->if-pos
	      (if (zero? y-edit-pos)
		  (let ((x-dim (if-x-dim i-f)))
		    (values (modulo x-edit-pos 
				    x-dim)
			    (+ y-pos
			       (quotient x-edit-pos
					 x-dim))))
		  (loop (cdr edit-lines)
			(- y-edit-pos 1)
			(+ y-pos
			   (length 
			    (edit-line->if-lines i-f 
						 (car edit-lines)))))))))))

;; ----------------------------------------------------------------------------
;; legalize-position
(define legalize-position
  (lambda (i-f)
    (let* ((x-edit-pos (if-x-edit-pos i-f))
	   (y-edit-pos (if-y-edit-pos i-f))
	   (current-line (list-ref (if-edit-lines i-f)
				   y-edit-pos))
	   (current-line-len (length current-line)))      
      (if (or (> x-edit-pos current-line-len)
	      (and (> current-line-len 0)
		   (= x-edit-pos current-line-len)
		   (char=? (last current-line)
			   #\newline)))
	  (goto-end-of-line i-f)))
    #t))

(define legal-offsets?
  (lambda (i-f)
    (let ((x (if-x-pos i-f))
	  (y (if-y-pos i-f)))
      (and (>= x 0)
	   (<  x (if-x-dim i-f))
	   (>= y 0)
	   (<  y (if-y-dim i-f))))))


(define legalize-offsets
  (lambda (i-f)
    (let ((x-pos (if-x-pos i-f))
	  (x-offset (if-x-offset i-f))
	  (x-dim (if-x-dim i-f))
	  (y-pos (if-y-pos i-f))
	  (y-offset (if-y-offset i-f))
	  (y-dim (if-y-dim i-f)))
      (if (< x-pos 0)
	  (begin 
	    (set! x-offset (+ x-offset x-pos))
	    (set! x-pos 0)))
      (if (> (+ x-pos 1) 
	     x-dim)
	  (let ((dx (- (+ x-pos 1)
		       x-dim)))
	    (set! x-offset (+ x-offset dx))
	    (set! x-pos (- x-pos dx))))
      (if (< y-pos 0)
	  (begin 
	    (set! y-offset (+ y-offset y-pos))
	    (set! y-pos 0)))
      (if (> (+ y-pos 1) 
	     y-dim)
	  (let ((dy (- (+ y-pos 1)
		       y-dim)))
	    (set! y-offset (+ y-offset dy))
	    (set! y-pos (- y-pos dy))))
      (set-if-x-pos! i-f x-pos)
      (set-if-x-offset! i-f x-offset)
      (set-if-y-pos! i-f y-pos)
      (set-if-y-offset! i-f y-offset)
      #t)))
;; legalize-position END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; predicates

(define first-line?
  (lambda (i-f)
    (zero? (if-y-edit-pos i-f))))

(define last-line?
  (lambda (i-f)
    (= (+ (if-y-edit-pos i-f)
	  1)
       (length (if-edit-lines i-f)))))

(define begin-of-line?
  (lambda (i-f)
    (zero? (if-x-edit-pos i-f))))

(define end-of-line?
  (lambda (i-f)
    (let* ((x-edit-pos (if-x-edit-pos i-f))
	   (y-edit-pos (if-y-edit-pos i-f))
	   (edit-line (list-ref (if-edit-lines i-f)
				y-edit-pos)))
      (or (= x-edit-pos
	     (length edit-line))
	  (char=? (list-ref edit-line
			    x-edit-pos)
		  #\newline)))))

(define left-border?
  (lambda (i-f)
    (= (if-x-pos i-f)
       0)))

(define right-border?
  (lambda (i-f)
    (= (if-x-pos i-f)
       (- (if-x-dim i-f) 1))))

(define lower-border?
  (lambda (i-f)
    (= (if-y-pos i-f)
       (- (if-y-dim i-f) 1))))

(define upper-border?
  (lambda (i-f)
    (= (if-y-pos i-f)
       0)))
;; predicates END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; selectors
(define sign-at-xy
  (lambda (i-f x y)
    #f))

(define sign-under-cursor
  (lambda (i-f)
    (let* ((x-edit-pos (if-x-edit-pos i-f))
	   (y-edit-pos (if-y-edit-pos i-f))
	   (current-line (list-ref (if-edit-lines i-f)
				   y-edit-pos))
	   (current-line-len (length current-line)))
      (if (< x-edit-pos current-line-len)
	  (list-ref current-line x-edit-pos)
	  #f))))

(define sign-before-cursor
  (lambda (i-f)
    #f))

(define sign-behind-cursor
   (lambda (i-f)
    #f))

;; selectors END
;; ---------------------------------------------------------------------------- 
;; helpfunctions END
;;===============================================================================

;;===============================================================================
;; "primitives"

(define caddddr
  (lambda (x)
    (car (cddddr x))))

(define last
  (lambda (lst)
    (if (null? lst)
	'error--last
	(car (reverse lst)))))

(define fill-up
  (lambda (lst len elem)
    (append lst 
	    (let loop ((n (- len
			     (length lst))))
	      (if (< n 0)
		  'error--fill-up
		  (if (zero? n)
		      '()
		      (cons elem
			    (loop (- n 1)))))))))

(define cat
  (lambda (lst-lst)
    (if (null? lst-lst)
	'()
	(append (car lst-lst)
		(cat (cdr lst-lst))))))

(define split
  (lambda (lst n)
    (let loop ((fst '())
	       (scnd lst)
	       (n n))
      (if (or (null? scnd)
	      (zero? n))
	  (values (reverse fst) scnd)
	  (loop (cons (car scnd)
		      fst)
		(cdr scnd)
		(- n 1))))))

(define remove
  (lambda (lst pos)
    (append (take lst pos)
	    (drop lst (+ pos 1)))))

(define insert
  (lambda (lst n elem)
    (if (zero? n)
	(cons elem lst)
	(cons (car lst)
	      (insert (cdr lst)
		      (- n 1)
		      elem)))))

(define replace 
  (lambda (lst n elem)    
    (if (zero? n)
	(cons elem 
	      (if (null? lst)
		  lst
		  (cdr lst)))
	(cons (car lst)
	      (replace (cdr lst)
		       (- n 1)
		       elem)))))

(define take
  (lambda (lst n)
    (if (or (null? lst)
	    (zero? n))
	'()
	(cons (car lst)
	      (take (cdr lst)
		    (- n 1))))))

(define drop
  (lambda (lst n)
    (if (or (null? lst)
	    (zero? n))
	lst
	(drop (cdr lst)
	      (- n 1)))))
	

;; "primitives" END
;;===============================================================================