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

20
collects/mred/edit.ss
View File

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

62
collects/mred/finder.ss
View File

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