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

racket/gui: change pasteboard to put location info in snips

Browse Source 
Use the field in a `snip%` that is otherwise used by a `text%` owner
to store line information. Reusing the field avoids the need for
an `eq?`-based hash table of snips.
This commit is contained in:
Matthew Flatt 2014-02-09 20:26:19 -07:00
parent 70d91b5516
commit 2bd8c2d8ed
2 changed files with 56 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -102,8 +102,14 @@
(define snips #f) (define snips #f)
(define last-snip #f) (define last-snip #f)
(define snip-location-list (make-hasheq)) (define (in-snip-locs)
(define/private (snip-loc snip) (hash-ref snip-location-list snip #f)) (make-do-sequence
(lambda () (values snip->loc
snip->next
snips
values
#f
#f))))
(define snip-admin (new standard-snip-admin% [editor this])) (define snip-admin (new standard-snip-admin% [editor this]))
@ -255,7 +261,7 @@
(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 (eq? 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)
(loc-x loc) (loc-y loc) (loc-x loc) (loc-y loc)
@ -264,7 +270,7 @@
(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 (eq? 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
dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly) dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly)
@ -273,7 +279,7 @@
(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))) (eq? 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)
(loc-x loc) (loc-y loc) (loc-x loc) (loc-y loc)
@ -329,7 +335,7 @@
(if dragable? (if dragable?
(begin (begin
(if snip (if snip
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(set! orig-x (loc-x loc)) (set! orig-x (loc-x loc))
(set! orig-y (loc-y loc)) (set! orig-y (loc-y loc))
(set! orig-w (loc-w loc)) (set! orig-w (loc-w loc))
@ -404,7 +410,7 @@
(let ([x (+ (send event get-x) scrollx)] (let ([x (+ (send event get-x) scrollx)]
[y (+ (send event get-y) scrolly)]) [y (+ (send event get-y) scrolly)])
(if s-caret-snip (if s-caret-snip
(let ([loc (snip-loc s-caret-snip)]) (let ([loc (snip->loc s-caret-snip)])
(send s-caret-snip on-char (send s-caret-snip on-char
dc (loc-x loc) (loc-y loc) (- x scrollx) (- y scrolly) dc (loc-x loc) (loc-y loc) (- x scrollx) (- y scrolly)
event)) event))
@ -442,7 +448,7 @@
(let loop ([s #f]) (let loop ([s #f])
(let ([s (find-next-selected-snip s)]) (let ([s (find-next-selected-snip s)])
(when s (when s
(let ([loc (snip-loc s)]) (let ([loc (snip->loc s)])
(set-loc-startx! loc (loc-x loc)) (set-loc-startx! loc (loc-x loc))
(set-loc-starty! loc (loc-y loc))) (set-loc-starty! loc (loc-y loc)))
(loop s))))) (loop s)))))
@ -455,7 +461,7 @@
(let loop ([s #f]) (let loop ([s #f])
(let ([s (find-next-selected-snip s)]) (let ([s (find-next-selected-snip s)])
(when s (when s
(let* ([loc (snip-loc s)] (let* ([loc (snip->loc s)]
[x (loc-startx loc)] [x (loc-startx loc)]
[y (loc-starty loc)]) [y (loc-starty loc)])
(set-loc-startx! loc (loc-x loc)) (set-loc-startx! loc (loc-x loc))
@ -469,7 +475,7 @@
(let loop ([s #f]) (let loop ([s #f])
(let ([s (find-next-selected-snip s)]) (let ([s (find-next-selected-snip s)])
(when s (when s
(let* ([loc (snip-loc s)]) (let* ([loc (snip->loc s)])
(move-to s (loc-startx loc) (loc-starty loc))) (move-to s (loc-startx loc) (loc-starty loc)))
(loop s)))) (loop s))))
@ -484,7 +490,7 @@
(let loop ([s #f]) (let loop ([s #f])
(let ([s (find-next-selected-snip s)]) (let ([s (find-next-selected-snip s)])
(when s (when s
(let ([loc (snip-loc s)]) (let ([loc (snip->loc s)])
(let-boxes ([x (+ (loc-startx loc) dx)] (let-boxes ([x (+ (loc-startx loc) dx)]
[y (+ (loc-starty loc) dy)]) [y (+ (loc-starty loc) dy)])
(interactive-adjust-move s x y) (interactive-adjust-move s x y)
@ -539,7 +545,7 @@
(end-edit-sequence)) (end-edit-sequence))
(define/private (do-select snip on?) (define/private (do-select snip on?)
(let ([loc (snip-loc snip)]) (let ([loc (and snip (snip->loc snip))])
(when (and loc (when (and loc
(not (eq? (loc-selected? loc) on?))) (not (eq? (loc-selected? loc) on?)))
(set! write-locked (add1 write-locked)) (set! write-locked (add1 write-locked))
@ -571,7 +577,7 @@
(let loop ([s snips]) (let loop ([s snips])
(when s (when s
(let ([loc (snip-loc s)]) (let ([loc (snip->loc s)])
(when (and (when (and
loc loc
(not (loc-selected? loc)) (not (loc-selected? loc))
@ -637,7 +643,8 @@
(new image-snip%) (new image-snip%)
snip)]) snip)])
(let ([search (and (snip-loc before) (let ([search (and before
(snip->loc before)
before)]) before)])
(set-snip-next! snip search) (set-snip-next! snip search)
@ -657,7 +664,7 @@
0.0 0.0 0.0 0.0
#f #t #f #t
snip)]) snip)])
(hash-set! snip-location-list 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 (eq? (snip->style snip)
@ -731,7 +738,7 @@
args args
[() [()
(delete-some (lambda (s) (delete-some (lambda (s)
(let ([l (snip-loc s)]) (let ([l (and s (snip->loc s))])
(and l ;; deleted already! (and l ;; deleted already!
(loc-selected? l)))))] (loc-selected? l)))))]
[([snip% s]) [([snip% s])
@ -749,7 +756,7 @@
(delete-some (lambda (s) #t))) (delete-some (lambda (s) #t)))
(define/private (-delete del-snip del) (define/private (-delete del-snip del)
(when (snip-loc del-snip) (when (snip->loc del-snip)
(when (eq? del-snip prev-mouse-snip) (when (eq? del-snip prev-mouse-snip)
(set! prev-mouse-snip #f)) (set! prev-mouse-snip #f))
(set! write-locked (add1 write-locked)) (set! write-locked (add1 write-locked))
@ -781,8 +788,8 @@
(set-snip-prev! (snip->next del-snip) (snip->prev del-snip)) (set-snip-prev! (snip->next del-snip) (snip->prev del-snip))
(set! last-snip (snip->prev del-snip))) (set! last-snip (snip->prev del-snip)))
(let ([loc (snip-loc del-snip)]) (let ([loc (snip->loc del-snip)])
(hash-remove! snip-location-list del-snip) (set-snip-loc! del-snip #f)
(when del (when del
(send del insert-snip del-snip (snip->next del-snip) (loc-x loc) (loc-y loc)))) (send del insert-snip del-snip (snip->next del-snip) (loc-x loc) (loc-y loc))))
@ -828,7 +835,7 @@
(def/public (move-to [snip% snip] [real? x] [real? y]) (def/public (move-to [snip% snip] [real? x] [real? y])
(unless (or s-user-locked? (unless (or s-user-locked?
(not (zero? write-locked))) (not (zero? write-locked)))
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(when (and loc (when (and loc
(not (and (not (and
(= (loc-x loc) x) (= (loc-x loc) x)
@ -888,14 +895,14 @@
[([snip% snip] [real? dx] [real? dy]) [([snip% snip] [real? dx] [real? dy])
(unless (or s-user-locked? (unless (or s-user-locked?
(not (zero? write-locked))) (not (zero? write-locked)))
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(when loc (when loc
(move-to snip (+ (loc-x loc) dx) (+ (loc-y loc) dy)))))] (move-to snip (+ (loc-x loc) dx) (+ (loc-y loc) dy)))))]
[([real? dx] [real? dy]) [([real? dx] [real? dy])
(unless (or s-user-locked? (unless (or s-user-locked?
(not (zero? write-locked))) (not (zero? write-locked)))
(begin-edit-sequence) (begin-edit-sequence)
(for ([loc (in-hash-values snip-location-list)]) (for ([loc (in-snip-locs)])
(when (loc-selected? loc) (when (loc-selected? loc)
(move (loc-snip loc) dx dy))) (move (loc-snip loc) dx dy)))
(end-edit-sequence))] (end-edit-sequence))]
@ -904,7 +911,7 @@
(def/public (resize [snip% snip] [real? w] [real? h]) (def/public (resize [snip% snip] [real? w] [real? h])
(if (not s-admin) (if (not s-admin)
#f #f
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(if (not loc) (if (not loc)
#f #f
(let ([oldw (loc-w loc)] (let ([oldw (loc-w loc)]
@ -981,8 +988,7 @@
(send snip size-cache-invalid) (send snip size-cache-invalid)
(update-snip snip) (update-snip snip)
#t) #t)
(for/fold ([didit? #f]) (for/fold ([didit? #f]) ([loc (in-snip-locs)])
([loc (in-hash-keys snip-location-list)])
(if (loc-selected? loc) (if (loc-selected? loc)
(let ([snip (loc-snip loc)]) (let ([snip (loc-snip loc)])
(send rec add-style-change (loc-snip loc) (snip->style snip)) (send rec add-style-change (loc-snip loc) (snip->style snip))
@ -1026,11 +1032,11 @@
(define/private (set-between snip before after) (define/private (set-between snip before after)
(unless (or s-user-locked? (unless (or s-user-locked?
(not (zero? write-locked)) (not (zero? write-locked))
(not (snip-loc snip)) (not (snip->loc snip))
(eq? snip before) (eq? snip before)
(eq? snip after) (eq? snip after)
(and before (not (snip-loc before))) (and before (not (snip->loc before)))
(and after (not (snip-loc after)))) (and after (not (snip->loc after))))
(set! write-locked (add1 write-locked)) (set! write-locked (add1 write-locked))
(if (not (can-reorder? snip (or before after) (and before #t))) (if (not (can-reorder? snip (or before after) (and before #t)))
(set! write-locked (sub1 write-locked)) (set! write-locked (sub1 write-locked))
@ -1156,12 +1162,12 @@
(def/public (find-snip [real? x] [real? y] [(make-or-false snip%) [after #f]]) (def/public (find-snip [real? x] [real? y] [(make-or-false snip%) [after #f]])
(let ([dummy (box 0)]) (let ([dummy (box 0)])
(let loop ([s (if after (let loop ([s (if after
(if (snip-loc after) (if (snip->loc after)
(snip->next after) (snip->next after)
#f) #f)
snips)]) snips)])
(and s (and s
(let ([loc (snip-loc s)]) (let ([loc (snip->loc s)])
(cond (cond
[(and ((loc-x loc) . <= . x) [(and ((loc-x loc) . <= . x)
((loc-y loc) . <= . y) ((loc-y loc) . <= . y)
@ -1176,18 +1182,18 @@
(def/override (find-first-snip) snips) (def/override (find-first-snip) snips)
(def/public (is-selected? [snip% asnip]) (def/public (is-selected? [snip% asnip])
(let ([loc (snip-loc asnip)]) (let ([loc (snip->loc asnip)])
(and loc (and loc
(loc-selected? loc)))) (loc-selected? loc))))
(def/public (find-next-selected-snip [(make-or-false snip%) start]) (def/public (find-next-selected-snip [(make-or-false snip%) start])
(let loop ([s (if start (let loop ([s (if start
(if (snip-loc start) (if (snip->loc start)
(snip->next start) (snip->next start)
#f) #f)
snips)]) snips)])
(and s (and s
(if (loc-selected? (snip-loc s)) (if (loc-selected? (snip->loc s))
s s
(loop (snip->next s)))))) (loop (snip->next s))))))
@ -1228,7 +1234,7 @@
(let loop ([snip last-snip] (let loop ([snip last-snip]
[old-style #f]) [old-style #f])
(if snip (if snip
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(when (and ((loc-x loc) . <= . cr) (when (and ((loc-x loc) . <= . cr)
((loc-y loc) . <= . cb) ((loc-y loc) . <= . cb)
((loc-r loc) . >= . cx) ((loc-r loc) . >= . cx)
@ -1402,7 +1408,7 @@
(let-values ([(r b) (let-values ([(r b)
(for/fold ([r 0.0] (for/fold ([r 0.0]
[b 0.0]) [b 0.0])
([loc (in-hash-values snip-location-list)]) ([loc (in-snip-locs)])
(when size-cache-invalid? (when size-cache-invalid?
(send (loc-snip loc) size-cache-invalid) (send (loc-snip loc) size-cache-invalid)
(set-loc-need-resize?! loc #t)) (set-loc-need-resize?! loc #t))
@ -1517,13 +1523,13 @@
(+ (loc-h loc) DOT-WIDTH)))) (+ (loc-h loc) DOT-WIDTH))))
(define/private (update-snip snip) (define/private (update-snip snip)
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(when loc (when loc
(update-location loc)))) (update-location loc))))
(define/private (update-selected) (define/private (update-selected)
(begin-edit-sequence) (begin-edit-sequence)
(for ([loc (in-hash-values snip-location-list)]) (for ([loc (in-snip-locs)])
(when (loc-selected? loc) (when (loc-selected? loc)
(update-location loc))) (update-location loc)))
(end-edit-sequence)) (end-edit-sequence))
@ -1609,7 +1615,7 @@
(on-focus (not snip)))) (on-focus (not snip))))
(def/override (resized [snip% snip] [any? redraw-now?]) (def/override (resized [snip% snip] [any? redraw-now?])
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(when (and loc (when (and loc
(not (loc-need-resize? loc))) (not (loc-need-resize? loc)))
(set! changed? #t) (set! changed? #t)
@ -1765,7 +1771,7 @@
s-style-list)]) s-style-list)])
(let loop ([snip snips]) (let loop ([snip snips])
(when snip (when snip
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(when (loc-selected? loc) (when (loc-selected? loc)
(let ([asnip (send snip copy)]) (let ([asnip (send snip copy)])
(send asnip set-admin #f) (send asnip set-admin #f)
@ -1801,11 +1807,11 @@
[right -inf.0] [right -inf.0]
[bottom -inf.0]) [bottom -inf.0])
(if (eq? snip start) (if (eq? 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:
(move dx dy)) (move dx dy))
(let ([loc (snip-loc snip)]) (let ([loc (snip->loc snip)])
(add-selected snip) (add-selected snip)
(when (loc-need-resize? loc) (when (loc-need-resize? loc)
(loc-resize loc dc)) (loc-resize loc dc))
@ -1872,7 +1878,7 @@
(when bottom-right? (when bottom-right?
(check-recalc)) (check-recalc))
(let ([loc (snip-loc thesnip)]) (let ([loc (snip->loc thesnip)])
(and loc (and loc
(begin (begin
(when x (set-box! x (+ (loc-x loc) (when x (set-box! x (+ (loc-x loc)
@ -1888,7 +1894,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(def/override (get-snip-data [snip% snip]) (def/override (get-snip-data [snip% snip])
(let ([loc (snip-loc snip)] (let ([loc (snip->loc snip)]
[sup (super get-snip-data snip)]) [sup (super get-snip-data snip)])
(if (not loc) (if (not loc)
sup sup
@ -1898,7 +1904,7 @@
(send data set-next sup) (send data set-next sup)
data)))) data))))
(def/override (set-snip-data [snip% snip] [editor-data% data]) (def/override (set-snip-data [snip% snip] [(make-or-false editor-data%) data])
(let loop ([data data]) (let loop ([data data])
(when data (when data
(let ([c (send data get-dataclass)]) (let ([c (send data get-dataclass)])

6
pkgs/snip-pkgs/snip-lib/racket/snip/private/snip.rkt
View File

@ -29,11 +29,13 @@
snip->prev snip->prev
snip->flags snip->flags
snip->line snip->line
snip->loc
snip->style snip->style
snip->snipclass snip->snipclass
set-snip-admin! set-snip-admin!
set-snip-line! set-snip-line!
set-snip-loc!
set-snip-style! set-snip-style!
set-snip-flags! set-snip-flags!
set-snip-count! set-snip-count!
@ -113,7 +115,7 @@
;; For use only by the owning editor: ;; For use only by the owning editor:
(field [s-prev #f] (field [s-prev #f]
[s-next #f] [s-next #f]
[s-line #f]) [s-line #f]) ; used for line by text%, loc by pastebpard%
(define/public (set-s-prev p) (set! s-prev p)) (define/public (set-s-prev p) (set! s-prev p))
(define/public (set-s-next p) (set! s-next p)) (define/public (set-s-next p) (set! s-next p))
(define/public (set-s-line l) (set! s-line l)) (define/public (set-s-line l) (set! s-line l))
@ -1401,11 +1403,13 @@
(define snip->prev (class-field-accessor snip% s-prev)) (define snip->prev (class-field-accessor snip% s-prev))
(define snip->flags (class-field-accessor snip% s-flags)) (define snip->flags (class-field-accessor snip% s-flags))
(define snip->line (class-field-accessor snip% s-line)) (define snip->line (class-field-accessor snip% s-line))
(define snip->loc (class-field-accessor snip% s-line))
(define snip->style (class-field-accessor snip% s-style)) (define snip->style (class-field-accessor snip% s-style))
(define snip->snipclass (class-field-accessor snip% s-snipclass)) (define snip->snipclass (class-field-accessor snip% s-snipclass))
(define set-snip-admin! (class-field-mutator snip% s-admin)) (define set-snip-admin! (class-field-mutator snip% s-admin))
(define set-snip-line! (class-field-mutator snip% s-line)) (define set-snip-line! (class-field-mutator snip% s-line))
(define set-snip-loc! (class-field-mutator snip% s-line))
(define set-snip-style! (class-field-mutator snip% s-style)) (define set-snip-style! (class-field-mutator snip% s-style))
(define set-snip-flags! (class-field-mutator snip% s-flags)) (define set-snip-flags! (class-field-mutator snip% s-flags))
(define set-snip-count! (class-field-mutator snip% s-count)) (define set-snip-count! (class-field-mutator snip% s-count))