Keep the state of the command-buffer in a BUFFER record. (before: a
bunch of variables)
This commit is contained in:
		
							parent
							
								
									1f50c28485
								
							
						
					
					
						commit
						31e0415c39
					
				| 
						 | 
				
			
			@ -40,43 +40,12 @@
 | 
			
		|||
		    "Ctrl+e:End of Line"
 | 
			
		||||
		    "Ctrl+k:Delete Line"))
 | 
			
		||||
		    
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
;;state of the upper window (Command-Window)
 | 
			
		||||
;;---------------------------
 | 
			
		||||
;;Text
 | 
			
		||||
(define text-command (list "Welcome in the scsh-ncurses-ui!" ""))
 | 
			
		||||
 | 
			
		||||
;;position in the history of all commands
 | 
			
		||||
(define pos-command 2)
 | 
			
		||||
 | 
			
		||||
;;col
 | 
			
		||||
(define pos-command-col 2)
 | 
			
		||||
 | 
			
		||||
;;Line after lines have been seperated to fit in the buffer
 | 
			
		||||
(define pos-command-fin-ln 2)
 | 
			
		||||
 | 
			
		||||
;;y-coordinate of the cursor
 | 
			
		||||
(define command-buffer-pos-y 2)
 | 
			
		||||
 | 
			
		||||
;;x-coordinate of the cursor
 | 
			
		||||
(define command-buffer-pos-x 2)
 | 
			
		||||
 | 
			
		||||
;;number of lines in the command-buffer
 | 
			
		||||
(define command-lines 0)
 | 
			
		||||
 | 
			
		||||
;;number of columns in the command-buffer
 | 
			
		||||
(define command-cols 0)
 | 
			
		||||
 | 
			
		||||
;;only true if the curser is in the last line
 | 
			
		||||
(define can-write-command #t)
 | 
			
		||||
 | 
			
		||||
;;active entry of the "edit-history"
 | 
			
		||||
(define command-history-pos 1)
 | 
			
		||||
 | 
			
		||||
;;representation of the whole buffer
 | 
			
		||||
(define command-buffer)
 | 
			
		||||
 | 
			
		||||
(define command-buffer 
 | 
			
		||||
  (make-buffer '("Welcome to the scsh-ncurses-ui!" "")
 | 
			
		||||
	       2 2 2 2 2
 | 
			
		||||
	       0 0
 | 
			
		||||
	       #t 1))
 | 
			
		||||
 | 
			
		||||
;;state of the lower window (Result-Window)
 | 
			
		||||
;;----------------------------
 | 
			
		||||
| 
						 | 
				
			
			@ -321,21 +290,21 @@
 | 
			
		|||
 | 
			
		||||
	   ;;C-x r -> redo
 | 
			
		||||
	   ((= ch 114)
 | 
			
		||||
	    (if (or (> (length text-command) 2)
 | 
			
		||||
	    (if (or (> (length (buffer-text command-buffer)) 2)
 | 
			
		||||
		    (not (equal? active-command "")))
 | 
			
		||||
		(let ((command-string (string-append active-command
 | 
			
		||||
							 active-parameters))
 | 
			
		||||
		      (text (sublist text-command 0 
 | 
			
		||||
				     (- (length text-command) 1))))
 | 
			
		||||
						     active-parameters))
 | 
			
		||||
		      (text (sublist (buffer-text command-buffer) 0 
 | 
			
		||||
				     (- (length (buffer-text command-buffer)) 1))))
 | 
			
		||||
		  (begin
 | 
			
		||||
		    (switch restore-message)
 | 
			
		||||
		    (set! text-command (append text 
 | 
			
		||||
					       (list command-string)))
 | 
			
		||||
			(execute-command)
 | 
			
		||||
			(set! command-history-pos (- (length text-command) 1))
 | 
			
		||||
			(set! c-x-pressed #f)
 | 
			
		||||
			(endwin)
 | 
			
		||||
			(run)))
 | 
			
		||||
		    (set-buffer-text! (append text (list command-string)))
 | 
			
		||||
		    (execute-command)
 | 
			
		||||
		    (set-buffer-history-pos! command-buffer
 | 
			
		||||
					     (- (length (buffer-text command-buffer)) 1))
 | 
			
		||||
		    (set! c-x-pressed #f)
 | 
			
		||||
		    (endwin)
 | 
			
		||||
		    (run)))
 | 
			
		||||
		(begin
 | 
			
		||||
		  (set! c-x-pressed #f)
 | 
			
		||||
		  (loop (wait-for-input)))))
 | 
			
		||||
| 
						 | 
				
			
			@ -377,7 +346,9 @@
 | 
			
		|||
		  (begin
 | 
			
		||||
		    (switch restore-message)
 | 
			
		||||
		    (execute-command)
 | 
			
		||||
		    (set! command-history-pos (- (length text-command) 1))
 | 
			
		||||
		    (set-buffer-history-pos!
 | 
			
		||||
		     command-buffer
 | 
			
		||||
		     (- (length (buffer-text command-buffer)) 1))
 | 
			
		||||
		    (paint-result-window)
 | 
			
		||||
		    (paint-bar-2)
 | 
			
		||||
		    (paint-command-window-contents)
 | 
			
		||||
| 
						 | 
				
			
			@ -386,61 +357,10 @@
 | 
			
		|||
 | 
			
		||||
	       (else 
 | 
			
		||||
		(begin
 | 
			
		||||
		  (set! command-buffer (make-buffer text-command 
 | 
			
		||||
						    pos-command
 | 
			
		||||
						    pos-command-col
 | 
			
		||||
						    pos-command-fin-ln
 | 
			
		||||
						    command-buffer-pos-y
 | 
			
		||||
						    command-buffer-pos-x
 | 
			
		||||
						    command-lines
 | 
			
		||||
						    command-cols
 | 
			
		||||
						    can-write-command
 | 
			
		||||
						    command-history-pos))
 | 
			
		||||
		  (set! command-buffer (input command-buffer ch))
 | 
			
		||||
		  (let ((text (buffer-text command-buffer))
 | 
			
		||||
			(pos-line (buffer-pos-line command-buffer))
 | 
			
		||||
			(pos-col (buffer-pos-col command-buffer))
 | 
			
		||||
			(pos-fin-ln (buffer-pos-fin-ln command-buffer))
 | 
			
		||||
			(pos-y (buffer-pos-y command-buffer))
 | 
			
		||||
			(pos-x (buffer-pos-x command-buffer))
 | 
			
		||||
			(num-lines (buffer-num-lines command-buffer))
 | 
			
		||||
			(num-cols (buffer-num-cols command-buffer))
 | 
			
		||||
			(can-write (buffer-can-write command-buffer))
 | 
			
		||||
			(history-pos (buffer-history-pos command-buffer)))
 | 
			
		||||
		    (begin
 | 
			
		||||
		      (set! text-command text)
 | 
			
		||||
		      (set! pos-command pos-line)
 | 
			
		||||
		      (set! pos-command-col pos-col)
 | 
			
		||||
		      (set! pos-command-fin-ln pos-fin-ln)
 | 
			
		||||
		      (set! command-buffer-pos-y pos-y)
 | 
			
		||||
		      (set! command-buffer-pos-x pos-x)
 | 
			
		||||
		      (set! command-lines num-lines)
 | 
			
		||||
		      (set! command-cols num-cols)
 | 
			
		||||
		      (set! can-write-command can-write)
 | 
			
		||||
		      (set! command-history-pos history-pos)))
 | 
			
		||||
		  (paint-command-window-contents)
 | 
			
		||||
		  (set! command-buffer
 | 
			
		||||
			(move-cursor command-buffer))
 | 
			
		||||
		  (let ((text (buffer-text command-buffer))
 | 
			
		||||
			(pos-line (buffer-pos-line command-buffer))
 | 
			
		||||
			(pos-col (buffer-pos-col command-buffer))
 | 
			
		||||
			(pos-fin-ln (buffer-pos-fin-ln command-buffer))
 | 
			
		||||
			(pos-y (buffer-pos-y command-buffer))
 | 
			
		||||
			(pos-x (buffer-pos-x command-buffer))
 | 
			
		||||
			(num-lines (buffer-num-lines command-buffer))
 | 
			
		||||
			(num-cols (buffer-num-cols command-buffer))
 | 
			
		||||
			(can-write (buffer-can-write command-buffer))
 | 
			
		||||
			(history-pos (buffer-history-pos command-buffer)))
 | 
			
		||||
		    (set! text-command text)
 | 
			
		||||
		    (set! pos-command pos-line)
 | 
			
		||||
		    (set! pos-command-col pos-col)
 | 
			
		||||
		    (set! pos-command-fin-ln pos-fin-ln)
 | 
			
		||||
		    (set! command-buffer-pos-y pos-y)
 | 
			
		||||
		    (set! command-buffer-pos-x pos-x)
 | 
			
		||||
		    (set! command-lines num-lines)
 | 
			
		||||
		    (set! command-cols num-cols)
 | 
			
		||||
		    (set! can-write-command can-write)
 | 
			
		||||
		    (set! command-history-pos history-pos))
 | 
			
		||||
		  (loop (wait-for-input)))))))))))
 | 
			
		||||
 | 
			
		||||
(define (window-init-curses-win! window)
 | 
			
		||||
| 
						 | 
				
			
			@ -492,19 +412,10 @@
 | 
			
		|||
       (ascii->char 0) (ascii->char 0)))
 | 
			
		||||
 | 
			
		||||
(define (paint-command-window-contents)
 | 
			
		||||
  (set! command-lines (- (app-window-height command-window) 2))
 | 
			
		||||
  (set! command-cols (- (app-window-width command-window) 3))
 | 
			
		||||
  (set! command-buffer
 | 
			
		||||
	(make-buffer text-command 
 | 
			
		||||
		     pos-command
 | 
			
		||||
		     pos-command-col
 | 
			
		||||
		     pos-command-fin-ln
 | 
			
		||||
		     command-buffer-pos-y
 | 
			
		||||
		     command-buffer-pos-x
 | 
			
		||||
		     command-lines
 | 
			
		||||
		     command-cols
 | 
			
		||||
		     can-write-command
 | 
			
		||||
		     command-history-pos))
 | 
			
		||||
  (set-buffer-num-lines! command-buffer
 | 
			
		||||
			 (- (app-window-height command-window) 2))
 | 
			
		||||
  (set-buffer-num-cols! command-buffer
 | 
			
		||||
			(- (app-window-width command-window) 3))
 | 
			
		||||
  (set! command-buffer 
 | 
			
		||||
	(print-command-buffer (app-window-curses-win command-window) 
 | 
			
		||||
			      command-buffer))
 | 
			
		||||
| 
						 | 
				
			
			@ -528,28 +439,7 @@
 | 
			
		|||
  (paint-result-window)
 | 
			
		||||
  
 | 
			
		||||
  (set! command-buffer 
 | 
			
		||||
	(move-cursor command-buffer))
 | 
			
		||||
 | 
			
		||||
  (let ((text (buffer-text command-buffer))
 | 
			
		||||
	(pos-line (buffer-pos-line command-buffer))
 | 
			
		||||
	(pos-col (buffer-pos-col command-buffer))
 | 
			
		||||
	(pos-fin-ln (buffer-pos-fin-ln command-buffer))
 | 
			
		||||
	(pos-y (buffer-pos-y command-buffer))
 | 
			
		||||
	(pos-x (buffer-pos-x command-buffer))
 | 
			
		||||
	(num-lines (buffer-num-lines command-buffer))
 | 
			
		||||
	(num-cols (buffer-num-cols command-buffer))
 | 
			
		||||
	(can-write (buffer-can-write command-buffer))
 | 
			
		||||
	(history-pos (buffer-history-pos command-buffer)))
 | 
			
		||||
    (set! text-command text)
 | 
			
		||||
    (set! pos-command pos-line)
 | 
			
		||||
    (set! pos-command-col pos-col)
 | 
			
		||||
    (set! pos-command-fin-ln pos-fin-ln)
 | 
			
		||||
    (set! command-buffer-pos-y pos-y)
 | 
			
		||||
    (set! command-buffer-pos-x pos-x)
 | 
			
		||||
    (set! command-lines num-lines)
 | 
			
		||||
    (set! command-cols num-cols)
 | 
			
		||||
    (set! can-write-command can-write)
 | 
			
		||||
    (set! command-history-pos history-pos)))
 | 
			
		||||
	(move-cursor command-buffer)))
 | 
			
		||||
 | 
			
		||||
(define (wait-for-input)
 | 
			
		||||
  (noecho)
 | 
			
		||||
| 
						 | 
				
			
			@ -563,7 +453,8 @@
 | 
			
		|||
;;which has to be executed.
 | 
			
		||||
(define execute-command
 | 
			
		||||
  (lambda ()
 | 
			
		||||
    (let* ((com (list-ref text-command (- (length text-command) 1)))
 | 
			
		||||
    (let* ((com (list-ref (buffer-text command-buffer) 
 | 
			
		||||
			  (- (length (buffer-text command-buffer)) 1)))
 | 
			
		||||
	   (com-par (extract-com-and-par com))
 | 
			
		||||
	   (command (car com-par))
 | 
			
		||||
	   (parameters (cdr com-par))
 | 
			
		||||
| 
						 | 
				
			
			@ -594,7 +485,9 @@
 | 
			
		|||
		(set! history (list hist-entry))
 | 
			
		||||
		(set! history-pos 1))))
 | 
			
		||||
 | 
			
		||||
	(set! text-command (append text-command (list "")))
 | 
			
		||||
	(set-buffer-text! command-buffer 
 | 
			
		||||
			  (append (buffer-text command-buffer)
 | 
			
		||||
				  (list "")))
 | 
			
		||||
	(set! active-command command)
 | 
			
		||||
	(set! active-parameters (get-param-as-str parameters))
 | 
			
		||||
	(set! current-result-object model)
 | 
			
		||||
| 
						 | 
				
			
			@ -665,11 +558,10 @@
 | 
			
		|||
		  
 | 
			
		||||
 | 
			
		||||
;;scroll buffer after one command was entered
 | 
			
		||||
(define scroll-command-buffer
 | 
			
		||||
  (lambda ()
 | 
			
		||||
    (begin
 | 
			
		||||
      (set! pos-command (+ pos-command 1))
 | 
			
		||||
      (set! pos-command-col 2))))
 | 
			
		||||
(define (scroll-command-buffer)
 | 
			
		||||
  (set-buffer-pos-line! command-buffer 
 | 
			
		||||
			(+ (buffer-pos-line command-buffer) 1))
 | 
			
		||||
  (set-buffer-pos-col! command-buffer 2))
 | 
			
		||||
 | 
			
		||||
;;evaluate an expression given as a string
 | 
			
		||||
(define evaluate
 | 
			
		||||
| 
						 | 
				
			
			@ -724,21 +616,23 @@
 | 
			
		|||
 | 
			
		||||
;;Management of the upper buffer
 | 
			
		||||
;;add a char to the buffer
 | 
			
		||||
(define add-to-command-buffer
 | 
			
		||||
  (lambda (ch)
 | 
			
		||||
	(let* ((last-pos (- (length text-command) 1))
 | 
			
		||||
	       (old-last-el (list-ref text-command last-pos))
 | 
			
		||||
	       (old-rest (sublist text-command 0 last-pos))
 | 
			
		||||
	       (before-ch (substring old-last-el 0 
 | 
			
		||||
				     (max 0 (- pos-command-col 2))))
 | 
			
		||||
	       (after-ch (substring old-last-el 
 | 
			
		||||
				    (max 0 (- pos-command-col 2))
 | 
			
		||||
				    (string-length old-last-el)))
 | 
			
		||||
	       (new-last-el (string-append  before-ch
 | 
			
		||||
					    (string (ascii->char ch))
 | 
			
		||||
					   after-ch)))
 | 
			
		||||
      (set! text-command (append old-rest (list new-last-el)))
 | 
			
		||||
      (set! pos-command-col (+ pos-command-col 1)))))
 | 
			
		||||
(define (add-to-command-buffer ch)
 | 
			
		||||
  (let* ((text (buffer-text command-buffer))
 | 
			
		||||
	 (last-pos (- (length text) 1))
 | 
			
		||||
	 (old-last-el (list-ref text last-pos))
 | 
			
		||||
	 (old-rest (sublist text 0 last-pos))
 | 
			
		||||
	 (before-ch (substring old-last-el 0 
 | 
			
		||||
			       (max 0 (- (buffer-pos-col command-buffer) 2))))
 | 
			
		||||
	 (after-ch (substring old-last-el 
 | 
			
		||||
			      (max 0 (- (buffer-pos-col command-buffer) 2))
 | 
			
		||||
			      (string-length old-last-el)))
 | 
			
		||||
	 (new-last-el (string-append  before-ch
 | 
			
		||||
				      (string (ascii->char ch))
 | 
			
		||||
				      after-ch)))
 | 
			
		||||
    (set-buffer-text! command-buffer
 | 
			
		||||
		     (append old-rest (list new-last-el)))
 | 
			
		||||
    (set-buffer-pos-col! command-buffer
 | 
			
		||||
			 (+ (buffer-pos-col command-buffer) 1))))
 | 
			
		||||
 | 
			
		||||
;;add a string to the buffer
 | 
			
		||||
(define add-string-to-command-buffer
 | 
			
		||||
| 
						 | 
				
			
			@ -793,7 +687,7 @@
 | 
			
		|||
  (let* ((window (app-window-curses-win result-window))
 | 
			
		||||
	 (print-message (make-print-message active-command 
 | 
			
		||||
					    current-result-object
 | 
			
		||||
					    command-cols))
 | 
			
		||||
					    (buffer-num-cols command-buffer)))
 | 
			
		||||
	 (model (switch print-message))
 | 
			
		||||
	 (text (print-object-text model))
 | 
			
		||||
	 (pos-y (print-object-pos-y model))
 | 
			
		||||
| 
						 | 
				
			
			@ -905,11 +799,15 @@
 | 
			
		|||
  (lambda ()
 | 
			
		||||
    (if (focus-on-command-buffer?)
 | 
			
		||||
	(begin
 | 
			
		||||
	  (if (>= pos-command-fin-ln command-lines)
 | 
			
		||||
	      (set! command-buffer-pos-y command-lines)
 | 
			
		||||
	      (set! command-buffer-pos-y pos-command-fin-ln))
 | 
			
		||||
	  (let ((posx (modulo pos-command-col command-cols)))
 | 
			
		||||
	    (set! command-buffer-pos-x posx)))
 | 
			
		||||
	  (if (>= (buffer-pos-fin-ln command-buffer) 
 | 
			
		||||
		  (buffer-num-lines command-buffer))
 | 
			
		||||
	      (set-buffer-pos-y! command-buffer 
 | 
			
		||||
				 (buffer-num-lines command-buffer))
 | 
			
		||||
	      (set-buffer-pos-y! command-buffer
 | 
			
		||||
				 (buffer-pos-fin-ln command-buffer)))
 | 
			
		||||
	  (let ((posx (modulo (buffer-pos-col command-buffer)
 | 
			
		||||
			      (buffer-num-cols command-buffer))))
 | 
			
		||||
	    (set-buffer-pos-x! command-buffer posx)))
 | 
			
		||||
	(begin
 | 
			
		||||
	  (if (>= pos-result result-lines)
 | 
			
		||||
	      (set! result-buffer-pos-y result-lines)
 | 
			
		||||
| 
						 | 
				
			
			@ -969,7 +867,7 @@
 | 
			
		|||
(define history-back
 | 
			
		||||
  (lambda ()
 | 
			
		||||
    (if (<= history-pos 0)
 | 
			
		||||
	values
 | 
			
		||||
	(values)
 | 
			
		||||
	(let* ((hist-entry (list-ref history (- history-pos 1)))
 | 
			
		||||
	       (entry-com (history-entry-command hist-entry))
 | 
			
		||||
	       (entry-par (history-entry-parameters hist-entry))
 | 
			
		||||
| 
						 | 
				
			
			@ -986,7 +884,7 @@
 | 
			
		|||
(define history-forward
 | 
			
		||||
  (lambda ()
 | 
			
		||||
	(if (> history-pos (- (length history) 1))
 | 
			
		||||
	    values
 | 
			
		||||
	    (values)
 | 
			
		||||
	    (let* ((hist-entry (list-ref history history-pos))
 | 
			
		||||
		   (entry-com (history-entry-command hist-entry))
 | 
			
		||||
		   (entry-par (history-entry-parameters hist-entry))
 | 
			
		||||
| 
						 | 
				
			
			@ -1009,17 +907,6 @@
 | 
			
		|||
(define restore-state
 | 
			
		||||
  (lambda ()
 | 
			
		||||
    (begin
 | 
			
		||||
      (set! text-command (list "Welcome in the scsh-ncurses-ui!" ""))
 | 
			
		||||
      (set! pos-command 2)
 | 
			
		||||
      (set! pos-command-col 2)
 | 
			
		||||
      (set! pos-command-fin-ln 2)
 | 
			
		||||
      (set! command-buffer-pos-y 2)
 | 
			
		||||
      (set! command-buffer-pos-x 2)
 | 
			
		||||
      (set! command-lines 0)
 | 
			
		||||
      (set! command-cols 0)
 | 
			
		||||
      (set! can-write-command #t)
 | 
			
		||||
      (set! command-history-pos 1)
 | 
			
		||||
      (set! command-buffer #f)
 | 
			
		||||
      (set! text-result (list "Start entering commands."))
 | 
			
		||||
      (set! pos-result 0)
 | 
			
		||||
      (set! pos-result-col 0)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue