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

cocoa cursors

Browse Source
This commit is contained in:
Matthew Flatt 2010-08-17 10:49:53 -06:00
parent 2dba600d59
commit 40c1c2ffef
29 changed files with 242 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drracket/private/unit.rkt
View File

@ -4158,8 +4158,8 @@ module browser threading seems wrong.
(define/override (on-event evt)
(let-values ([(w h) (get-client-size)])
(let ([new-inside?
(and (<= 0 (send evt get-x) w)
(<= 0 (send evt get-y) h))]
(and (< 0 (send evt get-x) w)
(< 0 (send evt get-y) h))]
[old-inside? inside?])
(set! inside? new-inside?)
(cond

5
collects/mred/private/kernel.rkt
View File

@ -34,4 +34,7 @@
eventspace-handler-thread
queue-callback
middle-queue-key
get-top-level-windows)
get-top-level-windows
begin-busy-cursor
is-busy?
end-busy-cursor)

2
collects/mred/private/wx/cocoa/button.rkt
View File

@ -24,7 +24,7 @@
(define MIN-BUTTON-WIDTH 72)
(define-objc-class MyButton NSButton
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (clicked: [_id sender])
(queue-window*-event wxb (lambda (wx) (send wx clicked)))))

14
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -47,7 +47,7 @@
(tellv ctx restoreGraphicsState)))))))
(define-objc-class MyView NSView
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (drawRect: [_NSRect r])
(when wxb
@ -127,7 +127,7 @@
(tellv ctx restoreGraphicsState)))))
(define-objc-class MyComboBox NSComboBox
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
#:protocols (NSComboBoxDelegate)
[wxb]
(-a _void (drawRect: [_NSRect r])
@ -172,7 +172,8 @@
move get-x get-y
on-size
register-as-child
get-size get-position)
get-size get-position
set-focus)
(define vscroll-ok? (and (memq 'vscroll style) #t))
(define vscroll? vscroll-ok?)
@ -607,6 +608,10 @@
(define/override (definitely-wants-event? e)
;; Called in Cocoa event-handling mode
(when (and is-combo?
(e . is-a? . mouse-event%)
(send e button-down? 'left))
(set-focus))
(or (not is-combo?)
(e . is-a? . key-event%)
(not (send e button-down? 'left))
@ -670,6 +675,9 @@
(when is-combo?
(set-box! xb (- (unbox xb) 22))))
(define/override (get-cursor-width-delta)
(if is-combo? 22 0))
(define/public (is-flipped?)
(tell #:type _BOOL (get-cocoa-content) isFlipped))

2
collects/mred/private/wx/cocoa/choice.rkt
View File

@ -19,7 +19,7 @@
(import-class NSPopUpButton)
(define-objc-class MyPopUpButton NSPopUpButton
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (clicked: [_id sender])
(queue-window*-event wxb (lambda (wx) (send wx clicked)))))

88
collects/mred/private/wx/cocoa/cursor.rkt
View File

@ -1,14 +1,53 @@
#lang scheme/base
(require ffi/objc
scheme/foreign
scheme/class)
(unsafe!)
(objc-unsafe!)
#lang racket/base
(require ffi/unsafe
ffi/unsafe/objc
racket/class
racket/draw
"image.rkt"
"types.rkt"
"../common/local.rkt")
(provide cursor-driver%)
(provide cursor-driver%
arrow-cursor-handle
get-wait-cursor-handle)
(import-class NSCursor)
(define wait #f)
(define bullseye #f)
(define blank #f)
(define size-ne/sw #f)
(define size-nw/se #f)
(define-syntax-rule (image-cursor id draw-proc)
(or id
(begin
(set! id (make-image-cursor draw-proc))
id)))
(define (make-image-cursor draw-proc)
(let* ([bm (make-object bitmap% 16 16 #f #t)]
[dc (make-object bitmap-dc% bm)])
(send dc set-smoothing 'aligned)
(draw-proc dc 16 16)
(send dc set-bitmap #f)
(let ([image (bitmap->image bm)])
(tell (tell NSCursor alloc)
initWithImage: image
hotSpot: #:type _NSPoint (make-NSPoint 8 8)))))
(define arrow-cursor-handle (tell NSCursor arrowCursor))
(define (get-wait-cursor-handle)
(image-cursor wait
(lambda (dc w h)
(send dc set-brush "black" 'solid)
(send dc draw-rectangle 5 0 6 4)
(send dc draw-rectangle 5 12 6 4)
(send dc set-brush "white" 'solid)
(send dc draw-ellipse 3 3 10 10)
(send dc draw-line 7 5 7 8)
(send dc draw-line 7 8 9 8))))
(define cursor-driver%
(class object%
(define handle #f)
@ -16,7 +55,7 @@
(define/public (set-standard sym)
(case sym
[(arrow)
(set! handle (tell NSCursor arrowCursor))]
(set! handle arrow-cursor-handle)]
[(cross)
(set! handle (tell NSCursor crosshairCursor))]
[(hand)
@ -26,9 +65,38 @@
[(size-n/s)
(set! handle (tell NSCursor resizeUpDownCursor))]
[(size-e/w)
(set! handle (tell NSCursor resizeLeftRightCursor))]))
(set! handle (tell NSCursor resizeLeftRightCursor))]
[(size-nw/se)
(set! handle
(image-cursor size-nw/se (lambda (dc w h)
(send dc draw-line 0 16 16 0)
(send dc draw-line 0 0 16 16)
(send dc draw-line 0 3 0 0)
(send dc draw-line 0 0 3 0)
(send dc draw-line 12 15 15 15)
(send dc draw-line 15 15 15 12))))]
[(size-ne/sw)
(set! handle
(image-cursor size-ne/sw (lambda (dc w h)
(send dc draw-line 0 16 16 0)
(send dc draw-line 0 0 16 16)
(send dc draw-line 12 0 15 0)
(send dc draw-line 15 0 15 3)
(send dc draw-line 0 12 0 15)
(send dc draw-line 0 15 3 15))))]
[(watch)
(set! handle (get-wait-cursor-handle))]
[(bullseye)
(set! handle
(image-cursor bullseye (lambda (dc w h)
(send dc draw-ellipse 1 1 (- w 2) (- h 2))
(send dc draw-ellipse 4 4 (- w 8) (- h 8))
(send dc draw-ellipse 7 7 2 2))))]
[(blank)
(set! handle (image-cursor blank void))]))
(define/public (ok?) (and handle #t))
(super-new)))
(define/public (get-handle) handle)
(super-new)))

41
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -9,6 +9,7 @@
"window.rkt"
"queue.rkt"
"menu-bar.rkt"
"cursor.rkt"
"../../syntax.rkt"
"../common/queue.rkt"
"../../lock.rkt")
@ -59,6 +60,7 @@
(let ([wx (->wx wxb)])
(when wx
(set! front wx)
(send wx install-wait-cursor)
(send wx install-mb)
(send wx notify-responder #t)
(queue-window-event wx (lambda ()
@ -67,7 +69,9 @@
(when wxb
(let ([wx (->wx wxb)])
(when wx
(when (eq? front wx) (set! front #f))
(when (eq? front wx)
(set! front #f)
(send wx uninstall-wait-cursor))
(send empty-mb install)
(send wx notify-responder #f)
(queue-window-event wx (lambda ()
@ -237,8 +241,11 @@
[next (tellv next makeKeyWindow)]
[root-fake-frame (send root-fake-frame install-mb)]
[else (void)]))))
(register-frame-shown this on?))))
(register-frame-shown this on?)
(when on?
(let ([b (eventspace-wait-cursor-count (get-eventspace))])
(set-wait-cursor-mode (not (zero? b))))))))
(define/override (show on?)
(when on?
(when (eventspace-shutdown? (get-eventspace))
@ -267,6 +274,17 @@
(define is-main? #f)
(define first-responder #f)
(define saved-child #f)
(define/override (register-child child on?)
(unless on? (error 'register-child-in-frame "did not expect #f"))
(unless (or (not saved-child) (eq? child saved-child))
(error 'register-child-in-frame "expected only one child"))
(set! saved-child child))
(define/override (set-cursor c)
(when saved-child
(send saved-child set-cursor c)))
(define/public (notify-responder on?)
(set! is-main? on?)
(when first-responder
@ -286,6 +304,23 @@
(when is-main?
(do-notify-responder wx on?)))
(define/public (install-wait-cursor)
(when (positive? (eventspace-wait-cursor-count (get-eventspace)))
(tellv (get-wait-cursor-handle) set)))
(define/public (uninstall-wait-cursor)
(when (positive? (eventspace-wait-cursor-count (get-eventspace)))
(tellv arrow-cursor-handle set)))
(define/public (set-wait-cursor-mode on?)
(if on?
(tell cocoa disableCursorRects)
(tell cocoa enableCursorRects))
(when (eq? this front)
(if on?
(install-wait-cursor)
(uninstall-wait-cursor))))
(define/public (flip-screen y)
(let ([f (tell #:type _NSRect (tell cocoa screen) frame)])
(- (NSSize-height (NSRect-size f)) y)))

2
collects/mred/private/wx/cocoa/gauge.rkt
View File

@ -19,7 +19,7 @@
(import-class NSProgressIndicator)
(define-objc-class MyProgressIndicator NSProgressIndicator
#:mixins (KeyMouseResponder)
#:mixins (KeyMouseResponder CursorDisplayer)
[wxb])
(defclass gauge% item%

4
collects/mred/private/wx/cocoa/group-panel.rkt
View File

@ -15,7 +15,7 @@
(import-class NSBox)
(define-objc-class MyBox NSBox
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb])
(defclass group-panel% (panel-mixin window%)
@ -37,6 +37,8 @@
(define/override (get-cocoa-content)
(tell (get-cocoa) contentView))
(define/override (get-cocoa-cursor-content)
(get-cocoa))
(define/public (set-label l)
(tellv (get-cocoa) setTitle: #:type _NSString l)))

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

@ -22,7 +22,7 @@
(import-protocol NSTableViewDataSource)
(define-objc-class MyTableView NSTableView
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
[-a _id (preparedCellAtColumn: [_NSInteger column] row: [_NSInteger row])
(let ([wx (->wx wxb)])

4
collects/mred/private/wx/cocoa/message.rkt
View File

@ -32,11 +32,11 @@
"NSApplicationPath")))
(define-objc-class MyTextField NSTextField
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb])
(define-objc-class MyImageView NSImageView
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb])
(defclass message% item%

6
collects/mred/private/wx/cocoa/panel.rkt
View File

@ -14,6 +14,10 @@
(import-class NSView)
(define-objc-class MyPanelView NSView
#:mixins (CursorDisplayer)
[wxb])
(define (panel-mixin %)
(class %
(inherit register-as-child)
@ -61,7 +65,7 @@
(super-new [parent parent]
[cocoa
(as-objc-allocation
(tell (tell NSView alloc)
(tell (tell MyPanelView alloc)
initWithFrame: #:type _NSRect (make-NSRect (make-init-point x y)
(make-NSSize w h))))]
[no-show? (memq 'deleted style)]))

3
collects/mred/private/wx/cocoa/platform.rkt
View File

@ -61,9 +61,6 @@
file-selector
is-color-display?
get-display-depth
begin-busy-cursor
is-busy?
end-busy-cursor
has-x-selection?
hide-cursor
bell

8
collects/mred/private/wx/cocoa/procs.rkt
View File

@ -49,9 +49,6 @@
display-size
bell
hide-cursor
end-busy-cursor
is-busy?
begin-busy-cursor
get-display-depth
is-color-display?
file-selector
@ -113,11 +110,6 @@
(define (hide-cursor)
(tellv NSCursor setHiddenUntilMouseMoves: #:type _BOOL #t))
(define busy-count 0)
(define (end-busy-cursor) (atomically (set! busy-count (add1 busy-count))))
(define (is-busy?) (positive? busy-count))
(define (begin-busy-cursor) (atomically (set! busy-count (sub1 busy-count))))
(define (get-display-depth) 32)
(define-unimplemented is-color-display?)
(define-unimplemented file-selector)

2
collects/mred/private/wx/cocoa/radio-box.rkt
View File

@ -24,7 +24,7 @@
(define NSListModeMatrix 2)
(define-objc-class MyMatrix NSMatrix
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (clicked: [_id sender])
(queue-window*-event wxb (lambda (wx) (send wx clicked)))))

2
collects/mred/private/wx/cocoa/slider.rkt
View File

@ -22,7 +22,7 @@
(import-class NSSlider)
(define-objc-class MySlider NSSlider
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
[wxb]
(-a _void (changed: [_id sender])
(let ([wx (->wx wxb)])

3
collects/mred/private/wx/cocoa/tab-panel.rkt
View File

@ -18,7 +18,7 @@
(import-protocol NSTabViewDelegate)
(define-objc-class MyTabView NSTabView
#:mixins (FocusResponder KeyMouseResponder)
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
#:protocols (NSTabViewDelegate)
[wxb]
(-a _void (tabView: [_id cocoa] didSelectTabViewItem: [_id item-cocoa])
@ -51,6 +51,7 @@
(tell #:type _void cocoa addSubview: content-cocoa)
(define/override (get-cocoa-content) content-cocoa)
(define/override (get-cocoa-cursor-content) cocoa)
(define/override (set-size x y w h)
(super set-size x y w h)
(tellv content-cocoa setFrame: #:type _NSRect (tell #:type _NSRect cocoa contentRect)))

39
collects/mred/private/wx/cocoa/window.rkt
View File

@ -8,6 +8,8 @@
"types.rkt"
"keycode.rkt"
"pool.rkt"
"cursor.rkt"
"../common/local.rkt"
"../../lock.rkt"
"../common/event.rkt"
"../common/queue.rkt"
@ -20,6 +22,7 @@
FocusResponder
KeyMouseResponder
CursorDisplayer
queue-window-event
queue-window*-event
@ -107,6 +110,13 @@
(queue-window-event wx (lambda ()
(send wx key-event-as-string str)))))])
(define-objc-mixin (CursorDisplayer Superclass)
[wxb]
[-a _void (resetCursorRects)
(let ([wx (->wx wxb)])
(when wx
(send wx reset-cursor-rects)))])
(define (do-key-event wxb event)
(let ([wx (->wx wxb)])
(and
@ -205,6 +215,7 @@
(define/public (get-cocoa) cocoa)
(define/public (get-cocoa-content) cocoa)
(define/public (get-cocoa-cursor-content) (get-cocoa-content))
(define/public (get-cocoa-window) (send parent get-cocoa-window))
(define/public (get-wx-window) (send parent get-wx-window))
@ -314,8 +325,8 @@
(set-box! h (->long (NSSize-height s)))))
(define/public (set-size x y w h)
(let ([x (if (= x -11111) 0 x)]
[y (if (= y -11111) 0 y)])
(let ([x (if (= x -11111) (get-x) x)]
[y (if (= y -11111) (get-y) y)])
(tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h))
(make-NSSize w h)))))
(define/public (move x y)
@ -409,8 +420,28 @@
(def/public-unimplemented fit)
(define/public (set-cursor c) (void))
(define cursor-handle #f)
(define/public (set-cursor c)
(let ([h (if c
(send (send c get-driver) get-handle)
#f)])
(unless (eq? h cursor-handle)
(atomically
(set! cursor-handle h)
(tellv (get-cocoa-window) invalidateCursorRectsForView: (get-cocoa-cursor-content))))))
(define/public (reset-cursor-rects)
;; called in event-pump thread
(when cursor-handle
(let ([content (get-cocoa-cursor-content)])
(let* ([r (tell #:type _NSRect content frame)]
[r (make-NSRect (make-NSPoint 0 0)
(make-NSSize
(- (NSSize-width (NSRect-size r))
(get-cursor-width-delta))
(NSSize-height (NSRect-size r))))])
(tellv content addCursorRect: #:type _NSRect r cursor: cursor-handle)))))
(define/public (get-cursor-width-delta) 0)
(define/public (gets-focus?) #f)
(def/public-unimplemented centre)))

3
collects/mred/private/wx/common/cursor.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/class
racket/draw
"local.rkt"
(only-in "../platform.rkt" cursor-driver%)
"../../syntax.rkt")
@ -32,5 +33,7 @@
c)]
(init-name 'cursor%)))
(define/public (get-driver) driver)
(def/public (ok?) (send driver ok?))
(super-new))

6
collects/mred/private/wx/common/local.rkt
View File

@ -5,4 +5,8 @@
(define-local-member-name
;; clipboard-client%:
get-client-eventspace)
get-client-eventspace
;; cursor%
get-driver)

40
collects/mred/private/wx/common/queue.rkt
View File

@ -26,6 +26,7 @@
eventspace-shutdown?
main-eventspace?
eventspace-handler-thread
eventspace-wait-cursor-count
queue-callback
middle-queue-key
@ -39,7 +40,11 @@
other-modal?
queue-quit-event
queue-prefs-event)
queue-prefs-event
begin-busy-cursor
end-busy-cursor
is-busy?)
;; ------------------------------------------------------------
;; This module must be instantiated only once:
@ -116,7 +121,13 @@
;; ------------------------------------------------------------
;; Eventspaces
(define-struct eventspace (handler-thread queue-proc frames-hash done-evt [shutdown? #:mutable] done-sema)
(define-struct eventspace (handler-thread
queue-proc
frames-hash
done-evt
[shutdown? #:mutable]
done-sema
[wait-cursor-count #:mutable])
#:property prop:evt (lambda (v)
(wrap-evt (eventspace-done-evt v)
(lambda (_) v))))
@ -270,7 +281,8 @@
frames
(semaphore-peek-evt done-sema)
#f
done-sema)]
done-sema
0)]
[cb-box (box #f)])
(parameterize ([current-cb-box cb-box])
(scheme_add_managed (current-custodian)
@ -390,3 +402,25 @@
(define (queue-prefs-event)
;; called in event-pump thread
(queue-event main-eventspace (application-pref-handler) 'med))
(define (begin-busy-cursor)
(let ([e (current-eventspace)])
(atomically
(set-eventspace-wait-cursor-count!
e
(add1 (eventspace-wait-cursor-count e)))
(when (= (eventspace-wait-cursor-count e) 1)
(for ([e (in-list (get-top-level-windows))])
(send e set-wait-cursor-mode #t))))))
(define (end-busy-cursor)
(let ([e (current-eventspace)])
(atomically
(set-eventspace-wait-cursor-count!
e
(sub1 (eventspace-wait-cursor-count e)))
(when (zero? (eventspace-wait-cursor-count e))
(for ([e (in-list (get-top-level-windows))])
(send e set-wait-cursor-mode #f))))))
(define (is-busy?) (positive? (eventspace-wait-cursor-count (current-eventspace))))

3
collects/mred/private/wx/gtk/frame.rkt
View File

@ -289,6 +289,9 @@
(define/public (set-status-text s) (void))
(def/public-unimplemented status-line-exists?)
(define/public (set-wait-cursor-mode on?)
(void))
(define maximized? #f)
(define/public (is-maximized?)

3
collects/mred/private/wx/gtk/platform.rkt
View File

@ -61,9 +61,6 @@
file-selector
is-color-display?
get-display-depth
begin-busy-cursor
is-busy?
end-busy-cursor
has-x-selection?
hide-cursor
bell

8
collects/mred/private/wx/gtk/procs.rkt
View File

@ -51,9 +51,6 @@
display-size
bell
hide-cursor
end-busy-cursor
is-busy?
begin-busy-cursor
get-display-depth
is-color-display?
file-selector
@ -119,11 +116,6 @@
(define-unimplemented bell)
(define (hide-cursor) (void))
(define busy-count 0)
(define (end-busy-cursor) (atomically (set! busy-count (add1 busy-count))))
(define (is-busy?) (positive? busy-count))
(define (begin-busy-cursor) (atomically (set! busy-count (sub1 busy-count))))
(define-unimplemented is-color-display?)
(define (id-to-menu-item i) i)

3
collects/mred/private/wx/platform.rkt
View File

@ -39,9 +39,6 @@
file-selector
is-color-display?
get-display-depth
begin-busy-cursor
is-busy?
end-busy-cursor
has-x-selection?
hide-cursor
bell

3
collects/mred/private/wx/win32/platform.rkt
View File

@ -60,9 +60,6 @@
file-selector
is-color-display?
get-display-depth
begin-busy-cursor
is-busy?
end-busy-cursor
has-x-selection?
hide-cursor
bell

3
collects/mred/private/wx/win32/procs.rkt
View File

@ -42,9 +42,6 @@
display-size
bell
hide-cursor
end-busy-cursor
is-busy?
begin-busy-cursor
get-display-depth
is-color-display?
file-selector

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

@ -56,7 +56,7 @@
(define wx-label-panel%
(class wx-horizontal-panel%
(init proxy parent label style font valign)
(init proxy parent label style font halign valign)
(inherit area-parent)
(define c #f)
@ -67,7 +67,7 @@
(unless (memq 'deleted style)
(send (area-parent) add-child this))
(define horiz? (is-horiz? style parent))
(define p (make-sub horiz? proxy this (if horiz? 'left 'center) valign))
(define p (make-sub horiz? proxy this (if horiz? 'left halign) valign))
(define l (make-label label proxy p font))
(define/public (set-label s) (when l (send l set-label s)))
@ -96,7 +96,7 @@
(init mred proxy parent cb label x y w h choices style font)
(inherit stretchable-in-y stretchable-in-x get-p set-c)
(super-init proxy parent label style font 'center)
(super-init proxy parent label style font 'left 'center)
(define c (make-object wx-internal-choice% mred proxy (get-p) cb label x y w h choices
(filter-style style) font))
@ -154,7 +154,7 @@
(init mred proxy parent cb label kind x y w h choices style font label-font)
(inherit get-p set-c)
(super-init proxy parent label style font 'top)
(super-init proxy parent label style font 'left 'top)
(define c (make-object wx-internal-list-box% mred proxy (get-p) cb label kind x y w h choices
(filter-style style) font label-font))
@ -227,7 +227,7 @@
(init mred proxy parent cb label x y w h choices major style font)
(inherit stretchable-in-y stretchable-in-x get-p set-c)
(super-init proxy parent label style font 'center)
(super-init proxy parent label style font 'left 'center)
(define c (make-object wx-internal-radio-box% mred proxy (get-p) cb label x y w h choices
major (filter-style style) font))
@ -302,7 +302,7 @@
(init mred proxy parent label range style font)
(inherit stretchable-in-y stretchable-in-x get-p set-c)
(super-init proxy parent label style font 'center)
(super-init proxy parent label style font 'center 'center)
(define c (make-object wx-internal-gauge% mred proxy (get-p) label range
(filter-style style) font))
@ -360,7 +360,7 @@
(init mred proxy parent func label value min-val max-val style font)
(inherit stretchable-in-y stretchable-in-x get-p set-c)
(super-init proxy parent label style font 'center)
(super-init proxy parent label style font 'center 'center)
(define c (make-object wx-internal-slider% mred proxy (get-p) func label value min-val max-val
(filter-style style) font))

2
collects/tests/gracket/item.rkt
View File

@ -2069,7 +2069,7 @@
f
(lambda (b e)
(send f set-cursor (make-object cursor% s)))))
'(arrow bullseye cross hand ibeam watch arrow-watch blank size-n/s size-e/w size-ne/sw size-nw/se))
'(arrow bullseye cross hand ibeam watch blank size-n/s size-e/w size-ne/sw size-nw/se))
(send f show #t))