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

racket/gui: change some eq? to object=?

Browse Source 
Some places in the editor API accept an object as an argument
where the object's identity is relevant. In that case, `object=?`
must be used instead of `eq?` to work right with contracts.
This commit is contained in:
Matthew Flatt 2014-02-09 21:09:11 -07:00
parent 2bd8c2d8ed
commit dc0653383f
4 changed files with 45 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/gui-pkgs/gui-lib/mred/private/wxme/editor-canvas.rkt
View File

@ -15,6 +15,9 @@
;; FIXME: need contracts on public classes
(define (object/bool=? a b)
(and a b (object=? a b)))
;; ----------------------------------------
(define simple-scroll%
@ -1013,7 +1016,7 @@
(define/public (set-editor m [update? #t])
(unless (eq? media m)
(when media
(when (eq? admin (send media get-admin))
(when (object/bool=? admin (send media get-admin))
(send media set-admin
(or (send admin get-nextadmin)
(send admin get-prevadmin))))
@ -1063,11 +1066,11 @@
(define/private (in-chain? admin oldadmin)
(or (let loop ([oldadmin oldadmin])
(and oldadmin
(or (eq? admin oldadmin)
(or (object/bool=? admin oldadmin)
(loop (send oldadmin get-prevadmin)))))
(let loop ([oldadmin oldadmin])
(and oldadmin
(or (eq? admin oldadmin)
(or (object/bool=? admin oldadmin)
(loop (send oldadmin get-nextadmin)))))))
(define/public (allow-scroll-to-last to-last?)

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

@ -757,7 +757,8 @@
(define/private (-delete del-snip del)
(when (snip->loc del-snip)
(when (eq? del-snip prev-mouse-snip)
(when (and prev-mouse-snip
(object=? del-snip prev-mouse-snip))
(set! prev-mouse-snip #f))
(set! write-locked (add1 write-locked))
(begin-edit-sequence)
@ -773,7 +774,8 @@
(set! write-locked (sub1 write-locked))
(let ([update-cursor?
(and (eq? del-snip s-caret-snip)
(and (and s-caret-snip
(object=? del-snip s-caret-snip))
(begin
(send s-caret-snip own-caret #f)
(set! s-caret-snip #f)
@ -1033,8 +1035,8 @@
(unless (or s-user-locked?
(not (zero? write-locked))
(not (snip->loc snip))
(eq? snip before)
(eq? snip after)
(and before (object=? snip before))
(and after (object=? snip after))
(and before (not (snip->loc before)))
(and after (not (snip->loc after))))
(set! write-locked (add1 write-locked))

2
pkgs/gui-pkgs/gui-lib/mred/private/wxme/text.rkt
View File

@ -3071,7 +3071,7 @@
[p (mline-get-position line)])
(let loop ([snip (mline-snip line)]
[p p])
(if (eq? snip thesnip)
(if (object=? snip thesnip)
(begin
(when pos
(set-box! pos p))

32
pkgs/gui-pkgs/gui-test/tests/gracket/wxme.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require racket/class
racket/contract
(only-in racket/gui/base
color%
font%
@ -1422,6 +1423,37 @@
(send t1 insert "Hello\tWorld")
(send t1 get-extent (box 0) (box 0)))
;; ----------------------------------------
;; Identity and contracts
(let ([t (new text%)])
(define s (new editor-snip%))
(send t insert "x")
(send t insert s)
(define (check s)
(expect (send t get-snip-location s) #t)
(expect (send t get-snip-position s) 1))
(check s)
(define/contract s2 (object/c) s)
(check s2))
(let ([t (new pasteboard%)])
(define s (new editor-snip%))
(send t insert (make-object string-snip% "x"))
(send t insert s 13 14)
(define (check s)
(define x (box 0))
(define y (box 0))
(expect (send t get-snip-location s x y) #t)
(expect (unbox x) 13.0)
(expect (unbox y) 14.0))
(check s)
(define/contract s2 (object/c) s)
(check s2)
(send t delete s2)
(expect (send t get-snip-location s) #f)
(expect (send t get-snip-location s2) #f))
;; ----------------------------------------
;; Error reporting