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

the tabber incorrectly counted tab chars as spaces when doing indentation;

Browse Source 
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
This commit is contained in:
Robby Findler 2011-04-08 07:45:48 -05:00
parent 5238c338b6
commit bb792c977d
2 changed files with 60 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/framework/private/scheme.rkt
View File

@ -521,28 +521,32 @@
(letrec (letrec
([find-offset ([find-offset
(λ (start-pos) (λ (start-pos)
(let ([end-pos (define tab-char? #f)
(define end-pos
(let loop ([p start-pos]) (let loop ([p start-pos])
(let ([c (get-character p)]) (let ([c (get-character p)])
(cond (cond
[(char=? c #\tab) [(char=? c #\tab)
(set! tab-char? #t)
(loop (add1 p))] (loop (add1 p))]
[(char=? c #\newline) [(char=? c #\newline)
p] p]
[(char-whitespace? c) [(char-whitespace? c)
(loop (add1 p))] (loop (add1 p))]
[else [else
p])))] p]))))
[start-x (box 0)] (define start-x (box 0))
[end-x (box 0)]) (define end-x (box 0))
(position-location start-pos start-x #f #t #t) (position-location start-pos start-x #f #t #t)
(position-location end-pos end-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" (define-values (w _1 _2 _3)
(send (get-dc) get-text-extent "x"
(send (send (get-style-list) (send (send (get-style-list)
find-named-style "Standard") find-named-style "Standard")
get-font))]) get-font)))
(cons (inexact->exact (floor (/ (- (unbox end-x) (unbox start-x)) w))) (values (inexact->exact (floor (/ (- (unbox end-x) (unbox start-x)) w)))
end-pos))))] end-pos
tab-char?))]
[visual-offset [visual-offset
(λ (pos) (λ (pos)
@ -559,12 +563,11 @@
[else (add1 (loop (sub1 p)))])))))] [else (add1 (loop (sub1 p)))])))))]
[do-indent [do-indent
(λ (amt) (λ (amt)
(let* ([pos-start end] (define pos-start end)
[curr-offset (find-offset pos-start)]) (define-values (gwidth curr-offset tab-char?) (find-offset pos-start))
(unless (= amt (- (cdr curr-offset) pos-start)) (unless (and (not tab-char?) (= amt (- curr-offset pos-start)))
(delete pos-start (cdr curr-offset)) (delete pos-start curr-offset)
(insert (make-string amt #\space) (insert (make-string amt #\space) pos-start)))]
pos-start))))]
[get-proc [get-proc
(λ () (λ ()
(let ([id-end (get-forward-sexp contains)]) (let ([id-end (get-forward-sexp contains)])
@ -589,7 +592,9 @@
(and up-p (and up-p
(equal? #\{ (get-character 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? (when (and is-tabbable?
(not (char=? (get-character (sub1 end)) (not (char=? (get-character (sub1 end))
#\newline))) #\newline)))
@ -598,7 +603,7 @@
[(not is-tabbable?) [(not is-tabbable?)
(when (= para 0) (when (= para 0)
(do-indent 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)) (and (<= (+ 3 real-start) (last-position))
(string=? ";;;" (string=? ";;;"
(get-text real-start (get-text real-start

25
collects/tests/framework/scheme.rkt
View File

@ -29,3 +29,28 @@
(test-text-balanced? 7 "(foo]" 0 #f #t) (test-text-balanced? 7 "(foo]" 0 #f #t)
(test-text-balanced? 8 "{foo} ((bar) [5.9])" 0 #f #t) (test-text-balanced? 8 "{foo} ((bar) [5.9])" 0 #f #t)
(test-text-balanced? 9 "#(1 2 . 3)" 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))")