suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adjust DrRacket so that it saves files with CRLF

Browse Source 
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
This commit is contained in:
Robby Findler 2011-09-30 08:41:58 -05:00
parent 17f11541b4
commit eb943f394e
6 changed files with 148 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/framework/private/frame.rkt
View File

@ -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%

2
collects/framework/private/main.rkt
View File

@ -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?)

5
collects/framework/private/preferences.rkt
View File

@ -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)))

2
collects/framework/private/sig.rkt
View File

@ -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))

86
collects/framework/private/text.rkt
View File

@ -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%)))

19
collects/scribblings/framework/text.scrbl
View File

@ -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.