suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed tabs io bug

Browse Source 
svn: r95
This commit is contained in:
Robby Findler 2005-06-14 03:25:21 +00:00
parent 299266d30a
commit 4e85d7f2ea
3 changed files with 64 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/drscheme/private/rep.ss
View File

@ -52,7 +52,12 @@ TODO
[-text<%> text<%>]) [-text<%> text<%>])
(define -text<%> (define -text<%>
(interface () (interface ((class->interface text%)
text:ports<%>
editor:file<%>
scheme:text<%>
color:text<%>
text:ports<%>)
reset-highlighting reset-highlighting
highlight-errors highlight-errors
highlight-errors/exn highlight-errors/exn
@ -64,6 +69,8 @@ TODO
get-user-teachpack-cache get-user-teachpack-cache
set-user-teachpack-cache set-user-teachpack-cache
get-definitions-text
kill-evaluation kill-evaluation
display-results display-results
@ -516,6 +523,7 @@ TODO
(define definitions-text 'not-yet-set-definitions-text) (define definitions-text 'not-yet-set-definitions-text)
(define/public (set-definitions-text dt) (set! definitions-text dt)) (define/public (set-definitions-text dt) (set! definitions-text dt))
(define/public (get-definitions-text) definitions-text)
(unless (is-a? context context<%>) (unless (is-a? context context<%>)
(error 'drscheme:rep:text% (error 'drscheme:rep:text%
@ -631,12 +639,6 @@ TODO
(set! error-ranges locs) (set! error-ranges locs)
(let ([defs
(let ([f (get-top-level-window)])
(and f
(is-a? f drscheme:unit:frame<%>)
(send f get-definitions-text)))])
(for-each (λ (loc) (send (srcloc-source loc) begin-edit-sequence)) locs) (for-each (λ (loc) (send (srcloc-source loc) begin-edit-sequence)) locs)
(when color? (when color?
@ -649,20 +651,20 @@ TODO
(send file highlight-range start finish error-color #f #f 'high))) (send file highlight-range start finish error-color #f #f 'high)))
locs)]) locs)])
(when (and defs error-arrows) (when (and definitions-text error-arrows)
(let ([filtered-arrows (let ([filtered-arrows
(remove-duplicate-error-arrows (remove-duplicate-error-arrows
(filter (filter
(λ (arr) (λ (arr)
(embedded-in? (car arr) defs)) (embedded-in? (car arr) definitions-text))
error-arrows))]) error-arrows))])
(send defs set-error-arrows filtered-arrows))) (send definitions-text set-error-arrows filtered-arrows)))
(set! internal-reset-callback (set! internal-reset-callback
(λ () (λ ()
(set! error-ranges #f) (set! error-ranges #f)
(when defs (when definitions-text
(send defs set-error-arrows #f)) (send definitions-text set-error-arrows #f))
(set! internal-reset-callback void) (set! internal-reset-callback void)
(for-each (λ (x) (x)) resets))))) (for-each (λ (x) (x)) resets)))))
@ -673,14 +675,14 @@ TODO
(when first-loc (when first-loc
(let ([first-finish (+ first-start first-span)]) (let ([first-finish (+ first-start first-span)])
(when (eq? first-file defs) ;; only move set the cursor in the defs window (when (eq? first-file definitions-text) ;; only move set the cursor in the defs window
(send first-file set-position first-start first-start)) (send first-file set-position first-start first-start))
(send first-file scroll-to-position first-start #f first-finish))) (send first-file scroll-to-position first-start #f first-finish)))
(for-each (λ (loc) (send (srcloc-source loc) end-edit-sequence)) locs) (for-each (λ (loc) (send (srcloc-source loc) end-edit-sequence)) locs)
(when first-loc (when first-loc
(send first-file set-caret-owner (get-focus-snip) 'global)))))) (send first-file set-caret-owner (get-focus-snip) 'global)))))
(define/public (reset-highlighting) (define/public (reset-highlighting)
(reset-error-ranges)) (reset-error-ranges))
@ -713,7 +715,13 @@ TODO
;; specialization ;; specialization
;; ;;
(define/override (after-io-insertion) (send context ensure-rep-shown this)) (define/override (after-io-insertion)
(let ([canvas (get-active-canvas)])
(when canvas
(let ([frame (send canvas get-top-level-window)])
(let ([tab (send definitions-text get-tab)])
(when (eq? (send frame get-current-tab) tab)
(send context ensure-rep-shown this)))))))
(define/augment (after-insert start len) (define/augment (after-insert start len)
(inner (void) after-insert start len) (inner (void) after-insert start len)
@ -1050,12 +1058,7 @@ TODO
(define/private init-evaluation-thread ; =Kernel= (define/private init-evaluation-thread ; =Kernel=
(λ () (λ ()
(let ([default (preferences:get drscheme:language-configuration:settings-preferences-symbol)] (set! user-language-settings (send definitions-text get-next-settings))
[frame (get-top-level-window)])
(if frame
(let ([defs (send frame get-definitions-text)])
(set! user-language-settings (send defs get-next-settings)))
(set! user-language-settings default)))
(set! user-custodian (make-custodian)) (set! user-custodian (make-custodian))
; (custodian-limit-memory user-custodian 10000000 user-custodian) ; (custodian-limit-memory user-custodian 10000000 user-custodian)

4
collects/drscheme/private/unit.ss
View File

@ -1221,7 +1221,7 @@ module browser threading seems wrong.
(when execute-menu-item (when execute-menu-item
(send execute-menu-item enable #f)) (send execute-menu-item enable #f))
(send execute-button enable #f) (send execute-button enable #f)
(send file-menu:create-new-tab-item enable #f) ;(send file-menu:create-new-tab-item enable #f)
(inner (void) disable-evaluation)) (inner (void) disable-evaluation))
(define/public-final (enable-evaluation-in-tab tab) (define/public-final (enable-evaluation-in-tab tab)
@ -1232,7 +1232,7 @@ module browser threading seems wrong.
(when execute-menu-item (when execute-menu-item
(send execute-menu-item enable #t)) (send execute-menu-item enable #t))
(send execute-button enable #t) (send execute-button enable #t)
(send file-menu:create-new-tab-item enable #t) ;(send file-menu:create-new-tab-item enable #t)
(inner (void) enable-evaluation)) (inner (void) enable-evaluation))
(inherit set-label) (inherit set-label)

6
collects/test-suite/tool.ss
View File

@ -135,7 +135,7 @@
;; Require the test-case macro into every new namespace when a program is run. ;; Require the test-case macro into every new namespace when a program is run.
(define require-macro-mixin (define require-macro-mixin
(mixin ((class->interface drscheme:rep:text%)) () (mixin ((class->interface drscheme:rep:text%)) ()
(inherit get-user-namespace get-canvas) (inherit get-user-namespace get-definitions-text)
#;((is-a?/c area<%>) . -> . (is-a?/c frame%)) #;((is-a?/c area<%>) . -> . (is-a?/c frame%))
;; The frame containing the given area ;; The frame containing the given area
@ -150,11 +150,11 @@
;; Overriden to reset test case boxes ;; Overriden to reset test case boxes
(define/override (reset-highlighting) (define/override (reset-highlighting)
(super reset-highlighting) (super reset-highlighting)
(let ([text (send (find-frame (get-canvas)) get-definitions-text)]) (let ([defs-text (get-definitions-text)])
;(if (send text delay-reset) ;(if (send text delay-reset)
; (send text delay-reset false) ; (send text delay-reset false)
; (send text reset-test-case-boxes)))) ; (send text reset-test-case-boxes))))
(send text reset-test-case-boxes))) (send defs-text reset-test-case-boxes)))
#;(-> void) #;(-> void)
;; Called when the program is execute to reset the rep:text ;; Called when the program is execute to reset the rep:text