.

original commit: 4b47ae4018481bc7c8efba75521e2af1af9aea98

collects/mred/edit-main.ss

@@ -0,0 +1,14 @@
+
+;; Uses editor.ss to open a frame for each argument
+
+(module edit-main mzscheme
+  (require "edit.ss"
+	   (lib "cmdline.ss"))
+
+  (command-line
+   "Edit"
+   (current-command-line-arguments)
+   [args files
+	 (if (null? files)
+	     (new-text-frame #f)
+	     (for-each new-text-frame files))]))

collects/mred/edit.ss

@@ -0,0 +1,64 @@
+
+;; Simple editor implementation; provides new-text-frame
+;; and new-pasteboard-frame
+
+(module edit mzscheme
+  (require (lib "class.ss")
+	   (lib "mred.ss" "mred"))
+
+  (provide new-text-frame
+	   new-pasteboard-frame)
+
+  (define (new-text-frame file) (new-frame text% file))
+  (define (new-pasteboard-frame file) (new-frame pasteboard% file))
+
+  (define (new-frame editor% file)
+    (define f (make-object frame% (or file "Simple Editor") #f 620 450))
+    (define c (make-object editor-canvas% f))
+    (define e (make-object editor%))
+    (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))
+
+    (make-object menu-item% "New Text Frame" file-menu
+		 (lambda (item event) 
+		   (new-text-frame #f))
+		 #\N)
+    (make-object menu-item% "New Pasteboard Frame" file-menu
+		 (lambda (item event) 
+		   (new-pasteboard-frame #f)))
+
+    (make-object menu-item% "Open..." file-menu
+		 (lambda (item event) 
+		   (send e load-file ""))
+		 #\O)
+    (make-object menu-item% "Save As..." file-menu
+		 (lambda (item event) 
+		   (send e save-file ""))
+		 #\S)
+    (make-object separator-menu-item% file-menu)
+    (make-object menu-item% "Print..." file-menu
+		 (lambda (item event)
+		   (send e print))
+		 #\P)
+    (make-object separator-menu-item% file-menu)
+    (make-object menu-item% "Close" file-menu
+		 (lambda (item event)
+		   (send f show #f))
+		 #\Q)
+
+    (append-editor-operation-menu-items edit-menu #f)
+
+    (append-editor-font-menu-items font-menu)
+    ((current-text-keymap-initializer) (send e get-keymap))
+    (send c set-editor e)
+
+    (when file
+      (if (regexp-match "[.]((gif)|(bmp)|(jpg)|(xbm))$" file)
+	  (send e insert (make-object image-snip% file))
+	  (send e load-file file)))
+    
+    (send f show #t)
+    f))

collects/mred/mred.ss

@@ -6055,6 +6055,32 @@
 
 (wx:set-dialogs get-file put-file get-ps-setup-from-user message-box)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; snip-class% and editor-data-class% loaders
+
+(let ([load-one
+       (lambda (str id %)
+	 (let ([m (with-handlers ([void (lambda (x) #f)])
+		    (and (regexp-match "^[(].*[)]$" str)
+			 (read (open-input-string str))))])
+	   (if (and (list? m)
+		    (eq? 'lib (car m))
+		    (andmap string? (cdr m)))
+	       (let ([result (dynamic-require m id)])
+		 (if (is-a? result %)
+		     result
+		     (error 'load-class "not a ~a% instance" id))))))])
+  ;; install the getters:
+  (wx:set-snip-class-getter 
+   (lambda (name)
+     (load-one name 'snip-class wx:snip-class%)))
+  (wx:set-editor-data-class-getter 
+   (lambda (name)
+     (load-one name 'editor-data-class wx:editor-data-class%))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (define-syntax propagate
   (lambda (stx)
     (syntax-case stx ()

collects/mred/private/kernel.ss

@@ -1398,7 +1398,9 @@
     set-dialogs
     set-executer
     current-gl-context
-    send-event)
+    send-event
+    set-snip-class-getter
+    set-editor-data-class-getter)
 
 )
 ;; end