added normalization during pasting to eliminate various ligatures, etc

svn: r12183

collects/drscheme/private/rep.ss

@@ -847,9 +847,19 @@ TODO
           (reset-highlighting))
         (inner (void) after-delete x y))
       
-      (define/override get-keymaps
+      (define/override (get-keymaps)
-        (λ ()
+        (let loop ([old-maps (super get-keymaps)])
-          (append (super get-keymaps) (list scheme-interaction-mode-keymap))))
+          (cond
+            [(null? old-maps) 
+             (list scheme-interaction-mode-keymap)]
+            [else
+             (cond
+               [(eq? (car old-maps) (keymap:get-global))
+                (list* (car old-maps)
+                       scheme-interaction-mode-keymap
+                       (cdr old-maps))]
+               [else
+                (cons (car old-maps) (loop (cdr old-maps)))])])))
       
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       ;;;                                            ;;;
@@ -1854,4 +1864,5 @@ TODO
              (drs-autocomplete-mixin 
               (λ (txt) (send txt get-definitions-text))
               (text:foreground-color-mixin
-               text:clever-file-format%)))))))))))))
+               (text:normalize-paste-mixin
+                text:clever-file-format%))))))))))))))

collects/drscheme/private/unit.ss

@@ -449,7 +449,8 @@ module browser threading seems wrong.
                       (text:foreground-color-mixin
                        (drscheme:rep:drs-autocomplete-mixin
                         (λ (x) x)
-                        text:info%))))))))))])
+                        (text:normalize-paste-mixin
+                         text:info%)))))))))))])
         (class* definitions-super% (definitions-text<%>)
           (inherit get-top-level-window is-locked? lock while-unlocked highlight-first-line)
           

collects/framework/private/main.ss

@@ -20,6 +20,9 @@
 
 (application-preferences-handler (λ () (preferences:show-dialog)))
 
+(preferences:set-default 'framework:ask-about-paste-normalization #t boolean?)
+(preferences:set-default 'framework:do-paste-normalization #t boolean?)
+
 (preferences:set-default 'framework:replace-visible? #f boolean?)
 (preferences:set-default 'framework:anchored-search #f boolean?)
 
@@ -328,5 +331,3 @@
 ;; they do not need to be set across starting up and shutting down
 ;; the application.
 ;(preferences:set 'framework:file-dialogs 'std)
-  
-  ;; setup the color scheme stuff

collects/framework/private/preferences.ss

@@ -443,6 +443,10 @@ the state transitions / contracts are:
                                'framework:anchored-search
                                (string-constant find-anchor-based)
                                values values)
+                   (make-check editor-panel
+                               'framework:do-paste-normalization
+                               (string-constant normalize-string-preference)
+                               values values)
                    (editor-panel-procs editor-panel))))])
       (add-editor-checkbox-panel)))
   

collects/framework/private/sig.ss

@@ -163,6 +163,7 @@
      foreground-color<%>
      hide-caret/selection<%>
      nbsp->space<%>
+     normalize-paste<%>
      delegate<%>
      wide-snip<%>
      searching<%>
@@ -177,6 +178,7 @@
      basic% 
      hide-caret/selection%
      nbsp->space%
+     normalize-paste%
      1-pixel-string-snip%
      1-pixel-tab-snip%
      delegate%
@@ -197,6 +199,7 @@
      foreground-color-mixin
      hide-caret/selection-mixin
      nbsp->space-mixin
+     normalize-paste-mixin
      wide-snip-mixin
      delegate-mixin
      searching-mixin

collects/framework/private/text.ss

@@ -821,7 +821,83 @@ WARNING: printf is rebound in the body of the unit to always
         (set! rewriting #f))
       (end-edit-sequence)
       (inner (void) after-insert start len))
-    (super-instantiate ())))
+    (super-new)))
+
+(define normalize-paste<%> (interface ((class->interface text%))
+                             ask-normalize?
+                             string-normalize))
+(define normalize-paste-mixin
+  (mixin (basic<%>) (normalize-paste<%>)
+    (inherit begin-edit-sequence end-edit-sequence
+             delete insert split-snip find-snip
+             get-snip-position get-top-level-window find-string)
+    (define pasting? #f)
+    (define rewriting? #f)
+    
+    (define/public (ask-normalize?)
+      (cond
+        [(preferences:get 'framework:ask-about-paste-normalization)
+         (let-values ([(mbr checked?)
+                       (message+check-box/custom
+                        (string-constant drscheme)
+                        (string-constant normalize-string-info)
+                        (string-constant dont-ask-again)
+                        (string-constant normalize)
+                        (string-constant leave-alone)
+                        #f
+                        (get-top-level-window)
+                        (cons (if (preferences:get 'framework:do-paste-normalization)
+                                  'default=1
+                                  'default=2)
+                              '(caution))
+                        2)])
+           (let ([normalize? (not (equal? 2 mbr))])
+             (preferences:set 'framework:ask-about-paste-normalization (not checked?))
+             (preferences:set 'framework:do-paste-normalization normalize?)
+             normalize?))]
+        [else
+         (preferences:get 'framework:do-paste-normalization)]))
+    (define/public (string-normalize s) (string-normalize-nfkc s))
+
+    
+    
+    (define/override (do-paste start time)
+      (dynamic-wind
+       (λ () (set! pasting? #t))
+       (λ () (super do-paste start time))
+       (λ () (set! pasting? #f))))
+    
+    (define/augment (on-insert start len)
+      (inner (void) on-insert start len)
+      (begin-edit-sequence))
+         
+    (define/augment (after-insert start len)
+      (when pasting?
+        (unless rewriting?
+          (set! rewriting? #t)
+          (let/ec abort
+            (define ask? #t)
+            (split-snip start)
+            (split-snip (+ start len))
+            (let loop ([snip (find-snip start 'after-or-none)])
+              (when snip
+                (let ([next (send snip next)])
+                  (when (is-a? snip string-snip%)
+                    (let* ([old (send snip get-text 0 (send snip get-count))]
+                           [new (string-normalize old)])
+                      (unless (equal? new old)
+                        (when ask?
+                          (set! ask? #f)
+                          (unless (ask-normalize?) (abort)))
+                        (let ([snip-pos (get-snip-position snip)])
+                          (delete snip-pos (+ snip-pos (string-length old)))
+                          (insert new snip-pos snip-pos #f)))))
+                  (loop next)))))
+          (set! rewriting? #f)))
+      (end-edit-sequence)
+      (inner (void) after-insert start len))
+    
+    (super-new)))
 
 (define searching<%> 
   (interface (editor:keymap<%> basic<%>)
@@ -3644,6 +3720,7 @@ designates the character that triggers autocompletion
 (define basic% (basic-mixin (editor:basic-mixin text%)))
 (define hide-caret/selection% (hide-caret/selection-mixin basic%))
 (define nbsp->space% (nbsp->space-mixin basic%))
+(define normalize-paste% (normalize-paste-mixin basic%))
 (define delegate% (delegate-mixin basic%))
 (define wide-snip% (wide-snip-mixin basic%))
 (define standard-style-list% (editor:standard-style-list-mixin wide-snip%))

collects/scribblings/framework/text.scrbl

@@ -302,6 +302,33 @@
     @method[text:nbsp->space-mixin on-insert].
   }
 }
+
+@definterface[text:normalize-paste<%> (text:basic<%>)]{
+  @defmethod[(ask-normalize?) boolean?]{
+    Prompts the user if the pasted text should be normalized 
+    (and updates various preferences based on the response).
+
+    Override this method in the mixin to avoid all GUI and preferences interactions.
+  }
+  @defmethod[(string-normalize [s string?]) string?]{
+    Normalizes @scheme[s]. Defaults to @scheme[string-normalize-nfkc].
+  }
+
+}
+
+@defmixin[text:normalize-paste-mixin (text:basic<%>) (text:normalize-paste<%>)]{
+  @defmethod[#:mode override (do-paste [start exact-nonnegative-integer?] [time (and/c exact? integer?)]) void?]{
+    Overridden to detect when insertions are due to pasting. Sets some internal state and calls the super.
+  }
+  @defmethod[#:mode augment (on-insert [start exact-nonnegative-integer?] [len exact-nonnegative-integer?]) void?]{
+   Calls @method[editor<%> begin-edit-sequence].
+  }
+  @defmethod[#:mode augment (after-insert [start exact-nonnegative-integer?] [len exact-nonnegative-integer?]) void?]{
+    Normalizes any next text and calls @method[editor<%> end-edit-sequence].
+  }
+
+}
+
 @definterface[text:searching<%> (editor:keymap<%> text:basic<%>)]{
   Any object matching this interface can be searched.
 

collects/string-constants/english-string-constants.ss

@@ -1424,4 +1424,11 @@ please adhere to these guidelines:
   (bug-track-forget-all "Forget All")
     
   
+  ;; string normalization. To see this, paste some text with a ligature into DrScheme
+  ;; the first three strings are in the dialog that appears. The last one is in the preferences dialog
+  (normalize "Normalize")
+  (leave-alone "Leave alone")
+  (normalize-string-info "The string you pasted contains ligatures or other non-normalized characters. Normalize them?")
+  (normalize-string-preference "Normalize pasted strings")
+  
   )