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

Delete trailing whitespace on return

Browse Source
This commit is contained in:
Max New 2015-03-09 17:12:43 -05:00 committed by Robby Findler
parent 93a21dd7cd
commit 63038285e5
3 changed files with 61 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
gui-doc/scribblings/framework/racket.scrbl
View File

@ -86,6 +86,7 @@
@defmethod*[(((insert-return) void?))]{
Inserts a newline into the buffer. If @method[racket:text<%>
tabify-on-return?] returns @racket[#t], this will tabify the new line.
Deletes any trailing whitespace from the old line.
}
@defmethod*[(((box-comment-out-selection

36
gui-lib/framework/private/racket.rkt
View File

@ -756,20 +756,28 @@
(define (tabify-all) (tabify-selection 0 (last-position)))
(define (insert-return)
(if (tabify-on-return?)
(begin
(begin-edit-sequence #t #f)
(insert #\newline)
(tabify (get-start-position))
(set-position
(let loop ([new-pos (get-start-position)])
(if (let ([next (get-character new-pos)])
(and (char-whitespace? next)
(not (char=? next #\newline))))
(loop (add1 new-pos))
new-pos)))
(end-edit-sequence))
(insert #\newline)))
(begin-edit-sequence #t #f)
(define end-of-whitespace (get-start-position))
(define start-cutoff
(paragraph-start-position (position-paragraph end-of-whitespace)))
(define start-of-whitespace
(let loop ([pos end-of-whitespace])
(if (and (> pos start-cutoff)
(char-whitespace? (get-character (sub1 pos))))
(loop (sub1 pos))
pos)))
(delete start-of-whitespace end-of-whitespace)
(insert #\newline)
(when (and (tabify-on-return?)
(tabify (get-start-position)))
(set-position
(let loop ([new-pos (get-start-position)])
(if (let ([next (get-character new-pos)])
(and (char-whitespace? next)
(not (char=? next #\newline))))
(loop (add1 new-pos))
new-pos))))
(end-edit-sequence))
(define (calc-last-para last-pos)
(let ([last-para (position-paragraph last-pos #t)])

38
gui-test/framework/tests/racket.rkt
View File

@ -185,6 +185,44 @@
(test-magic-square-bracket 'for/fold1 "(for/fold (" "(for/fold ([")
(test-magic-square-bracket 'for/fold2 "(for/fold ([x 1]) (" "(for/fold ([x 1]) ([")
(define (test-insert-return/proc line before-txt before-pos after-txt after-pos #:tabify? [tabify? #t])
(test
(string->symbol (format "racket:test-insert-return ~a" line))
(λ (x)
(and (equal? (car x) after-pos)
(equal? (cadr x) after-txt)))
(λ ()
(queue-sexp-to-mred
`(let ()
(define t (new (class racket:text%
(define/override (tabify-on-return?) ,tabify?)
(super-new))))
(send t insert ,before-txt)
(send t set-position ,before-pos)
(send t insert-return)
(list (send t get-start-position)
(send t get-text)))))))
(define-syntax (test-insert-return stx)
(syntax-case stx ()
[(_ before-txt before-pos after-txt after-pos . args)
(with-syntax ([line (syntax-line stx)])
#'(test-insert-return/proc line before-txt before-pos after-txt after-pos . args))]))
(test-insert-return "" 0 "\n" 1)
(test-insert-return "" 0 "\n" 1 #:tabify? #f)
(test-insert-return " " 1 "\n" 1)
(test-insert-return " " 1 "\n" 1 #:tabify? #f)
(test-insert-return "( " 2 "(\n " 3)
(test-insert-return "( " 2 "(\n" 2 #:tabify? #f)
(test-insert-return "hellothere" 5 "hello\nthere" 6)
(test-insert-return "hellothere" 5 "hello\nthere" 6 #:tabify? #f)
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 20 "#lang racket\n(+ 123\n 456)\n 4" 22)
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 20 "#lang racket\n(+ 123\n456)\n 4" 20 #:tabify? #f)
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 22 "#lang racket\n(+ 123\n 456)\n 4" 22)
(test-insert-return "#lang racket\n(+ 123 456)\n 4" 22 "#lang racket\n(+ 123\n 456)\n 4" 20 #:tabify? #f)
(test-insert-return "#lang racket\n(+ 123 \n 456)\n 4" 22 "#lang racket\n(+ 123 \n\n 456)\n 4" 24)
(test-insert-return "#lang racket\n(+ 123 \n 456)\n 4" 22 "#lang racket\n(+ 123 \n\n 456)\n 4" 22 #:tabify? #f)
(define (test-message-send/proc line before expected pos msg
#:check-result? [check-result? #f]