Adjust DrRacket so that it saves files with CRLF

line terminators when:

  a) running under windows, and
  b) the file on the disk (when DrRacket first opens it)
     contains all CRLF line endings.

In all other situations, the file is saved with LF terminators.

Before this commit, DrRacket would always use the platform-specific
convention, regardless of the original content of the file.

closes PR 12242

original commit: 4a2757f2004fa84901cbae7ff9a257616ce7acaa

collects/framework/private/frame.rkt

@@ -921,6 +921,7 @@
                        overwrite-status-changed
                        anchor-status-changed
                        editor-position-changed
+                       use-file-text-mode-changed
                        add-line-number-menu-items))
 (define text-info-mixin
   (mixin (info<%>) (text-info<%>)
@@ -1077,12 +1078,24 @@
     (define/public (add-line-number-menu-items menu)
       (void))
     
+    (define/public (use-file-text-mode-changed)
+      (when (object? file-text-mode-msg)
+        (define ed (get-info-editor))
+        (send file-text-mode-msg-parent change-children
+              (λ (l)
+                (if (and (is-a? ed text:info<%>)
+                         (eq? (system-type) 'windows)
+                         (send ed use-file-text-mode))
+                  (list file-text-mode-msg)
+                  '())))))
+    
     (define/override (update-info)
       (super update-info)
       (update-macro-recording-icon)
       (overwrite-status-changed)
       (anchor-status-changed)
-      (editor-position-changed))
+      (editor-position-changed)
+      (use-file-text-mode-changed))
     (super-new)
     
     (inherit get-info-panel)
@@ -1093,7 +1106,9 @@
                                  [stretchable-width #f]
                                  [stretchable-height #f]
                                  [extra-menu-items (λ (menu) (add-line-number-menu-items menu))]))
-    (define position-canvas (new position-canvas% [parent position-parent] [init-width "000:00-000:00"]))
+    (define position-canvas (new position-canvas% 
+                                 [parent position-parent] 
+                                 [init-width "000:00-000:00"]))
     (define/private (change-position-edit-contents str)
       (send position-canvas set-str str))
     
@@ -1101,6 +1116,15 @@
           (λ (l)
             (cons position-parent (remq position-parent l))))
 
+    (define file-text-mode-msg-parent (new horizontal-panel%
+                                           [stretchable-width #f]
+                                           [stretchable-height #f]
+                                           [parent (get-info-panel)]))
+    (define file-text-mode-msg (new file-text-mode-msg% [parent file-text-mode-msg-parent]))
+    (send file-text-mode-msg-parent change-children (λ (l) '()))
+    (send (get-info-panel) change-children
+          (λ (l)
+            (cons file-text-mode-msg-parent (remq file-text-mode-msg-parent l))))
     
     (define-values (anchor-message
                     overwrite-message 
@@ -1133,7 +1157,28 @@
     (send macro-recording-message show #f)
     (send anchor-message show #f)
     (send overwrite-message show #f)
-    (editor-position-changed)))
+    (editor-position-changed)
+    (use-file-text-mode-changed)))
+
+(define crlf-string "CRLF")
+(define file-text-mode-msg%
+  (class canvas%
+    (inherit min-width min-height get-dc refresh)
+    (define/override (on-paint)
+      (define dc (get-dc))
+      (send dc set-pen "black" 1 'transparent)
+      (send dc set-brush "orange" 'solid)
+      (define-values (w h d a) (send dc get-text-extent crlf-string))
+      (send dc draw-rectangle 0 0 (+ w 4) h)
+      (send dc draw-text crlf-string 2 0))
+    (super-new)
+    (inherit stretchable-width)
+    (stretchable-width #f)
+    (send (get-dc) set-font small-control-font)
+    (let ()
+      (define-values (w h d a) (send (get-dc) get-text-extent crlf-string))
+      (min-width (inexact->exact (ceiling (+ w 4))))
+      (min-height (inexact->exact (ceiling h))))))         
 
 (define click-pref-panel%
   (class horizontal-panel%

collects/framework/private/main.rkt

@@ -25,6 +25,8 @@
 ;; used to time how long it takes to set a preference; the value is not actually used.
 (preferences:set-default 'drracket:prefs-debug #f (λ (x) #t))
 
+(preferences:set-default 'framework:always-use-platform-specific-linefeed-convention #f boolean?)
+
 (preferences:set-default 'framework:overwrite-mode-keybindings #f boolean?)
 
 (preferences:set-default 'framework:ask-about-paste-normalization #t boolean?)

collects/framework/private/preferences.rkt

@@ -494,6 +494,11 @@ the state transitions / contracts are:
                                'framework:automatic-parens
                                (string-constant enable-automatic-parens)
                                values values)
+                   (when (eq? (system-type) 'windows)
+                     (make-check editor-panel
+                                 'framework:always-use-platform-specific-linefeed-convention
+                                 (string-constant always-use-platform-specific-linefeed-convention)
+                                 values values))
                    (editor-panel-procs editor-panel))))])
       (add-editor-checkbox-panel)))
   

collects/framework/private/sig.rkt

@@ -181,6 +181,7 @@
      info<%>
      file<%>
      clever-file-format<%>
+     crlf-line-endings<%>
      ports<%>
      input-box<%>
      autocomplete<%>
@@ -218,6 +219,7 @@
      info-mixin
      file-mixin
      clever-file-format-mixin
+     crlf-line-endings-mixin
      ports-mixin
      input-box-mixin
      autocomplete-mixin))

collects/framework/private/text.rkt

@@ -1724,6 +1724,13 @@
     (define/augment (after-set-position)
       (maybe-queue-editor-position-update)
       (inner (void) after-set-position))
+    (define/override use-file-text-mode
+      (case-lambda
+        [() (super use-file-text-mode)]
+        [(x) (super use-file-text-mode x)
+             (enqueue-for-frame
+              (λ (x) (send x use-file-text-mode-changed))
+              'framework:file-text-mode-changed)]))
     
     ;; maybe-queue-editor-position-update : -> void
     ;; updates the editor-position in the frame,
@@ -1756,7 +1763,7 @@
     (inherit get-file-format set-file-format find-first-snip)
       
     ;; all-string-snips : -> boolean
-    ;; returns #t when it is safe to save this file in 'text mode.
+    ;; returns #t when it is safe to save this file in regular (non-WXME) mode.
     (define/private (all-string-snips)
       (let loop ([s (find-first-snip)])
         (cond
@@ -1788,7 +1795,41 @@
            (set-file-format 'standard)]
           [else (void)]))
       (inner (void) on-save-file name format))
-    (super-instantiate ())))
+    
+    (super-new)))
+
+(define unix-line-endings-regexp #rx"(^$)|((^|[^\r])\n)")
+(unless (and (regexp-match? unix-line-endings-regexp "")
+             (regexp-match? unix-line-endings-regexp "\n")
+             (regexp-match? unix-line-endings-regexp "a\n")
+             (not (regexp-match? unix-line-endings-regexp "\r\n"))
+             (regexp-match? unix-line-endings-regexp "x\ny\r\nz\n")
+             (regexp-match? unix-line-endings-regexp "\n\r\n")
+             (not (regexp-match? unix-line-endings-regexp "a\r\nb\r\nc\r\n"))
+             (regexp-match? unix-line-endings-regexp "a\r\nb\r\nc\n")
+             (regexp-match? unix-line-endings-regexp "a\nb\r\nc\r\n"))
+  (error 'framework/private/text.rkt "unix-line-endings-regexp test failure"))
+
+(define crlf-line-endings<%> (interface ((class->interface text%))))
+
+(define crlf-line-endings-mixin
+  (mixin ((class->interface text%)) (crlf-line-endings<%>)
+    (inherit get-filename use-file-text-mode)
+    (define/augment (after-load-file success?)
+      (cond
+        [(preferences:get 'framework:always-use-platform-specific-linefeed-convention)
+         (define unix-endings?
+           (with-handlers ((exn:fail:filesystem? (λ (x) #t)))
+             (call-with-input-file (get-filename)
+               (λ (port)
+                 (regexp-match? unix-line-endings-regexp port)))))
+         (use-file-text-mode
+          (and (eq? (system-type) 'windows) 
+               unix-endings?))]
+        [else (use-file-text-mode #t)])
+      (inner (void) after-load-file success?))
+
+    (super-new)))
 
 
 (define file<%>
@@ -3464,11 +3505,16 @@ designates the character that triggers autocompletion
 (define completion-box% 
   (class* object% (completion-box<%>)
     
-    (init-field completions       ; scroll-manager%       the possible completions (all of which have base-word as a prefix)
+    (init-field completions       ; scroll-manager%      
-                line-x            ; int                   the x coordinate of the line where the menu goes
+                ;                   the possible completions (all of which have base-word as a prefix)
-                line-y-above      ; int                   the y coordinate of the top of the line where the menu goes
+                line-x            ; int                  
-                line-y-below      ; int                   the y coordinate of the bottom of the line where the menu goes
+                ;                   the x coordinate of the line where the menu goes
-                editor            ; editor<%>             the owner of this completion box
+                line-y-above      ; int                   
+                ;                   the y coordinate of the top of the line where the menu goes
+                line-y-below      ; int                  
+                ;                   the y coordinate of the bottom of the line where the menu goes
+                editor            ; editor<%>             
+                ;                   the owner of this completion box
                 )
     
     (define/public (empty?) (send completions empty?))
@@ -3524,7 +3570,9 @@ designates the character that triggers autocompletion
                  (cond
                    [(null? pc)
                     (let-values ([(hidden?) (send completions items-are-hidden?)] 
-                                 [(tw th _1 _2) (send dc get-text-extent hidden-completions-text (get-reg-font))])
+                                 [(tw th _1 _2) (send dc get-text-extent
+                                                      hidden-completions-text
+                                                      (get-reg-font))])
                       (let ([w (if hidden? (max tw w) w)]
                             [h (if hidden? (+ th h) h)])
                         (initialize-mouse-offset-map! coord-map)
@@ -3578,7 +3626,10 @@ designates the character that triggers autocompletion
           [(send completions empty?)
            (let ([font (send dc get-font)])
              (send dc set-font (get-mt-font))
-             (send dc draw-text (string-constant no-completions) (+ mx dx menu-padding-x) (+ menu-padding-y my dy))
+             (send dc draw-text 
+                   (string-constant no-completions) 
+                   (+ mx dx menu-padding-x)
+                   (+ menu-padding-y my dy))
              (send dc set-font font))]
           [else
            (send dc set-font (get-reg-font))
@@ -3641,7 +3692,8 @@ designates the character that triggers autocompletion
          (set! highlighted-menu-item 0)
          (scroll-display-down)]
         [else
-         (set! highlighted-menu-item (modulo (add1 highlighted-menu-item) (send completions get-visible-length)))
+         (set! highlighted-menu-item (modulo (add1 highlighted-menu-item)
+                                             (send completions get-visible-length)))
          (redraw)]))
     
     ;; prev-item : -> void
@@ -3654,7 +3706,8 @@ designates the character that triggers autocompletion
                (sub1 (send completions get-visible-length)))
          (scroll-display-up)]
         [else
-         (set! highlighted-menu-item (modulo (sub1 highlighted-menu-item) (send completions get-visible-length)))
+         (set! highlighted-menu-item (modulo (sub1 highlighted-menu-item)
+                                             (send completions get-visible-length)))
          (redraw)]))
     
     ;; scroll-display-down : -> void
@@ -3697,8 +3750,11 @@ designates the character that triggers autocompletion
     (define/public (handle-mouse-movement x y)
       (let*-values ([(mx my w h) (get-menu-coordinates)])
         (when (and (<= mx x (+ mx w))
-                   (< (+ my menu-padding-y) y (+ my (vector-length (geometry-mouse->menu-item-vector geometry)))))
+                   (< (+ my menu-padding-y)
-          (set! highlighted-menu-item (vector-ref (geometry-mouse->menu-item-vector geometry) (inexact->exact (- y my))))
+                      y 
+                      (+ my (vector-length (geometry-mouse->menu-item-vector geometry)))))
+          (set! highlighted-menu-item (vector-ref (geometry-mouse->menu-item-vector geometry)
+                                                  (inexact->exact (- y my))))
           (redraw))))
     
     ;; get-current-selection : -> string
@@ -4100,7 +4156,7 @@ designates the character that triggers autocompletion
 (define return% (return-mixin -keymap%))
 (define autowrap% (editor:autowrap-mixin -keymap%))
 (define file% (file-mixin (editor:file-mixin autowrap%)))
-(define clever-file-format% (clever-file-format-mixin file%))
+(define clever-file-format% (crlf-line-endings-mixin (clever-file-format-mixin file%)))
 (define backup-autosave% (editor:backup-autosave-mixin clever-file-format%))
 (define searching% (searching-mixin backup-autosave%))
 (define info% (info-mixin (editor:info-mixin searching%)))

collects/scribblings/framework/text.scrbl

@@ -699,6 +699,25 @@
   }
 }
 
+@definterface[text:crlf-line-endings<%> (text%)]{
+  Objects supporting this interface use 
+  @method[editor<%> use-file-text-mode] to
+  change the line ending style under windows. See 
+  @method[text:crlf-line-endings-mixin after-load-file] for more information.
+}
+
+
+@defmixin[text:crlf-line-endings-mixin (text%) (text:crlf-line-endings<%>)]{
+  @defmethod[#:mode override (after-load-file [success? any/c]) void?]{
+    Checks to see if the newly loaded file has any lines terminated with 
+    @racket["\n"] (i.e., not @racket["\r\n"]) or if the file is empty. 
+    If so, and if the @racket[system-type] returns @racket['windows], then
+    this method calls @method[editor<%> use-file-text-mode], passing @racket[#f]. 
+    
+    Otherwise, calls @method[editor<%> use-file-text-mode] with @racket[#t].
+  }
+}
+
 @definterface[text:file<%> (editor:file<%> text:basic<%>)]{
   Mixins that implement this interface lock themselves when the file they are
   editing is read only.