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

...

Browse Source 
original commit: b6bb24d3892c59e396b7845a2b09667a20c2f8a3
This commit is contained in:
Robby Findler 2000-08-07 04:03:40 +00:00
parent 92f6a21022
commit 060863e0fc
3 changed files with 20 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/framework/finder.ss
View File

@ -173,7 +173,7 @@
(if (eq? (send evt get-event-type) 'list-box-dclick)
(let ([dir (send directory-field get-value)])
(if (directory-exists? dir)
(set-directory (mzlib:file:normalize-path dir))
(set-directory (normal-case-path (mzlib:file:normalize-path dir)))
(if multi-mode?
(do-add)
(do-ok))))
@ -213,7 +213,7 @@
(string=? name ""))
(let ([file (send directory-field get-value)])
(if (directory-exists? file)
(set-directory (mzlib:file:normalize-path file))
(set-directory (normal-case-path (mzlib:file:normalize-path file)))
(message-box
"Error"
"You must specify a file name")))]
@ -231,7 +231,7 @@
(let ([dir-name (send directory-field get-value)])
(if (directory-exists? dir-name)
(set-directory (mzlib:file:normalize-path dir-name))
(set-directory (normal-case-path (mzlib:file:normalize-path dir-name)))
; otherwise, try to return absolute path
@ -278,7 +278,8 @@
file
" contains nonexistent directory or cycle."))
#f)])
(mzlib:file:normalize-path file))])
(normal-case-path
(mzlib:file:normalize-path file)))])
(when normal-path
(set-box! result-box normal-path)
(show #f))))))))]))))]
@ -287,7 +288,8 @@
(lambda (name)
(unless (or (directory-exists? name)
(send result-list find-string name))
(send result-list append (mzlib:file:normalize-path name))))]
(send result-list append
(normal-case-path (mzlib:file:normalize-path name)))))]
[do-add
(lambda args
@ -458,7 +460,8 @@
[dir (build-path current-dir
(make-relative which))])
(if (directory-exists? dir)
(set-directory (mzlib:file:normalize-path dir))
(set-directory (normal-case-path
(mzlib:file:normalize-path dir)))
(if multi-mode?
(do-add)
(do-ok))))))]))]
@ -490,7 +493,8 @@
(when (eq? (send evt get-event-type) 'text-field-enter)
(let ([dir (send directory-field get-value)])
(if (directory-exists? dir)
(set-directory (mzlib:file:normalize-path dir))
(set-directory (normal-case-path
(mzlib:file:normalize-path dir)))
(if multi-mode?
(do-add)
(do-ok)))))))))]
@ -577,7 +581,8 @@
(cond
[(and start-dir
(directory-exists? start-dir))
(set-directory (mzlib:file:normalize-path start-dir))]
(set-directory (normal-case-path
(mzlib:file:normalize-path start-dir)))]
[last-directory (set-directory last-directory)]
[else (set-directory (current-directory))])
@ -707,7 +712,7 @@
f
filter-msg))))
#f
(let* ([f (mzlib:file:normalize-path f)]
(let* ([f (normal-case-path (mzlib:file:normalize-path f))]
[dir (mzlib:file:path-only f)]
[name (mzlib:file:file-name-from-path f)])
(cond

8
collects/framework/frame.ss
View File

@ -656,7 +656,7 @@
(lambda (item control)
(let* ([b (box #f)]
[edit (get-editor)]
[filename (send edit get-filename b)])
[filename (get-filename b)])
(if (or (not filename) (unbox b))
(bell)
(let ([start
@ -1399,7 +1399,7 @@
(define file<%> (interface (-editor<%>)))
(define file-mixin
(mixin (-editor<%>) (file<%>) args
(inherit get-editor)
(inherit get-editor get-filename get-label)
(rename [super-can-close? can-close?])
(override
[can-close?
@ -1408,10 +1408,10 @@
[user-allowed-or-not-modified
(or (not (send edit is-modified?))
(case (gui-utils:unsaved-warning
(let ([fn (send edit get-filename)])
(let ([fn (get-filename)])
(if (string? fn)
fn
"Untitled"))
(get-label)))
"Close"
#t
this)

5
collects/framework/group.ss
View File

@ -202,9 +202,8 @@
(mzlib:file:normalize-path name)))]
[test-frame
(lambda (frame)
(and (is-a? frame frame:editor<%>)
(let* ([editor (send frame get-editor)]
[filename (send editor get-filename)])
(and (is-a? frame frame:basic<%>)
(let* ([filename (send frame get-filename)])
(and (string? filename)
(string=? normalized
(with-handlers ([(lambda (x) #t)