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

fixed bugs

Browse Source 
original commit: b9d0cc2f64dfd3f0d9c0f4ac2db68ea1354b1bab
This commit is contained in:
Robby Findler 1996-09-07 23:53:13 +00:00
parent 4911302840
commit 64c13fc49d
2 changed files with 47 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/mred/edit.ss
View File

@ -159,7 +159,8 @@
(define make-edit%
(lambda (super%)
(class (make-std-buffer% super%) args
(inherit mode canvases get-file-format
(inherit mode canvases get-file-format
set-filename
change-style save-file
invalidate-bitmap-cache
begin-edit-sequence end-edit-sequence
@ -209,17 +210,24 @@
(lambda (name format)
(unless (or skip-check
(= format wx:const-media-ff-std)
(and (or (= format wx:const-media-ff-same)
(= format wx:const-media-ff-guess))
(= format wx:const-media-ff-guess)
(and (= format wx:const-media-ff-same)
(= (get-file-format)
wx:const-media-ff-std)))
(dynamic-wind
(lambda () (set! skip-check #t))
(lambda ()
(when (and (has-non-text-snips)
(or (not (mred:preferences:get-preference 'mred:verify-change-format))
(mred:gui-utils:get-choice "Save this file as plain text?" "No" "Yes")))
(save-file name wx:const-media-ff-std)))
(cond
[(= format wx:const-media-ff-copy)
(let ([format (get-file-format)])
(set-file-format wx:const-media-ff-std)
(save-file name format)
(set-file-format format))]
[(and (has-non-text-snips)
(or (not (mred:preferences:get-preference 'mred:verify-change-format))
(mred:gui-utils:get-choice "Save this file as plain text?" "No" "Yes")))
(save-file name wx:const-media-ff-std)]
[else (void)]))
(lambda () (set! skip-check #f))))
(super-on-save-file name format)))]

62
collects/mred/finder.ss
View File

@ -128,22 +128,6 @@
"Error")
(do-goto button event orig-dir)))))))]
[on-default-action
(lambda (which)
(if (eq? which name-list)
(let* ([which (send name-list get-string-selection)]
[dir (build-path current-dir
(make-relative which))])
(if (directory-exists? dir)
(set-directory (mzlib:file:normalize-path dir))
(if save-mode?
(send name-field set-value which)
(if multi-mode?
(do-add)
(do-ok)))))
(if (eq? which name-field)
(do-ok))))]
[do-name
(lambda (text event)
(if (eq? (send event get-event-type)
@ -265,14 +249,27 @@
[middle-panel (make-object mred:container:horizontal-panel% main-panel)]
[left-middle-panel (make-object mred:container:vertical-panel% middle-panel)]
[right-middle-panel (when multi-mode? (make-object mred:container:vertical-panel% middle-panel))]
[name-list (begin
(new-line)
(make-object mred:container:list-box%
left-middle-panel do-name-list
() wx:const-single
-1 -1
(if multi-mode? (* 1/2 WIDTH) WIDTH) 300
() wx:const-needed-sb))]
[name-list%
(class-asi mred:container:list-box%
(public
[on-default-action
(lambda ()
(let* ([which (send name-list get-string-selection)]
[dir (build-path current-dir
(make-relative which))])
(if (directory-exists? dir)
(set-directory (mzlib:file:normalize-path dir))
(if save-mode?
(send name-field set-value which)
(if multi-mode?
(do-add)
(do-ok))))))]))]
[name-list (make-object name-list%
left-middle-panel do-name-list
() wx:const-single
-1 -1
(if multi-mode? (* 1/2 WIDTH) WIDTH) 300
() wx:const-needed-sb)]
[save-panel (when save-mode? (make-object mred:container:horizontal-panel% main-panel))]
[bottom-panel (make-object mred:container:horizontal-panel% main-panel)]
[result-list
@ -303,12 +300,17 @@
(private
[name-field
(when save-mode?
(let ([v (make-object mred:container:text%
save-panel do-name
"Name: " ""
-1 -1
400 -1
wx:const-process-enter)])
(let* ([% (class-asi mred:container:text%
(public
[on-default-action
(lambda ()
(do-ok))]))]
[v (make-object %
save-panel do-name
"Name: " ""
-1 -1
400 -1
wx:const-process-enter)])
(send v stretchable-in-x #t)
(if (string? start-name)
(send v set-value start-name))