added a little more prefs -- need to synch with Richard

original commit: 6253f8441eb5213332e8851c84df1ca4039a860a

collects/mred/prefs.ss

@@ -1,9 +1,15 @@
 ;; need a preference for pconvert
 
+;; timing problem with prefernces and marshalling and unmarshalling
+;; possibly stage it. So, first read in the marshalled preference,
+;; then when I am asked for the preference for the first time, check
+;; to see if it needs to be unmarshalled.
+
 (define mred:preferences@
   (unit/s mred:preferences^
     (import [mred:debug mred:debug^]
-	    [mred:exn mred:exn^])
+	    [mred:exn mred:exn^]
+	    [mzlib:function mzlib:function^])
     
     (define preferences-filename
       (case wx:platform
@@ -12,8 +18,11 @@
 	[else "mred.pre"])) ;; windows 
     
     (define preferences (make-hash-table))
+    (define marshall-unmarshall (make-hash-table))
     
-    (define get-preference 
+    (define-struct un/marshall (marshall unmarshall))
+    
+    (define get-preference-box
       (lambda (p) 
 	(hash-table-get preferences p
 			(lambda () 
@@ -21,8 +30,28 @@
 				  (format "unknown preference: ~a" p)
 				  ((debug-info-handler))))))))
     
+    (define get-preference (mzlib:function:compose unbox get-preference-box))
+    
     (define set-preference
-      (lambda (p value) (hash-table-put! preferences p value)))
+      (lambda (p value)
+	(let/ec k
+	  (set-box! (hash-table-get preferences p 
+				    (lambda () 
+				      (let ([box (box value)])
+					(hash-table-put! preferences p box)
+					(k box))))
+		    value))))
+    
+    (define set-preference-default
+      (lambda (p value)
+	(hash-table-get preferences p 
+			(lambda () 
+			  (hash-table-put! preferences p (box value))))
+	(set! defaults (cons (list p value) defaults))))
+    
+    (define set-preference-un/marshall
+      (lambda (p marshall unmarshall)
+	(hash-table-put! marshall-unmarshall p (make-un/marshall marshall unmarshall))))
     
     (define defaults '((highlight-parens #t)
 		       (autosaving-on? #t)
@@ -36,21 +65,44 @@
     
     (define save-user-preferences 
       (lambda () 
+	(let ([marshall-pref
+	       (lambda (p boxed-value)
+		 (let* ([value (unbox boxed-value)]
+			[marshalled
+			 (let/ec k
+			   ((un/marshall-marshall
+			     (hash-table-get marshall-unmarshall p
+					     (lambda ()
+					       (k value))))
+			    value))])
+		   (list p marshalled)))])
 	(call-with-output-file preferences-filename
-	  (lambda (p) (write (hash-table-map preferences list) p))
+	  (lambda (p)
-	  'replace)))
+	    (write (hash-table-map preferences marshall-pref) p))
+	  'replace))))
     
     (define read-user-preferences 
       (lambda ()
+	(let ([unmarshall-update
+	       (lambda (input)
+		 (let* ([p (mzlib:function:first input)]
+			[marshalled (mzlib:function:second input)]
+			[unmarshalled 
+			 (let/ec k
+			   ((un/marshall-unmarshall
+			     (hash-table-get marshall-unmarshall p
+					     (lambda () (k marshalled))))
+			    marshalled))])
+		   (set-preference p unmarshalled)))])
 	  (when (file-exists? preferences-filename)
-	  (for-each (lambda (x) (apply set-preference x))
+	    (let ([input (call-with-input-file preferences-filename read)])
-		    (call-with-input-file preferences-filename read)))))
+	      (when (list? input)
+		(for-each unmarshall-update input)))))))
     
     (define preferences-dialog
       (lambda ()
-	(restore-defaults)
 	(save-user-preferences)
-	(wx:message-box "Saved default preferences.")))
+	(wx:message-box "Saved preferences.")))
     
     (restore-defaults)
     (read-user-preferences)))