added connections

original commit: d7e01eee7b44b76345cc32b58356743ca0e853f2

collects/mred/edit.ss

@@ -1,6 +1,8 @@
+
 (define mred:edit@
   (unit/sig mred:edit^
     (import [mred:debug : mred:debug^]
+	    [mred:connections : mred:connections^]
 	    [mred:finder : mred:finder^]
 	    [mred:path-utils : mred:path-utils^]
 	    [mred:mode : mred:mode^]
@@ -18,11 +20,13 @@
     (define-struct range (start end b/w-bitmap color))
     (define-struct rectangle (left top width height b/w-bitmap color))
 
+    (mred:preferences:set-preference-default 'mred:auto-set-wrap? #f)
+
     (define make-std-buffer%
       (lambda (buffer%)
 	(class buffer% args
 	  (sequence (mred:debug:printf 'creation "creating a buffer"))
-	  (inherit modified? get-filename save-file
+	  (inherit modified? get-filename save-file canvases
 		   get-max-width get-admin)
 	  (rename
 	    [super-set-filename set-filename]
@@ -52,18 +56,13 @@
 					  v
 					  '())))]
 	    
-	    [auto-set-wrap? #f]
+	    [auto-set-wrap? (mred:preferences:get-preference 'mred:auto-set-wrap?)]
 	    [set-auto-set-wrap
 	     (lambda (v)
 	       (mred:debug:printf 'rewrap "set-auto-set-wrap: ~a~n" v)
 	       (set! auto-set-wrap? v)
 	       (rewrap))]
 	    
-	    [active-canvas #f]
-	    [set-active-canvas
-	     (lambda (c)
-	       (set! active-canvas c))]
-	    
 	    [rewrap
 	     (let ([do-wrap
 		    (lambda (new-width)
@@ -93,14 +92,6 @@
 			 0
 			 canvases)))
 		     (do-wrap -1))))]
-	    [canvases '()]
-	    [add-canvas
-	     (lambda (canvas)
-	       (set! canvases (cons canvas canvases)))]
-	    [remove-canvas
-	     (lambda (canvas)
-	       (set! canvases (mzlib:function:remove canvas canvases)))]
-	    
 	    [mode #f]
 	    [set-mode
 	     (lambda (m)
@@ -170,25 +161,7 @@
 			(let ([back-name (mred:path-utils:generate-backup-name name)])
 			  (unless (file-exists? back-name)
 			    (rename-file name back-name))))
-		      #t)))]
-	    
-	    [get-canvas
-	     (lambda ()
-	       (cond
-		 [(and active-canvas
-		       (member active-canvas canvases))
-		  active-canvas]
-		 [(null? canvases) #f]
-		 [else (car canvases)]))]
-	    [get-frame
-	     (lambda ()
-	       (let ([c (get-canvas)])
-		 (if c
-		     (let ([f (ivar c frame)])
-		       (if (null? f)
-			   #f
-			   f))
-		     #f)))])
+		      #t)))])
 	  (sequence
 	    (apply super-init args)))))
 
@@ -234,7 +207,7 @@
 		  [super-after-set-size-constraint after-set-size-constraint])
 	  (private
 	    [styles-fixed-edit-modified? #f]
-	    [restore-file-format void]) ; the function void, not #<void>
+	    [restore-file-format void])
 	  (public
 	    [on-save-file
 	     (let ([has-non-text-snips 
@@ -515,8 +488,7 @@
 	      (mred:keymap:set-keymap-implied-shifts keymap)
 	      (send keymap chain-to-keymap mred:keymap:global-keymap #f))))))
 
-    (define edit% (make-edit% wx:media-edit%))
+    (define edit% (make-edit% mred:connections:connections-media-edit%))
 
     (define make-pasteboard% make-std-buffer%)
-
-    (define pasteboard% (make-pasteboard% wx:media-pasteboard%))))
+    (define pasteboard% (make-pasteboard% mred:connections:connections-media-pasteboard%))))

collects/mred/keys.ss

@@ -647,7 +647,11 @@
 			(if (mred:preferences:get-preference 'mred:delete-forward?)
 			    "delete-next-character"
 			    "delete-previous-character")
-			edit event #t)))])
+			edit event #t)))]
+	     [toggle-overwrite
+	      (lambda (edit event)
+		(send edit set-overwrite-mode
+		      (not (send edit get-overwrite-mode))))])
 	(lambda (kmap)
 	  ; Redirect keymapping error messages to stderr
 	  (send kmap set-error-callback keyerr)
@@ -668,6 +672,8 @@
 	    (wx:add-media-pasteboard-functions kmap)
 
 	    ; Map names to keyboard functions
+	    (add "toggle-overwrite" toggle-overwrite)
+
 	    (add "rcs" rcs)
 
 	    (add "exit" (lambda (edit event)
@@ -873,6 +879,9 @@
 
 	    (map "c:space" "toggle-anchor")
 
+	    (map "insert" "toggle-overwrite")
+	    (map-meta "o" "toggle-overwrite")
+
 	    (map-meta "g" "goto-line")
 	    (map-meta "p" "goto-position")
 

collects/mred/panel.ss

@@ -12,7 +12,7 @@
 	(class-asi super%
 	  (rename [super-change-children change-children])
 	  (inherit children get-parent)
-	  (public [get-canvas% (lambda () mred:canvas:editor-canvas%)])
+	  (public [get-canvas% (lambda () mred:canvas:frame-title-canvas%)])
 	  (private
 	    [edit-mapping (make-hash-table)]
 	    [bind
@@ -30,7 +30,6 @@
 			      p))])
 		     (hash-table-get edit-mapping child add-new))
 		   child))])
-						     
 	  (public
 
 	    ; this contains the edits and panels that are children of
@@ -38,7 +37,6 @@
 	    ; necessarily immediate children, since they may be split.
 	    [actual-children null]
 	   
-
 	    [collapse
 	     (lambda (canvas)
 	       (letrec* ([media (send canvas get-media)]
@@ -60,30 +58,34 @@
 
 	    [split
 	     (opt-lambda (canvas [panel% mred:container:horizontal-panel%])
-	       (let ([frame (ivar canvas frame)])
+	       (let* ([frame (ivar canvas frame)]
+		      [media (send canvas get-media)]
+		      [canvas% (object-class canvas)]
+		      [parent (send canvas get-parent)]
+		      [new-panel #f]
+		      [left-split #f]
+		      [right-split #f])
 		 (dynamic-wind
 		  (lambda () (send frame set-perform-updates #f))
-		  (lambda () (letrec* ([media (send canvas get-media)]
-				       [canvas% (object-class canvas)]
-				       [parent (send canvas get-parent)]
-				       [new-panel (make-object panel% parent)]
-				       [left-split (make-object canvas% new-panel)]
-				       [right-split (make-object canvas% new-panel)])
-			       (send parent change-children
-				     (lambda (l)
-				       (let ([before (remq new-panel l)])
-					 (map (lambda (x) (if (eq? x canvas)
-							      new-panel
-							      x))
-					      before))))
-			       (send* media (remove-canvas canvas)
-				            (add-canvas left-split)
-					    (add-canvas right-split))
-			       (send* left-split (set-media media) (set-frame frame) (set-focus))
-			       (send* right-split (set-media media) (set-frame frame))
-			       (when (eq? this parent)
-				 (bind media new-panel))))
-		  (lambda () (send frame set-perform-updates #t)))))]
+		  (lambda () 
+		    (set! new-panel (make-object panel% parent))
+		    (set! left-split (make-object canvas% new-panel))
+		    (set! right-split (make-object canvas% new-panel))
+		    (send parent change-children
+			  (lambda (l)
+			    (let ([before (remq new-panel l)])
+			      (map (lambda (x) (if (eq? x canvas)
+						   new-panel
+						   x))
+				   before)))))
+		  (lambda () (send frame set-perform-updates #t)))
+		 (send* media (remove-canvas canvas)
+			(add-canvas left-split)
+			(add-canvas right-split))
+		 (send* left-split (set-media media) (set-focus))
+		 (send* right-split (set-media media))
+		 (when (eq? this parent)
+		   (bind media new-panel))))]
 	    [change-children
 	     (lambda (f)
 	       (let ([new-children (f actual-children)])

collects/mred/prefs.ss

@@ -15,10 +15,11 @@
     (mred:debug:printf 'invoke "mred:preferences@")
     
     (define preferences-filename
-      (case wx:platform
-	[(unix) (build-path (expand-path "~") ".mred.prefs")]
-	[(macintosh) "MrEd Preferences"]
-	[else "mred.pre"])) ;; windows 
+      (build-path (wx:find-directory 'pref)
+		  (case wx:platform
+		    [(unix)  ".mred.prefs"]
+		    [(macintosh) "MrEd Preferences"]
+		    [else "mred.pre"])))
     
     (define preferences (make-hash-table))
     (define marshall-unmarshall (make-hash-table))
@@ -237,6 +238,7 @@
 
 	    (make-check 'mred:verify-exit "Verify exit?" id id)
 	    (make-check 'mred:verify-change-format "Ask before changing save format?" id id)
+	    (make-check 'mred:auto-set-wrap? "Wordwrap editor buffers?" id id)
 	    main)))))
 
     (define make-run-once