From eb943f394e8cd2f7fae414e2468f3a48ded30db0 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 30 Sep 2011 08:41:58 -0500 Subject: [PATCH] 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 | 53 ++++++++++++- collects/framework/private/main.rkt | 2 + collects/framework/private/preferences.rkt | 5 ++ collects/framework/private/sig.rkt | 2 + collects/framework/private/text.rkt | 86 ++++++++++++++++++---- collects/scribblings/framework/text.scrbl | 19 +++++ 6 files changed, 148 insertions(+), 19 deletions(-) diff --git a/collects/framework/private/frame.rkt b/collects/framework/private/frame.rkt index c3ab42c9..78458089 100644 --- a/collects/framework/private/frame.rkt +++ b/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,14 +1106,25 @@ [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)) (send (get-info-panel) change-children (λ (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% diff --git a/collects/framework/private/main.rkt b/collects/framework/private/main.rkt index c0e8ed90..0b85867a 100644 --- a/collects/framework/private/main.rkt +++ b/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?) diff --git a/collects/framework/private/preferences.rkt b/collects/framework/private/preferences.rkt index 2e98c591..24dd3d9f 100644 --- a/collects/framework/private/preferences.rkt +++ b/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))) diff --git a/collects/framework/private/sig.rkt b/collects/framework/private/sig.rkt index 9f432003..d44b5673 100644 --- a/collects/framework/private/sig.rkt +++ b/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)) diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt index 28fc67b6..8f5750fe 100644 --- a/collects/framework/private/text.rkt +++ b/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, @@ -1754,9 +1761,9 @@ (define clever-file-format-mixin (mixin ((class->interface text%)) (clever-file-format<%>) (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) - line-x ; int the x coordinate of the line where the menu goes - 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 + (init-field completions ; scroll-manager% + ; the possible completions (all of which have base-word as a prefix) + line-x ; int + ; the x coordinate of the line where the menu goes + 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))))) - (set! highlighted-menu-item (vector-ref (geometry-mouse->menu-item-vector geometry) (inexact->exact (- y my)))) + (< (+ my menu-padding-y) + 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%))) diff --git a/collects/scribblings/framework/text.scrbl b/collects/scribblings/framework/text.scrbl index cb81645e..83899a11 100644 --- a/collects/scribblings/framework/text.scrbl +++ b/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.