..

original commit: acbc28ecaacc6ba5dcc305ec303ba53194a7f068

collects/framework/framework.ss

@@ -1,3 +1,6 @@
+;; should import the flattened test and guiutils stuff and
+;; dynamically link to that.
+
 (module framework mzscheme
   (require (lib "unitsig.ss"))
 

collects/framework/private/color-model.ss

@@ -1,8 +1,8 @@
-(module canvas mzscheme
+(module color-model mzscheme
   (require (lib "unitsig.ss")
 	   "sig.ss"
 	   (lib "mred-sig.ss" "mred")
-	   (lib "function.ss"))
+	   (lib "list.ss"))
 
   (provide color-model@)
 

collects/framework/private/editor.ss

@@ -1,6 +1,7 @@
 (module editor mzscheme
   (require (lib "unitsig.ss")
 	   "sig.ss"
+	   "../guiutils-sig.ss"
 	   (lib "mred-sig.ss" "mred")
 	   (lib "file.ss"))
 
@@ -310,7 +311,7 @@
 	    [update-filename
 	     (lambda (name)
 	       (let ([filename (if name
-				   (mzlib:file:file-name-from-path (mzlib:file:normalize-path name))
+				   (file-name-from-path (normalize-path name))
 				   "")])
 		 (for-each (lambda (canvas)
 			     (let ([tlw (send canvas get-top-level-window)])

collects/framework/private/exit.ss

@@ -1,6 +1,7 @@
 (module exit mzscheme
   (require (lib "unitsig.ss")
 	   "sig.ss"
+	   "../guiutils-sig.ss"
 	   (lib "mred-sig.ss" "mred")
 	   (lib "file.ss"))
 
@@ -61,11 +62,10 @@
 	      user-says)
 	    #t))
 
-      (define -exit
-	(opt-lambda ()
-	  (unless exiting?
-	    (set! exiting? #t)
-	    (when (can-exit?)
-	      (on-exit)
-	      (queue-callback (lambda () (exit))))
-	    (set! exiting? #f)))))))
+      (define (-exit)
+	(unless exiting?
+	  (set! exiting? #t)
+	  (when (can-exit?)
+	    (on-exit)
+	    (queue-callback (lambda () (exit))))
+	  (set! exiting? #f))))))

collects/framework/private/finder.ss

@@ -3,7 +3,7 @@
 	   "sig.ss"
 	   (lib "mred-sig.ss" "mred")
 	   (lib "string.ss")
-	   (lib "function.ss")
+	   (lib "list.ss")
 	   (lib "file.ss"))
 
   (provide finder@)
@@ -22,7 +22,7 @@
       (define filter-match?
 	(lambda (filter name msg)
 	  (let-values ([(base name dir?) (split-path name)])
-	    (if (mzlib:string:regexp-match-exact? filter name)
+	    (if (regexp-match-exact? filter name)
 		#t
 		(begin
 		  (message-box "Error" msg)
@@ -104,7 +104,7 @@
 			    (let-values ([(base-dir in-dir dir?) 
 					  (split-path this-dir)])
 			      (if (eq? (system-type) 'windows)
-				  (mzlib:string:string-lowercase! in-dir))
+				  (string-lowercase! in-dir))
 			      (let* ([dir-list (cons this-dir dir-list)]
 				     [menu-list (cons in-dir menu-list)])
 				(if base-dir
@@ -121,7 +121,7 @@
 		    
 		    (send name-list clear)
 		    (send name-list set
-			  (mzlib:function:quicksort
+			  (quicksort
 			   (let ([no-periods? 
 				  (not (preferences:get
 					'framework:show-periods-in-dirlist))])
@@ -138,8 +138,7 @@
 				      [(directory-exists? (build-path dir s))
 				       (cons s rest)]
 				      [(or (not file-filter)
-					   (mzlib:string:regexp-match-exact? 
-					    file-filter s))
+					   (regexp-match-exact? file-filter s))
 				       (cons s rest)]
 				      [else rest])))))
 					;(if (eq? (system-type) 'unix) string<? string-ci<?)
@@ -176,7 +175,7 @@
 	       (if (eq? (send evt get-event-type) 'list-box-dclick)
 		   (let ([dir (send directory-field get-value)])
 		     (if (directory-exists? dir)
-			 (set-directory (normal-case-path (mzlib:file:normalize-path dir)))
+			 (set-directory (normal-case-path (normalize-path dir)))
 			 (if multi-mode?
 			     (do-add)
 			     (do-ok))))
@@ -216,7 +215,7 @@
 			    (string=? name ""))
 		       (let ([file (send directory-field get-value)])
 			 (if (directory-exists? file)
-			     (set-directory (normal-case-path (mzlib:file:normalize-path file)))
+			     (set-directory (normal-case-path (normalize-path file)))
 			     (message-box 
 			      "Error"
 			      "You must specify a file name")))]
@@ -224,7 +223,7 @@
 		      [(and save-mode? 
 			    non-empty?
 			    file-filter 
-			    (not (mzlib:string:regexp-match-exact? file-filter name)))
+			    (not (regexp-match-exact? file-filter name)))
 		       (message-box "Error" file-filter-msg)]
 
 		      [else
@@ -234,7 +233,7 @@
 		       (let ([dir-name (send directory-field get-value)])
 			 
 			 (if (directory-exists? dir-name)
-			     (set-directory (normal-case-path (mzlib:file:normalize-path dir-name)))
+			     (set-directory (normal-case-path (normalize-path dir-name)))
 			     
 					; otherwise, try to return absolute path
 			     
@@ -282,7 +281,7 @@
 							" contains nonexistent directory or cycle."))
 						      #f)])
 						(normal-case-path
-						 (mzlib:file:normalize-path file)))])
+						 (normalize-path file)))])
 					 (when normal-path 
 					   (set-box! result-box normal-path)
 					   (show #f))))))))]))))]
@@ -292,7 +291,7 @@
 	       (unless (or (directory-exists? name)
 			   (send result-list find-string name))
 		 (send result-list append
-		       (normal-case-path (mzlib:file:normalize-path name)))))]
+		       (normal-case-path (normalize-path name)))))]
 	    
 	    [do-add
 	     (lambda args
@@ -464,7 +463,7 @@
 					      (make-relative which))])
 			(if (directory-exists? dir)
 			    (set-directory (normal-case-path
-					    (mzlib:file:normalize-path dir)))
+					    (normalize-path dir)))
 			    (if multi-mode?
 				(do-add)
 				(do-ok))))))]))]
@@ -497,7 +496,7 @@
 		      (let ([dir (send directory-field get-value)])
 			(if (directory-exists? dir)
 			    (set-directory (normal-case-path
-					    (mzlib:file:normalize-path dir)))
+					    (normalize-path dir)))
 			    (if multi-mode?
 				(do-add)
 				(do-ok)))))))))]
@@ -587,7 +586,7 @@
 	     [(and start-dir
 		   (directory-exists? start-dir))
 	      (set-directory (normal-case-path
-			      (mzlib:file:normalize-path start-dir)))]
+			      (normalize-path start-dir)))]
 	     [last-directory (set-directory last-directory)]
 	     [else (set-directory (current-directory))])
 	    
@@ -622,11 +621,11 @@
 		      [parent-win (dialog-parent-parameter)])
 	   (let* ([directory (if (and (not in-directory)
 				      (string? name))
-				 (mzlib:file:path-only name)
+				 (path-only name)
 				 in-directory)]
 		  [saved-directory last-directory]
 		  [name (or (and (string? name)
-				 (mzlib:file:file-name-from-path name))
+				 (file-name-from-path name))
 			    name)])
 	     (make-object finder-dialog% 
 	       parent-win
@@ -699,10 +698,10 @@
 		     [parent-win (dialog-parent-parameter)])
 	  (let* ([directory (if (and (not directory)
 				     (string? name))
-				(mzlib:file:path-only name)
+				(path-only name)
 				directory)]
 		 [name (or (and (string? name)
-				(mzlib:file:file-name-from-path name))
+				(file-name-from-path name))
 			   name)]
 		 [f (put-file 
 		     prompt 
@@ -717,9 +716,9 @@
 					     f
 					     filter-msg))))
 		#f
-		(let* ([f (normal-case-path (mzlib:file:normalize-path f))]
-		       [dir (mzlib:file:path-only f)]
-		       [name (mzlib:file:file-name-from-path f)])
+		(let* ([f (normal-case-path (normalize-path f))]
+		       [dir (path-only f)]
+		       [name (file-name-from-path f)])
 		  (cond
 		   [(not (and (string? dir) (directory-exists? dir)))
 		    (message-box "Error" "That directory does not exist.")
@@ -742,7 +741,7 @@
 
 	    (if f
 		(if (or (not filter) (filter-match? filter f filter-msg))
-		    (let ([f (mzlib:file:normalize-path f)])
+		    (let ([f (normalize-path f)])
 		      (cond
 		       [(directory-exists? f)
 			(message-box "Error" "That is a directory name.")

collects/framework/private/frame.ss

@@ -2,7 +2,7 @@
   (require (lib "unitsig.ss")
 	   "sig.ss"
 	   (lib "mred-sig.ss" "mred")
-	   (lib "function.ss")
+	   (lib "list.ss")
 	   (lib "file.ss"))
 
   (provide frame@)
@@ -116,7 +116,7 @@
 	[after-new-child
 	 (lambda (child)
 	   (when after-init?
-	     (change-children (lambda (l) (mzlib:function:remq child l)))
+	     (change-children (lambda (l) (remq child l)))
 	     (error 'frame:basic-mixin
 		    "do not add children directly to a frame:basic (unless using make-root-area-container); use the get-area-container method instead"
 		    )))])
@@ -560,7 +560,7 @@
       (sequence
 	(let ([move-front
 	       (lambda (x l)
-		 (cons x (mzlib:function:remq x l)))])
+		 (cons x (remq x l)))])
 	  (send (get-info-panel) change-children
 		(lambda (l)
 		  (move-front
@@ -635,7 +635,7 @@
 	   (send (get-editor) on-close))])
       (private
 	[label (if file-name
-		   (mzlib:file:file-name-from-path file-name)
+		   (file-name-from-path file-name)
 		   (gui-utils:next-untitled-name))]
 	[label-prefix (application:current-app-name)]
 	[do-label
@@ -1271,7 +1271,7 @@
 	 (opt-lambda ([startup? #f])
 	   (send super-root change-children
                  (lambda (l)
-                   (mzlib:function:remove search-panel l)))
+                   (remove search-panel l)))
 	   (clear-search-highlight)
 	   (unless startup?
 	     (send 

collects/framework/private/group.ss

@@ -50,7 +50,7 @@
 	     (lambda (frame)
 	       (let* ([menu (get-windows-menu frame)])
 		 (set! windows-menus
-		       (mzlib:function:remove
+		       (remove
 			menu
 			windows-menus
 			eq?))))]
@@ -71,7 +71,7 @@
 				   default-name)
 			       label)))]
 		      [sorted-frames
-		       (mzlib:function:quicksort
+		       (quicksort
 			frames
 			(lambda (f1 f2)
 			  (string-ci<=? (get-name (frame-frame f1))
@@ -161,7 +161,7 @@
 	    [can-remove-frame?
 	     (opt-lambda (f)
 	       (let ([new-frames 
-		      (mzlib:function:remove
+		      (remove
 		       f frames
 		       (lambda (f fr) (eq? f (frame-frame fr))))])
 		 (if (null? new-frames)
@@ -172,7 +172,7 @@
 	       (when (eq? f active-frame)
 		 (set! active-frame #f))
 	       (let ([new-frames
-		      (mzlib:function:remove
+		      (remove
 		       f frames
 		       (lambda (f fr) (eq? f (frame-frame fr))))])
 		 (set! frames new-frames)
@@ -207,7 +207,7 @@
 		       (with-handlers ([(lambda (x) #t)
 					(lambda (x) name)])
 			 (normal-case-path
-			  (mzlib:file:normalize-path name)))]
+			  (normalize-path name)))]
 		      [test-frame
 		       (lambda (frame)
 			 (and (is-a? frame frame:basic<%>)
@@ -217,7 +217,7 @@
 					       (with-handlers ([(lambda (x) #t)
 								(lambda (x) filename)])
 						 (normal-case-path
-						  (mzlib:file:normalize-path 
+						  (normalize-path 
 						   filename))))))))])
 		 (let loop ([frames frames])
 		   (cond

collects/framework/private/handler.ss

@@ -54,7 +54,7 @@
 	(lambda (name handlers)
 	  (let/ec exit
 	    (let ([extension (if (string? name)
-				 (or (mzlib:file:filename-extension name)
+				 (or (filename-extension name)
 				     "")
 				 "")])
 	      (for-each
@@ -128,7 +128,7 @@
 		[get (lambda () the-dir)]
 		[set-from-file!
 		 (lambda (file) 
-		   (set! the-dir (mzlib:file:path-only file)))]
+		   (set! the-dir (path-only file)))]
 		[set-to-default
 		 (lambda ()
 		   (set! the-dir (current-directory)))])

collects/framework/private/keymap.ss

@@ -118,7 +118,7 @@
 		   [(null? mods) null]
 		   [(null? (cdr mods)) null]
 		   [else (cons (car mods) (loop (cdr mods)))]))]
-	       [key (car (mzlib:function:last-pair mods/key))]
+	       [key (car (last-pair mods/key))]
 	       [shift (if neg? #f 'd/c)]
 	       [control (if neg? #f 'd/c)]
 	       [alt (if neg? #f 'd/c)]
@@ -144,7 +144,7 @@
 			  [(#\m) (set! meta val)])))
 		    mods)
 	  (join-strings ":"
-			(mzlib:function:filter
+			(filter
 			 (lambda (x) x)
 			 (list
 			  (do-key #\a alt)

collects/framework/private/panel.ss

@@ -1,14 +1,14 @@
 (module panel mzscheme
   (require (lib "unitsig.ss")
 	   "sig"
-	   (lib "mred-sig.ss" "mred"))
+	   (lib "mred-sig.ss" "mred")
+	   (lib "list.ss"))
 
   (provide panel@)
 
   (define panel@
 (unit/sig framework:panel^
-  (import mred^
-	  [mzlib:function : mzlib:function^])
+  (import mred^)
   
   (rename [-editor<%> editor<%>])
 
@@ -383,7 +383,7 @@
 	   (let ([len (length children)])
 	     (unless (= (- len 1) (length (send thumb-canvas get-percentages)))
 	       (send thumb-canvas set-percentages 
-		     (mzlib:function:build-list
+		     (build-list
 		      (- len 1)
 		      (lambda (i) (/ 1 (- len 1))))))))])
       (rename [super-change-children change-children])
@@ -395,7 +395,7 @@
              (if thumb-canvas
                  (let* ([res (cons
                               thumb-canvas
-                              (mzlib:function:filter
+                              (filter
                                (lambda (c) (not (eq? c thumb-canvas)))
                                (f l)))])
                    (fix-percentage-length res)

collects/framework/private/preferences.ss

@@ -1,7 +1,8 @@
 (module preferences mzscheme
   (require (lib "unitsig.ss")
 	   "sig"
-	   (lib "mred-sig.ss" "mred"))
+	   (lib "mred-sig.ss" "mred")
+	   (lib "pretty.ss"))
 
   (provide preferences@)
   (define preferences@
@@ -10,9 +11,7 @@
 	  [prefs-file : framework:prefs-file^]
 	  [exn : framework:exn^]
 	  [exit : framework:exit^]
-	  [panel : framework:panel^]
-	  [mzlib:pretty-print : mzlib:pretty-print^]
-	  [mzlib:function : mzlib:function^])
+	  [panel : framework:panel^])
 
   (rename [-read read])
   
@@ -218,7 +217,7 @@
 			    (exn-message exn)))])
 	  (call-with-output-file (prefs-file:get-preferences-filename)
 	    (lambda (p)
-	      (mzlib:pretty-print:pretty-print
+	      (pretty-print
 	       (hash-table-map preferences marshall-pref) p))
 	    'truncate 'text)))))
 

collects/framework/private/scheme.ss

@@ -6,7 +6,9 @@
 (module scheme mzscheme
   (require (lib "unitsig.ss")
 	   "sig"
-	   (lib "mred-sig.ss" "mred"))
+	   (lib "mred-sig.ss" "mred")
+	   (lib "list.ss")
+	   (lib "thread.ss"))
 
   (provide scheme@)
 
@@ -20,9 +22,7 @@
 	  [icon : framework:icon^]
 	  [keymap : framework:keymap^]
 	  [text : framework:text^]
-	  [frame : framework:frame^]
-	  [mzlib:thread : mzlib:thread^]
-	  [mzlib:function : mzlib:function^])
+	  [frame : framework:frame^])
   
   (rename [-text% text%]
 	  [-text<%> text<%>])
@@ -312,9 +312,9 @@
 			     [else #f])]
 			   [handle-single
 			    (lambda (single)
-			      (let* ([left (mzlib:function:first single)]
-				     [right (mzlib:function:second single)]
-				     [error? (mzlib:function:third single)]
+			      (let* ([left (first single)]
+				     [right (second single)]
+				     [error? (third single)]
 				     [off (highlight-range 
 					   left
 					   right
@@ -539,7 +539,7 @@
 		  (let loop ([para first-para])
 		    (when (<= para end-para)
 		      (tabify (paragraph-start-position para))
-		      (mzlib:thread:dynamic-enable-break (lambda () (break-enabled)))
+		      (dynamic-enable-break (lambda () (break-enabled)))
 		      (loop (add1 para))))
 		  (when (and (>= (position-paragraph start-pos) end-para)
 			     (<= (paren:skip-whitespace 
@@ -960,7 +960,7 @@
 	       (letrec ([all-keywords (hash-table-map hash-table list)]
 			[pick-out (lambda (wanted in out)
 				    (cond
-				     [(null? in) (mzlib:function:quicksort out string<=?)]
+				     [(null? in) (quicksort out string<=?)]
 				     [else (if (eq? wanted (cadr (car in))) 
 					       (pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out))
 					       (pick-out wanted (cdr in) out))]))])

collects/framework/private/text.ss

@@ -1,8 +1,8 @@
 (module text mzscheme
   (require (lib "unitsig.ss")
 	   "sig"
-	   (lib "mred-sig.ss" "mred"))
-
+	   (lib "mred-sig.ss" "mred")
+	   (lib "list.ss"))
   (provide text@)
 
   (define text@
@@ -14,8 +14,7 @@
 	  [keymap : framework:keymap^]
           [gui-utils : framework:gui-utils^]
 	  [color-model : framework:color-model^]
-	  [frame : framework:frame^]
-	  [mzlib:function : mzlib:function^])
+	  [frame : framework:frame^])
   
   (rename [-keymap% keymap%])
   
@@ -182,8 +181,8 @@
 		      [old-rectangles range-rectangles])
 		  
 		  (set! range-rectangles 
-			(mzlib:function:foldl (lambda (x l) (append (new-rectangles x) l))
-					      null ranges))))]
+			(foldl (lambda (x l) (append (new-rectangles x) l))
+			       null ranges))))]
 	     [ranges null]
 	     [pen (make-object pen% "BLACK" 0 'solid)]
 	     [brush (make-object brush% "black" 'solid)])

collects/framework/private/version.ss

@@ -19,8 +19,9 @@
 	(lambda ()
 	  (foldr
 	   (lambda (entry sofar)
-	     (match entry
-	       [(sep num) (string-append sofar sep num)]))
+	     (let ([sep (first entry)]
+		   [num (second entry)])
+	       (string-append sofar sep num)))
 	   (version)
 	   specs)))