fixed a part of PR 8471
svn: r5265
This commit is contained in:
Robby Findler
parent
5646c26ba9
commit
cd2f2ee56b
|
|
@ -1605,10 +1605,31 @@ module browser threading seems wrong.
|
|||
|
||||
|
||||
(inherit get-edit-target-window)
|
||||
|
||||
(define/private (split)
|
||||
(let* ([canvas-to-be-split (get-edit-target-window)]
|
||||
[update
|
||||
(λ (set-canvases! canvases canvas% text)
|
||||
(let ([canvas-to-be-split (get-edit-target-window)])
|
||||
(cond
|
||||
[(memq canvas-to-be-split definitions-canvases)
|
||||
(split-definitions canvas-to-be-split)]
|
||||
[(memq canvas-to-be-split interactions-canvases)
|
||||
(split-interactions canvas-to-be-split)]
|
||||
[else (bell)])))
|
||||
|
||||
(define/private (split-definitions canvas-to-be-split)
|
||||
(handle-split canvas-to-be-split
|
||||
(λ (x) (set! definitions-canvases x))
|
||||
definitions-canvases
|
||||
(drscheme:get/extend:get-definitions-canvas)
|
||||
definitions-text))
|
||||
|
||||
(define/private (split-interactions canvas-to-be-split)
|
||||
(handle-split canvas-to-be-split
|
||||
(λ (x) (set! interactions-canvases x))
|
||||
interactions-canvases
|
||||
(drscheme:get/extend:get-interactions-canvas)
|
||||
interactions-text))
|
||||
|
||||
(define/private (handle-split canvas-to-be-split set-canvases! canvases canvas% text)
|
||||
(let-values ([(ox oy ow oh cursor-y)
|
||||
(get-visible-region canvas-to-be-split)])
|
||||
(let ([orig-percentages (send resizable-panel get-percentages)]
|
||||
|
|
@ -1658,19 +1679,7 @@ module browser threading seems wrong.
|
|||
(set-visible-region new-canvas ox oy ow oh cursor-y)
|
||||
(set-visible-region canvas-to-be-split ox oy ow oh cursor-y)
|
||||
|
||||
(send new-canvas focus))))])
|
||||
(cond
|
||||
[(memq canvas-to-be-split definitions-canvases)
|
||||
(update (λ (x) (set! definitions-canvases x))
|
||||
definitions-canvases
|
||||
(drscheme:get/extend:get-definitions-canvas)
|
||||
definitions-text)]
|
||||
[(memq canvas-to-be-split interactions-canvases)
|
||||
(update (λ (x) (set! interactions-canvases x))
|
||||
interactions-canvases
|
||||
(drscheme:get/extend:get-interactions-canvas)
|
||||
interactions-text)]
|
||||
[else (bell)])))
|
||||
(send new-canvas focus))))
|
||||
|
||||
;; split-demand : menu-item -> void
|
||||
;; enables the menu-item if splitting is allowed, disables otherwise
|
||||
|
|
@ -1752,9 +1761,27 @@ module browser threading seems wrong.
|
|||
(unbox bh))))
|
||||
|
||||
(define/private (collapse)
|
||||
(let* ([target (get-edit-target-window)]
|
||||
[handle-collapse
|
||||
(λ (get-canvases set-canvases!)
|
||||
(let* ([target (get-edit-target-window)])
|
||||
(cond
|
||||
[(memq target definitions-canvases)
|
||||
(collapse-definitions target)]
|
||||
[(memq target interactions-canvases)
|
||||
(collapse-interactions target)]
|
||||
[else (bell)])))
|
||||
|
||||
(define/private (collapse-definitions target)
|
||||
(handle-collapse
|
||||
target
|
||||
(λ () definitions-canvases)
|
||||
(λ (c) (set! definitions-canvases c))))
|
||||
|
||||
(define/private (collapse-interactions target)
|
||||
(handle-collapse
|
||||
target
|
||||
(λ () interactions-canvases)
|
||||
(λ (c) (set! interactions-canvases c))))
|
||||
|
||||
(define/private (handle-collapse target get-canvases set-canvases!)
|
||||
(if (= 1 (length (get-canvases)))
|
||||
(bell)
|
||||
(let* ([old-percentages (send resizable-panel get-percentages)]
|
||||
|
|
@ -1815,19 +1842,8 @@ module browser threading seems wrong.
|
|||
ah
|
||||
#t))))
|
||||
|
||||
(send soon-to-be-bigger-canvas focus))))])
|
||||
(cond
|
||||
[(memq target definitions-canvases)
|
||||
(handle-collapse
|
||||
(λ () definitions-canvases)
|
||||
(λ (c) (set! definitions-canvases c)))]
|
||||
[(memq target interactions-canvases)
|
||||
(handle-collapse
|
||||
(λ () interactions-canvases)
|
||||
(λ (c) (set! interactions-canvases c)))]
|
||||
[else (bell)])))
|
||||
|
||||
|
||||
(send target set-editor #f)
|
||||
(send soon-to-be-bigger-canvas focus))))
|
||||
;
|
||||
;
|
||||
;
|
||||
|
|
@ -2081,6 +2097,7 @@ module browser threading seems wrong.
|
|||
;; change-to-tab : tab -> void
|
||||
;; updates current-tab, definitions-text, and interactactions-text
|
||||
;; to be the nth tab. Also updates the GUI to show the new tab
|
||||
(inherit begin-container-sequence end-container-sequence)
|
||||
(define/private (change-to-tab tab)
|
||||
(let ([old-delegate (send definitions-text get-delegate)]
|
||||
[old-tab current-tab])
|
||||
|
|
@ -2089,6 +2106,8 @@ module browser threading seems wrong.
|
|||
(set! definitions-text (send current-tab get-defs))
|
||||
(set! interactions-text (send current-tab get-ints))
|
||||
|
||||
|
||||
(begin-container-sequence)
|
||||
(for-each (λ (defs-canvas) (send defs-canvas set-editor definitions-text))
|
||||
definitions-canvases)
|
||||
(for-each (λ (ints-canvas) (send ints-canvas set-editor interactions-text))
|
||||
|
|
@ -2101,7 +2120,8 @@ module browser threading seems wrong.
|
|||
|
||||
(send definitions-text update-frame-filename)
|
||||
(send definitions-text set-delegate old-delegate)
|
||||
(on-tab-change old-tab current-tab)))
|
||||
(on-tab-change old-tab current-tab)
|
||||
(end-container-sequence)))
|
||||
|
||||
(define/pubment (on-tab-change from-tab to-tab)
|
||||
(let ([old-enabled (send from-tab get-enabled)]
|
||||
|
|
@ -2182,11 +2202,35 @@ module browser threading seems wrong.
|
|||
'defs)))
|
||||
|
||||
(define/private (restore-visible-tab-regions)
|
||||
(define (set-visible-regions txt regions)
|
||||
(define (set-visible-regions txt regions ints?)
|
||||
(when regions
|
||||
(let* ([canvases (send txt get-canvases)])
|
||||
(when (equal? (length canvases) (length regions))
|
||||
(for-each (λ (c r) (set-visible-region txt c r)) canvases regions)))))
|
||||
(let* ([canvases (send txt get-canvases)]
|
||||
[canvases-count (length canvases)]
|
||||
[regions-count (length regions)])
|
||||
(cond
|
||||
[(> canvases-count regions-count)
|
||||
(let loop ([i (- canvases-count regions-count)]
|
||||
[canvases canvases])
|
||||
(unless (zero? i)
|
||||
(if ints?
|
||||
(collapse-interactions (car canvases))
|
||||
(collapse-definitions (car canvases)))
|
||||
(loop (- i 1)
|
||||
(cdr canvases))))]
|
||||
[(= canvases-count regions-count)
|
||||
(void)]
|
||||
[(< canvases-count regions-count)
|
||||
(let loop ([i (- regions-count canvases-count)]
|
||||
[canvases canvases])
|
||||
(unless (zero? i)
|
||||
(if ints?
|
||||
(split-interactions (car canvases))
|
||||
(split-definitions (car canvases)))
|
||||
(loop (- i 1)
|
||||
(cdr canvases))))]))
|
||||
(for-each (λ (c r) (set-visible-region txt c r))
|
||||
(send txt get-canvases)
|
||||
regions)))
|
||||
(define (set-visible-region txt canvas region)
|
||||
(let ([admin (send txt get-admin)])
|
||||
(send admin scroll-to
|
||||
|
|
@ -2199,8 +2243,8 @@ module browser threading seems wrong.
|
|||
(set! interactions-shown? is?)
|
||||
(set! definitions-shown? ds?)
|
||||
(update-shown)
|
||||
(set-visible-regions definitions-text vd)
|
||||
(set-visible-regions interactions-text vi))
|
||||
(set-visible-regions definitions-text vd #f)
|
||||
(set-visible-regions interactions-text vi #t))
|
||||
(case (send current-tab get-focus-d/i)
|
||||
[(defs) (send (car definitions-canvases) focus)]
|
||||
[(ints) (send (car interactions-canvases) focus)]))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user