refactor to introduce compute-amount-to-indent

gui-doc/scribblings/framework/racket.scrbl

@@ -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.

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,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)
+              (if (= para 0)
-             (do-indent 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))
+                  (+ (visual-offset enclosing) 1)
-               (do-indent 0))]
+                  0)]
              [(= contains last)
               ;; this is the first expression in the define
-           (do-indent (+ (visual-offset contains)
+              (+ (visual-offset contains)
-                         (procedure-indent)))]
+                 (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

gui-lib/info.rkt

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