First try to split up PAINT into multiple functions, thus, allowing to
repaint only parts of the screen. However, this commit introduces some funny display bugs. ;-)
This commit is contained in:
eknauel
parent
599021b937
commit
2353335d5e
|
|
@ -12,13 +12,19 @@
|
||||||
;;*************************************************************************
|
;;*************************************************************************
|
||||||
;;State
|
;;State
|
||||||
|
|
||||||
;;The different windows
|
(define-record-type app-window :app-window
|
||||||
;;------------------------
|
(make-app-window x y width height curses-win)
|
||||||
(define bar1)
|
app-window?
|
||||||
(define bar2)
|
(x app-window-x)
|
||||||
(define bar3)
|
(y app-window-y)
|
||||||
(define command-win)
|
(width app-window-width)
|
||||||
(define result-win)
|
(height app-window-height)
|
||||||
|
(curses-win app-window-curses-win set-app-window-curses-win!))
|
||||||
|
|
||||||
|
(define bar-1 #f)
|
||||||
|
(define bar-2 #f)
|
||||||
|
(define command-window #f)
|
||||||
|
(define result-window #f)
|
||||||
|
|
||||||
(define shortcuts '("F1:Exit"
|
(define shortcuts '("F1:Exit"
|
||||||
"F2:Repaint (after change of buffer size)"
|
"F2:Repaint (after change of buffer size)"
|
||||||
|
|
@ -224,320 +230,299 @@
|
||||||
;;Actions
|
;;Actions
|
||||||
|
|
||||||
;;start the whole thing
|
;;start the whole thing
|
||||||
(define nuit
|
(define (nuit)
|
||||||
(lambda ()
|
(run))
|
||||||
(run)))
|
|
||||||
|
|
||||||
;;handle input
|
;;handle input
|
||||||
(define run
|
(define (run)
|
||||||
(lambda ()
|
|
||||||
(begin
|
|
||||||
|
|
||||||
;;initialisation
|
'(set-interrupt-handler interrupt/keyboard
|
||||||
(init-screen)
|
(lambda a
|
||||||
(set! bar1 (newwin 0 0 0 0))
|
(set! active-keyboard-interrupt a)))
|
||||||
(set! bar2 (newwin 0 0 0 0))
|
|
||||||
(set! bar3 (newwin 0 0 0 0))
|
|
||||||
(set! command-win (newwin 0 0 0 0))
|
|
||||||
(set! result-win (newwin 0 0 0 0))
|
|
||||||
|
|
||||||
;;Handling Keyboard-interrupts
|
;;Loop
|
||||||
;;If a keyboard-interrupt occurs it is stored in "active-keyboard-interrupt"
|
(paint)
|
||||||
(set-interrupt-handler interrupt/keyboard
|
(let loop ((ch (wait-for-input)))
|
||||||
(lambda a
|
(cond
|
||||||
(set! active-keyboard-interrupt a)))
|
;;The result of pressing these keys is independent of which
|
||||||
|
;;Buffer is active
|
||||||
|
;;Finish
|
||||||
|
((= ch key-f1)
|
||||||
|
(begin
|
||||||
|
(let ((restore-message (make-restore-message
|
||||||
|
active-command
|
||||||
|
current-result-object)))
|
||||||
|
(switch restore-message)
|
||||||
|
(restore-state))
|
||||||
|
(endwin)
|
||||||
|
(display "")))
|
||||||
|
|
||||||
;;Loop
|
((= ch key-f2)
|
||||||
(paint)
|
(endwin)
|
||||||
(let loop ((ch (wait-for-input)))
|
(run))
|
||||||
(cond
|
|
||||||
|
|
||||||
;;The result of pressing these keys is independent of which
|
;;Ctrl-x -> wait for next input
|
||||||
;;Buffer is active
|
((= ch 24)
|
||||||
;;Finish
|
(begin
|
||||||
((= ch key-f1)
|
(set! c-x-pressed (not c-x-pressed))
|
||||||
(begin
|
(if (= active-buffer 2)
|
||||||
(let ((restore-message (make-restore-message
|
(let ((key-message
|
||||||
active-command
|
(make-key-pressed-message active-command
|
||||||
current-result-object)))
|
current-result-object
|
||||||
(switch restore-message)
|
ch)))
|
||||||
(restore-state))
|
(set! current-result-object (switch key-message))))
|
||||||
(endwin)
|
(paint)
|
||||||
(display "")))
|
(loop (wait-for-input))))
|
||||||
|
|
||||||
((= ch key-f2)
|
;; forward in result history
|
||||||
(endwin)
|
((= ch key-npage)
|
||||||
(run))
|
(history-forward)
|
||||||
|
(paint-result-window)
|
||||||
|
(loop (wait-for-input)))
|
||||||
|
|
||||||
;;Ctrl-x -> wait for next input
|
;; back in result history
|
||||||
((= ch 24)
|
((= ch key-ppage)
|
||||||
(begin
|
(history-back)
|
||||||
(set! c-x-pressed (not c-x-pressed))
|
(paint-result-window)
|
||||||
(if (= active-buffer 2)
|
(loop (wait-for-input)))
|
||||||
(let ((key-message
|
|
||||||
(make-key-pressed-message active-command
|
|
||||||
current-result-object
|
|
||||||
ch)))
|
|
||||||
(set! current-result-object (switch key-message))))
|
|
||||||
(paint)
|
|
||||||
(loop (wait-for-input))))
|
|
||||||
|
|
||||||
;; forward in result history
|
;;if lower window is active a message is sent.
|
||||||
((= ch key-npage)
|
(else
|
||||||
(history-forward)
|
(if c-x-pressed
|
||||||
(print-result-buffer result-win)
|
(cond
|
||||||
(loop (wait-for-input)))
|
|
||||||
|
|
||||||
;; back in result history
|
;;Ctrl-x o ->switch buffer
|
||||||
((= ch key-ppage)
|
((= ch 111)
|
||||||
(history-back)
|
(begin
|
||||||
(print-result-buffer result-win)
|
(if (= active-buffer 1)
|
||||||
(loop (wait-for-input)))
|
(begin
|
||||||
|
(set! active-buffer 2)
|
||||||
|
(let ((key-message
|
||||||
;;if lower window is active a message is sent.
|
(make-key-pressed-message active-command
|
||||||
(else
|
|
||||||
(if c-x-pressed
|
|
||||||
(cond
|
|
||||||
|
|
||||||
;;Ctrl-x o ->switch buffer
|
|
||||||
((= ch 111)
|
|
||||||
(begin
|
|
||||||
(if (= active-buffer 1)
|
|
||||||
(begin
|
|
||||||
(set! active-buffer 2)
|
|
||||||
(let ((key-message
|
|
||||||
(make-key-pressed-message active-command
|
|
||||||
current-result-object
|
current-result-object
|
||||||
97)))
|
97)))
|
||||||
(set! current-result-object (switch key-message))))
|
(set! current-result-object (switch key-message))))
|
||||||
(set! active-buffer 1))
|
(set! active-buffer 1))
|
||||||
(set! c-x-pressed #f)
|
(set! c-x-pressed #f)
|
||||||
(loop (wait-for-input))))
|
(loop (wait-for-input))))
|
||||||
|
|
||||||
;;C-x r -> redo
|
;;C-x r -> redo
|
||||||
((= ch 114)
|
((= ch 114)
|
||||||
(if (or (> (length text-command) 2)
|
(if (or (> (length text-command) 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 text-command 0
|
||||||
(- (length text-command) 1))))
|
(- (length text-command) 1))))
|
||||||
(begin
|
(begin
|
||||||
(switch restore-message)
|
(switch restore-message)
|
||||||
(set! text-command (append text
|
(set! text-command (append text
|
||||||
(list command-string)))
|
(list command-string)))
|
||||||
(execute-command)
|
(execute-command)
|
||||||
(set! command-history-pos (- (length text-command) 1))
|
(set! command-history-pos (- (length text-command) 1))
|
||||||
(set! c-x-pressed #f)
|
(set! c-x-pressed #f)
|
||||||
(endwin)
|
(endwin)
|
||||||
(run)))
|
(run)))
|
||||||
(begin
|
|
||||||
(set! c-x-pressed #f)
|
|
||||||
(loop (wait-for-input)))))
|
|
||||||
|
|
||||||
(else
|
|
||||||
(begin
|
(begin
|
||||||
(if (= active-buffer 2)
|
|
||||||
(let ((key-message
|
|
||||||
(make-key-pressed-message active-command
|
|
||||||
current-result-object
|
|
||||||
ch)))
|
|
||||||
(set! current-result-object (switch key-message)))
|
|
||||||
|
|
||||||
(if (= ch 115)
|
|
||||||
(let* ((message
|
|
||||||
(make-selection-message
|
|
||||||
active-command current-result-object))
|
|
||||||
(marked-items (switch message)))
|
|
||||||
(add-string-to-command-buffer marked-items))))
|
|
||||||
(set! c-x-pressed #f)
|
(set! c-x-pressed #f)
|
||||||
(loop (wait-for-input)))))
|
(loop (wait-for-input)))))
|
||||||
|
|
||||||
|
(else
|
||||||
|
(begin
|
||||||
(if (= active-buffer 2)
|
(if (= active-buffer 2)
|
||||||
(let ((key-message
|
(let ((key-message
|
||||||
(make-key-pressed-message active-command
|
(make-key-pressed-message active-command
|
||||||
current-result-object
|
current-result-object
|
||||||
ch)))
|
ch)))
|
||||||
(begin
|
(set! current-result-object (switch key-message)))
|
||||||
(set! current-result-object (switch key-message))
|
|
||||||
(loop (wait-for-input))))
|
|
||||||
|
|
||||||
(cond
|
(if (= ch 115)
|
||||||
|
(let* ((message
|
||||||
|
(make-selection-message
|
||||||
|
active-command current-result-object))
|
||||||
|
(marked-items (switch message)))
|
||||||
|
(add-string-to-command-buffer marked-items))))
|
||||||
|
(set! c-x-pressed #f)
|
||||||
|
(loop (wait-for-input)))))
|
||||||
|
|
||||||
;;Enter
|
(if (= active-buffer 2)
|
||||||
((= ch 10)
|
(let ((key-message
|
||||||
(let ((restore-message (make-restore-message
|
(make-key-pressed-message active-command
|
||||||
active-command
|
current-result-object
|
||||||
current-result-object)))
|
ch)))
|
||||||
(begin
|
(begin
|
||||||
(switch restore-message)
|
(set! current-result-object (switch key-message))
|
||||||
(execute-command)
|
(loop (wait-for-input))))
|
||||||
(set! command-history-pos (- (length text-command) 1))
|
|
||||||
|
(cond
|
||||||
|
|
||||||
|
;;Enter
|
||||||
|
((= ch 10)
|
||||||
|
(let ((restore-message (make-restore-message
|
||||||
|
active-command
|
||||||
|
current-result-object)))
|
||||||
|
(begin
|
||||||
|
(switch restore-message)
|
||||||
|
(execute-command)
|
||||||
|
(set! command-history-pos (- (length text-command) 1))
|
||||||
;(loop (paint))))
|
;(loop (paint))))
|
||||||
(endwin)
|
(endwin)
|
||||||
(run))))
|
(run))))
|
||||||
|
|
||||||
|
(else
|
||||||
|
(begin
|
||||||
;;Ctrl+p -> History back
|
(set! command-buffer (make-buffer text-command
|
||||||
; ((= ch 16)
|
pos-command
|
||||||
; (begin
|
pos-command-col
|
||||||
; (history-back)
|
pos-command-fin-ln
|
||||||
; (loop (paint))))
|
command-buffer-pos-y
|
||||||
|
command-buffer-pos-x
|
||||||
; ;;Ctrl+n -> History forward
|
command-lines
|
||||||
; ((= ch 14)
|
command-cols
|
||||||
; (begin
|
can-write-command
|
||||||
; (history-forward)
|
command-history-pos))
|
||||||
; (loop (paint))))
|
(set! command-buffer (input command-buffer ch))
|
||||||
|
(let ((text (buffer-text command-buffer))
|
||||||
; ;;Ctrl+s -> get selection
|
(pos-line (buffer-pos-line command-buffer))
|
||||||
; ((= ch 19)
|
(pos-col (buffer-pos-col command-buffer))
|
||||||
; (let* ((message (make-selection-message active-command
|
(pos-fin-ln (buffer-pos-fin-ln command-buffer))
|
||||||
; current-result-object))
|
(pos-y (buffer-pos-y command-buffer))
|
||||||
; (marked-items (switch message)))
|
(pos-x (buffer-pos-x command-buffer))
|
||||||
; (begin
|
(num-lines (buffer-num-lines command-buffer))
|
||||||
; (add-string-to-command-buffer marked-items)
|
(num-cols (buffer-num-cols command-buffer))
|
||||||
; (loop (paint)))))
|
(can-write (buffer-can-write command-buffer))
|
||||||
|
(history-pos (buffer-history-pos command-buffer)))
|
||||||
(else
|
|
||||||
(begin
|
(begin
|
||||||
(set! command-buffer (make-buffer text-command
|
(set! text-command text)
|
||||||
pos-command
|
(set! pos-command pos-line)
|
||||||
pos-command-col
|
(set! pos-command-col pos-col)
|
||||||
pos-command-fin-ln
|
(set! pos-command-fin-ln pos-fin-ln)
|
||||||
command-buffer-pos-y
|
(set! command-buffer-pos-y pos-y)
|
||||||
command-buffer-pos-x
|
(set! command-buffer-pos-x pos-x)
|
||||||
command-lines
|
(set! command-lines num-lines)
|
||||||
command-cols
|
(set! command-cols num-cols)
|
||||||
can-write-command
|
(set! can-write-command can-write)
|
||||||
command-history-pos))
|
(set! command-history-pos history-pos)))
|
||||||
(set! command-buffer (input command-buffer ch))
|
(paint-command-window-contents)
|
||||||
(let ((text (buffer-text command-buffer))
|
(loop (wait-for-input)))))))))))
|
||||||
(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)
|
|
||||||
(loop (wait-for-input)))))))))))))
|
|
||||||
|
|
||||||
;;print and wait for input
|
(define (window-init-curses-win! window)
|
||||||
(define (paint)
|
(set-app-window-curses-win!
|
||||||
|
window
|
||||||
|
(newwin (app-window-height window) (app-window-width window)
|
||||||
|
(app-window-y window) (app-window-x window))))
|
||||||
|
|
||||||
|
(define (init-windows!)
|
||||||
(init-screen)
|
(init-screen)
|
||||||
(let* ((bar1-y 1)
|
(set! bar-1
|
||||||
(bar1-x 1)
|
(make-app-window 1 1
|
||||||
(bar1-h 2)
|
(- (COLS) 2) 2
|
||||||
(bar1-w (- (COLS) 2))
|
#f))
|
||||||
(bar2-y (+ (round (/ (LINES) 3)) 2))
|
(set! bar-2
|
||||||
(bar2-x 1)
|
(make-app-window 1 (+ (round (/ (LINES) 3)) 2)
|
||||||
(bar2-h 3)
|
(- (COLS) 2) 3
|
||||||
(bar2-w (- (COLS) 2))
|
#f))
|
||||||
(comwin-y 2)
|
(set! command-window
|
||||||
(comwin-x 1)
|
(make-app-window 1 2
|
||||||
(comwin-h (- bar2-y 2))
|
(- (COLS) 2) (- (app-window-y bar-2) 2)
|
||||||
(comwin-w (- (COLS) 2))
|
#f))
|
||||||
(reswin-y (+ bar2-y 3))
|
(set! result-window
|
||||||
(reswin-x 1)
|
(make-app-window 1 (+ (app-window-y bar-2) 3)
|
||||||
(reswin-h (- (- (LINES) 6) comwin-h))
|
(- (COLS) 2)
|
||||||
(reswin-w (- (COLS) 2)))
|
(- (- (LINES) 6) (app-window-height command-window))
|
||||||
|
#f))
|
||||||
|
(window-init-curses-win! bar-1)
|
||||||
|
(window-init-curses-win! bar-2)
|
||||||
|
(window-init-curses-win! command-window)
|
||||||
|
(window-init-curses-win! result-window)
|
||||||
|
(wclear (app-window-curses-win bar-1))
|
||||||
|
(wclear (app-window-curses-win bar-2))
|
||||||
|
(wclear (app-window-curses-win command-window))
|
||||||
|
(wclear (app-window-curses-win result-window))
|
||||||
|
(clear))
|
||||||
|
|
||||||
(wclear bar1)
|
(define (paint-bar-1)
|
||||||
(wclear bar2)
|
(mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT")
|
||||||
(wclear command-win)
|
(wrefresh (app-window-curses-win bar-1)))
|
||||||
(wclear result-win)
|
|
||||||
(clear)
|
|
||||||
|
|
||||||
(set! bar1 (newwin bar1-h bar1-w bar1-y bar1-x))
|
(define (paint-bar-2)
|
||||||
(set! bar2 (newwin bar2-h bar2-w bar2-y bar2-x))
|
(box (app-window-curses-win bar-2) (ascii->char 0) (ascii->char 0))
|
||||||
(set! command-win (newwin comwin-h comwin-w comwin-y comwin-x))
|
(print-active-command-win (app-window-curses-win bar-2)
|
||||||
(set! result-win (newwin reswin-h reswin-w reswin-y reswin-x))
|
(app-window-width bar-2)))
|
||||||
|
|
||||||
;(box standard-screen (ascii->char 0) (ascii->char 0))
|
(define (paint-command-window)
|
||||||
;(refresh)
|
(box (app-window-curses-win command-window)
|
||||||
(mvwaddstr bar1 0 1 "SCSH-NUIT")
|
(ascii->char 0) (ascii->char 0)))
|
||||||
(wrefresh bar1)
|
|
||||||
|
|
||||||
(box bar2 (ascii->char 0) (ascii->char 0))
|
(define (paint-command-window-contents)
|
||||||
(print-active-command-win bar2 bar2-w)
|
(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! command-buffer
|
||||||
|
(print-command-buffer (app-window-curses-win command-window)
|
||||||
|
command-buffer))
|
||||||
|
(wrefresh (app-window-curses-win command-window)))
|
||||||
|
|
||||||
(box command-win (ascii->char 0) (ascii->char 0))
|
(define (paint-result-window)
|
||||||
(set! command-lines (- comwin-h 2))
|
(wclear (app-window-curses-win result-window))
|
||||||
(set! command-cols (- comwin-w 3))
|
(box (app-window-curses-win result-window)
|
||||||
|
(ascii->char 0) (ascii->char 0))
|
||||||
|
(set! result-lines (- (app-window-height result-window) 2))
|
||||||
|
(set! result-cols (- (app-window-width result-window) 3))
|
||||||
|
(print-result-buffer result-window)
|
||||||
|
(wrefresh (app-window-curses-win result-window)))
|
||||||
|
|
||||||
(set! command-buffer (make-buffer text-command
|
(define (paint)
|
||||||
pos-command
|
(init-windows!)
|
||||||
pos-command-col
|
(paint-bar-1)
|
||||||
pos-command-fin-ln
|
(paint-bar-2)
|
||||||
command-buffer-pos-y
|
(paint-command-window)
|
||||||
command-buffer-pos-x
|
(paint-command-window-contents)
|
||||||
command-lines
|
(paint-result-window)
|
||||||
command-cols
|
|
||||||
can-write-command
|
|
||||||
command-history-pos))
|
|
||||||
|
|
||||||
(set! command-buffer (print-command-buffer command-win command-buffer))
|
(set! command-buffer
|
||||||
|
(cur-right-pos (app-window-curses-win command-window)
|
||||||
|
(app-window-curses-win result-window)
|
||||||
|
(app-window-height command-window)
|
||||||
|
(app-window-height result-window)
|
||||||
|
command-buffer))
|
||||||
|
|
||||||
(wrefresh command-win)
|
(let ((text (buffer-text command-buffer))
|
||||||
(box result-win (ascii->char 0) (ascii->char 0))
|
(pos-line (buffer-pos-line command-buffer))
|
||||||
(set! result-lines (- reswin-h 2))
|
(pos-col (buffer-pos-col command-buffer))
|
||||||
(set! result-cols (- reswin-w 3))
|
(pos-fin-ln (buffer-pos-fin-ln command-buffer))
|
||||||
(print-result-buffer result-win)
|
(pos-y (buffer-pos-y command-buffer))
|
||||||
(wrefresh result-win)
|
(pos-x (buffer-pos-x command-buffer))
|
||||||
|
(num-lines (buffer-num-lines command-buffer))
|
||||||
(set! command-buffer (cur-right-pos command-win result-win comwin-h
|
(num-cols (buffer-num-cols command-buffer))
|
||||||
reswin-h command-buffer))
|
(can-write (buffer-can-write command-buffer))
|
||||||
|
(history-pos (buffer-history-pos command-buffer)))
|
||||||
(let ((text (buffer-text command-buffer))
|
(set! text-command text)
|
||||||
(pos-line (buffer-pos-line command-buffer))
|
(set! pos-command pos-line)
|
||||||
(pos-col (buffer-pos-col command-buffer))
|
(set! pos-command-col pos-col)
|
||||||
(pos-fin-ln (buffer-pos-fin-ln command-buffer))
|
(set! pos-command-fin-ln pos-fin-ln)
|
||||||
(pos-y (buffer-pos-y command-buffer))
|
(set! command-buffer-pos-y pos-y)
|
||||||
(pos-x (buffer-pos-x command-buffer))
|
(set! command-buffer-pos-x pos-x)
|
||||||
(num-lines (buffer-num-lines command-buffer))
|
(set! command-lines num-lines)
|
||||||
(num-cols (buffer-num-cols command-buffer))
|
(set! command-cols num-cols)
|
||||||
(can-write (buffer-can-write command-buffer))
|
(set! can-write-command can-write)
|
||||||
(history-pos (buffer-history-pos command-buffer)))
|
(set! command-history-pos history-pos)))
|
||||||
(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)))
|
|
||||||
|
|
||||||
;(refresh)
|
|
||||||
; (wrefresh command-win)
|
|
||||||
; (wrefresh result-win)
|
|
||||||
; (wrefresh bar1)
|
|
||||||
; (wrefresh bar2)
|
|
||||||
))
|
|
||||||
|
|
||||||
(define (wait-for-input)
|
(define (wait-for-input)
|
||||||
(noecho)
|
(noecho)
|
||||||
(keypad bar1 #t)
|
(keypad (app-window-curses-win bar-1) #t)
|
||||||
(set! active-keyboard-interrupt #f)
|
(set! active-keyboard-interrupt #f)
|
||||||
(let ((ch (wgetch bar1)))
|
(let ((ch (wgetch (app-window-curses-win bar-1))))
|
||||||
(echo)
|
(echo)
|
||||||
ch))
|
ch))
|
||||||
|
|
||||||
|
|
@ -771,65 +756,64 @@
|
||||||
|
|
||||||
|
|
||||||
;;print the lower window
|
;;print the lower window
|
||||||
(define print-result-buffer
|
(define (print-result-buffer result-window)
|
||||||
(lambda (reswin)
|
(let* ((window (app-window-curses-win result-window))
|
||||||
(let* ((print-message (make-print-message active-command
|
(print-message (make-print-message active-command
|
||||||
current-result-object
|
current-result-object
|
||||||
command-cols))
|
command-cols))
|
||||||
(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))
|
||||||
(pos-x (print-object-pos-x model))
|
(pos-x (print-object-pos-x model))
|
||||||
(highlighted-lns (print-object-highlighted-lines model))
|
(highlighted-lns (print-object-highlighted-lines model))
|
||||||
(marked-lns (print-object-marked-lines model)))
|
(marked-lns (print-object-marked-lines model)))
|
||||||
(begin
|
(set! text-result text)
|
||||||
(set! text-result text)
|
(set! pos-result pos-y)
|
||||||
(set! pos-result pos-y)
|
(set! pos-result-col pos-x)
|
||||||
(set! pos-result-col pos-x)
|
(set! highlighted-lines highlighted-lns)
|
||||||
(set! highlighted-lines highlighted-lns)
|
(set! marked-lines marked-lns)
|
||||||
(set! marked-lines marked-lns)
|
(right-highlighted-lines)
|
||||||
(right-highlighted-lines)
|
(right-marked-lines)
|
||||||
(right-marked-lines)
|
(let ((lines (get-right-result-lines)))
|
||||||
(let ((lines (get-right-result-lines)))
|
(let loop ((pos 1))
|
||||||
(let loop ((pos 1))
|
(if (> pos result-lines)
|
||||||
(if (> pos result-lines)
|
values
|
||||||
values
|
(let ((line (list-ref lines (- pos 1))))
|
||||||
(let ((line (list-ref lines (- pos 1))))
|
(begin
|
||||||
(begin
|
(if (not (standard-result-obj? current-result-object))
|
||||||
(if (not (standard-result-obj? current-result-object))
|
(set! line
|
||||||
(set! line
|
(if (> (string-length line) result-cols)
|
||||||
(if (> (string-length line) result-cols)
|
(let ((start-line
|
||||||
(let ((start-line
|
(substring line 0
|
||||||
(substring line 0
|
(- (ceiling (/ result-cols 2))
|
||||||
(- (ceiling (/ result-cols 2))
|
3)))
|
||||||
3)))
|
(end-line
|
||||||
(end-line
|
(substring line
|
||||||
(substring line
|
(- (string-length line)
|
||||||
(- (string-length line)
|
(ceiling
|
||||||
(ceiling
|
(/ result-cols 2)))
|
||||||
(/ result-cols 2)))
|
(string-length line))))
|
||||||
(string-length line))))
|
(string-append start-line "..." end-line))
|
||||||
(string-append start-line "..." end-line))
|
line)))
|
||||||
line)))
|
(if (and (member pos highlighted-lines)
|
||||||
(if (and (member pos highlighted-lines)
|
(= active-buffer 2))
|
||||||
(= active-buffer 2))
|
(begin
|
||||||
|
(wattron window (A-REVERSE))
|
||||||
|
(mvwaddstr window pos 1 line)
|
||||||
|
(wattrset window (A-NORMAL))
|
||||||
|
(wrefresh window)
|
||||||
|
(loop (+ pos 1)))
|
||||||
|
(if (member pos marked-lines)
|
||||||
(begin
|
(begin
|
||||||
(wattron reswin (A-REVERSE))
|
(wattron window (A-BOLD))
|
||||||
(mvwaddstr reswin pos 1 line)
|
(mvwaddstr window pos 1 line)
|
||||||
(wattrset reswin (A-NORMAL))
|
(wattrset window (A-NORMAL))
|
||||||
(wrefresh reswin)
|
(wrefresh window)
|
||||||
(loop (+ pos 1)))
|
(loop (+ pos 1)))
|
||||||
(if (member pos marked-lines)
|
(begin
|
||||||
(begin
|
(mvwaddstr window pos 1 line)
|
||||||
(wattron reswin (A-BOLD))
|
(wrefresh window)
|
||||||
(mvwaddstr reswin pos 1 line)
|
(loop (+ pos 1))))))))))))
|
||||||
(wattrset reswin (A-NORMAL))
|
|
||||||
(wrefresh reswin)
|
|
||||||
(loop (+ pos 1)))
|
|
||||||
(begin
|
|
||||||
(mvwaddstr reswin pos 1 line)
|
|
||||||
(wrefresh reswin)
|
|
||||||
(loop (+ pos 1))))))))))))))
|
|
||||||
|
|
||||||
;;visible lines
|
;;visible lines
|
||||||
(define get-right-result-lines
|
(define get-right-result-lines
|
||||||
|
|
@ -1176,6 +1160,3 @@
|
||||||
str
|
str
|
||||||
(loop (cdr lst)
|
(loop (cdr lst)
|
||||||
(string-append str " " (car lst)))))))
|
(string-append str " " (car lst)))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue