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

Small changes for app-windows 

part of darcs patch Wed Sep 21 20:50:24 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 16:32:10 +00:00
parent 35ec8720e1
commit 889fa445f1
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
scheme/win.scm
View File

@ -1,5 +1,5 @@
(define-record-type app-window :app-window (define-record-type app-window :app-window
(make-app-window x y width height curses-win) (really-make-app-window x y width height curses-win)
app-window? app-window?
(x app-window-x) (x app-window-x)
(y app-window-y) (y app-window-y)
@ -7,6 +7,9 @@
(height app-window-height) (height app-window-height)
(curses-win app-window-curses-win set-app-window-curses-win!)) (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 (define-record-discloser :app-window
(lambda (rec) (lambda (rec)
`(app-window `(app-window
@ -72,30 +75,29 @@
(make-app-window (+ (app-window-x outer-window) 1) (make-app-window (+ (app-window-x outer-window) 1)
(+ (app-window-y outer-window) 1) (+ (app-window-y outer-window) 1)
(- (app-window-width outer-window) 2) (- (app-window-width outer-window) 2)
(- (app-window-height outer-window) 2) (- (app-window-height outer-window) 2)))
#f))
(define (window-init-curses-win! window) (define (app-window-init-curses-win! window)
(set-app-window-curses-win! (set-app-window-curses-win!
window window
(newwin (app-window-height window) (app-window-width window) (newwin (app-window-height window) (app-window-width window)
(app-window-y window) (app-window-x window)))) (app-window-y window) (app-window-x window))))
(define (delete-app-window! window)
(delwin (app-window-curses-win window)))
(define (init-windows!) (define (init-windows!)
(set! *bar-1* (set! *bar-1*
(make-app-window 1 1 (make-app-window 1 1
(- (COLS) 2) 2 (- (COLS) 2) 2))
#f))
(debug-message '*bar-1* *bar-1*) (debug-message '*bar-1* *bar-1*)
(set! *active-command-window* (set! *active-command-window*
(make-app-window 1 (+ (round (/ (LINES) 3)) 2) (make-app-window 1 (+ (round (/ (LINES) 3)) 2)
(- (COLS) 2) 3 (- (COLS) 2) 3))
#f))
(debug-message '*active-command-window* *active-command-window*) (debug-message '*active-command-window* *active-command-window*)
(set! *command-frame-window* (set! *command-frame-window*
(make-app-window 1 2 (make-app-window 1 2
(- (COLS) 2) (- (app-window-y (active-command-window)) 2) (- (COLS) 2) (- (app-window-y (active-command-window)) 2)))
#f))
(debug-message '*command-frame-window* *command-frame-window*) (debug-message '*command-frame-window* *command-frame-window*)
(set! *command-window* (set! *command-window*
(make-inlying-app-window (command-frame-window))) (make-inlying-app-window (command-frame-window)))
@ -103,8 +105,7 @@
(set! *result-frame-window* (set! *result-frame-window*
(make-app-window 1 (+ (app-window-y (active-command-window)) 3) (make-app-window 1 (+ (app-window-y (active-command-window)) 3)
(- (COLS) 2) (- (COLS) 2)
(- (- (LINES) 6) (app-window-height (command-frame-window))) (- (- (LINES) 6) (app-window-height (command-frame-window)))))
#f))
(debug-message '*result-frame-window* *result-frame-window*) (debug-message '*result-frame-window* *result-frame-window*)
(set! *result-window* (set! *result-window*
(make-inlying-app-window (result-frame-window))) (make-inlying-app-window (result-frame-window)))
@ -114,7 +115,7 @@
(list (bar-1) (active-command-window) (list (bar-1) (active-command-window)
(command-frame-window) (command-window) (command-frame-window) (command-window)
(result-frame-window) (result-window)))) (result-frame-window) (result-window))))
(for-each window-init-curses-win! all-windows) (for-each app-window-init-curses-win! all-windows)
(set-result-buffer-num-lines! (set-result-buffer-num-lines!
*result-buffer* (- (app-window-height (result-window)) 2)) *result-buffer* (- (app-window-height (result-window)) 2))