added new, fixed a bug in character constants for the new [ handling

svn: r2663

collects/framework/private/scheme.ss

@@ -975,13 +975,15 @@
           (inherit is-frozen? is-stopped?)
           (define/public (rewrite-square-paren)
             (insert (cond
-                      [(or (is-frozen?) (is-stopped?))
+                      [(or (not (preferences:get 'framework:fixup-parens))
+                           (is-frozen?)
+                           (is-stopped?))
                        #\[]
                       [else (choose-paren this (get-start-position))])
                     (get-start-position)
                     (get-end-position)))
           
-          (super-instantiate ())))
+          (super-new)))
 
       (define -text-mode<%>
         (interface ()
@@ -1214,22 +1216,36 @@
       ;; returns the character to replace a #\[ with, based
       ;; on the context where it is typed in.
       (define (choose-paren text pos)
-        (if (memq (send text classify-position pos) '(string error comment symbol))
+        (if (memq (send text classify-position pos) '(string error comment symbol constant))
             #\[
             (let* ([before-whitespace-pos (send text skip-whitespace pos 'backward #t)]
                    [backward-match (send text backward-match before-whitespace-pos 0)])
               (let ([b-m-char (and (number? backward-match) (send text get-character backward-match))])
                 (cond
-                  [(member b-m-char '(#\( #\[ #\{))
-                   ;; found a "sibling" parenthesized sequence. use the parens it uses.
-                   b-m-char]
                   [backward-match
-                   ;; there is a sexp before this, but it isn't parenthesized.
+                   ;; there is an expression before this, at this layer
-                   ;; if it is the `cond' keyword, we get a square bracket. otherwise not.
+                   (let* ([before-whitespace-pos2 (send text skip-whitespace backward-match 'backward #t)]
-                   (if (and (beginning-of-sequence? text backward-match)
+                          [backward-match2 (send text backward-match before-whitespace-pos2 0)])
-                            (text-between-equal? "cond" text backward-match before-whitespace-pos))
+                     
-                       #\[
+                     (cond
-                       #\()]
+                       ;; we found a new expression, two steps back, so we don't use the sibling
+                       ;; check here -- we just go with square brackets.
+                       [(and backward-match2
+                             (text-between-equal? "new"
+                                                  text
+                                                  backward-match2
+                                                  before-whitespace-pos2))
+                        #\[]
+                       [(member b-m-char '(#\( #\[ #\{))
+                        ;; found a "sibling" parenthesized sequence. use the parens it uses.
+                        b-m-char]
+                       [else
+                        ;; there is a sexp before this, but it isn't parenthesized.
+                        ;; if it is the `cond' keyword, we get a square bracket. otherwise not.
+                        (if (and (beginning-of-sequence? text backward-match)
+                                 (text-between-equal? "cond" text backward-match before-whitespace-pos))
+                            #\[
+                            #\()]))]
                   [(not (zero? before-whitespace-pos))
                    ;; this is the first thing in the sequence
                    ;; pop out one layer and look for a keyword.

collects/tests/framework/key-specs.ss

@@ -1,53 +0,0 @@
-(define-struct key-spec (before after macos unix windows))
-(define-struct buff-spec (string start end))
-
-(define global-specs
-  (list
-   (make-key-spec (make-buff-spec "abc" 1 1)
-		  (make-buff-spec "abc" 2 2)
-		  (list '(#\f control) '(right))
-		  (list '(#\f control) '(right))
-		  (list '(#\f control) '(right)))))
-
-(define (build-open-bracket-spec str pos char)
-  (make-key-spec (make-buff-spec str pos pos)
-                 (make-buff-spec 
-                  (string-append (substring str 0 pos)
-                                 (string char)
-                                 (substring str pos (string-length str)))
-                  (+ pos 1)
-                  (+ pos 1))
-                 (list (list char))
-                 (list (list char))
-                 (list (list char))))
-
-(define scheme-specs
-  (list 
-   (make-key-spec (make-buff-spec "(abc (def))" 4 4)
-		  (make-buff-spec "(abc (def))" 10 10)
-		  (list '(right alt))
-		  (list '(right alt))
-		  (list '(right alt)))
-   (make-key-spec (make-buff-spec "'(abc (def))" 1 1)
-		  (make-buff-spec "'(abc (def))" 12 12)
-		  (list '(right alt))
-		  (list '(right alt))
-		  (list '(right alt)))
-   (build-open-bracket-spec "(f cond " 8 #\()
-   (build-open-bracket-spec "(f let (" 8 #\()
-   (build-open-bracket-spec "(let (" 6 #\[)
-   (build-open-bracket-spec "(let (" 5 #\()
-   (build-open-bracket-spec "(kond " 5 #\()
-   (build-open-bracket-spec "(cond " 5 #\[)
-   (build-open-bracket-spec "(let ([]" 8 #\[)
-   (build-open-bracket-spec "(let ({}" 8 #\{)
-   (build-open-bracket-spec "()" 2 #\()
-   (build-open-bracket-spec "(let (;;" 8 #\[)
-   (build-open-bracket-spec ";" 1 #\[)
-   (build-open-bracket-spec "\"" 1 #\[)
-   (build-open-bracket-spec "\"\"" 1 #\[)
-   (build-open-bracket-spec "||" 1 #\[)
-   (build-open-bracket-spec "ab" 1 #\[)
-   (build-open-bracket-spec "" 0 #\()
-   (build-open-bracket-spec "(let (" 6 #\[)))
-

collects/tests/framework/keys.ss

@@ -80,7 +80,62 @@
   (test-canonicalize 11 "esc;s:a" "esc;s:a")
   (test-canonicalize 12 "s:a;esc" "s:a;esc")
   
-  (include "key-specs.ss")
+  (define-struct key-spec (before after macos unix windows))
+  (define-struct buff-spec (string start end))
+  
+  (define global-specs
+    (list
+     (make-key-spec (make-buff-spec "abc" 1 1)
+                    (make-buff-spec "abc" 2 2)
+                    (list '(#\f control) '(right))
+                    (list '(#\f control) '(right))
+                    (list '(#\f control) '(right)))))
+  
+  (define (build-open-bracket-spec str pos char)
+    (make-key-spec (make-buff-spec str pos pos)
+                   (make-buff-spec 
+                    (string-append (substring str 0 pos)
+                                   (string char)
+                                   (substring str pos (string-length str)))
+                    (+ pos 1)
+                    (+ pos 1))
+                   (list (list char))
+                   (list (list char))
+                   (list (list char))))
+  
+  (define scheme-specs
+    (list 
+     (make-key-spec (make-buff-spec "(abc (def))" 4 4)
+                    (make-buff-spec "(abc (def))" 10 10)
+                    (list '(right alt))
+                    (list '(right alt))
+                    (list '(right alt)))
+     (make-key-spec (make-buff-spec "'(abc (def))" 1 1)
+                    (make-buff-spec "'(abc (def))" 12 12)
+                    (list '(right alt))
+                    (list '(right alt))
+                    (list '(right alt)))
+     (build-open-bracket-spec "(f cond " 8 #\()
+     (build-open-bracket-spec "(f let (" 8 #\()
+     (build-open-bracket-spec "(let (" 6 #\[)
+     (build-open-bracket-spec "(let (" 5 #\()
+     (build-open-bracket-spec "(kond " 5 #\()
+     (build-open-bracket-spec "(cond " 5 #\[)
+     (build-open-bracket-spec "(let ([]" 8 #\[)
+     (build-open-bracket-spec "(let ({}" 8 #\{)
+     (build-open-bracket-spec "()" 2 #\()
+     (build-open-bracket-spec "(let (;;" 8 #\[)
+     (build-open-bracket-spec ";" 1 #\[)
+     (build-open-bracket-spec "\"" 1 #\[)
+     (build-open-bracket-spec "\"\"" 1 #\[)
+     (build-open-bracket-spec "||" 1 #\[)
+     (build-open-bracket-spec "ab" 1 #\[)
+     (build-open-bracket-spec "" 0 #\()
+     (build-open-bracket-spec "(let (" 6 #\[)
+     (build-open-bracket-spec "(new x% " 8 #\[)
+     (build-open-bracket-spec "#\\" 1 #\[)
+     (build-open-bracket-spec "#\\a" 1 #\[)))
+  
   
   (send-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t))
   (wait-for-frame "dummy to trick frame group")