suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add a little more info into the build-rectangle check for when it fails

Browse Source 
original commit: 4af72a5825c4296885eb1dc8fe374331e2697123
This commit is contained in:
Robby Findler 2012-11-26 23:29:43 -06:00
parent 76834746c1
commit 5717adf512
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/framework/private/text.rkt
View File

@ -41,15 +41,17 @@
(define-struct range (start end caret-space? style color [rectangles #:mutable]) #:inspector #f) (define-struct range (start end caret-space? style color [rectangles #:mutable]) #:inspector #f)
(define-struct rectangle (left top right bottom style color) #:inspector #f) (define-struct rectangle (left top right bottom style color) #:inspector #f)
(define (build-rectangle left top right bottom style color) (define (build-rectangle left top right bottom style color [info (λ () "")])
(unless (or (symbol? right) (symbol? left)) (unless (or (symbol? right) (symbol? left))
(when (right . < . left) (when (right . < . left)
(error 'build-rectangle "found right to the right of left: ~s" (error 'build-rectangle "found right to the right of left: ~s; info ~a"
(list left top right bottom style color)))) (list left top right bottom style color)
(info))))
(unless (or (symbol? top) (symbol? bottom)) (unless (or (symbol? top) (symbol? bottom))
(when (bottom . < . top) (when (bottom . < . top)
(error 'build-rectangle "found bottom above top: ~s" (error 'build-rectangle "found bottom above top: ~s; info ~a"
(list left top right bottom style color)))) (list left top right bottom style color)
(info))))
(make-rectangle left top right bottom style color)) (make-rectangle left top right bottom style color))
@ -235,7 +237,11 @@
end-x) end-x)
bottom-start-y bottom-start-y
style style
color))] color
(λ () (format "start = ~s end = ~s filename = ~s content = ~s"
start end
(send this get-filename)
(send this get-text 0 100)))))]
[(or (eq? style 'hollow-ellipse) [(or (eq? style 'hollow-ellipse)
(eq? style 'ellipse)) (eq? style 'ellipse))
(define end-line (position-line end end-eol?)) (define end-line (position-line end end-eol?))