166 lines
4.7 KiB
Scheme
166 lines
4.7 KiB
Scheme
(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-record-discloser :app-window
|
|
(lambda (rec)
|
|
`(app-window
|
|
(x ,(app-window-x rec)) (y ,(app-window-y rec))
|
|
(w ,(app-window-width rec)) (h ,(app-window-height rec)))))
|
|
|
|
(define *bar-1* #f)
|
|
(define (bar-1) *bar-1*)
|
|
|
|
(define *active-command-window* #f)
|
|
(define (active-command-window) *active-command-window*)
|
|
|
|
(define *command-frame-window* #f)
|
|
(define (command-frame-window) *command-frame-window*)
|
|
|
|
(define *command-window* #f)
|
|
(define (command-window) *command-window*)
|
|
|
|
(define *result-window* #f)
|
|
(define (result-window) *result-window*)
|
|
|
|
(define *result-frame-window* #f)
|
|
(define (result-frame-window) *result-frame-window*)
|
|
|
|
(define *command-buffer*
|
|
(make-buffer '("pwd" "")
|
|
2 2 2 1 1
|
|
0 0
|
|
#t 1))
|
|
|
|
(define (command-buffer) *command-buffer*)
|
|
|
|
(define *result-buffer*
|
|
(make-result-buffer 0 0 0 0
|
|
#f #f ; set in INIT-WINDOWS
|
|
'() '()))
|
|
|
|
(define (result-buffer) *result-buffer*)
|
|
|
|
(define *focus-buffer* 'command-buffer)
|
|
|
|
(define (focus-on-command-buffer?)
|
|
(eq? *focus-buffer* 'command-buffer))
|
|
|
|
(define (focus-command-buffer!)
|
|
(set! *focus-buffer* 'command-buffer))
|
|
|
|
(define (focus-on-result-buffer?)
|
|
(eq? *focus-buffer* 'result-buffer))
|
|
|
|
(define (focus-result-buffer!)
|
|
(set! *focus-buffer* 'result-buffer))
|
|
|
|
(define *untouched-tty* #f)
|
|
|
|
(define (save-initial-tty-info! port)
|
|
(set! *untouched-tty* (copy-tty-info (tty-info port))))
|
|
|
|
(define (restore-initial-tty-info! port)
|
|
(set-tty-info/now port *untouched-tty*))
|
|
|
|
(define (make-inlying-app-window outer-window)
|
|
(make-app-window (+ (app-window-x outer-window) 1)
|
|
(+ (app-window-y outer-window) 1)
|
|
(- (app-window-width outer-window) 2)
|
|
(- (app-window-height outer-window) 2)
|
|
#f))
|
|
|
|
(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!)
|
|
(set! *bar-1*
|
|
(make-app-window 1 1
|
|
(- (COLS) 2) 2
|
|
#f))
|
|
(debug-message '*bar-1* *bar-1*)
|
|
(set! *active-command-window*
|
|
(make-app-window 1 (+ (round (/ (LINES) 3)) 2)
|
|
(- (COLS) 2) 3
|
|
#f))
|
|
(debug-message '*active-command-window* *active-command-window*)
|
|
(set! *command-frame-window*
|
|
(make-app-window 1 2
|
|
(- (COLS) 2) (- (app-window-y (active-command-window)) 2)
|
|
#f))
|
|
(debug-message '*command-frame-window* *command-frame-window*)
|
|
(set! *command-window*
|
|
(make-inlying-app-window (command-frame-window)))
|
|
(debug-message '*command-window* *command-window*)
|
|
(set! *result-frame-window*
|
|
(make-app-window 1 (+ (app-window-y (active-command-window)) 3)
|
|
(- (COLS) 2)
|
|
(- (- (LINES) 6) (app-window-height (command-frame-window)))
|
|
#f))
|
|
(debug-message '*result-frame-window* *result-frame-window*)
|
|
(set! *result-window*
|
|
(make-inlying-app-window (result-frame-window)))
|
|
(debug-message '*result-window* *result-window*)
|
|
|
|
(let ((all-windows
|
|
(list (bar-1) (active-command-window)
|
|
(command-frame-window) (command-window)
|
|
(result-frame-window) (result-window))))
|
|
(for-each window-init-curses-win! all-windows)
|
|
|
|
(set-result-buffer-num-lines!
|
|
*result-buffer* (- (app-window-height (result-window)) 2))
|
|
(set-result-buffer-num-cols!
|
|
*result-buffer* (- (app-window-width (result-window)) 1))
|
|
|
|
(for-each wclear
|
|
(map app-window-curses-win all-windows))))
|
|
|
|
;; result-buffer-object-change-channel
|
|
|
|
(define result-buffer-changed-channel
|
|
(make-channel))
|
|
|
|
(define result-buffer-changes-subscribers
|
|
(make-channel))
|
|
|
|
(define (signal-result-buffer-object-change)
|
|
(let ((ack-channel (make-channel)))
|
|
(debug-message "signal-result-buffer-object-change")
|
|
(send result-buffer-changed-channel ack-channel)
|
|
(receive ack-channel)))
|
|
|
|
(define (spawn-result-buffer-surveillant)
|
|
(spawn
|
|
(lambda ()
|
|
(let lp ()
|
|
(select
|
|
(wrap (receive-rv result-buffer-changes-subscribers)
|
|
(lambda (answer-channel)
|
|
(debug-message "result-buffer-surveillant 1")
|
|
(sync (wrap
|
|
(receive-rv result-buffer-changed-channel)
|
|
(lambda (ack-channel)
|
|
(send answer-channel ack-channel))))
|
|
(lp)))
|
|
(wrap (receive-rv result-buffer-changed-channel)
|
|
(lambda (ack-channel)
|
|
(send ack-channel 'no-one-is-interested)
|
|
(debug-message "result-buffer-surveillant 2")
|
|
(lp))))))))
|
|
|
|
(define (result-buffer-other-object-has-focus-rv)
|
|
(let ((answer-channel (make-channel)))
|
|
(send result-buffer-changes-subscribers answer-channel)
|
|
(receive-rv answer-channel)))
|
|
|
|
(spawn-result-buffer-surveillant)
|