From cb651731d031361df7ec32b6e2dd2514bd33532f Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 17 Apr 2015 11:37:09 -0500 Subject: [PATCH] refactor to introduce compute-amount-to-indent --- gui-doc/scribblings/framework/racket.scrbl | 32 +- gui-lib/framework/private/racket.rkt | 376 +++++++++++---------- gui-lib/info.rkt | 2 +- 3 files changed, 222 insertions(+), 188 deletions(-) diff --git a/gui-doc/scribblings/framework/racket.scrbl b/gui-doc/scribblings/framework/racket.scrbl index 6ba0f0f0..ecf393bf 100644 --- a/gui-doc/scribblings/framework/racket.scrbl +++ b/gui-doc/scribblings/framework/racket.scrbl @@ -42,7 +42,7 @@ } } @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?))]{ Returns a limit for backward-matching parenthesis starting at position @@ -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. @@ -153,11 +173,11 @@ @racket[start-pos]. } - @defmethod*[(((find-up-sexp (start-pos exact-integer?)) - (or/c #f exact-integer?)))]{ - Returns the position of the beginning of the next sexpression outside the - sexpression that contains @racket[start-pos]. If there is no such - sexpression, it returns @racket[#f]. + @defmethod*[(((find-up-sexp (start-pos exact-integer?)) + (or/c #f exact-integer?)))]{ + Returns the position of the beginning of the next sexpression outside the + sexpression that contains @racket[start-pos]. If there is no such + sexpression, it returns @racket[#f]. } @defmethod*[(((up-sexp (start exact-integer?)) void?))]{ diff --git a/gui-lib/framework/private/racket.rkt b/gui-lib/framework/private/racket.rkt index c0d86887..6ed5cb35 100644 --- a/gui-lib/framework/private/racket.rkt +++ b/gui-lib/framework/private/racket.rkt @@ -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,189 +524,200 @@ (define/public (tabify-on-return?) #t) (define/public (tabify [pos (get-start-position)]) - (unless (is-stopped?) - (define tabify-prefs (preferences:get 'framework:tabify)) - (define last-pos (last-position)) + (define amt (compute-amount-to-indent pos)) + (define (do-indent amt) (define para (position-paragraph pos)) - (define is-tabbable? - (and (> para 0) - (not (memq (classify-position (- (paragraph-start-position para) 1)) - '(comment string error))))) - (define end (if is-tabbable? (paragraph-start-position para) 0)) - (define limit (get-limit pos)) - - ;; "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 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 (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) - 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)))]))))) - - (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)) - (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) - (define-values (gwidth curr-offset tab-char?) (find-offset start)) - gwidth) - - (when (and is-tabbable? - (not (char=? (get-character (sub1 end)) - #\newline))) - (insert #\newline (paragraph-start-position para))) - - (cond - [(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-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)) + (define is-tabbable? + (and (> para 0) + (not (memq (classify-position (- (paragraph-start-position para) 1)) + '(comment string error))))) + (define end (if is-tabbable? (paragraph-start-position para) 0)) + (define limit (get-limit pos)) + + ;; "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 (visual-offset pos) + (let loop ([p (sub1 pos)]) + (if (= p -1) + 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)))]))))) + + (define (get-proc) (define id-end (get-forward-sexp contains)) - (define name-length - (if id-end - (- id-end contains) - 0)) - (cond - [(second-sexp-is-ellipsis? contains) - (do-indent (visual-offset contains))] - [(not (find-up-sexp pos)) - (do-indent (visual-offset contains))] - [else - (do-indent (+ (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) - (do-indent (visual-offset last)))))]))) + (and (and id-end (> id-end contains)) + (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) + (define-values (gwidth curr-offset tab-char?) (find-offset start)) + gwidth) + + (when (and is-tabbable? + (not (char=? (get-character (sub1 end)) + #\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. ;; otherwise, returns #f diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index 322fcd43..ce90d168 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.8") +(define version "1.9")