.

original commit: 5784d04172859715e08d109f0028a756ef7d7214

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)