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

.

Browse Source 
original commit: ed0e1bb8d920eb1aedc52d256f7ef866ec348e74
This commit is contained in:
Matthew Flatt 2002-01-11 15:04:49 +00:00
parent aeab1cd869
commit d2dad83cc5
1 changed files with 24 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/mred/mred.ss
View File

@ -1517,16 +1517,39 @@
(stretchable-in-x #f)
(stretchable-in-y #t)))))))
(define list-box-wheel-step #f)
(define wx-list-box%
(make-window-glue%
(class100 (make-control% wx:list-box%
const-default-x-margin const-default-y-margin
#t #t) args
(rename
[super-pre-on-char pre-on-char])
(inherit get-first-item
set-first-visible-item)
(private
[scroll (lambda (dir)
(unless list-box-wheel-step
(set! list-box-wheel-step (get-preference '|MrEd:wheelStep| (lambda () 3)))
(unless (and (number? list-box-wheel-step)
(exact? list-box-wheel-step)
(integer? list-box-wheel-step)
(<= 1 list-box-wheel-step 100))
(set! list-box-wheel-step 3)))
(let ([top (get-first-item)])
(set-first-visible-item (+ top (* list-box-wheel-step dir)))))])
(override
[handles-key-code (lambda (x alpha? meta?)
(case x
[(up down) #t]
[else (and alpha? (not meta?))]))])
[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])))])
(sequence (apply super-init args)))))
(define wx-radio-box%