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

.

Browse Source 
original commit: c83d6061c78d2dc7ef6680d3c4b3fe795d5a9fe2
This commit is contained in:
Matthew Flatt 2003-06-12 21:38:30 +00:00
parent 20dbafe0a0
commit dc55ffbd8b
1 changed files with 48 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
collects/mred/mred.ss
View File

@ -1316,11 +1316,12 @@
(sequence (sequence
(apply super-init mred proxy args)))) (apply super-init mred proxy args))))
;; Weak boxed:
(define active-main-frame #f) (define active-main-frame #f)
(wx:application-file-handler (entry-point (wx:application-file-handler (entry-point
(lambda (f) (lambda (f)
(let ([af active-main-frame]) (let ([af (weak-box-value active-main-frame)])
(when af (when af
(queue-window-callback (queue-window-callback
af af
@ -1346,7 +1347,7 @@
[f (entry-point [f (entry-point
(lambda () (lambda ()
(unless running-quit? (unless running-quit?
(let ([af active-main-frame]) (let ([af (weak-box-value active-main-frame)])
(when af (when af
(set! running-quit? #t) (set! running-quit? #t)
(queue-window-callback (queue-window-callback
@ -1474,7 +1475,7 @@
(set! act-date/seconds (current-seconds)) (set! act-date/seconds (current-seconds))
(set! act-date/milliseconds (current-milliseconds)) (set! act-date/milliseconds (current-milliseconds))
(when (wx:main-eventspace? (get-eventspace)) (when (wx:main-eventspace? (get-eventspace))
(set! active-main-frame this))) (set! active-main-frame (make-weak-box this))))
;; Windows needs trampoline: ;; Windows needs trampoline:
(queue-window-callback (queue-window-callback
this this
@ -7388,47 +7389,54 @@
[lock-semaphore (make-semaphore 1)] [lock-semaphore (make-semaphore 1)]
[update-str-to-snip [update-str-to-snip
(lambda () (lambda ()
(cond (if (not snip)
[(not snip) (set! str #f)
(set! str #f)] (let ([snip-start (send text get-snip-position snip)])
[((send text get-snip-position snip) . >= . end) (cond
(set! str #f)] [(snip-start . >= . end)
[(is-a? snip wx:string-snip%) (set! str #f)]
(set! str (send snip get-text 0 (send snip get-count)))] [(is-a? snip wx:string-snip%)
[else (set! str (send snip get-text 0 (min (send snip get-count)
(set! str 'snip)]))] (- end snip-start))))]
[else
(set! str 'snip)]))))]
[next-snip [next-snip
(lambda () (lambda ()
(set! snip (send snip next)) (set! snip (send snip next))
(set! pos 0) (set! pos 0)
(update-str-to-snip))] (update-str-to-snip))]
[read-char (lambda () [read-chars (lambda (to-str)
(cond (cond
[(not str) eof] [(not str) eof]
[(string? str) [(string? str)
(begin0 (let* ([sl (string-length str)]
(string-ref str pos) [n (min (- sl pos) (string-length to-str))])
(set! pos (+ pos 1)) (let loop ([i 0])
(when ((string-length str) . <= . pos) (unless (= i n)
(next-snip)))] (string-set! to-str i (string-ref str (+ i pos)))
[(eq? str 'snip) (loop (add1 i))))
(let ([the-snip snip]) (set! pos (+ pos n))
(lambda (file line col ppos) (when (sl . <= . pos)
(if (is-a? the-snip readable-snip<%>) (next-snip))
(with-handlers ([exn:special-comment? n)]
(lambda (exn) [(eq? str 'snip)
;; implies "done" (let ([the-snip snip])
(next-snip) (lambda (file line col ppos)
(raise exn))]) (if (is-a? the-snip readable-snip<%>)
(let-values ([(val size done?) (with-handlers ([exn:special-comment?
(send the-snip read-one-special pos file line col ppos)]) (lambda (exn)
(if done? ;; implies "done"
(next-snip) (next-snip)
(set! pos (add1 pos))) (raise exn))])
(values val size))) (let-values ([(val size done?)
(begin (send the-snip read-one-special pos file line col ppos)])
(next-snip) (if done?
(values (send the-snip copy) 1)))))]))] (next-snip)
(set! pos (add1 pos)))
(values val size)))
(begin
(next-snip)
(values (send the-snip copy) 1)))))]))]
[close (lambda () (void))] [close (lambda () (void))]
;; We create a slow port for now; in the future, try ;; We create a slow port for now; in the future, try
;; grabbing more characters: ;; grabbing more characters:
@ -7438,13 +7446,7 @@
(if (semaphore-try-wait? lock-semaphore) (if (semaphore-try-wait? lock-semaphore)
(dynamic-wind (dynamic-wind
void void
(lambda () (lambda () (read-chars s))
(let ([c (read-char)])
(if (char? c)
(begin
(string-set! s 0 c)
1)
c)))
(lambda () (semaphore-post lock-semaphore))) (lambda () (semaphore-post lock-semaphore)))
(make-semaphore-peek lock-semaphore)))) (make-semaphore-peek lock-semaphore))))
#f ; no peek #f ; no peek