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

Now trap nonexistent paths in save dialog.

Browse Source 
If current-dir doesn't exist on reopen of dialog, the bonafide
current directory is used.

Checkbox for dotfiles now initialized.

original commit: 77ca877d64188427de3387e220723d2128339336
This commit is contained in:
Paul Steckler 1998-02-19 18:24:59 +00:00
parent f0059a9c1b
commit a9380cf720
1 changed files with 83 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
collects/mred/finder.ss
View File

@ -103,59 +103,64 @@
(private (private
[set-directory ; sets directory in listbox [set-directory ; sets directory in listbox
(lambda (dir) ; dir is normalized
(mred:gui-utils:show-busy-cursor
(lambda ()
(set! current-dir dir)
(set! last-directory dir)
(let-values
([(dir-list menu-list)
(let loop ([this-dir dir]
[dir-list ()]
[menu-list ()])
(let-values ([(base-dir in-dir dir?) (split-path this-dir)])
(if (eq? wx:platform 'windows)
(mzlib:string:string-lowercase! in-dir))
(let* ([dir-list (cons this-dir dir-list)]
[menu-list (cons in-dir menu-list)])
(if base-dir
(loop base-dir dir-list menu-list)
; No more
(values dir-list menu-list)))))])
(set! dirs (reverse dir-list))
(send dir-choice clear)
(let loop ([choices (reverse menu-list)])
(unless (null? choices)
(send dir-choice append (car choices))
(loop (cdr choices))))
(send dir-choice set-selection 0)
(send top-panel force-redraw))
(send name-list clear) (lambda (dir) ; dir is normalized
(send name-list set (when (directory-exists? dir)
(mzlib:function:quicksort (mred:gui-utils:show-busy-cursor
(let ([no-periods? (not (mred:preferences:get-preference (lambda ()
'mred:show-periods-in-dirlist))]) (set! current-dir dir)
(let loop ([l (directory-list dir)]) (set! last-directory dir)
(if (null? l) (let-values
null ([(dir-list menu-list)
(let ([s (car l)] (let loop ([this-dir dir]
[rest (loop (cdr l))]) [dir-list ()]
(cond [menu-list ()])
[(and no-periods? (let-values ([(base-dir in-dir dir?)
(<= 1 (string-length s)) (split-path this-dir)])
(char=? (string-ref s 0) #\.)) (if (eq? wx:platform 'windows)
rest] (mzlib:string:string-lowercase! in-dir))
[(directory-exists? (build-path dir s)) (let* ([dir-list (cons this-dir dir-list)]
(cons (string-append s (get-slash)) [menu-list (cons in-dir menu-list)])
rest)] (if base-dir
[(or (not file-filter) (loop base-dir dir-list menu-list)
(mzlib:string:regexp-match-exact? file-filter s)) ; No more
(cons s rest)] (values dir-list menu-list)))))])
[else rest]))))) (set! dirs (reverse dir-list))
(if (eq? wx:platform 'unix) string<? string-ci<?))) (send dir-choice clear)
(send name-list set-selection-and-edit 0) (let loop ([choices (reverse menu-list)])
(set! last-selected -1))))] (unless (null? choices)
(send dir-choice append (car choices))
(loop (cdr choices))))
(send dir-choice set-selection 0)
(send top-panel force-redraw))
(send name-list clear)
(send name-list set
(mzlib:function:quicksort
(let ([no-periods?
(not (mred:preferences:get-preference
'mred:show-periods-in-dirlist))])
(let loop ([l (directory-list dir)])
(if (null? l)
null
(let ([s (car l)]
[rest (loop (cdr l))])
(cond
[(and no-periods?
(<= 1 (string-length s))
(char=? (string-ref s 0) #\.))
rest]
[(directory-exists? (build-path dir s))
(cons (string-append s (get-slash))
rest)]
[(or (not file-filter)
(mzlib:string:regexp-match-exact?
file-filter s))
(cons s rest)]
[else rest])))))
(if (eq? wx:platform 'unix) string<? string-ci<?)))
(send name-list set-selection-and-edit 0)
(set! last-selected -1)))))]
[set-edit [set-edit
(lambda () (lambda ()
@ -175,7 +180,9 @@
[show [show
(lambda (b) (lambda (b)
(when b (when b
(set-directory current-dir)) (if (directory-exists? current-dir)
(set-directory current-dir)
(set-directory (current-directory))))
(super-show b))] (super-show b))]
[do-period-in/exclusion [do-period-in/exclusion
@ -273,10 +280,21 @@
"Warning" "Warning"
wx:const-yes-no) wx:const-yes-no)
wx:const-yes)) wx:const-yes))
(begin (let ([normal-path
(set-box! (with-handlers
result-box (mzlib:file:normalize-path file)) ([(lambda (_) #t)
(show #f)))))))]))))] (lambda (_)
(wx:message-box
(string-append
"The file "
file
" contains nonexistent directory or cycle.")
"Warning")
#f)])
(mzlib:file:normalize-path file))])
(when normal-path
(set-box! result-box normal-path)
(show #f))))))))]))))]
[add-one [add-one
(lambda (name) (lambda (name)
@ -517,10 +535,14 @@
(sequence (sequence
(when (eq? wx:platform 'unix) (when (eq? wx:platform 'unix)
(make-object mred:container:check-box% dot-panel (let ([dot-cb
do-period-in/exclusion (make-object
"Show files and directories that begin with a dot") mred:container:check-box% dot-panel
(send dot-panel stretchable-in-y #f)) do-period-in/exclusion
"Show files and directories that begin with a dot")])
(send dot-panel stretchable-in-y #f)
(send dot-cb set-value
(mred:preferences:get-preference 'mred:show-periods-in-dirlist))))
(send directory-panel stretchable-in-y #f) (send directory-panel stretchable-in-y #f)