scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

239
scheme/nuit-engine.scm
View File

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