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 (lambda (dir) ; dir is normalized
(mred:gui-utils:show-busy-cursor (when (directory-exists? dir)
(lambda () (mred:gui-utils:show-busy-cursor
(set! current-dir dir) (lambda ()
(set! last-directory dir) (set! current-dir dir)
(let-values (set! last-directory dir)
([(dir-list menu-list) (let-values
(let loop ([this-dir dir] ([(dir-list menu-list)
[dir-list ()] (let loop ([this-dir dir]
[menu-list ()]) [dir-list ()]
(let-values ([(base-dir in-dir dir?) (split-path this-dir)]) [menu-list ()])
(if (eq? wx:platform 'windows) (let-values ([(base-dir in-dir dir?)
(mzlib:string:string-lowercase! in-dir)) (split-path this-dir)])
(let* ([dir-list (cons this-dir dir-list)] (if (eq? wx:platform 'windows)
[menu-list (cons in-dir menu-list)]) (mzlib:string:string-lowercase! in-dir))
(if base-dir (let* ([dir-list (cons this-dir dir-list)]
(loop base-dir dir-list menu-list) [menu-list (cons in-dir menu-list)])
; No more (if base-dir
(values dir-list menu-list)))))]) (loop base-dir dir-list menu-list)
(set! dirs (reverse dir-list)) ; No more
(send dir-choice clear) (values dir-list menu-list)))))])
(let loop ([choices (reverse menu-list)]) (set! dirs (reverse dir-list))
(unless (null? choices) (send dir-choice clear)
(send dir-choice append (car choices)) (let loop ([choices (reverse menu-list)])
(loop (cdr choices)))) (unless (null? choices)
(send dir-choice set-selection 0) (send dir-choice append (car choices))
(send top-panel force-redraw)) (loop (cdr choices))))
(send dir-choice set-selection 0)
(send name-list clear) (send top-panel force-redraw))
(send name-list set
(mzlib:function:quicksort (send name-list clear)
(let ([no-periods? (not (mred:preferences:get-preference (send name-list set
'mred:show-periods-in-dirlist))]) (mzlib:function:quicksort
(let loop ([l (directory-list dir)]) (let ([no-periods?
(if (null? l) (not (mred:preferences:get-preference
null 'mred:show-periods-in-dirlist))])
(let ([s (car l)] (let loop ([l (directory-list dir)])
[rest (loop (cdr l))]) (if (null? l)
(cond null
[(and no-periods? (let ([s (car l)]
(<= 1 (string-length s)) [rest (loop (cdr l))])
(char=? (string-ref s 0) #\.)) (cond
rest] [(and no-periods?
[(directory-exists? (build-path dir s)) (<= 1 (string-length s))
(cons (string-append s (get-slash)) (char=? (string-ref s 0) #\.))
rest)] rest]
[(or (not file-filter) [(directory-exists? (build-path dir s))
(mzlib:string:regexp-match-exact? file-filter s)) (cons (string-append s (get-slash))
(cons s rest)] rest)]
[else rest]))))) [(or (not file-filter)
(if (eq? wx:platform 'unix) string<? string-ci<?))) (mzlib:string:regexp-match-exact?
(send name-list set-selection-and-edit 0) file-filter s))
(set! last-selected -1))))] (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)