Keep the state of the command-buffer in a BUFFER record. (before: a

bunch of variables)
This commit is contained in:
eknauel 2005-05-11 13:30:51 +00:00
parent 1f50c28485
commit 31e0415c39
1 changed files with 63 additions and 176 deletions

View File

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