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.