From 08858776413a9b5f69465586a3fc3f4d4e41a9d2 Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Thu, 21 May 2009 05:35:38 +0000
Subject: [PATCH] ranges for stepper-jump

svn: r14895
---
 collects/stepper/private/model.ss   | 44 +++++++++++++++++++----------
 collects/stepper/view-controller.ss |  9 +++++-
 2 files changed, 37 insertions(+), 16 deletions(-)

diff --git a/collects/stepper/private/model.ss b/collects/stepper/private/model.ss
index 65df49dc15..c313090adb 100644
--- a/collects/stepper/private/model.ss
+++ b/collects/stepper/private/model.ss
@@ -11,7 +11,7 @@
 ; held = NO-HELD-STEP :
 ;  first(x) : held := HELD(x)
 ;  skipped-first : held := SKIPPED-STEP
-;  second(x) : trigger(NO-HELD-STEP, x), held := NO-HELD-STEP
+;  second(x) : trigger(NO-HELD-STEP, x), held := NO-HELD-STEP.
 ;      this happens when evaluating unannotated code
 ;  skipped-second : held := NO-HELD-STEP
 ;      I believe this can also arise in unannotated code
@@ -72,6 +72,12 @@
       . -> .
       void?)])
 
+   
+(define-struct posn-info (posn span))
+
+(provide (struct-out posn-info))
+
+
 ; go starts a stepper instance
 ; see provide stmt for contract
 (define (go program-expander receive-result render-settings
@@ -94,7 +100,7 @@
   ;; the "held" variables are used to store the "before" step.
   (define held-exp-list the-no-sexp)
   
-  (define-struct held (exps was-app? source-pos))
+  (define-struct held (exps was-app? source-info))
   
   (define held-finished-list null)
   
@@ -215,7 +221,9 @@
                                  mark-list returned-value-list render-settings)
                                 #f))
                           (r:step-was-app? mark-list)
-                          (syntax-position (mark-source (car mark-list))))))]
+                          (make-posn-info
+                           (syntax-position (mark-source (car mark-list)))
+                           (syntax-span (mark-source (car mark-list)))))))]
                 
                 [(result-exp-break result-value-break)
                  (let ([reconstruct 
@@ -248,7 +256,7 @@
                       (append (reconstruct-all-completed) (reconstruct))
                       'normal
                       #f #f))]
-                   [(struct held (held-exps held-step-was-app? held-source-pos))
+                   [(struct held (held-exps held-step-was-app? held-posn-info))
                     (let*-values
                         ([(step-kind)
                           (if (and held-step-was-app?
@@ -267,8 +275,11 @@
                       
                       (send-result
                        (make-before-after-result
-                        left-exps right-exps step-kind held-source-pos
-                        (syntax-position (mark-source (car mark-list))))))]))]
+                        left-exps right-exps step-kind 
+                        held-posn-info
+                        (make-posn-info
+                         (syntax-position (mark-source (car mark-list)))
+                         (syntax-span (mark-source (car mark-list)))))))]))]
                 
                 [(double-break)
                  ;; a double-break occurs at the beginning of a let's
@@ -284,13 +295,16 @@
                                         (maybe-lift (car reconstruct-result) #f))]
                         [right-side (map (lambda (exp) (unwind exp render-settings))
                                          (maybe-lift (cadr reconstruct-result) #t))])
-                   ;; add highlighting code as for other cases...
-                   (receive-result
-                    (make-before-after-result
-                     (append new-finished-list left-side)
-                     (append new-finished-list right-side)
-                     'normal
-                     #f #f)))]
+                   (let ([posn-info (make-posn-info
+                                     (syntax-position (mark-source (car mark-list)))
+                                     (syntax-span (mark-source (car mark-list))))])
+                     (receive-result
+                      (make-before-after-result
+                       (append new-finished-list left-side)
+                       (append new-finished-list right-side)
+                       'normal
+                       posn-info
+                       posn-info))))]
                 
                 [(expr-finished-break)
                  (unless (not mark-list)
@@ -323,13 +337,13 @@
     (match held-exp-list
       [(struct no-sexp ())
         (receive-result (make-error-result message))]
-      [(struct held (exps dc source-pos))
+      [(struct held (exps dc posn-info))
        (begin
          (receive-result
           (make-before-error-result (append held-finished-list exps)
                                     message
                                     #f
-                                    source-pos))
+                                    posn-info))
          (set! held-exp-list the-no-sexp))]))
   
   (program-expander
diff --git a/collects/stepper/view-controller.ss b/collects/stepper/view-controller.ss
index b8a2c8b56f..4b571f6037 100644
--- a/collects/stepper/view-controller.ss
+++ b/collects/stepper/view-controller.ss
@@ -169,8 +169,15 @@
   
   ;; is this step on the selected expression?
   (define (selected-exp-step? history-entry)
-    (member selection-posn (step-posns history-entry)))
+    (ormap (posn-in-span selection-posn) (step-posns history-entry)))
   
+  (define ((posn-in-span selection-posn) source-posn-info)
+    (match source-posn-info
+      [#f #f]
+      [(struct model:posn-info (posn span))
+       (and posn
+            (<= posn selection-posn)
+            (< selection-posn (+ posn span)))]))
   
   ;; build gui object: