From bb792c977dfa8a363ec201945527cfaa66a2a33e Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 8 Apr 2011 07:45:48 -0500 Subject: [PATCH] the tabber incorrectly counted tab chars as spaces when doing indentation; this meant that if some line were supposed to be indented in the third column and you had two tabs and a space on that line, the indenter would leave it alone. Now, if it sees tabs in the line anywhere, it just decides that the line is not properly indented and re-indents it (always using spaces) Also: started a tabber test suite --- collects/framework/private/scheme.rkt | 65 ++++++++++++++------------- collects/tests/framework/scheme.rkt | 25 +++++++++++ 2 files changed, 60 insertions(+), 30 deletions(-) diff --git a/collects/framework/private/scheme.rkt b/collects/framework/private/scheme.rkt index 199ad465d9..556a96608a 100644 --- a/collects/framework/private/scheme.rkt +++ b/collects/framework/private/scheme.rkt @@ -521,28 +521,32 @@ (letrec ([find-offset (λ (start-pos) - (let ([end-pos - (let loop ([p start-pos]) - (let ([c (get-character p)]) - (cond - [(char=? c #\tab) - (loop (add1 p))] - [(char=? c #\newline) - p] - [(char-whitespace? c) - (loop (add1 p))] - [else - p])))] - [start-x (box 0)] - [end-x (box 0)]) - (position-location start-pos start-x #f #t #t) - (position-location end-pos end-x #f #t #t) - (let-values ([(w _1 _2 _3) (send (get-dc) get-text-extent "x" - (send (send (get-style-list) - find-named-style "Standard") - get-font))]) - (cons (inexact->exact (floor (/ (- (unbox end-x) (unbox start-x)) w))) - end-pos))))] + (define tab-char? #f) + (define end-pos + (let loop ([p start-pos]) + (let ([c (get-character p)]) + (cond + [(char=? c #\tab) + (set! tab-char? #t) + (loop (add1 p))] + [(char=? c #\newline) + p] + [(char-whitespace? c) + (loop (add1 p))] + [else + p])))) + (define start-x (box 0)) + (define end-x (box 0)) + (position-location start-pos start-x #f #t #t) + (position-location end-pos end-x #f #t #t) + (define-values (w _1 _2 _3) + (send (get-dc) get-text-extent "x" + (send (send (get-style-list) + find-named-style "Standard") + get-font))) + (values (inexact->exact (floor (/ (- (unbox end-x) (unbox start-x)) w))) + end-pos + tab-char?))] [visual-offset (λ (pos) @@ -559,12 +563,11 @@ [else (add1 (loop (sub1 p)))])))))] [do-indent (λ (amt) - (let* ([pos-start end] - [curr-offset (find-offset pos-start)]) - (unless (= amt (- (cdr curr-offset) pos-start)) - (delete pos-start (cdr curr-offset)) - (insert (make-string amt #\space) - pos-start))))] + (define pos-start end) + (define-values (gwidth curr-offset tab-char?) (find-offset pos-start)) + (unless (and (not tab-char?) (= amt (- curr-offset pos-start))) + (delete pos-start curr-offset) + (insert (make-string amt #\space) pos-start)))] [get-proc (λ () (let ([id-end (get-forward-sexp contains)]) @@ -589,7 +592,9 @@ (and up-p (equal? #\{ (get-character up-p))))] - [indent-first-arg (λ (start) (car (find-offset start)))]) + [indent-first-arg (λ (start) + (define-values (gwidth curr-offset tab-char?) (find-offset start)) + gwidth)]) (when (and is-tabbable? (not (char=? (get-character (sub1 end)) #\newline))) @@ -598,7 +603,7 @@ [(not is-tabbable?) (when (= para 0) (do-indent 0))] - [(let ([real-start (cdr (find-offset end))]) + [(let-values ([(gwidth real-start tab-char?) (find-offset end)]) (and (<= (+ 3 real-start) (last-position)) (string=? ";;;" (get-text real-start diff --git a/collects/tests/framework/scheme.rkt b/collects/tests/framework/scheme.rkt index 60e1165c38..e9ca909b9f 100644 --- a/collects/tests/framework/scheme.rkt +++ b/collects/tests/framework/scheme.rkt @@ -29,3 +29,28 @@ (test-text-balanced? 7 "(foo]" 0 #f #t) (test-text-balanced? 8 "{foo} ((bar) [5.9])" 0 #f #t) (test-text-balanced? 9 "#(1 2 . 3)" 0 #f #t) + +(define (test-indentation which before after) + (test + (string->symbol (format "scheme:test-indentation-~a" which)) + (λ (x) (equal? x after)) + (λ () + (queue-sexp-to-mred + `(let* ([t (new scheme:text%)] + [f (new frame% [label ""] [width 600] [height 600])] + [ec (new editor-canvas% [parent f] [editor t])]) + (send f reflow-container) + (send t insert ,before) + (send t tabify-all) + (send t get-text)))))) + +(test-indentation 1 "a" "a") +(test-indentation 2 "(a\n b)" "(a\n b)") +(test-indentation 3 "(a\nb)" "(a\n b)") +(test-indentation 3 "(a b\nc)" "(a b\n c)") +(test-indentation 3 "(a ...\nb)" "(a ...\n b)") +(test-indentation 4 "(lambda (x)\nb)" "(lambda (x)\n b)") +(test-indentation 5 "(lambdaa (x)\nb)" "(lambdaa (x)\n b)") +(test-indentation 6 + "(define x\n (let/ec return\n (when 1\n (when 2\n\t\t 3))\n 2))" + "(define x\n (let/ec return\n (when 1\n (when 2\n 3))\n 2))")