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

Can save in empty dir under UNIX

Browse Source 
original commit: 359be8df977c9f3c1ed4780e3a4fff44d0657ae3
This commit is contained in:
Paul Steckler 1998-05-04 19:35:03 +00:00
parent 531b785cf1
commit eb706bd7cd
1 changed files with 28 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/mred/finder.ss
View File

@ -207,7 +207,9 @@
[do-ok [do-ok
(lambda args (lambda args
(if multi-mode? (if multi-mode?
(let ([dir-name (send directory-edit get-text)]) (let ([dir-name (send directory-edit get-text)])
(if (directory-exists? dir-name) (if (directory-exists? dir-name)
(set-directory (mzlib:file:normalize-path dir-name)) (set-directory (mzlib:file:normalize-path dir-name))
@ -219,20 +221,33 @@
(loop (sub1 n) (loop (sub1 n)
(cons (send result-list get-string n) (cons (send result-list get-string n)
result)))))) result))))))
(let ([name (send name-list get-string-selection)]) ; not multi-mode
(let ([name (send name-list get-string-selection)]
[non-empty? (> (send name-list number) 0)])
(cond (cond
[(and save-mode? (not (string? name))) 'nothing-selected]
[(and save-mode? (string=? name "")) [(and save-mode?
non-empty?
(not (string? name))) 'nothing-selected]
[(and save-mode?
non-empty?
(string=? name ""))
(let ([file (send directory-edit get-text)]) (let ([file (send directory-edit get-text)])
(if (directory-exists? file) (if (directory-exists? file)
(set-directory (mzlib:file:normalize-path file)) (set-directory (mzlib:file:normalize-path file))
(mred:gui-utils:message-box (mred:gui-utils:message-box
"You must specify a file name" "You must specify a file name"
"Error")))] "Error")))]
[(and save-mode? [(and save-mode?
non-empty?
file-filter file-filter
(not (mzlib:string:regexp-match-exact? file-filter name))) (not (mzlib:string:regexp-match-exact? file-filter name)))
(mred:gui-utils:message-box file-filter-msg "Error")] (mred:gui-utils:message-box file-filter-msg "Error")]
[else [else
; if dir in edit box, go to that dir ; if dir in edit box, go to that dir
@ -453,14 +468,15 @@
[on-default-action [on-default-action
(lambda () (lambda ()
(let* ([which (send name-list get-string-selection)] (when (> (send name-list number) 0)
[dir (build-path current-dir (let* ([which (send name-list get-string-selection)]
(make-relative which))]) [dir (build-path current-dir
(if (directory-exists? dir) (make-relative which))])
(set-directory (mzlib:file:normalize-path dir)) (if (directory-exists? dir)
(if multi-mode? (set-directory (mzlib:file:normalize-path dir))
(do-add) (if multi-mode?
(do-ok)))))]))] (do-add)
(do-ok))))))]))]
[name-list (make-object name-list% [name-list (make-object name-list%
left-middle-panel do-name-list left-middle-panel do-name-list
@ -636,7 +652,7 @@
[replace? #f] [replace? #f]
[prompt "Select file"] [prompt "Select file"]
[filter #f] [filter #f]
[filter-msg "Invalid form"] [filter-msg "Invalid form"]
[parent-win (dialog-parent-parameter)]) [parent-win (dialog-parent-parameter)])
(let* ([directory (if (and (null? directory) (let* ([directory (if (and (null? directory)
(string? name)) (string? name))