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
|
||||
|
||||
;;The different windows
|
||||
;;------------------------
|
||||
(define bar1)
|
||||
(define bar2)
|
||||
(define bar3)
|
||||
(define command-win)
|
||||
(define result-win)
|
||||
(define-record-type app-window :app-window
|
||||
(make-app-window x y width height curses-win)
|
||||
app-window?
|
||||
(x app-window-x)
|
||||
(y app-window-y)
|
||||
(width app-window-width)
|
||||
(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"
|
||||
"F2:Repaint (after change of buffer size)"
|
||||
|
|
@ -224,320 +230,299 @@
|
|||
;;Actions
|
||||
|
||||
;;start the whole thing
|
||||
(define nuit
|
||||
(lambda ()
|
||||
(run)))
|
||||
(define (nuit)
|
||||
(run))
|
||||
|
||||
;;handle input
|
||||
(define run
|
||||
(lambda ()
|
||||
(begin
|
||||
(define (run)
|
||||
|
||||
;;initialisation
|
||||
(init-screen)
|
||||
(set! bar1 (newwin 0 0 0 0))
|
||||
(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
|
||||
;;If a keyboard-interrupt occurs it is stored in "active-keyboard-interrupt"
|
||||
(set-interrupt-handler interrupt/keyboard
|
||||
(lambda a
|
||||
(set! active-keyboard-interrupt a)))
|
||||
'(set-interrupt-handler interrupt/keyboard
|
||||
(lambda a
|
||||
(set! active-keyboard-interrupt a)))
|
||||
|
||||
;;Loop
|
||||
(paint)
|
||||
(let loop ((ch (wait-for-input)))
|
||||
(cond
|
||||
|
||||
;;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
|
||||
(paint)
|
||||
(let loop ((ch (wait-for-input)))
|
||||
(cond
|
||||
;;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 "")))
|
||||
|
||||
((= ch key-f2)
|
||||
(endwin)
|
||||
(run))
|
||||
|
||||
((= ch key-f2)
|
||||
(endwin)
|
||||
(run))
|
||||
;;Ctrl-x -> wait for next input
|
||||
((= ch 24)
|
||||
(begin
|
||||
(set! c-x-pressed (not c-x-pressed))
|
||||
(if (= active-buffer 2)
|
||||
(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))))
|
||||
|
||||
;;Ctrl-x -> wait for next input
|
||||
((= ch 24)
|
||||
(begin
|
||||
(set! c-x-pressed (not c-x-pressed))
|
||||
(if (= active-buffer 2)
|
||||
(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
|
||||
((= ch key-npage)
|
||||
(history-forward)
|
||||
(paint-result-window)
|
||||
(loop (wait-for-input)))
|
||||
|
||||
;; back in result history
|
||||
((= ch key-ppage)
|
||||
(history-back)
|
||||
(paint-result-window)
|
||||
(loop (wait-for-input)))
|
||||
|
||||
;; forward in result history
|
||||
((= ch key-npage)
|
||||
(history-forward)
|
||||
(print-result-buffer result-win)
|
||||
(loop (wait-for-input)))
|
||||
|
||||
;; back in result history
|
||||
((= ch key-ppage)
|
||||
(history-back)
|
||||
(print-result-buffer result-win)
|
||||
(loop (wait-for-input)))
|
||||
|
||||
|
||||
;;if lower window is active a message is sent.
|
||||
(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
|
||||
;;if lower window is active a message is sent.
|
||||
(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
|
||||
97)))
|
||||
(set! current-result-object (switch key-message))))
|
||||
(set! active-buffer 1))
|
||||
(set! c-x-pressed #f)
|
||||
(loop (wait-for-input))))
|
||||
(set! current-result-object (switch key-message))))
|
||||
(set! active-buffer 1))
|
||||
(set! c-x-pressed #f)
|
||||
(loop (wait-for-input))))
|
||||
|
||||
;;C-x r -> redo
|
||||
((= ch 114)
|
||||
(if (or (> (length text-command) 2)
|
||||
(not (equal? active-command "")))
|
||||
(let ((command-string (string-append active-command
|
||||
;;C-x r -> redo
|
||||
((= ch 114)
|
||||
(if (or (> (length text-command) 2)
|
||||
(not (equal? active-command "")))
|
||||
(let ((command-string (string-append active-command
|
||||
active-parameters))
|
||||
(text (sublist text-command 0
|
||||
(- (length text-command) 1))))
|
||||
(begin
|
||||
(switch restore-message)
|
||||
(set! text-command (append text
|
||||
(list command-string)))
|
||||
(text (sublist text-command 0
|
||||
(- (length text-command) 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)))
|
||||
(begin
|
||||
(set! c-x-pressed #f)
|
||||
(loop (wait-for-input)))))
|
||||
|
||||
(else
|
||||
(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)
|
||||
(loop (wait-for-input)))))
|
||||
|
||||
|
||||
(else
|
||||
(begin
|
||||
(if (= active-buffer 2)
|
||||
(let ((key-message
|
||||
(make-key-pressed-message active-command
|
||||
current-result-object
|
||||
ch)))
|
||||
(begin
|
||||
(set! current-result-object (switch key-message))
|
||||
(loop (wait-for-input))))
|
||||
(set! current-result-object (switch key-message)))
|
||||
|
||||
(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))
|
||||
(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)))))
|
||||
|
||||
(if (= active-buffer 2)
|
||||
(let ((key-message
|
||||
(make-key-pressed-message active-command
|
||||
current-result-object
|
||||
ch)))
|
||||
(begin
|
||||
(set! current-result-object (switch key-message))
|
||||
(loop (wait-for-input))))
|
||||
|
||||
(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))))
|
||||
(endwin)
|
||||
(run))))
|
||||
|
||||
|
||||
|
||||
;;Ctrl+p -> History back
|
||||
; ((= ch 16)
|
||||
; (begin
|
||||
; (history-back)
|
||||
; (loop (paint))))
|
||||
|
||||
; ;;Ctrl+n -> History forward
|
||||
; ((= ch 14)
|
||||
; (begin
|
||||
; (history-forward)
|
||||
; (loop (paint))))
|
||||
(endwin)
|
||||
(run))))
|
||||
|
||||
; ;;Ctrl+s -> get selection
|
||||
; ((= ch 19)
|
||||
; (let* ((message (make-selection-message active-command
|
||||
; current-result-object))
|
||||
; (marked-items (switch message)))
|
||||
; (begin
|
||||
; (add-string-to-command-buffer marked-items)
|
||||
; (loop (paint)))))
|
||||
|
||||
(else
|
||||
(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! 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)
|
||||
(loop (wait-for-input)))))))))))))
|
||||
(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)
|
||||
(loop (wait-for-input)))))))))))
|
||||
|
||||
;;print and wait for input
|
||||
(define (paint)
|
||||
(define (window-init-curses-win! window)
|
||||
(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)
|
||||
(let* ((bar1-y 1)
|
||||
(bar1-x 1)
|
||||
(bar1-h 2)
|
||||
(bar1-w (- (COLS) 2))
|
||||
(bar2-y (+ (round (/ (LINES) 3)) 2))
|
||||
(bar2-x 1)
|
||||
(bar2-h 3)
|
||||
(bar2-w (- (COLS) 2))
|
||||
(comwin-y 2)
|
||||
(comwin-x 1)
|
||||
(comwin-h (- bar2-y 2))
|
||||
(comwin-w (- (COLS) 2))
|
||||
(reswin-y (+ bar2-y 3))
|
||||
(reswin-x 1)
|
||||
(reswin-h (- (- (LINES) 6) comwin-h))
|
||||
(reswin-w (- (COLS) 2)))
|
||||
(set! bar-1
|
||||
(make-app-window 1 1
|
||||
(- (COLS) 2) 2
|
||||
#f))
|
||||
(set! bar-2
|
||||
(make-app-window 1 (+ (round (/ (LINES) 3)) 2)
|
||||
(- (COLS) 2) 3
|
||||
#f))
|
||||
(set! command-window
|
||||
(make-app-window 1 2
|
||||
(- (COLS) 2) (- (app-window-y bar-2) 2)
|
||||
#f))
|
||||
(set! result-window
|
||||
(make-app-window 1 (+ (app-window-y bar-2) 3)
|
||||
(- (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)
|
||||
(wclear bar2)
|
||||
(wclear command-win)
|
||||
(wclear result-win)
|
||||
(clear)
|
||||
(define (paint-bar-1)
|
||||
(mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT")
|
||||
(wrefresh (app-window-curses-win bar-1)))
|
||||
|
||||
(set! bar1 (newwin bar1-h bar1-w bar1-y bar1-x))
|
||||
(set! bar2 (newwin bar2-h bar2-w bar2-y bar2-x))
|
||||
(set! command-win (newwin comwin-h comwin-w comwin-y comwin-x))
|
||||
(set! result-win (newwin reswin-h reswin-w reswin-y reswin-x))
|
||||
|
||||
;(box standard-screen (ascii->char 0) (ascii->char 0))
|
||||
;(refresh)
|
||||
(mvwaddstr bar1 0 1 "SCSH-NUIT")
|
||||
(wrefresh bar1)
|
||||
(define (paint-bar-2)
|
||||
(box (app-window-curses-win bar-2) (ascii->char 0) (ascii->char 0))
|
||||
(print-active-command-win (app-window-curses-win bar-2)
|
||||
(app-window-width bar-2)))
|
||||
|
||||
(box bar2 (ascii->char 0) (ascii->char 0))
|
||||
(print-active-command-win bar2 bar2-w)
|
||||
(define (paint-command-window)
|
||||
(box (app-window-curses-win command-window)
|
||||
(ascii->char 0) (ascii->char 0)))
|
||||
|
||||
(box command-win (ascii->char 0) (ascii->char 0))
|
||||
(set! command-lines (- comwin-h 2))
|
||||
(set! command-cols (- comwin-w 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 command-win command-buffer))
|
||||
(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! command-buffer
|
||||
(print-command-buffer (app-window-curses-win command-window)
|
||||
command-buffer))
|
||||
(wrefresh (app-window-curses-win command-window)))
|
||||
|
||||
(wrefresh command-win)
|
||||
(box result-win (ascii->char 0) (ascii->char 0))
|
||||
(set! result-lines (- reswin-h 2))
|
||||
(set! result-cols (- reswin-w 3))
|
||||
(print-result-buffer result-win)
|
||||
(wrefresh result-win)
|
||||
|
||||
(set! command-buffer (cur-right-pos command-win result-win comwin-h
|
||||
reswin-h command-buffer))
|
||||
(define (paint-result-window)
|
||||
(wclear (app-window-curses-win result-window))
|
||||
(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)))
|
||||
|
||||
(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)))
|
||||
(define (paint)
|
||||
(init-windows!)
|
||||
(paint-bar-1)
|
||||
(paint-bar-2)
|
||||
(paint-command-window)
|
||||
(paint-command-window-contents)
|
||||
(paint-result-window)
|
||||
|
||||
(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))
|
||||
|
||||
;(refresh)
|
||||
; (wrefresh command-win)
|
||||
; (wrefresh result-win)
|
||||
; (wrefresh bar1)
|
||||
; (wrefresh bar2)
|
||||
))
|
||||
(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)
|
||||
(noecho)
|
||||
(keypad bar1 #t)
|
||||
(keypad (app-window-curses-win bar-1) #t)
|
||||
(set! active-keyboard-interrupt #f)
|
||||
(let ((ch (wgetch bar1)))
|
||||
(let ((ch (wgetch (app-window-curses-win bar-1))))
|
||||
(echo)
|
||||
ch))
|
||||
|
||||
|
|
@ -771,65 +756,64 @@
|
|||
|
||||
|
||||
;;print the lower window
|
||||
(define print-result-buffer
|
||||
(lambda (reswin)
|
||||
(let* ((print-message (make-print-message active-command
|
||||
current-result-object
|
||||
command-cols))
|
||||
(model (switch print-message))
|
||||
(text (print-object-text model))
|
||||
(pos-y (print-object-pos-y model))
|
||||
(pos-x (print-object-pos-x model))
|
||||
(highlighted-lns (print-object-highlighted-lines model))
|
||||
(marked-lns (print-object-marked-lines model)))
|
||||
(begin
|
||||
(set! text-result text)
|
||||
(set! pos-result pos-y)
|
||||
(set! pos-result-col pos-x)
|
||||
(set! highlighted-lines highlighted-lns)
|
||||
(set! marked-lines marked-lns)
|
||||
(right-highlighted-lines)
|
||||
(right-marked-lines)
|
||||
(let ((lines (get-right-result-lines)))
|
||||
(let loop ((pos 1))
|
||||
(if (> pos result-lines)
|
||||
values
|
||||
(let ((line (list-ref lines (- pos 1))))
|
||||
(begin
|
||||
(if (not (standard-result-obj? current-result-object))
|
||||
(set! line
|
||||
(if (> (string-length line) result-cols)
|
||||
(let ((start-line
|
||||
(substring line 0
|
||||
(- (ceiling (/ result-cols 2))
|
||||
3)))
|
||||
(end-line
|
||||
(substring line
|
||||
(- (string-length line)
|
||||
(ceiling
|
||||
(/ result-cols 2)))
|
||||
(string-length line))))
|
||||
(string-append start-line "..." end-line))
|
||||
line)))
|
||||
(if (and (member pos highlighted-lines)
|
||||
(= active-buffer 2))
|
||||
(define (print-result-buffer result-window)
|
||||
(let* ((window (app-window-curses-win result-window))
|
||||
(print-message (make-print-message active-command
|
||||
current-result-object
|
||||
command-cols))
|
||||
(model (switch print-message))
|
||||
(text (print-object-text model))
|
||||
(pos-y (print-object-pos-y model))
|
||||
(pos-x (print-object-pos-x model))
|
||||
(highlighted-lns (print-object-highlighted-lines model))
|
||||
(marked-lns (print-object-marked-lines model)))
|
||||
(set! text-result text)
|
||||
(set! pos-result pos-y)
|
||||
(set! pos-result-col pos-x)
|
||||
(set! highlighted-lines highlighted-lns)
|
||||
(set! marked-lines marked-lns)
|
||||
(right-highlighted-lines)
|
||||
(right-marked-lines)
|
||||
(let ((lines (get-right-result-lines)))
|
||||
(let loop ((pos 1))
|
||||
(if (> pos result-lines)
|
||||
values
|
||||
(let ((line (list-ref lines (- pos 1))))
|
||||
(begin
|
||||
(if (not (standard-result-obj? current-result-object))
|
||||
(set! line
|
||||
(if (> (string-length line) result-cols)
|
||||
(let ((start-line
|
||||
(substring line 0
|
||||
(- (ceiling (/ result-cols 2))
|
||||
3)))
|
||||
(end-line
|
||||
(substring line
|
||||
(- (string-length line)
|
||||
(ceiling
|
||||
(/ result-cols 2)))
|
||||
(string-length line))))
|
||||
(string-append start-line "..." end-line))
|
||||
line)))
|
||||
(if (and (member pos highlighted-lines)
|
||||
(= 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
|
||||
(wattron reswin (A-REVERSE))
|
||||
(mvwaddstr reswin pos 1 line)
|
||||
(wattrset reswin (A-NORMAL))
|
||||
(wrefresh reswin)
|
||||
(wattron window (A-BOLD))
|
||||
(mvwaddstr window pos 1 line)
|
||||
(wattrset window (A-NORMAL))
|
||||
(wrefresh window)
|
||||
(loop (+ pos 1)))
|
||||
(if (member pos marked-lines)
|
||||
(begin
|
||||
(wattron reswin (A-BOLD))
|
||||
(mvwaddstr reswin pos 1 line)
|
||||
(wattrset reswin (A-NORMAL))
|
||||
(wrefresh reswin)
|
||||
(loop (+ pos 1)))
|
||||
(begin
|
||||
(mvwaddstr reswin pos 1 line)
|
||||
(wrefresh reswin)
|
||||
(loop (+ pos 1))))))))))))))
|
||||
(begin
|
||||
(mvwaddstr window pos 1 line)
|
||||
(wrefresh window)
|
||||
(loop (+ pos 1))))))))))))
|
||||
|
||||
;;visible lines
|
||||
(define get-right-result-lines
|
||||
|
|
@ -1176,6 +1160,3 @@
|
|||
str
|
||||
(loop (cdr lst)
|
||||
(string-append str " " (car lst)))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue