Keep the state of the command-buffer in a BUFFER record. (before: a
bunch of variables)
This commit is contained in:
eknauel
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,18 +290,18 @@
|
|||
|
||||
;;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))))
|
||||
(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)))
|
||||
(set-buffer-text! (append text (list command-string)))
|
||||
(execute-command)
|
||||
(set! command-history-pos (- (length text-command) 1))
|
||||
(set-buffer-history-pos! command-buffer
|
||||
(- (length (buffer-text command-buffer)) 1))
|
||||
(set! c-x-pressed #f)
|
||||
(endwin)
|
||||
(run)))
|
||||
|
|
@ -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))
|
||||
(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 (- pos-command-col 2))))
|
||||
(max 0 (- (buffer-pos-col command-buffer) 2))))
|
||||
(after-ch (substring old-last-el
|
||||
(max 0 (- pos-command-col 2))
|
||||
(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! text-command (append old-rest (list new-last-el)))
|
||||
(set! pos-command-col (+ pos-command-col 1)))))
|
||||
(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