Macro stepper: added navigation methods

svn: r7335

original commit: d4e96a80cb7be97f5216a3482d1e49cea59c4d91

collects/macro-debugger/view/cursor.ss

@@ -18,6 +18,7 @@
            cursor:move-prev
            cursor:move-to-start
            cursor:move-to-end
+           cursor:skip-to
 
            cursor->list
            cursor:prefix->list
@@ -116,6 +117,11 @@
       (cursor:move-next c)
       (cursor:move-to-end c)))
 
+  (define (cursor:skip-to c i)
+    (unless (or (eq? (cursor:next c) i) (cursor:at-end? c))
+      (cursor:move-next c)
+      (cursor:skip-to c i)))
+  
   (define (cursor->list c)
     (append (cursor:prefix->list c)
             (cursor:suffix->list c)))

collects/macro-debugger/view/stepper.ss

@@ -216,26 +216,67 @@
 
       ;; Navigate
 
-      (define/private (navigate-to-start)
+      (define/public-final (at-start?)
+        (cursor:at-start? (focused-steps)))
+      (define/public-final (at-end?)
+        (cursor:at-end? (focused-steps)))
+
+      (define/public-final (navigate-to-start)
         (cursor:move-to-start (focused-steps))
         (update/save-position))
-      (define/private (navigate-to-end)
+      (define/public-final (navigate-to-end)
         (cursor:move-to-end (focused-steps))
         (update/save-position))
-      (define/private (navigate-previous)
+      (define/public-final (navigate-previous)
         (cursor:move-prev (focused-steps))
         (update/save-position))
-      (define/private (navigate-next)
+      (define/public-final (navigate-next)
         (cursor:move-next (focused-steps))
         (update/save-position))
 
-      (define/private (navigate-up)
+      (define/public-final (navigate-forward/count n)
+        (unless (integer? n)
+          (raise-type-error 'navigate-forward/count "integer" n))
+        (cond [(zero? n)
+               (update/save-position)]
+              [(positive? n)
+               (cursor:move-next (focused-steps))
+               (navigate-forward/count (sub1 n))]
+              [(negative? n)
+               (cursor:move-prev (focused-steps))
+               (navigate-forward/count (add1 n))]))
+
+      (define/public-final (navigate-forward/pred p)
+        (let* ([cursor (focused-steps)]
+               [steps (and cursor (cursor:suffix->list cursor))]
+               [pred (lambda (s)
+                       (and (rewrite-step? s)
+                            (ormap p (step-foci1 s))
+                            s))]
+               [step (ormap pred steps)])
+          (unless step
+            (error 'navigate-forward/pred "no step matching predicate"))
+          (cursor:skip-to cursor step)
+          (update/save-position)))
+
+      (define/public-final (navigate-up)
         (cursor:move-prev terms)
         (refresh/move))
-      (define/private (navigate-down)
+      (define/public-final (navigate-down)
         (cursor:move-next terms)
         (refresh/move))
 
+      (define/public-final (navigate-down/pred p)
+        (let* ([termlist (cursor:suffix->list terms)]
+               [pred (lambda (trec)
+                       (and (p (lift/deriv-e1 (trec-deriv trec)))
+                            trec))]
+               [term (ormap pred termlist)])
+          (unless term
+            (error 'navigate-down/pred "no term matching predicate"))
+          (cursor:skip-to terms term)
+          (refresh/move)))
+
       ;; insert-step-separator : string -> void
       (define/private (insert-step-separator text)
         (send sbview add-text "\n    ")

collects/macro-debugger/view/view.ss

@@ -13,9 +13,9 @@
     (macro-stepper-frame-mixin
      (frame:standard-menus-mixin
       (frame:basic-mixin frame%))))
-  
+
   ;; Main entry points
-  
+
   (define (make-macro-stepper)
     (let ([f (new macro-stepper-frame%
                   (config (new macro-stepper-config/prefs%)))])
@@ -24,8 +24,9 @@
 
   (define (go stx)
     (let ([stepper (make-macro-stepper)])
-      (send stepper add-deriv (trace stx))))
+      (send stepper add-deriv (trace stx))
-  
+      stepper))
+
   (define (go/deriv deriv)
     (let* ([f (new macro-stepper-frame%)]
            [w (send f get-widget)])