From 7fb3d5c395b64cddf4d1dc2d4af3f9c5e8d3e016 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 4 Jan 2012 10:57:05 -0600 Subject: [PATCH] improve the red highlighting in drracket so that it picks the first thing in the stack that's in the definitions window (instead of just the first thing in the stack period) --- collects/drracket/private/debug.rkt | 27 ++++++++++++++++++--------- collects/drracket/private/rep.rkt | 2 +- 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt index 263fcea935..fa27a9d63e 100644 --- a/collects/drracket/private/debug.rkt +++ b/collects/drracket/private/debug.rkt @@ -286,17 +286,19 @@ profile todo: [stack2 (if (exn? exn) (map cdr (filter cdr (cut-stack-at-checkpoint exn))) '())] + [port-name-matches-cache (make-hasheq)] + [stack1-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack1)] + [stack2-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack2)] [src-locs (cond [(exn:srclocs? exn) ((exn:srclocs-accessor exn) exn)] + [(pick-first-defs port-name-matches-cache defs stack1) => list] + [(pick-first-defs port-name-matches-cache defs stack2) => list] [(pair? stack1) (list (car stack1))] [(pair? stack2) (list (car stack2))] [else '()])] - [port-name-matches-cache (make-hasheq)] - [stack1-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack1)] - [stack2-editions (map (λ (x) (srcloc->edition/pair defs ints x port-name-matches-cache)) stack2)] [src-locs-edition (and (pair? src-locs) (srcloc->edition/pair defs ints (car src-locs) port-name-matches-cache))]) @@ -330,16 +332,12 @@ profile todo: [(and (or (symbol? src) (path? src)) ints - (if port-name-matches-cache - (hash-ref! port-name-matches-cache (cons ints src) (λ () (send ints port-name-matches? src))) - (send ints port-name-matches? src))) + (port-name-matches?/use-cache ints src port-name-matches-cache)) (cons (make-weak-box ints) (send ints get-edition-number))] [(and (or (symbol? src) (path? src)) defs - (if port-name-matches-cache - (hash-ref! port-name-matches-cache (cons defs src) (λ () (send defs port-name-matches? src))) - (send defs port-name-matches? src))) + (port-name-matches?/use-cache defs src port-name-matches-cache)) (cons (make-weak-box defs) (send defs get-edition-number))] [(path? src) (let ([frame (send (group:get-the-frame-group) locate-file src)]) @@ -349,6 +347,17 @@ profile todo: (send (send frame get-definitions-text) get-edition-number))))] [else #f]))) + (define (pick-first-defs port-name-matches-cache defs stack) + (for/or ([srcloc (in-list stack)]) + (and (srcloc? srcloc) + (port-name-matches?/use-cache defs (srcloc-source srcloc) port-name-matches-cache) + srcloc))) + + (define (port-name-matches?/use-cache txt src port-name-matches-cache) + (if port-name-matches-cache + (hash-ref! port-name-matches-cache (cons txt src) (λ () (send txt port-name-matches? src))) + (send txt port-name-matches? src))) + ;; =User= (define (print-planet-icon-to-stderr exn) (when (exn:fail:contract:blame? exn) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index ef30b47836..7f5dc3a747 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -605,7 +605,7 @@ TODO (λ () (set! clear-error-highlighting void) (for-each (λ (x) (x)) resets))))) - + (let* ([first-loc (and (pair? locs) (car locs))] [first-file (and first-loc (srcloc-source first-loc))] [first-start (and first-loc (- (srcloc-position first-loc) 1))]