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

refactor to introduce compute-amount-to-indent

Browse Source
This commit is contained in:
Robby Findler 2015-04-17 11:37:09 -05:00
parent 20520bf88e
commit cb651731d0
3 changed files with 222 additions and 188 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -83,6 +83,26 @@
Tabs all lines.
}
@defmethod[#:mode public-final
(compute-racket-amount-to-indent [pos exact-nonnegative-integer?])
exact-nonnegative-integer?]{
Computes the amount of space to indent the line containing @racket[pos],
using the default s-expression indentation strategy.
@history[#:added "1.9"]
}
@defmethod[#:mode augment
(compute-amount-to-indent [pos exact-nonnegative-integer?])
exact-nonnegative-integer?]{
Computes the amount of space to indent the line containing @racket[pos].
Defaults to using using the default s-expression indentation strategy
via @method[racket:text<%> compute-racket-amount-to-indent].
@history[#:added "1.9"]
}
@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.

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

@ -399,7 +399,10 @@
introduce-let-ans
move-sexp-out
kill-enclosing-parens
toggle-round-square-parens))
toggle-round-square-parens
compute-racket-amount-to-indent
compute-amount-to-indent))
(define init-wordbreak-map
(λ (map)
@ -521,7 +524,50 @@
(define/public (tabify-on-return?) #t)
(define/public (tabify [pos (get-start-position)])
(unless (is-stopped?)
(define amt (compute-amount-to-indent pos))
(define (do-indent amt)
(define para (position-paragraph pos))
(define end (paragraph-start-position para))
(define-values (gwidth curr-offset tab-char?) (find-offset end))
(unless (and (not tab-char?) (= amt (- curr-offset end)))
(delete end curr-offset)
(insert (make-string amt #\space) end)))
(when amt (do-indent amt)))
(define/private (find-offset start-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 sizing-dc (or (get-dc) (make-object bitmap-dc% (make-bitmap 1 1))))
(define-values (w _1 _2 _3)
(send sizing-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?))
(define/pubment (compute-amount-to-indent pos)
(inner (compute-racket-amount-to-indent pos) compute-amount-to-indent pos))
(define/public-final (compute-racket-amount-to-indent pos)
(cond
[(is-stopped?) #f]
[else
(define tabify-prefs (preferences:get 'framework:tabify))
(define last-pos (last-position))
(define para (position-paragraph pos))
@ -562,35 +608,6 @@
(backward-match last limit)))
#f))
(define sizing-dc (or (get-dc) (make-object bitmap-dc% (make-bitmap 1 1))))
(define (find-offset start-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 sizing-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?))
(define (visual-offset pos)
(let loop ([p (sub1 pos)])
(if (= p -1)
@ -604,12 +621,6 @@
[(char=? c #\newline) 0]
[else (add1 (loop (sub1 p)))])))))
(define (do-indent amt)
(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)))
(define (get-proc)
(define id-end (get-forward-sexp contains))
(and (and id-end (> id-end contains))
@ -638,19 +649,21 @@
#\newline)))
(insert #\newline (paragraph-start-position para)))
(define amt-to-indent
(cond
[(not is-tabbable?)
(when (= para 0)
(do-indent 0))]
(if (= para 0)
0
#f)]
[(let-values ([(gwidth real-start tab-char?) (find-offset end)])
(and (<= (+ 3 real-start) (last-position))
(string=? ";;;"
(get-text real-start
(+ 2 real-start)))))
(void)]
#f]
[(not contains)
;; Something went wrong matching. Should we get here?
(do-indent 0)]
0]
[(not last)
;; We can't find a match backward from pos,
;; but we seem to be inside an S-exp, so
@ -658,21 +671,21 @@
;; the associated paren
(define enclosing (find-up-sexp pos))
(if enclosing
(do-indent (+ (visual-offset enclosing) 1))
(do-indent 0))]
(+ (visual-offset enclosing) 1)
0)]
[(= contains last)
;; this is the first expression in the define
(do-indent (+ (visual-offset contains)
(procedure-indent)))]
(+ (visual-offset contains)
(procedure-indent))]
[(and (for/fold-style?)
last2
(= contains last2))
(do-indent (- last (paragraph-start-position last-para)))]
(- last (paragraph-start-position last-para))]
[(or (define-or-lambda-style?)
(for/fold-style?))
;; In case of "define", etc., ignore the position of last
;; and just indent under the "define"
(do-indent (add1 (visual-offset contains)))]
(add1 (visual-offset contains))]
[(= contain-para last-para)
;; So far, the S-exp containing "pos" was all on
;; one line (possibly not counting the opening paren),
@ -686,14 +699,14 @@
0))
(cond
[(second-sexp-is-ellipsis? contains)
(do-indent (visual-offset contains))]
(visual-offset contains)]
[(not (find-up-sexp pos))
(do-indent (visual-offset contains))]
(visual-offset contains)]
[else
(do-indent (+ (visual-offset contains)
(+ (visual-offset contains)
name-length
(indent-first-arg (+ contains
name-length))))])]
name-length)))])]
[else
;; No particular special case, so indent to match first
;; S-expr that starts on the previous line
@ -703,7 +716,8 @@
(position-paragraph next-to-last))])
(if (equal? last-para next-to-last-para)
(loop next-to-last next-to-last-para)
(do-indent (visual-offset last)))))])))
(visual-offset last))))]))
amt-to-indent]))
;; returns #t if `contains' is at a position on a line with an sexp, an ellipsis and nothing else.
;; otherwise, returns #f

2
gui-lib/info.rkt
View File

@ -30,4 +30,4 @@
(define pkg-authors '(mflatt robby))
(define version "1.8")
(define version "1.9")