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

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

@ -42,7 +42,7 @@
} }
} }
@definterface[racket:text<%> (text:basic<%> mode:host-text<%> color:text<%>)]{ @definterface[racket:text<%> (text:basic<%> mode:host-text<%> color:text<%>)]{
Texts matching this interface support Racket mode operations. Texts matching this interface support Racket mode operations.
@defmethod*[(((get-limit (start exact-integer?)) exact-integer?))]{ @defmethod*[(((get-limit (start exact-integer?)) exact-integer?))]{
Returns a limit for backward-matching parenthesis starting at position Returns a limit for backward-matching parenthesis starting at position
@ -83,6 +83,26 @@
Tabs all lines. 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?))]{ @defmethod*[(((insert-return) void?))]{
Inserts a newline into the buffer. If @method[racket:text<%> Inserts a newline into the buffer. If @method[racket:text<%>
tabify-on-return?] returns @racket[#t], this will tabify the new line. tabify-on-return?] returns @racket[#t], this will tabify the new line.
@ -153,11 +173,11 @@
@racket[start-pos]. @racket[start-pos].
} }
@defmethod*[(((find-up-sexp (start-pos exact-integer?)) @defmethod*[(((find-up-sexp (start-pos exact-integer?))
(or/c #f exact-integer?)))]{ (or/c #f exact-integer?)))]{
Returns the position of the beginning of the next sexpression outside the Returns the position of the beginning of the next sexpression outside the
sexpression that contains @racket[start-pos]. If there is no such sexpression that contains @racket[start-pos]. If there is no such
sexpression, it returns @racket[#f]. sexpression, it returns @racket[#f].
} }
@defmethod*[(((up-sexp (start exact-integer?)) void?))]{ @defmethod*[(((up-sexp (start exact-integer?)) void?))]{

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

@ -399,7 +399,10 @@
introduce-let-ans introduce-let-ans
move-sexp-out move-sexp-out
kill-enclosing-parens kill-enclosing-parens
toggle-round-square-parens)) toggle-round-square-parens
compute-racket-amount-to-indent
compute-amount-to-indent))
(define init-wordbreak-map (define init-wordbreak-map
(λ (map) (λ (map)
@ -521,189 +524,200 @@
(define/public (tabify-on-return?) #t) (define/public (tabify-on-return?) #t)
(define/public (tabify [pos (get-start-position)]) (define/public (tabify [pos (get-start-position)])
(unless (is-stopped?) (define amt (compute-amount-to-indent pos))
(define tabify-prefs (preferences:get 'framework:tabify)) (define (do-indent amt)
(define last-pos (last-position))
(define para (position-paragraph pos)) (define para (position-paragraph pos))
(define is-tabbable? (define end (paragraph-start-position para))
(and (> para 0) (define-values (gwidth curr-offset tab-char?) (find-offset end))
(not (memq (classify-position (- (paragraph-start-position para) 1)) (unless (and (not tab-char?) (= amt (- curr-offset end)))
'(comment string error))))) (delete end curr-offset)
(define end (if is-tabbable? (paragraph-start-position para) 0)) (insert (make-string amt #\space) end)))
(define limit (get-limit pos)) (when amt (do-indent amt)))
;; "contains" is the start of the initial sub-S-exp
;; in the S-exp that contains "pos". If pos is outside
;; all S-exps, this will be the start of the initial
;; S-exp
(define contains
(if is-tabbable?
(backward-containing-sexp end limit)
#f))
(define contain-para (and contains
(position-paragraph contains)))
;; last is the start of the S-exp just before "pos"
(define last
(if contains
(let ([p (get-backward-sexp end)])
(if (and p (p . >= . limit))
p
(backward-match end limit)))
#f))
(define last-para (and last (position-paragraph last)))
;; last2 is the start of the S-exp just before the one before "pos"
(define last2
(if last
(let ([p (get-backward-sexp last)])
(if (and p (p . >= . limit))
p
(backward-match last limit)))
#f))
(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 sizing-dc (or (get-dc) (make-object bitmap-dc% (make-bitmap 1 1))))
(define (find-offset start-pos) (define-values (w _1 _2 _3)
(define tab-char? #f) (send sizing-dc get-text-extent "x"
(define end-pos (send (send (get-style-list)
(let loop ([p start-pos]) find-named-style "Standard")
(let ([c (get-character p)]) get-font)))
(cond (values (inexact->exact (floor (/ (- (unbox end-x) (unbox start-x)) w)))
[(char=? c #\tab) end-pos
(set! tab-char? #t) tab-char?))
(loop (add1 p))] (define/pubment (compute-amount-to-indent pos)
[(char=? c #\newline) (inner (compute-racket-amount-to-indent pos) compute-amount-to-indent pos))
p] (define/public-final (compute-racket-amount-to-indent pos)
[(char-whitespace? c) (cond
(loop (add1 p))] [(is-stopped?) #f]
[else [else
p])))) (define tabify-prefs (preferences:get 'framework:tabify))
(define start-x (box 0)) (define last-pos (last-position))
(define end-x (box 0)) (define para (position-paragraph pos))
(position-location start-pos start-x #f #t #t) (define is-tabbable?
(position-location end-pos end-x #f #t #t) (and (> para 0)
(define-values (w _1 _2 _3) (not (memq (classify-position (- (paragraph-start-position para) 1))
(send sizing-dc get-text-extent "x" '(comment string error)))))
(send (send (get-style-list) (define end (if is-tabbable? (paragraph-start-position para) 0))
find-named-style "Standard") (define limit (get-limit pos))
get-font)))
(values (inexact->exact (floor (/ (- (unbox end-x) (unbox start-x)) w)))
end-pos
tab-char?))
(define (visual-offset pos) ;; "contains" is the start of the initial sub-S-exp
(let loop ([p (sub1 pos)]) ;; in the S-exp that contains "pos". If pos is outside
(if (= p -1) ;; all S-exps, this will be the start of the initial
0 ;; S-exp
(let ([c (get-character p)]) (define contains
(cond (if is-tabbable?
[(char=? c #\null) 0] (backward-containing-sexp end limit)
[(char=? c #\tab) #f))
(let ([o (loop (sub1 p))]) (define contain-para (and contains
(+ o (- 8 (modulo o 8))))] (position-paragraph contains)))
[(char=? c #\newline) 0]
[else (add1 (loop (sub1 p)))])))))
(define (do-indent amt) ;; last is the start of the S-exp just before "pos"
(define pos-start end) (define last
(define-values (gwidth curr-offset tab-char?) (find-offset pos-start)) (if contains
(unless (and (not tab-char?) (= amt (- curr-offset pos-start))) (let ([p (get-backward-sexp end)])
(delete pos-start curr-offset) (if (and p (p . >= . limit))
(insert (make-string amt #\space) pos-start))) p
(define (get-proc) (backward-match end limit)))
(define id-end (get-forward-sexp contains)) #f))
(and (and id-end (> id-end contains)) (define last-para (and last (position-paragraph last)))
(let ([text (get-text contains id-end)])
(or (get-keyword-type text tabify-prefs)
'other))))
(define (procedure-indent)
(case (get-proc)
[(begin define) 1]
[(lambda) 3]
[else 0]))
(define (define-or-lambda-style?)
(define proc-name (get-proc))
(or (equal? proc-name 'define)
(equal? proc-name 'lambda)))
(define (for/fold-style?)
(define proc-name (get-proc))
(equal? proc-name 'for/fold))
(define (indent-first-arg start) ;; last2 is the start of the S-exp just before the one before "pos"
(define-values (gwidth curr-offset tab-char?) (find-offset start)) (define last2
gwidth) (if last
(let ([p (get-backward-sexp last)])
(if (and p (p . >= . limit))
p
(backward-match last limit)))
#f))
(when (and is-tabbable? (define (visual-offset pos)
(not (char=? (get-character (sub1 end)) (let loop ([p (sub1 pos)])
#\newline))) (if (= p -1)
(insert #\newline (paragraph-start-position para))) 0
(let ([c (get-character p)])
(cond
[(char=? c #\null) 0]
[(char=? c #\tab)
(let ([o (loop (sub1 p))])
(+ o (- 8 (modulo o 8))))]
[(char=? c #\newline) 0]
[else (add1 (loop (sub1 p)))])))))
(cond (define (get-proc)
[(not is-tabbable?)
(when (= para 0)
(do-indent 0))]
[(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)]
[(not contains)
;; Something went wrong matching. Should we get here?
(do-indent 0)]
[(not last)
;; We can't find a match backward from pos,
;; but we seem to be inside an S-exp, so
;; go "up" an S-exp, and move forward past
;; the associated paren
(define enclosing (find-up-sexp pos))
(if enclosing
(do-indent (+ (visual-offset enclosing) 1))
(do-indent 0))]
[(= contains last)
;; this is the first expression in the define
(do-indent (+ (visual-offset contains)
(procedure-indent)))]
[(and (for/fold-style?)
last2
(= contains last2))
(do-indent (- 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)))]
[(= contain-para last-para)
;; So far, the S-exp containing "pos" was all on
;; one line (possibly not counting the opening paren),
;; so indent to follow the first S-exp's end
;; unless there are just two sexps and the second is an ellipsis.
;; in that case, we just ignore the ellipsis
(define id-end (get-forward-sexp contains)) (define id-end (get-forward-sexp contains))
(define name-length (and (and id-end (> id-end contains))
(if id-end (let ([text (get-text contains id-end)])
(- id-end contains) (or (get-keyword-type text tabify-prefs)
0)) 'other))))
(cond (define (procedure-indent)
[(second-sexp-is-ellipsis? contains) (case (get-proc)
(do-indent (visual-offset contains))] [(begin define) 1]
[(not (find-up-sexp pos)) [(lambda) 3]
(do-indent (visual-offset contains))] [else 0]))
[else (define (define-or-lambda-style?)
(do-indent (+ (visual-offset contains) (define proc-name (get-proc))
name-length (or (equal? proc-name 'define)
(indent-first-arg (+ contains (equal? proc-name 'lambda)))
name-length))))])] (define (for/fold-style?)
[else (define proc-name (get-proc))
;; No particular special case, so indent to match first (equal? proc-name 'for/fold))
;; S-expr that starts on the previous line
(let loop ([last last][last-para last-para]) (define (indent-first-arg start)
(let* ([next-to-last (backward-match last limit)] (define-values (gwidth curr-offset tab-char?) (find-offset start))
[next-to-last-para (and next-to-last gwidth)
(position-paragraph next-to-last))])
(if (equal? last-para next-to-last-para) (when (and is-tabbable?
(loop next-to-last next-to-last-para) (not (char=? (get-character (sub1 end))
(do-indent (visual-offset last)))))]))) #\newline)))
(insert #\newline (paragraph-start-position para)))
(define amt-to-indent
(cond
[(not is-tabbable?)
(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)))))
#f]
[(not contains)
;; Something went wrong matching. Should we get here?
0]
[(not last)
;; We can't find a match backward from pos,
;; but we seem to be inside an S-exp, so
;; go "up" an S-exp, and move forward past
;; the associated paren
(define enclosing (find-up-sexp pos))
(if enclosing
(+ (visual-offset enclosing) 1)
0)]
[(= contains last)
;; this is the first expression in the define
(+ (visual-offset contains)
(procedure-indent))]
[(and (for/fold-style?)
last2
(= contains last2))
(- 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"
(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),
;; so indent to follow the first S-exp's end
;; unless there are just two sexps and the second is an ellipsis.
;; in that case, we just ignore the ellipsis
(define id-end (get-forward-sexp contains))
(define name-length
(if id-end
(- id-end contains)
0))
(cond
[(second-sexp-is-ellipsis? contains)
(visual-offset contains)]
[(not (find-up-sexp pos))
(visual-offset contains)]
[else
(+ (visual-offset contains)
name-length
(indent-first-arg (+ contains
name-length)))])]
[else
;; No particular special case, so indent to match first
;; S-expr that starts on the previous line
(let loop ([last last][last-para last-para])
(let* ([next-to-last (backward-match last limit)]
[next-to-last-para (and next-to-last
(position-paragraph next-to-last))])
(if (equal? last-para next-to-last-para)
(loop next-to-last next-to-last-para)
(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. ;; returns #t if `contains' is at a position on a line with an sexp, an ellipsis and nothing else.
;; otherwise, returns #f ;; otherwise, returns #f

2
gui-lib/info.rkt
View File

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