svn: r16495
This commit is contained in:
Robby Findler 2009-11-01 11:18:55 +00:00
parent 32965d7fa6
commit dbe8db54f4

View File

@ -2537,7 +2537,6 @@ module browser threading seems wrong.
(define/override (update-shown) (define/override (update-shown)
(super update-shown) (super update-shown)
(let ([new-children (let ([new-children
(foldl (foldl
(λ (shown? children sofar) (λ (shown? children sofar)
@ -2549,10 +2548,9 @@ module browser threading seems wrong.
definitions-shown?) definitions-shown?)
(list interactions-canvases (list interactions-canvases
definitions-canvases))] definitions-canvases))]
[old-children (send resizable-panel get-children)]
[p (preferences:get 'drscheme:unit-window-size-percentage)]) [p (preferences:get 'drscheme:unit-window-size-percentage)])
(update-defs/ints-resize-corner) (update-defs/ints-resize-corner)
(send definitions-item set-label (send definitions-item set-label
(if definitions-shown? (if definitions-shown?
(string-constant hide-definitions-menu-item-label) (string-constant hide-definitions-menu-item-label)
@ -2561,36 +2559,48 @@ module browser threading seems wrong.
(if interactions-shown? (if interactions-shown?
(string-constant hide-interactions-menu-item-label) (string-constant hide-interactions-menu-item-label)
(string-constant show-interactions-menu-item-label))) (string-constant show-interactions-menu-item-label)))
(send resizable-panel begin-container-sequence) (send resizable-panel begin-container-sequence)
;; this might change the unit-window-size-percentage, so save/restore it ;; this might change the unit-window-size-percentage, so save/restore it
(send resizable-panel change-children (λ (l) new-children)) (send resizable-panel change-children (λ (l) new-children))
(preferences:set 'drscheme:unit-window-size-percentage p) (preferences:set 'drscheme:unit-window-size-percentage p)
;; restore preferred interactions/definitions sizes ;; restore preferred interactions/definitions sizes
(when (and (= 1 (length definitions-canvases)) (when (and (= 1 (length definitions-canvases))
(= 1 (length interactions-canvases)) (= 1 (length interactions-canvases))
(= 2 (length new-children))) (= 2 (length new-children)))
(with-handlers ([exn:fail? (λ (x) (void))]) (with-handlers ([exn:fail? (λ (x) (void))])
(send resizable-panel set-percentages (send resizable-panel set-percentages
(list p (- 1 p)))))) (list p (- 1 p)))))
(send resizable-panel end-container-sequence) (send resizable-panel end-container-sequence)
(when (ormap (λ (child) (when (ormap (λ (child)
(and (is-a? child editor-canvas%) (and (is-a? child editor-canvas%)
(not (send child has-focus?)))) (not (send child has-focus?))))
(send resizable-panel get-children)) (send resizable-panel get-children))
(let ([new-focus
(let loop ([children (send resizable-panel get-children)]) (let loop ([children (send resizable-panel get-children)])
(cond (cond
[(null? children) (void)] [(null? children) (void)]
[else (let ([child (car children)]) [else (let ([child (car children)])
(if (is-a? child editor-canvas%) (if (is-a? child editor-canvas%)
(send child focus) child
(loop (cdr children))))]))) (loop (cdr children))))]))]
[old-focus
(ormap (λ (x) (and (is-a? x editor-canvas%) (send x has-focus?) x))
old-children)])
;; conservatively, only scroll when the focus stays in the same place.
(when old-focus
(when (eq? old-focus new-focus)
(let ([ed (send old-focus get-editor)])
(when ed
(send ed scroll-to-position
(send ed get-start-position)
#f
(send ed get-end-position))))))
(send new-focus focus)))
(for-each (for-each
(λ (get-item) (λ (get-item)
@ -2602,7 +2612,7 @@ module browser threading seems wrong.
(λ () (file-menu:get-save-as-item)) (λ () (file-menu:get-save-as-item))
;(λ () (file-menu:save-as-text-item)) ; Save As Text... ;(λ () (file-menu:save-as-text-item)) ; Save As Text...
(λ () (file-menu:get-print-item)))) (λ () (file-menu:get-print-item))))
(send file-menu:print-interactions-item enable interactions-shown?)) (send file-menu:print-interactions-item enable interactions-shown?)))
(define/augment (can-close?) (define/augment (can-close?)
(and (andmap (lambda (tab) (and (andmap (lambda (tab)