fixed a bug and improved note at top of preferences.ss

svn: r5060

collects/framework/private/preferences.ss

@@ -1,50 +1,28 @@
-#|
-
-todo:
-
-  -read
-
-|#
 
 #|
 
-save needs contracts
+There are three attributes for each preference:
 
-showing the dialog needs preferences.
-
-There are four attributes for each preference (technically, "read from 
-disk" is global, but we can just think of it happening to each one 
-independently, but simultaneously):
-
-  - read from disk, or not
   - default set, or not
   - marshalling function set, or not
   - initialization still okay, or not
 
 the state transitions / contracts are:
 
-  get(true, true, _, _) -> (true, true, _, false)
+  get(true, _, _) -> (true, _, false)
-  get(false, _, _, _) -> error not yet read from disk
+  get(false, _, _) -> error default not yet set
-  get(_, false, _, _) -> error default not yet set
 
   set is just like get.
 
-  set-default(true, false, true, true) -> set-default(true, true, _, true)
+  set-default(false, _, true) -> set-default(true, _, true)
-  set-default(false, _, _, _) -> error not yet read from disk
+  set-default(true, _, _) -> error default already set
-  set-default(_, true, _, _) -> error default already set
+  set-default(_, _, false) -> initialization not okay anymore  /* cannot happen, I think */
-  set-default(_, _, _, false) -> initialization not okay anymore  /* cannot happen, I think */
 
-  set-un/marshall(true, true, false, true) -> (true, true, true, true)
+  set-un/marshall(true, false, true) -> (true, true, true)
   .. otherwise error
 
-  read(false, _, _, true) -> (true, _, _, true)
-  read(true, _, _, _) -> error, already read from disk
-  read(_, _, _, false) -> initialization phase over /* cannot happen */
-
   for all syms: 
-   prefs-snapshot(true, _, _, _) -> (true, _, _, false) 
+   prefs-snapshot(_, _, _) -> (_, _, false) 
-
-for the last one, need a global "no more initialization can happen" flag.
 
 |#
 
@@ -116,12 +94,11 @@ for the last one, need a global "no more initialization can happen" flag.
   (define (get p)
     (cond
       [(pref-default-set? p)
-       (let/ec k
+       (let* ([g (gensym)]
-         (unmarshall
+	      [pref (get-preference (add-pref-prefix p) (λ () g))])
-          p
+	 (if (eq? g pref)
-          (get-preference (add-pref-prefix p)
+	     (default-value (hash-table-get defaults p))
-                          (λ ()
+	     (unmarshall p pref)))]
-                            (k (default-value (hash-table-get defaults p)))))))]
       [(not (pref-default-set? p))
        (raise-unknown-preference-error
         'preferences:get

collects/framework/private/scheme.ss

@@ -420,7 +420,8 @@
           (define (tabify-on-return?) #t)
           (define tabify    
             (opt-lambda ([pos (get-start-position)])
-              (let* ([last-pos (last-position)]
+              (let* ([tabify-prefs (preferences:get 'framework:tabify)]
+		     [last-pos (last-position)]
                      [para (position-paragraph pos)]
 		     [is-tabbable? (and (> para 0)
 					(not (memq (classify-position (sub1 (paragraph-start-position para)))
@@ -486,7 +487,7 @@
 			(let ([id-end (get-forward-sexp contains)])
 			  (if (and id-end (> id-end contains))
 			      (let* ([text (get-text contains id-end)])
-                                (or (get-keyword-type text)
+                                (or (get-keyword-type text tabify-prefs)
                                     'other)))))]
                      [procedure-indent
                       (λ ()
@@ -1027,25 +1028,29 @@
             (send text set-styles-fixed #t)
 	    (send text end-edit-sequence))
           
-          (super-new (get-token scheme-lexer-wrapper)
+	  (define tabify-pref (preferences:get 'framework:tabify))
+	  (preferences:add-callback
+	   'framework:tabify
+	   (lambda (k v) (set! tabify-pref v)))
+	  (define/private (scheme-lexer-wrapper in)
+	    (let-values (((lexeme type paren start end) (scheme-lexer in)))
+	      (cond
+		((and (eq? type 'symbol)
+		      (get-keyword-type lexeme tabify-pref))
+		 (values lexeme 'keyword paren start end))
+		(else
+		 (values lexeme type paren start end)))))
+
+          (super-new (get-token (lambda (in) (scheme-lexer-wrapper in)))
                      (token-sym->style short-sym->style-name)
                      (matches '((|(| |)|)
                                 (|[| |]|)
                                 (|{| |}|))))))
       
-      (define (scheme-lexer-wrapper in)
+      ;; get-keyword-type : string (list ht regexp regexp regexp)
-        (let-values (((lexeme type paren start end) (scheme-lexer in)))
+      ;;                 -> (union #f 'lambda 'define 'begin)
-          (cond
+      (define (get-keyword-type text pref)
-            ((and (eq? type 'symbol)
+        (let* ([ht (car pref)]
-                  (get-keyword-type lexeme))
-             (values lexeme 'keyword paren start end))
-            (else
-             (values lexeme type paren start end)))))
-      
-      ;; get-keyword-type : string -> (union #f 'lambda 'define 'begin)
-      (define (get-keyword-type text)
-        (let* ([pref (preferences:get 'framework:tabify)]
-               [ht (car pref)]
                [beg-reg (cadr pref)]
                [def-reg (caddr pref)]
                [lam-reg (cadddr pref)])