scsh-ncurses/scheme/input-fields.scm

;;===============================================================================
;; exeptions

(define-condition-type 'buffer-full '(error))
(define buffer-full? (condition-predicate 'buffer-full))

;; exeptions END
;;===============================================================================

;;===============================================================================
;; record input-field:

(define-record-type input-field :input-field
  (really-make-input-field prompt
			   default-text
			   edit-lines
			   window
			   behavior
			   insert-active
			   x-loc      y-loc        ;; position of INPUT-I-F-FIELD
			   x-dim      y-dim        ;; size of INPUT-I-F-FIELD
			   x-pos      y-pos        ;; cursor position in INPUT-I-F-FIELD
			   x-edit-pos y-edit-pos   ;; cursor position in edit-lines (text-buffer)
			   x-offset   y-offset     ;; what snippet of the edit-lines are shown in I_F
			   x-scroll   y-scroll)    ;; which direction is allowed to be scrolled
  input-field?
  (prompt        input-if-field-prompt         set-input-if-field-prompt!)
  (default-text  input-if-field-default-text)
  (edit-lines    input-if-field-edit-lines    set-input-if-field-edit-lines!)
  (window        input-if-field-window        set-input-if-field-window!)
  (behavior      input-if-field-behavior      set-input-if-field-behavior!)
  (insert-active input-if-field-insert-active set-input-if-field-insert-active!)
  (x-loc         input-if-field-x-loc         set-input-if-field-x-loc!)
  (y-loc         input-if-field-y-loc         set-input-if-field-y-loc!)
  (x-dim         input-if-field-x-dim         set-input-if-field-x-dim!)
  (y-dim         input-if-field-y-dim         set-input-if-field-y-dim!)
  (x-pos         input-if-field-x-pos         set-input-if-field-x-pos!)
  (y-pos         input-if-field-y-pos         set-input-if-field-y-pos!)
  (x-edit-pos    input-if-field-x-edit-pos    set-input-if-field-x-edit-pos!)
  (y-edit-pos    input-if-field-y-edit-pos    set-input-if-field-y-edit-pos!)
  (x-offset      input-if-field-x-offset      set-input-if-field-x-offset!)
  (y-offset      input-if-field-y-offset      set-input-if-field-y-offset!)
  (x-scroll      input-if-field-x-scroll      set-input-if-field-x-scroll!)
  (y-scroll      input-if-field-y-scroll      set-input-if-field-y-scroll!))

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

(define input-if-field-init-text
  (lambda (input-i-f-field)
    (let ((prompt (input-if-field-prompt input-i-f-field)))
      (if prompt
	  (string-append prompt
			 (input-if-field-default-text input-i-f-field))
	  (input-if-field-default-text input-i-f-field)))))

(define input-field-prompt input-if-field-prompt)
(define set-input-field-prompt! set-input-if-field-prompt!)
(define input-field-x-edit-pos input-if-field-x-edit-pos)

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

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

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

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

;; "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 (input-i-f-field window x y)
    (set-input-if-field-window! input-i-f-field window)
    (set-input-if-field-y-loc! input-i-f-field y)
    (set-input-if-field-x-loc! input-i-f-field x)
    (set! input-fields-lookup-list
	  (cons (make-weak-pointer input-i-f-field)
		(util-filter (lambda (x) x)
			     input-fields-lookup-list)))
    (refresh-all input-i-f-field)
    (wrefresh window)))

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

(define remove-input-field
  (lambda (input-i-f-field)
    (set! input-fields-lookup-list 
	  (let loop ((input-fields input-fields-lookup-list))
	    (if (null? input-fields)
		'()
		(let ((first (car input-fields)))
		  (if (eq? input-i-f-field 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 ((input-i-f-field-lst input-fields-lookup-list))
	(if (null? input-i-f-field-lst)
	    #f
	    (let* ((input-i-f-field (weak-pointer-ref (car input-i-f-field-lst)))
		   (win (if input-i-f-field 
			    (input-if-field-window input-i-f-field)
			    #f)))
	      (if (eq? window win)
		  (or (cursor-over-this-input-field? x y input-i-f-field)
		      (loop (cdr input-i-f-field-lst)))
		  (loop (cdr input-i-f-field-lst)))))))))

(define cursor-over-this-input-field?
  (lambda (cursor-x cursor-y  input-i-f-field)
    (let* ((upper-left-x (input-if-field-x-loc input-i-f-field))
	   (upper-left-y (input-if-field-y-loc input-i-f-field))
	   (lower-right-x (- (+ upper-left-x
				(input-if-field-x-dim input-i-f-field))
			     1))
	   (lower-right-y (- (+ upper-left-y
				(input-if-field-y-dim input-i-f-field))
			     1)))
      (if (and (>= cursor-y upper-left-y)
	       (<= cursor-y lower-right-y)
	       (>= cursor-x upper-left-x)
	       (<= cursor-x lower-right-x))
	  input-i-f-field
	  #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 input-if-field-default-text)
(define input-field-x-location   input-if-field-x-loc)
(define input-field-y-location   input-if-field-y-loc)
(define input-field-x-size       input-if-field-x-dim)
(define input-field-y-size       input-if-field-y-dim)
(define input-field-column       input-if-field-x-edit-pos)
(define input-field-line         input-if-field-y-edit-pos)
(define input-field-x-scroll     input-if-field-x-scroll)
(define input-field-y-scroll     input-if-field-y-scroll)
(define input-field-insert       input-if-field-insert-active)

(define input-field-text
  (lambda (input-i-f-field)
    (let* ((prompt (input-if-field-prompt input-i-f-field))
	   (lst (cat (input-if-field-edit-lines input-i-f-field))))
      (list->string (if prompt 
			(drop lst (string-length prompt))
			lst)))))

(define set-input-field-text!
  (lambda (input-i-f-field text)
;    (set-input-if-field-edit-lines! input-i-f-field
;			(string->edit-lines input-i-f-field text))))
    (goto-begin-of-line input-i-f-field)
    (set-input-if-field-edit-lines! input-i-f-field
			(string->input-if-field-edit-lines input-i-f-field
					       (let ((prompt (input-if-field-prompt input-i-f-field)))
						 (if prompt
						     (string-append prompt
								    text)
						     text))))
    (goto-end-of-line input-i-f-field)))



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

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

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

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

(define input-field-clear
  (lambda (input-i-f-field)
    (let* ((prompt (input-if-field-prompt input-i-f-field))
	   (x-pos (if prompt
		      (string-length prompt)
		      0)))
      (set-input-if-field-x-offset!   input-i-f-field 0)
      (set-input-if-field-y-offset!   input-i-f-field 0)
      (set-input-if-field-x-pos!      input-i-f-field x-pos)
      (set-input-if-field-y-pos!      input-i-f-field 0)
      (set-input-if-field-x-edit-pos! input-i-f-field x-pos)
      (set-input-if-field-y-edit-pos! input-i-f-field 0)
      (set-input-if-field-edit-lines! input-i-f-field (if prompt 
				  (list (string->list prompt))
				  '(())))
      (refresh-all input-i-f-field))))

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

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

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


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

(define paint-black
  (lambda (input-i-f-field)
    (let ((x-dim (input-if-field-x-dim input-i-f-field))
	  (y-dim (input-if-field-y-dim input-i-f-field))
	  (x-loc (input-if-field-x-loc input-i-f-field))
	  (y-loc (input-if-field-y-loc input-i-f-field))
	  (win (input-if-field-window input-i-f-field)))
      (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))))))))



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

(define input-if-field-refresh
  (lambda (input-i-f-field msg)
    (cond ((eq? msg 'buffer-full)    ;; TODO buffer-full should be signaled
	   (values 'buffer-full #f)) ;; --- had no clou how to catch it ... :-(
	  (msg
	   (refresh-all input-i-f-field))
	  (else (values #t #f)))))

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

;(define refresh-from-position  ;; TODO
;  (lambda (input-i-f-field)
;    #f))

(define input-field-window-lines
  (lambda (input-i-f-field)
    (let ((x-loc (input-if-field-x-loc input-i-f-field))
	  (y-loc (input-if-field-y-loc input-i-f-field))
	  (x-dim (input-if-field-x-dim input-i-f-field))
	  (y-dim (input-if-field-y-dim input-i-f-field))
	  (x-offset (input-if-field-x-offset input-i-f-field))
	  (y-offset (input-if-field-y-offset input-i-f-field))
	  (win (input-if-field-window input-i-f-field)))
      (let* ((input-if-field-lines (map (lambda (input-if-field-line)
			      (util-filter (lambda (char)
					     (not (char=? char #\newline)))
					   input-if-field-line))
			    (cat (map (lambda (edit-line)
					(edit-line->input-if-field-lines input-i-f-field
							     edit-line))
				      (input-if-field-edit-lines input-i-f-field)))))
	     (input-if-field-lines-cut (take (drop (map (lambda (input-if-field-line)
					      (take (drop input-if-field-line
							  x-offset)
						    x-dim))
					    input-if-field-lines)
				       y-offset)
				 y-dim)))
	input-if-field-lines-cut))))

(define refresh-all
  (lambda (input-i-f-field)
    (let ((x-loc (input-if-field-x-loc input-i-f-field))
	  (y-loc (input-if-field-y-loc input-i-f-field))
	  (x-dim (input-if-field-x-dim input-i-f-field))
	  (y-dim (input-if-field-y-dim input-i-f-field))
	  (x-offset (input-if-field-x-offset input-i-f-field))
	  (y-offset (input-if-field-y-offset input-i-f-field))
	  (win (input-if-field-window input-i-f-field)))
      (let* ((input-if-field-lines-filled (map (lambda (input-if-field-line)
				     (fill-up input-if-field-line
					      x-dim
					      #\space))
				   (fill-up (map (lambda (input-if-field-line)
						   (fill-up input-if-field-line
							    x-dim
							    #\space))
						 (input-field-window-lines input-i-f-field))
					    y-dim
					    '()))))
	(let loop ((lines input-if-field-lines-filled)
		   (y-ofst 0))
	  (if (null? lines)
	      (refresh-position input-i-f-field)
	      (begin
		(mvwaddstr win 
			   (+ y-loc y-ofst)
			   x-loc
			   (list->string (car lines)))
		(loop (cdr lines)
		      (+ y-ofst 1)))))))))
		
(define refresh-current-line
  (lambda (input-i-f-field)
    #f))

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(define insert-char
  (lambda (input-i-f-field char)
    (let* ((y-edit-pos (input-if-field-y-edit-pos input-i-f-field))
	   (edit-lines (input-if-field-edit-lines input-i-f-field))
	   (current-line (list-ref edit-lines
				   y-edit-pos))
	   (new-lines-tmp (string->edit-lines
			   (list->string 
			    ((if (or (char=? char #\newline)
				     (input-if-field-insert-active input-i-f-field))
				 insert
				 replace)
			     current-line
			     (input-if-field-x-edit-pos input-i-f-field)
			     char))))
	   (new-lines (if (and (= (+ y-edit-pos 1)
				  (length edit-lines))
			       (end-of-line? input-i-f-field)
			       (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 (input-if-field-y-scroll input-i-f-field)
	      (= (length (edit-lines->input-if-field-lines input-i-f-field new-lines))
		 (length (edit-line->input-if-field-lines input-i-f-field current-line)))
	      (<= (length (edit-lines->input-if-field-lines input-i-f-field new-edit-lines))
		  (input-if-field-y-dim input-i-f-field)))
	  (begin (set-input-if-field-edit-lines! input-i-f-field new-edit-lines)
		 (if (char=? char #\newline)
		     (begin (set-input-if-field-x-edit-pos! input-i-f-field 0)
			    (set-input-if-field-y-edit-pos! input-i-f-field (+ (input-if-field-y-edit-pos input-i-f-field)
						       1))
			    (sync-input-if-field-edit-pos input-i-f-field))
		     (move-right input-i-f-field))
		 #t)
	  'buffer-full))))
;	  (signal 'buffer-full 
;		  (input-if-field-x-edit-pos input-i-f-field)
;		  (input-if-field-y-edit-pos input-i-f-field))))))	    

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

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

(define delete-right
  (lambda (input-i-f-field)
    (let* ((x-edit-pos (input-if-field-x-edit-pos input-i-f-field))
	   (y-edit-pos (input-if-field-y-edit-pos input-i-f-field))
	   (edit-lines (input-if-field-edit-lines input-i-f-field))
	   (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-input-if-field-edit-lines! input-i-f-field (replace edit-lines
					     y-edit-pos
					     new-line))
	    #t)
	  #f))))

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

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

(define delete-all-right
  (lambda (input-i-f-field)
    (let* ((x-edit-pos (input-if-field-x-edit-pos input-i-f-field))
	   (y-edit-pos (input-if-field-y-edit-pos input-i-f-field))
	   (edit-lines (input-if-field-edit-lines input-i-f-field))
	   (current-line (list-ref edit-lines
				   y-edit-pos)))
      (if (and (end-of-line? input-i-f-field)
	       (not (last-line? input-i-f-field)))
	  (begin
	    (set-input-if-field-edit-lines! input-i-f-field
				(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-input-if-field-edit-lines! input-i-f-field 
				(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 (input-i-f-field)
    (let* ((x-edit-pos (input-if-field-x-edit-pos input-i-f-field))
	   (y-edit-pos (input-if-field-y-edit-pos input-i-f-field))
	   (edit-lines (input-if-field-edit-lines input-i-f-field))
	   (edit-lines-len (length edit-lines))
	   (current-line (list-ref edit-lines
				   y-edit-pos)))
      (if (= edit-lines-len 1)
	  (begin 
	    (set-input-if-field-edit-lines! input-i-f-field '(()))
	    (set-input-if-field-x-edit-pos! input-i-f-field 0)
	    (sync-input-if-field-edit-pos input-i-f-field))
	  (begin
	    (set-input-if-field-edit-lines! input-i-f-field (remove edit-lines
					    y-edit-pos))
	    (set-input-if-field-x-edit-pos! input-i-f-field 0)
	    (set-input-if-field-y-edit-pos! input-i-f-field (min y-edit-pos
					 (- edit-lines-len 2)))
	    (sync-input-if-field-edit-pos input-i-f-field))))))

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

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

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

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


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


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

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

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

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

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

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

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

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

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

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

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

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

(define goto-next-backward
  (lambda (input-i-f-field . chars)
    (if (move-backward input-i-f-field)
	(let loop ()
	  (let ((sign (sign-under-cursor input-i-f-field)))
	    (if (and sign
		     (memq sign chars))
		(begin
		  (prompt-pos-check input-i-f-field)
		  #t)
		(if (move-backward input-i-f-field)
		    (loop)
		    (begin
		      (prompt-pos-check input-i-f-field)
		      #f)))))
	#f)))

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

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

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

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

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

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

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

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

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

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

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

(define input-field-resize
  (lambda (input-i-f-field x y)
    (let ((win (input-if-field-window input-i-f-field)))
      ;(report win "resize!")
      (if (and (>= x 0)
	       (>= y 0)
	       (<= (+ x (input-if-field-x-loc input-i-f-field)); (input-if-field-x-dim input-i-f-field)) ;; + x-dim
		   (getmaxx win))
	       (<= (+ y (input-if-field-y-loc input-i-f-field)); (input-if-field-y-dim input-i-f-field)) ;; + y-dim
		   (getmaxy win)))
	  (let* ((prompt (input-if-field-prompt input-i-f-field))
		 (x-pos (if prompt
			    (string-length prompt)
			    0)))
	    ;(report win "resize!")
	    (paint-black input-i-f-field)
;	    (set-input-if-field-x-offset!   input-i-f-field 0)
;	    (set-input-if-field-y-offset!   input-i-f-field 0)
;	    (set-input-if-field-x-pos!      input-i-f-field x-pos)
;	    (set-input-if-field-y-pos!      input-i-f-field 0)
;	    (set-input-if-field-x-edit-pos! input-i-f-field x-pos)
;	    (set-input-if-field-y-edit-pos! input-i-f-field 0)
	    (set-input-if-field-x-dim!      input-i-f-field x)
	    (set-input-if-field-y-dim!      input-i-f-field y)
	    (set-input-if-field-edit-lines! input-i-f-field 
				(string->input-if-field-edit-lines input-i-f-field
						       (input-field-text-wp input-i-f-field)))
	    (sync-input-if-field-edit-pos input-i-f-field)
	    (legalize-position input-i-f-field)
	    (if (not (legal-offsets? input-i-f-field))
		(legalize-offsets input-i-f-field))
	    (refresh-all input-i-f-field))
	  #f))))
		 
(define input-field-toggle-x-scroll
  (lambda (input-i-f-field)
    (let* ((prompt (input-if-field-prompt input-i-f-field))
	   (x-pos (if prompt
		      (string-length prompt)
		      0)))
      (paint-black input-i-f-field)
;      (set-input-if-field-x-offset!   input-i-f-field 0)
;      (set-input-if-field-y-offset!   input-i-f-field 0)
;      (set-input-if-field-x-pos!      input-i-f-field x-pos)
;      (set-input-if-field-y-pos!      input-i-f-field 0)
;      (set-input-if-field-x-edit-pos! input-i-f-field x-pos)
;      (set-input-if-field-y-edit-pos! input-i-f-field 0)
      (set-input-if-field-x-scroll!   input-i-f-field (not (input-if-field-x-scroll input-i-f-field)))
      (set-input-if-field-edit-lines! input-i-f-field 
			  (string->input-if-field-edit-lines input-i-f-field
						 (input-field-text-wp input-i-f-field)))
    (sync-input-if-field-edit-pos input-i-f-field)
      (legalize-position input-i-f-field)
      (if (not (legal-offsets? input-i-f-field))
	  (legalize-offsets input-i-f-field))
      (refresh-all input-i-f-field))))

(define input-field-toggle-y-scroll
  (lambda (input-i-f-field)
    (let* ((prompt (input-if-field-prompt input-i-f-field))
	   (x-pos (if prompt
		      (string-length prompt)
		      0)))
      (paint-black input-i-f-field)
      ;(set-input-if-field-x-offset!   input-i-f-field 0)
      ;(set-input-if-field-y-offset!   input-i-f-field 0)
      ;(set-input-if-field-x-pos!      input-i-f-field x-pos)
      ;(set-input-if-field-y-pos!      input-i-f-field 0)
      ;(set-input-if-field-x-edit-pos! input-i-f-field x-pos)
      ;(set-input-if-field-y-edit-pos! input-i-f-field 0)
      (set-input-if-field-y-scroll!   input-i-f-field (not (input-if-field-y-scroll input-i-f-field)))
      (set-input-if-field-edit-lines! input-i-f-field 
			  (string->input-if-field-edit-lines input-i-f-field
						 (input-field-text-wp input-i-f-field)))
      (sync-input-if-field-edit-pos input-i-f-field)
      (legalize-position input-i-f-field)
      (if (not (legal-offsets? input-i-f-field))
	  (legalize-offsets input-i-f-field))
      (refresh-all input-i-f-field))))

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

;; 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->input-if-field-lines
  (lambda (input-i-f-field edit-line)
    (let ((x-dim (input-if-field-x-dim input-i-f-field))
	  (x-scroll (input-if-field-x-scroll input-i-f-field)))
      (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-input-if-field-line-from-edit-line x-dim edit-line))
		  (lambda (input-if-field-line edit-line)
		    (cons input-if-field-line
			  (loop edit-line))))))))))

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

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

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

(define split-edit-line-from-input-if-field-lines
  (lambda (input-if-field-lines)
    (let loop ((edit-line '())
	       (rest input-if-field-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->input-if-field-edit-lines
 (lambda (input-i-f-field string)
    (let* ((edit-lines (string->edit-lines-with-null string))
	   (input-if-field-lines (edit-lines->input-if-field-lines input-i-f-field edit-lines))
	   (input-if-field-lines-cut (if (input-if-field-y-scroll input-i-f-field)
			     input-if-field-lines
			     (take input-if-field-lines
				   (input-if-field-y-dim input-i-f-field)))))
      (input-if-field-lines->edit-lines input-if-field-lines-cut))))

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

(define edit-pos->input-if-field-pos
  (lambda (input-i-f-field x-edit-pos y-edit-pos)
    (if (input-if-field-x-scroll input-i-f-field)
	(values x-edit-pos y-edit-pos)
	(let loop ((edit-lines (input-if-field-edit-lines input-i-f-field))
		   (y-edit-pos y-edit-pos)
		   (y-pos 0))
	  (if (null? edit-lines)
	      'error--edit-pos->input-if-field-pos
	      (if (zero? y-edit-pos)
		  (let ((x-dim (input-if-field-x-dim input-i-f-field)))
		    (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->input-if-field-lines input-i-f-field 
						 (car edit-lines)))))))))))

;; ----------------------------------------------------------------------------
;; legalize-position
(define legalize-position
  (lambda (input-i-f-field)
    (let* ((x-edit-pos (input-if-field-x-edit-pos input-i-f-field))
	   (y-edit-pos (input-if-field-y-edit-pos input-i-f-field))
	   (current-line (list-ref (input-if-field-edit-lines input-i-f-field)
				   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 input-i-f-field)))
    #t))

(define prompt-pos-check
  (lambda (input-i-f-field)
    (if (zero? (input-if-field-y-edit-pos input-i-f-field))
	(let ((prompt (input-if-field-prompt input-i-f-field)))
	  (if prompt
	      (let ((prompt-length (string-length prompt)))
		(if (< (input-if-field-x-edit-pos input-i-f-field)
		       prompt-length)
		    (set-input-if-field-x-edit-pos! input-i-f-field prompt-length))))))))
  
(define legal-offsets?
  (lambda (input-i-f-field)
    (let ((x (input-if-field-x-pos input-i-f-field))
	  (y (input-if-field-y-pos input-i-f-field)))
      (and (>= x 0)
	   (<  x (input-if-field-x-dim input-i-f-field))
	   (>= y 0)
	   (<  y (input-if-field-y-dim input-i-f-field))))))


(define legalize-offsets
  (lambda (input-i-f-field)
    (let ((x-pos (input-if-field-x-pos input-i-f-field))
	  (x-offset (input-if-field-x-offset input-i-f-field))
	  (x-dim (input-if-field-x-dim input-i-f-field))
	  (y-pos (input-if-field-y-pos input-i-f-field))
	  (y-offset (input-if-field-y-offset input-i-f-field))
	  (y-dim (input-if-field-y-dim input-i-f-field)))
      (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-input-if-field-x-pos! input-i-f-field x-pos)
      (set-input-if-field-x-offset! input-i-f-field x-offset)
      (set-input-if-field-y-pos! input-i-f-field y-pos)
      (set-input-if-field-y-offset! input-i-f-field y-offset)
      #t)))
;; legalize-position END
;; ----------------------------------------------------------------------------

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

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

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

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

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

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

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

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

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

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

(define sign-under-cursor
  (lambda (input-i-f-field)
    (let* ((x-edit-pos (input-if-field-x-edit-pos input-i-f-field))
	   (y-edit-pos (input-if-field-y-edit-pos input-i-f-field))
	   (current-line (list-ref (input-if-field-edit-lines input-i-f-field)
				   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 (input-i-f-field)
    #f))

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

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

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

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

(define cadddddr
  (lambda (x)
    (car (cdr (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
;;===============================================================================

;;======================================================================
;; debug-stuff
(define report
  (lambda (win str)
    (let ((win (init-screen))
	  (x (getx win));
	  (y (gety win)))
      (mvwaddstr win 0 0 str)
      (wmove win y x)
      (wrefresh win))))