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

added in force saving to non-text format

Browse Source 
original commit: 5591833b765a08c3c8cf550339980882ecb4c3f3
This commit is contained in:
Robby Findler 1996-08-28 21:45:39 +00:00
parent a67e1a2bfa
commit 9a3dc853d6
1 changed files with 46 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
collects/mred/edit.ss
View File

@ -7,10 +7,14 @@
[mred:scheme-paren : mred:scheme-paren^] [mred:scheme-paren : mred:scheme-paren^]
[mred:keymap : mred:keymap^] [mred:keymap : mred:keymap^]
[mred:icon : mred:icon^] [mred:icon : mred:icon^]
[mred:preferences : mred:preferences^]
[mred:gui-utils : mred:gui-utils^]
[mzlib:function : mzlib:function^]) [mzlib:function : mzlib:function^])
(mred:debug:printf 'invoke "mred:edit@") (mred:debug:printf 'invoke "mred:edit@")
(mred:preferences:set-preference-default 'mred:verify-change-format #f)
(define-struct range (start end b/w-bitmap color)) (define-struct range (start end b/w-bitmap color))
(define-struct rectangle (left top width height b/w-bitmap color)) (define-struct rectangle (left top width height b/w-bitmap color))
@ -121,16 +125,15 @@
[on-save-file [on-save-file
(lambda (name format) (lambda (name format)
(set! auto-save-error? #f) (set! auto-save-error? #f)
(if (super-on-save-file name format) (and (super-on-save-file name format)
(begin (begin
(if (and backup? (when (and backup?
(not (= format wx:const-media-ff-copy))) (not (= format wx:const-media-ff-copy))
(if (file-exists? name) (file-exists? name))
(let ([back-name (mred:path-utils:generate-backup-name name)]) (let ([back-name (mred:path-utils:generate-backup-name name)])
(unless (file-exists? back-name) (unless (file-exists? back-name)
(rename-file name back-name))))) (rename-file name back-name))))
#t) #t)))]
#f))]
[get-canvas [get-canvas
(lambda () (lambda ()
@ -155,8 +158,8 @@
(define make-edit% (define make-edit%
(lambda (super%) (lambda (super%)
(class (make-std-buffer% super%) args (class (make-std-buffer% super%) args
(inherit mode canvases (inherit mode canvases get-file-format
change-style change-style save-file
invalidate-bitmap-cache invalidate-bitmap-cache
begin-edit-sequence end-edit-sequence begin-edit-sequence end-edit-sequence
flash-on get-keymap get-start-position flash-on get-keymap get-start-position
@ -171,6 +174,8 @@
[super-on-paint on-paint] [super-on-paint on-paint]
[super-on-local-event on-local-event] [super-on-local-event on-local-event]
[super-on-local-char on-local-char] [super-on-local-char on-local-char]
[super-on-save-file on-save-file]
[super-after-set-position after-set-position] [super-after-set-position after-set-position]
@ -190,6 +195,35 @@
(private (private
[styles-fixed-edit-modified? #f]) [styles-fixed-edit-modified? #f])
(public (public
[on-save-file
(let ([skip-check #f]
[has-non-text-snips
(lambda ()
(let loop ([s (find-snip 0 wx:const-snip-after)])
(cond
[(null? s) #f]
[(is-a? s wx:text-snip%)
(loop (send s next))]
[else #t])))])
(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))
(= (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)))
(lambda () (set! skip-check #f))))
(super-on-save-file name format)))]
[autowrap-bitmap mred:icon:autowrap-bitmap] [autowrap-bitmap mred:icon:autowrap-bitmap]
[after-load-file [after-load-file
(lambda (sucessful?) (lambda (sucessful?)