diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt index 6d7b865cc5..6c0e4b9f2d 100644 --- a/collects/drracket/private/debug.rkt +++ b/collects/drracket/private/debug.rkt @@ -27,7 +27,6 @@ profile todo: racket/match mrlib/include-bitmap images/compile-time - syntax/rect (for-syntax images/icons/misc images/icons/style images/icons/control images/logos) (for-syntax racket/base)) @@ -304,13 +303,9 @@ profile todo: [(pair? stack2) (list (car stack2))] [else '()])] - [srcloc-rects (cond - [(and (exn:srcloc-rects? exn) - (exn:srclocs? exn)) ;; only look at the rects when the exn has srclocs - ((exn:srcloc-rects-accessor exn) exn)] - [else #f])] [src-locs-edition (and (pair? src-locs) (srcloc->edition/pair defs ints (car src-locs) port-name-matches-cache))]) + (print-planet-icon-to-stderr exn) (unless (exn:fail:user? exn) (unless (exn:fail:syntax? exn) @@ -331,12 +326,9 @@ profile todo: (λ () ;; need to make sure that the user's eventspace is still the same ;; and still running here? - (send ints highlight-errors - src-locs - (if (null? stack1) - stack2 - stack1) - srcloc-rects))))))) + (send ints highlight-errors src-locs (if (null? stack1) + stack2 + stack1)))))))) (define (srcloc->edition/pair defs ints srcloc [port-name-matches-cache #f]) (let ([src (srcloc-source srcloc)]) diff --git a/collects/drracket/private/eval.rkt b/collects/drracket/private/eval.rkt index 1fb1c07f71..c8cebc7c06 100644 --- a/collects/drracket/private/eval.rkt +++ b/collects/drracket/private/eval.rkt @@ -185,8 +185,7 @@ (define to-be-copied-module-specs (list ''#%foreign '(lib "mzlib/pconvert-prop.rkt") - '(lib "planet/terse-info.rkt") - '(lib "syntax/rect.rkt"))) + '(lib "planet/terse-info.rkt"))) ;; ensure that they are all here. (for-each (λ (x) (dynamic-require x #f)) to-be-copied-module-specs) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index 363da4d1c4..9f4d804aad 100644 --- a/collects/drracket/private/rep.rkt +++ b/collects/drracket/private/rep.rkt @@ -23,7 +23,6 @@ TODO racket/port racket/set - syntax/rect string-constants setup/xref racket/gui/base @@ -543,66 +542,10 @@ TODO ;; error-ranges : (union false? (cons srcloc (listof srcloc))) (define error-ranges #f) (define/public (get-error-ranges) error-ranges) - (define/public (set-error-ranges srclocs [srcloc-rects #f]) - (define candidate-srclocs - (and srclocs - (not (null? srclocs)) - (cleanup-locs srclocs))) - (cond - [(and candidate-srclocs srcloc-rects) - (set! error-ranges - (apply - append - (for/list ([srcloc (in-list candidate-srclocs)]) - (define pending-range-start #f) - (define pending-range-end #f) - (define srclocs '()) - (for ([pos (in-range (srcloc-position srcloc) - (+ (srcloc-position srcloc) - (srcloc-span srcloc)))]) - (define keep-pos? - (for/or ([srcloc-rect (in-list srcloc-rects)] - #:when (equal? (srcloc-rect-source srcloc-rect) - (srcloc-source range))) - (pos-in-rect? pos srcloc-rect))) - - (when keep-pos? - (cond - [(not pending-range-start) - (set! pending-range-start pos) - (set! pending-range-end pos)] - [(= (+ pending-range-end 1) pos) - (set! pending-range-end pos)] - [else - (set! srclocs (cons (srcloc (srcloc-source srcloc) - #f #f - pending-range-start - (- pending-range-end pending-range-start)) - srclocs)) - (set! pending-range-start pos) - (set! pending-range-end pos)]))) - srclocs)))] - [else - (set! error-ranges candidate-srclocs)])) - - (define/private (pos-in-rect? pos srcloc-rect) - (define src (srcloc-rect-source srcloc-rect)) - (define height (srcloc-rect-height srcloc-rect)) - (define width (srcloc-rect-width srcloc-rect)) - (cond - [(is-a? src text%) - (define start-para (send src position-paragraph (srcloc-rect-pos srcloc-rect))) - (define para-offset (- (srcloc-rect-pos srcloc-rect) start-para)) - (let loop ([this-line-start (srcloc-rect-pos srcloc-rect)] - [y 0]) - (cond - [(= y height) #f] - [(<= this-line-start pos (+ this-line-start width)) #t] - [else - (loop (+ (send src paragraph-start-position (+ start-para y)) para-offset) - (+ y 1))]))] - [else #f])) - + (define/public (set-error-ranges ranges) + (set! error-ranges (and ranges + (not (null? ranges)) + (cleanup-locs ranges)))) (define clear-error-highlighting void) (define/public (reset-error-ranges) (set-error-ranges #f) @@ -625,12 +568,11 @@ TODO ;; =Kernel= =handler= ;; highlight-errors : (listof srcloc) ;; (union #f (listof srcloc)) - ;; (union #f (listof srcloc-rect)) ;; -> (void) - (define/public (highlight-errors raw-locs [raw-error-arrows #f] [srcloc-rects #f]) + (define/public (highlight-errors raw-locs [raw-error-arrows #f]) (clear-error-highlighting) (when definitions-text (send definitions-text set-error-arrows #f)) - (set-error-ranges raw-locs srcloc-rects) + (set-error-ranges raw-locs) (define locs (or (get-error-ranges) '())) ;; calling set-error-range cleans up the locs (define error-arrows (and raw-error-arrows (cleanup-locs raw-error-arrows))) @@ -681,7 +623,7 @@ TODO (send tlw ensure-defs-shown)))) (send first-file set-caret-owner (get-focus-snip) 'global)))) - + ;; unlike highlight-error just above, this function does not change ;; what the currently noted errors locations are, it just highlights ;; one of them. diff --git a/collects/syntax/rect.rkt b/collects/syntax/rect.rkt deleted file mode 100644 index 2c361dcd13..0000000000 --- a/collects/syntax/rect.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket/base -(provide (struct-out exn:fail:syntax/rects) - (struct-out exn:fail:read/rects) - (struct-out exn:fail:read:eof/rects) - (struct-out exn:fail:read:non-char/rects) - (struct-out srcloc-rect) - prop:exn:srcloc-rects - exn:srcloc-rects? - exn:srcloc-rects-accessor) - -(define-values (prop:exn:srcloc-rects exn:srcloc-rects? exn:srcloc-rects-accessor) - (make-struct-type-property 'exn:srcloc-rects)) - -(struct exn:fail:syntax/rects exn:fail:syntax (rects) - #:property prop:exn:srcloc-rects (λ (x) (exn:fail:syntax/rects-rects x))) - -(struct exn:fail:read/rects exn:fail:read (rects) - #:property prop:exn:srcloc-rects (λ (x) (exn:fail:read/rects-rects x))) -(struct exn:fail:read:eof/rects exn:fail:read:eof (rects) - #:property prop:exn:srcloc-rects (λ (x) (exn:fail:read:eof/rects-rects x))) -(struct exn:fail:read:non-char/rects exn:fail:read:non-char (rects) - #:property prop:exn:srcloc-rects (λ (x) (exn:fail:read:non-char/rects-rects x))) - -(struct srcloc-rect (source pos width height) #:transparent)