diff --git a/collects/mred/edit.ss b/collects/mred/edit.ss index 8150101d..d8e51bff 100644 --- a/collects/mred/edit.ss +++ b/collects/mred/edit.ss @@ -13,14 +13,38 @@ (define (new-pasteboard-frame file) (new-frame pasteboard% file)) (define (new-frame editor% file) - (define f (make-object frame% "MrEdIt" #f 620 450)) + (define f (make-object (class frame% + (inherit modified) + (rename [super-can-close? can-close?]) + (define/override (can-close?) + (and (super-can-close?) + (or (not (modified)) + (let ([r (message-box/custom + "Editor Modified" + "The editor has been modified. Really close it?" + "Close" + "Cancel" + "Save and Close" + this + '(default=2 disallow-close))]) + (or (and (= r 3) + (send e save-file)) + (= r 1)))))) + (super-new)) + "MrEdIt" #f 620 450)) (define c (make-object editor-canvas% f)) - (define e (make-object editor%)) + (define e (make-object (class editor% + (rename [super-set-modified set-modified]) + (define/override (set-modified mod?) + (send f modified mod?) + (super-set-modified mod?)) + (super-new)))) (define mb (make-object menu-bar% f)) (define file-menu (make-object menu% "File" mb)) (define edit-menu (make-object menu% "Edit" mb)) (define font-menu (make-object menu% "Font" mb)) + (define para-menu (make-object menu% "Paragraph" mb)) (make-object menu-item% "New Text Frame" file-menu (lambda (item event) @@ -50,7 +74,9 @@ (make-object separator-menu-item% file-menu) (make-object menu-item% "Close" file-menu (lambda (item event) - (send f show #f)) + (when (send f can-close?) + (send f on-close) + (send f show #f))) #\Q) (append-editor-operation-menu-items edit-menu #f) @@ -75,6 +101,49 @@ (mk "Smoothed" 'smoothed) (mk "Not Smoothed" 'unsmoothed))) + (make-object menu-item% "Set Margins..." para-menu + (lambda (i ev) + (let* ([d (make-object dialog% "Margins" f)] + [mk-txt (lambda (label) (make-object + text-field% + label + d + void + "0.0"))] + [first-left (mk-txt "First Left")] + [rest-left (mk-txt "Rest Left")] + [right (mk-txt "Right")] + [button-panel (new horizontal-pane% + [parent d] + [alignment '(right center)])] + [ok (make-object button% "Ok" button-panel + (lambda (b ev) + (let* ([get (lambda (field) + (let ([n (string->number (send field get-value))]) + (and n (real? n) (not (negative? n)) n)))] + [first-left (get first-left)] + [rest-left (get rest-left)] + [right (get right)]) + (if (and first-left + rest-left + right) + (let ([start (send e position-paragraph + (send e get-start-position))] + [end (send e position-paragraph + (send e get-end-position))]) + (let loop ([i start]) + (unless (i . > . end) + (send e set-paragraph-margins + i first-left rest-left right) + (loop (add1 i))) + (send d show #f))) + (bell)))) + '(border))] + [cancel (make-object button% "Cancel" button-panel + (lambda (b e) + (send d show #f)))]) + (send d show #t)))) + ((current-text-keymap-initializer) (send e get-keymap)) (send c set-editor e)