commander-s/scheme/win.scm

(define-record-type app-window :app-window
  (really-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 (make-app-window x y width height)
  (really-make-app-window x y width height #f))

(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)))

(define (app-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 (delete-app-window! window)
  (delwin (app-window-curses-win window)))

(define (init-windows!)
  (set! *bar-1*
	(make-app-window 1 1 
			 (- (COLS) 2) 2))
  (debug-message '*bar-1* *bar-1*)
  (set! *active-command-window*
	(make-app-window 1 (+ (round (/ (LINES) 3)) 2)
			 (- (COLS) 2) 3))
  (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)))
  (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)))))
  (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 app-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)