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

Use object=? instead of eq? to handle equality for contracted objects

Browse Source
This commit is contained in:
Daniel Feltey 2015-03-01 20:06:20 -05:00 committed by Matthew Flatt
parent b3457212d2
commit 93a21dd7cd
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gui-lib/mred/private/wxme/pasteboard.rkt
View File

@ -237,7 +237,7 @@
;; find snip: ;; find snip:
(let ([snip (find-snip x y)]) (let ([snip (find-snip x y)])
(and snip (and snip
(eq? snip s-caret-snip) (object-or-false=? snip s-caret-snip)
(let-boxes ([x 0.0] [y 0.0]) (let-boxes ([x 0.0] [y 0.0])
(get-snip-location snip x y) (get-snip-location snip x y)
(let ([c (send snip adjust-cursor dc (- x scrollx) (- y scrolly) (let ([c (send snip adjust-cursor dc (- x scrollx) (- y scrolly)
@ -260,7 +260,7 @@
(values dc (+ x scrollx) (+ y scrolly) scrollx scrolly)))]) (values dc (+ x scrollx) (+ y scrolly) scrollx scrolly)))])
(let ([snip (find-snip x y)]) (let ([snip (find-snip x y)])
(when (and prev-mouse-snip (when (and prev-mouse-snip
(not (eq? snip prev-mouse-snip))) (not (object-or-false=? snip prev-mouse-snip)))
(let ([loc (snip->loc prev-mouse-snip)]) (let ([loc (snip->loc prev-mouse-snip)])
(send prev-mouse-snip on-event (send prev-mouse-snip on-event
dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly) dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly)
@ -269,7 +269,7 @@
(set! prev-mouse-snip #f) (set! prev-mouse-snip #f)
(when (and snip (when (and snip
(has-flag? (snip->flags snip) HANDLES-ALL-MOUSE-EVENTS) (has-flag? (snip->flags snip) HANDLES-ALL-MOUSE-EVENTS)
(not (eq? snip s-caret-snip))) (not (object-or-false=? snip s-caret-snip)))
(let ([loc (snip->loc snip)]) (let ([loc (snip->loc snip)])
(set! prev-mouse-snip snip) (set! prev-mouse-snip snip)
(send snip on-event (send snip on-event
@ -278,7 +278,7 @@
event))) event)))
(if (and s-caret-snip (if (and s-caret-snip
(or (not (send event button-down?)) (or (not (send event button-down?))
(eq? snip s-caret-snip))) (object-or-false=? snip s-caret-snip)))
(let ([loc (snip->loc s-caret-snip)]) (let ([loc (snip->loc s-caret-snip)])
(send s-caret-snip on-event (send s-caret-snip on-event
dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly) dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly)
@ -667,8 +667,8 @@
(set-snip-loc! snip loc) (set-snip-loc! snip loc)
(set-snip-style! snip (send s-style-list convert (snip->style snip))) (set-snip-style! snip (send s-style-list convert (snip->style snip)))
(when (eq? (snip->style snip) (when (object=? (snip->style snip)
(send s-style-list basic-style)) (send s-style-list basic-style))
(let ([s (get-default-style)]) (let ([s (get-default-style)])
(when s (when s
(set-snip-style! snip s)))) (set-snip-style! snip s))))
@ -1098,11 +1098,11 @@
;; lock during set-admin! [???] ;; lock during set-admin! [???]
(send snip set-admin a) (send snip set-admin a)
(if (not (eq? (send snip get-admin) a)) (if (not (object-or-false=? (send snip get-admin) a))
;; something went wrong ;; something went wrong
(cond (cond
[(and (not a) [(and (not a)
(eq? (snip->admin snip) orig-admin)) (object-or-false=? (snip->admin snip) orig-admin))
;; force admin to null ;; force admin to null
(set-snip-admin! snip #f) (set-snip-admin! snip #f)
snip] snip]
@ -1248,7 +1248,7 @@
(send snip draw (send snip draw
dc x y dcx dcy dcr dcb dx dy dc x y dcx dcy dcr dcb dx dy
(if (eq? snip s-caret-snip) (if (object-or-false=? snip s-caret-snip)
show-caret show-caret
'no-caret)) 'no-caret))
@ -1799,7 +1799,7 @@
(do-buffer-paste cb time #f) (do-buffer-paste cb time #f)
(if (and s-admin (if (and s-admin
(not (eq? snips start))) (not (object-or-false=? snips start)))
(let ([dc (get-dc)]) (let ([dc (get-dc)])
(when dc (when dc
;; get top/left/bottom/right of pasted group: ;; get top/left/bottom/right of pasted group:
@ -1808,7 +1808,7 @@
[top +inf.0] [top +inf.0]
[right -inf.0] [right -inf.0]
[bottom -inf.0]) [bottom -inf.0])
(if (eq? snip start) (if (object-or-false=? snip start)
(let ([dx (- cx (/ (+ left right) 2))] (let ([dx (- cx (/ (+ left right) 2))]
[dy (- cy (/ (+ top bottom) 2))]) [dy (- cy (/ (+ top bottom) 2))])
;; shift the pasted group to center: ;; shift the pasted group to center:
@ -1824,7 +1824,7 @@
(max (loc-b loc) bottom))))))) (max (loc-b loc) bottom)))))))
;; just select them: ;; just select them:
(let loop ([snip snips]) (let loop ([snip snips])
(unless (eq? snip start) (unless (object-or-false=? snip start)
(add-selected snip) (add-selected snip)
(loop (snip->next snip)))))))) (loop (snip->next snip))))))))