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

* Proper fix for the path-list bug (undo bogus semaphore)

Browse Source 
* Don't reset the paths if the glob pattern is not changed

svn: r3339
This commit is contained in:
Eli Barzilay 2006-06-12 14:13:58 +00:00
parent 9221c7703d
commit a009ba322d
1 changed files with 25 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/mred/private/path-dialog.ss
View File

@ -230,6 +230,7 @@
(do-enter))) (do-enter)))
(loop (cdar m))))) (loop (cdar m)))))
(send dir-text lock)) (send dir-text lock))
(clear-path-list-state)
(if (directory-exists? dir) (if (directory-exists? dir)
(begin (set! paths (sorted-dirlist dir)) (begin (set! paths (sorted-dirlist dir))
(send path-list set paths) (send path-list set paths)
@ -494,20 +495,14 @@
;; Use the path-list for completion options ;; Use the path-list for completion options
(define saved-path-list-state #f) (define saved-path-list-state #f)
(define saved-path-list-sema (make-semaphore 1)) (define (clear-path-list-state)
(set! saved-path-list-state #f))
(define (save-path-list-state) (define (save-path-list-state)
(dynamic-wind
(lambda () (semaphore-wait saved-path-list-sema))
(lambda ()
(unless saved-path-list-state (unless saved-path-list-state
(set! saved-path-list-state (set! saved-path-list-state
(list (send path-list get-first-visible-item) (list (send path-list get-first-visible-item)
(send path-list get-selections))))) (send path-list get-selections)))))
(lambda () (semaphore-post saved-path-list-sema))))
(define (restore-path-list-state) (define (restore-path-list-state)
(dynamic-wind
(lambda () (semaphore-wait saved-path-list-sema))
(lambda ()
(when saved-path-list-state (when saved-path-list-state
(send path-list set paths) (send path-list set paths)
(for-each (lambda (i) (send path-list select i)) (for-each (lambda (i) (send path-list select i))
@ -515,22 +510,21 @@
(send path-list (send path-list
set-first-visible-item (car saved-path-list-state)) set-first-visible-item (car saved-path-list-state))
(set! saved-path-list-state #f))) (set! saved-path-list-state #f)))
(lambda () (semaphore-post saved-path-list-sema))))
;; Timer for delaying completion ;; Timer for delaying completion
(define completion-timer (define completion-timer
(new (class wx:timer% (super-new) (new (class wx:timer% (super-new)
(define delay 400)
(define running? #f) (define running? #f)
(define/override (start) (define/override (start)
(set! running? #t) (set! running? #t)
(super start 400 #t)) (super start delay #t))
(define/override (stop) (define/override (stop)
(set! running? #f) (set! running? #f)
(super stop)) (super stop))
(define/public (reset) (define/public (reset)
(when running? (send this stop)) (when running? (send this stop))
(set! running? #t) (start))
(super start 400 #t))
(define/public (wait) ; delay if running (define/public (wait) ; delay if running
(when running? (reset))) (when running? (reset)))
(define/public (fire) (define/public (fire)
@ -592,6 +586,7 @@
(define path-list (define path-list
(new (class list-box% (new (class list-box%
;; make sure that if the focus is here, the text is synced ;; make sure that if the focus is here, the text is synced
;; (questionable behavior)
(define/override (on-focus on?) (when on? (new-selected-paths))) (define/override (on-focus on?) (when on? (new-selected-paths)))
(super-new)) (super-new))
[parent this] [label #f] [choices '()] [parent this] [label #f] [choices '()]
@ -613,12 +608,15 @@
(define text* (send text get-editor)) (define text* (send text get-editor))
(send text* select-all) (send text* select-all)
(define globs (and filters (glob->2regexps (cadar filters)))) (define last-set-glob (and filters (cadar filters)))
(define globs (and filters (glob->2regexps last-set-glob)))
(define (set-filter new . keep-focus?) (define (set-filter new . keep-focus?)
(when new (send file-filter set-value new))
(let ([filt (or new (send file-filter get-value))]) (let ([filt (or new (send file-filter get-value))])
(when (pair? new) (send file-filter set-value filt)) (unless (equal? last-set-glob filt)
(set! last-set-glob filt)
(set! globs (and (not (equal? "" filt)) (glob->2regexps filt))) (set! globs (and (not (equal? "" filt)) (glob->2regexps filt)))
(set-dir dir) (set-dir dir))
(unless (and (pair? keep-focus?) (car keep-focus?)) (unless (and (pair? keep-focus?) (car keep-focus?))
(send text focus)))) (send text focus))))
(define file-filter (define file-filter