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

cocoa: fix list-box scrolling

Browse Source 
Closes PR 11948
This commit is contained in:
Matthew Flatt 2011-08-04 07:38:10 -06:00
parent 84b9cf6b90
commit 1bc8978ce8
2 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/mred/private/wx/cocoa/list-box.rkt
View File

@ -187,17 +187,19 @@
[else (cons i (loop (tell #:type _NSInteger v
indexGreaterThanIndex: #:type _NSInteger i)))])))))))
(define/private (visible-range)
(tell #:type _NSRange content-cocoa
rowsInRect: #:type _NSRect (tell #:type _NSRect cocoa documentVisibleRect)))
(define/public (get-first-item)
(NSRange-location (visible-range)))
(define/public (number-of-visible-items)
(NSRange-length (visible-range)))
(define doc (tell #:type _NSRect cocoa documentVisibleRect))
(define h (tell #:type _CGFloat content-cocoa rowHeight))
(max 1 (inexact->exact (floor (/ (NSSize-height (NSRect-size doc)) h)))))
(define/public (get-first-item)
(define doc (tell #:type _NSRect cocoa documentVisibleRect))
(NSRange-location (tell #:type _NSRange content-cocoa rowsInRect: #:type _NSRect doc)))
(define/public (set-first-visible-item i)
;; FIXME: visble doesn't mean at top:
(tellv content-cocoa scrollRowToVisible: #:type _NSInteger i))
(define num-vis (number-of-visible-items))
(define start (max 0 (min i (- count num-vis))))
(tellv content-cocoa scrollRowToVisible: #:type _NSInteger start)
(tellv content-cocoa scrollRowToVisible: #:type _NSInteger (+ start (sub1 num-vis))))
(define/private (replace items i s)
(append (take items i)

14
collects/mred/private/wxlitem.rkt
View File

@ -124,7 +124,8 @@
(class100 (make-control% wx:list-box% 0 0 #t #t) (parent cb label kind x y w h choices style font
label-font columns column-order)
(inherit get-first-item
set-first-visible-item)
set-first-visible-item
number-of-visible-items)
(private
[scroll (lambda (dir)
(unless list-box-wheel-step
@ -136,7 +137,7 @@
(set! list-box-wheel-step 3)))
(let ([top (get-first-item)])
(set-first-visible-item
(max 0 (+ top (* list-box-wheel-step dir))))))])
(max 0 (+ top (* (min list-box-wheel-step (number-of-visible-items)) dir))))))])
(override
[handles-key-code (lambda (x alpha? meta?)
(case x
@ -144,10 +145,11 @@
[else (and alpha? (not meta?))]))]
[pre-on-char (lambda (w e)
(or (super pre-on-char w e)
(case (send e get-key-code)
[(wheel-up) (scroll -1) #t]
[(wheel-down) (scroll 1) #t]
[else #f])))])
(and (not (eq? (system-type) 'macosx)) ; scrolling is built into NSListView
(case (send e get-key-code)
[(wheel-up) (scroll -1) #t]
[(wheel-down) (scroll 1) #t]
[else #f]))))])
(sequence (super-init style parent cb label kind x y w h choices (cons 'deleted style) font
label-font columns column-order)))))