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-FIELD
			   x-dim      y-dim       ;; size of INPUT-FIELD
			   x-pos      y-pos       ;; cursor position in INPUT-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-field-prompt        set-input-field-prompt!)
  (default-text  input-field-default-text)
  (edit-lines    input-field-edit-lines    set-input-field-edit-lines!)
  (window        input-field-window        set-input-field-window!)
  (behavior      input-field-behavior      set-input-field-behavior!)
  (insert-active input-field-insert-active set-input-field-insert-active!)
  (x-loc         input-field-x-loc         set-input-field-x-loc!)
  (y-loc         input-field-y-loc         set-input-field-y-loc!)
  (x-dim         input-field-x-dim         set-input-field-x-dim!)
  (y-dim         input-field-y-dim         set-input-field-y-dim!)
  (x-pos         input-field-x-pos         set-input-field-x-pos!)
  (y-pos         input-field-y-pos         set-input-field-y-pos!)
  (x-edit-pos    input-field-x-edit-pos    set-input-field-x-edit-pos!)
  (y-edit-pos    input-field-y-edit-pos    set-input-field-y-edit-pos!)
  (x-offset      input-field-x-offset      set-input-field-x-offset!)
  (y-offset      input-field-y-offset      set-input-field-y-offset!)
  (x-scroll      input-field-x-scroll      set-input-field-x-scroll!)
  (y-scroll      input-field-y-scroll      set-input-field-y-scroll!))

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

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

;; 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-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-field-edit-lines! 
	 input-field
	 (string->input-field-edit-lines input-field
					 (input-field-init-text input-field)))
	input-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-field window x y)
    (set-input-field-window! input-field window)
    (set-input-field-y-loc! input-field y)
    (set-input-field-x-loc! input-field x)
    (set! input-fields-lookup-list
	  (cons (make-weak-pointer input-field)
		(util-filter (lambda (x) x)
			     input-fields-lookup-list)))))

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

(define cursor-over-this-input-field?
  (lambda (cursor-x cursor-y  input-field)
    (let* ((upper-left-x (input-field-x-loc input-field))
	   (upper-left-y (input-field-y-loc input-field))
	   (lower-right-x (- (+ upper-left-x
				(input-field-x-dim input-field))
			     1))
	   (lower-right-y (- (+ upper-left-y
				(input-field-y-dim input-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-field
	  #f))))
;; "basics" - remove / install-input-field & cursor-over-input-field END
;; ---------------------------------------------------------------------------

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

;; TODOO - besser mit "export-as"... oder wie das heißt
(define input-field-default-text input-field-default-text)
(define input-field-x-location   input-field-x-loc)
(define input-field-y-location   input-field-y-loc)
(define input-field-x-size       input-field-x-dim)
(define input-field-y-size       input-field-y-dim)
(define input-field-column       input-field-x-edit-pos)
(define input-field-line         input-field-y-edit-pos)
(define input-field-x-scroll     input-field-x-scroll)
(define input-field-y-scroll     input-field-y-scroll)
(define input-field-insert       input-field-insert-active)

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

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



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


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

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

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

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

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

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

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

(define paint-black
  (lambda (input-field)
    (let ((blank-string (make-string (input-field-x-dim input-field)
				     #\space))
	  (y-dim (input-field-y-dim input-field))
	  (x-loc (input-field-x-loc input-field))
	  (y-loc (input-field-y-loc input-field))
	  (win (input-field-window input-field)))
      (let loop ((dy 0))
	(if (= dy y-dim)
	    #t
	    (begin 
	      (mvwaddstr win 
			 (+ y-loc dy) x-loc
			 blank-string)
	      (loop (+ dy 1))))))))


(define refresh-position
  (lambda (input-field)
    (wmove (input-field-window input-field)
	   (+ (input-field-y-loc input-field)
	      (input-field-y-pos input-field))
	   (+ (input-field-x-loc input-field)
	      (input-field-x-pos input-field)))))


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

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

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

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


;; (values <known> <act>)....
;; <known> == #f wird direkt
;; von send-input-field abgefangen.
(define care-for-return
  (lambda (input-field msg) 
    (case msg
      ((buffer-full)
       (values 'buffer-full 'buffer-full)) ;; das ist böse²! sollte eigentlich über signals gemacht werden -- die konnte ich aber nicht catchen :'(
      ((just-position)
       (refresh-position input-field)
       (values #t #t))
      ((side-effect)
       (values #t #f))
      ((#f) ;; konnte nichts machen
       (values #t #f))
      ((#t) ;; etwas zugefügt oder entfernt
       (refresh-all input-field)
       (values #t #t))
      (else 
       (values #t #f)))))
       
(define send-input-field
  (lambda (input-field msg . args)
    (if (integer? msg)
	(cond ((get-behavior input-field msg) =>
	       (lambda (method)
		 (apply really-send-input-field input-field method args)))
	      (else (apply really-send-input-field input-field msg args)))
	(values #f #f))))

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

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

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

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

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

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

(define move-forward
  (lambda (input-field)
    (cond ((move-right input-field) =>
	   id)
	  ((move-next-line input-field)
	   (goto-begin-of-line input-field)
	   #t) ;;vorsichsthalber -- worst case -- vielleicht gescrollt
	  (else #f))))

(define move-backward
  (lambda (input-field)
    (cond ((move-left input-field) =>
	   id)
	  ((move-prev-line input-field)
	   (goto-end-of-line input-field)
	   #t) ;;worst case
	  (else #f))))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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


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

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

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

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

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

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

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

(define goto-end-of-last-line
  (lambda (input-field)
    (goto-begin-of-last-line input-field)
    (goto-end-of-line input-field)))

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

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

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

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

;; goto END
;; ----------------------------------------------------------------------------
;; ----------------------------------------------------------------------------
;; others
(define toggle-insert
  (lambda (input-field)
    (set-input-field-insert-active! 
     input-field 
     (not (input-field-insert-active input-field)))))
;; others END
;; ----------------------------------------------------------------------------

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

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

(define restore-input-field
  (lambda (input-field)
    (set-input-field-edit-lines! 
     input-field 
     (string->input-field-edit-lines input-field
				     (input-field-text-wp input-field)))
    (sync-input-field-edit-pos input-field)
    #t))

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

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

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

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

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

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

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

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

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

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

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

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

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

(define input-field->edit-pos
  (lambda (input-field)
    (let ((x-pos (+ (input-field-x-offset input-field)
		    (input-field-x-pos input-field)))
	  (y-pos (+ (input-field-y-offset input-field)
		    (input-field-y-pos input-field)))
	  (x-scroll (input-field-x-scroll input-field)))
      (if x-scroll
	  (values x-pos y-pos)
	  (let loop ((edit-lines (input-field-edit-lines input-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-field-edit-lines input-field)
					    y-edit-pos))
			  y-edit-pos))
		(let* ((edit-line (car edit-lines))
		       (num-input-field-lines 
			(length 
			 (edit-line->input-field-lines input-field edit-line))))
		  (if (< y-pos num-input-field-lines)
		      (values (+ (* y-pos 
				    (input-field-x-dim input-field))
				 x-pos)
			      y-edit-pos)
		      (loop (cdr edit-lines)
			    (+ y-edit-pos 1)
			    (- y-pos num-input-field-lines))))))))))

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

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

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


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

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

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

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

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

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

(define cursor-at-edit-end-position?
  (lambda (input-field)
    (and (end-of-line? input-field)
	 (last-line? input-field))))

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

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

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

(define upper-border?
  (lambda (input-field)
    (= (input-field-y-pos input-field)
       0)))

(define space-left?
  (lambda (input-field)
    (not (and (lower-border? input-field)
	      (right-border? input-field)))))

;; predicates END
;; ----------------------------------------------------------------------------

;; ----------------------------------------------------------------------------
;; selectors

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

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


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

(define id
  (lambda (x)
    x))

(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)))))

;; "save" versions of take and drop

(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)))))