3a9f8eea4f
"My" -> "Racket". The "My" prefix was from initial experiments, of course, and I just never got around to changing it before. I think these names go into a global namespace, though, at the ObjC level, so they need to have a distinct and Racket-specific prefix.
74 lines
2.4 KiB
Racket
74 lines
2.4 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
ffi/unsafe
|
|
ffi/unsafe/objc
|
|
"../../syntax.rkt"
|
|
"item.rkt"
|
|
"types.rkt"
|
|
"const.rkt"
|
|
"utils.rkt"
|
|
"window.rkt"
|
|
"../common/event.rkt")
|
|
|
|
(provide
|
|
(protect-out choice%))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(import-class NSPopUpButton)
|
|
|
|
(define-objc-class RacketPopUpButton NSPopUpButton
|
|
#:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
|
|
[wxb]
|
|
(-a _void (clicked: [_id sender])
|
|
(queue-window*-event wxb (lambda (wx) (send wx clicked)))))
|
|
|
|
(defclass choice% item%
|
|
(init parent cb label
|
|
x y w h
|
|
choices style font)
|
|
(inherit get-cocoa init-font register-as-child)
|
|
|
|
(super-new [parent parent]
|
|
[cocoa
|
|
(let ([cocoa
|
|
(as-objc-allocation
|
|
(tell (tell RacketPopUpButton alloc)
|
|
initWithFrame: #:type _NSRect (make-NSRect (make-init-point x y)
|
|
(make-NSSize w h))
|
|
pullsDown: #:type _BOOL #f))])
|
|
(for ([lbl (in-list choices)]
|
|
[i (in-naturals)])
|
|
(tellv cocoa
|
|
insertItemWithTitle: #:type _NSString lbl
|
|
atIndex: #:type _NSInteger i))
|
|
(init-font cocoa font)
|
|
(tellv cocoa sizeToFit)
|
|
(tellv cocoa setTarget: cocoa)
|
|
(tellv cocoa setAction: #:type _SEL (selector clicked:))
|
|
cocoa)]
|
|
[callback cb]
|
|
[no-show? (memq 'deleted style)])
|
|
|
|
(define callback cb)
|
|
(define/public (clicked)
|
|
(callback this (new control-event%
|
|
[event-type 'choice]
|
|
[time-stamp (current-milliseconds)])))
|
|
|
|
(define/public (set-selection i)
|
|
(tellv (get-cocoa) selectItemAtIndex: #:type _NSInteger i))
|
|
(define/public (get-selection)
|
|
(tell #:type _NSInteger (get-cocoa) indexOfSelectedItem))
|
|
(define/public (number)
|
|
(tell #:type _NSInteger (get-cocoa) numberOfItems))
|
|
(define/public (clear)
|
|
(tellv (get-cocoa) removeAllItems))
|
|
(define/public (append lbl)
|
|
(tellv (get-cocoa)
|
|
insertItemWithTitle: #:type _NSString lbl
|
|
atIndex: #:type _NSInteger (number)))
|
|
|
|
(define/override (maybe-register-as-child parent on?)
|
|
(register-as-child parent on?)))
|