add get-client-handle' to window<%>'

This commit is contained in:
Matthew Flatt 2011-01-05 12:15:37 -07:00
parent adfa67206d
commit 81cbf1ae1f
8 changed files with 53 additions and 17 deletions

View File

@ -139,6 +139,8 @@
[do-set-status-text (lambda (s)
(when status-message
(send status-message set-label s)))])
(override
[get-client-handle (lambda () (send wx-panel get-client-handle))])
(sequence
(super-init (lambda () (set! wx (mk-wx finish)) wx)
(lambda () wx-panel) (lambda () mid-panel)

View File

@ -116,7 +116,7 @@
get-client-size get-size get-width get-height get-x get-y
get-cursor set-cursor popup-menu
show is-shown? on-superwindow-show refresh
get-handle))
get-handle get-client-handle))
(define-keywords window%-keywords [enabled #t])
@ -173,6 +173,7 @@
[get-plain-label (lambda () (and (string? label) (wx:label->plain-label label)))]
[get-handle (lambda () (send wx get-handle))]
[get-client-handle (lambda () (send wx get-client-handle))]
[accept-drop-files
(entry-point

View File

@ -727,6 +727,7 @@
(send (get-parent) end-no-cursor-rects))
(define/public (get-handle) (get-cocoa))
(define/public (get-client-handle) (get-cocoa-content))
(define/public (popup-menu m x y)
(send m do-popup (get-cocoa-content) (get-cocoa-window) x (flip-client y)

View File

@ -612,6 +612,7 @@
(define/public (on-drop-file path) (void))
(define/public (get-handle) (get-gtk))
(define/public (get-client-handle) (get-client-gtk))
(define/public (popup-menu m x y)
(let ([gx (box x)]

View File

@ -249,6 +249,7 @@
(define/public (on-set-focus) (void))
(define/public (on-kill-focus) (void))
(define/public (get-handle) hwnd)
(define/public (get-client-handle) (get-client-hwnd))
(define enabled? #t)
(define parent-enabled? #t)

View File

@ -41,21 +41,29 @@
[ph-used?s (map (lambda (x) (box #f)) names)]
[struct-decl-for (lambda (id)
(and (identifier? id)
(let* ([s (symbol->string (syntax-e id))]
[m (regexp-match-positions "make-" s)])
(and m
(let ([name (datum->syntax
id
(string->symbol (string-append (substring s 0 (caar m))
(substring s (cdar m) (string-length s))))
id)])
(let ([v (syntax-local-value name (lambda () #f))])
(and v
(struct-declaration-info? v)
(let ([decl (extract-struct-info v)])
(let ([get-struct
(lambda (id)
(let ([v (syntax-local-value id (lambda () #f))])
(and v
(struct-declaration-info? v)
(let ([decl (extract-struct-info v)])
(and (cadr decl)
(andmap values (list-ref decl 4))
decl)))))))))]
decl)))))])
(or (get-struct id)
(let ([s (syntax-property id 'constructor-for)])
(and s
(identifier? s)
(get-struct s)))
(let* ([s (symbol->string (syntax-e id))]
[m (regexp-match-positions "make-" s)])
(and m
(let ([name (datum->syntax
id
(string->symbol (string-append (substring s 0 (caar m))
(substring s (cdar m) (string-length s))))
id)])
(get-struct name))))))))]
[append-ids null]
[same-special-id? (lambda (a b)
;; Almost module-or-top-identifier=?,

View File

@ -44,7 +44,9 @@
(datum->syntax orig (syntax-e orig) stx orig))
(syntax-case stx ()
[(self arg ...) (datum->syntax stx
(cons (transfer-srcloc orig #'self)
(cons (syntax-property (transfer-srcloc orig #'self)
'constructor-for
(syntax-local-introduce #'self))
(syntax-e (syntax (arg ...))))
stx
stx)]

View File

@ -81,6 +81,25 @@ Note that under X, keyboard focus can move to the menu bar
}
@defmethod[(get-client-handle) cpointer?]{
Returns a handle to the ``inside'' of the window for the current
platform's GUI toolbox. The value that the pointer represents depends
on the platform:
@itemize[
@item{Windows: @tt{HWND}}
@item{Mac OS X: @tt{NSView}}
@item{X: @tt{GtkWidget}}
]
See also @method[window<%> get-handle].}
@defmethod[(get-client-size)
(values (integer-in 0 10000)
(integer-in 0 10000))]{
@ -107,9 +126,10 @@ Returns the window's cursor, or @scheme[#f] if this window's cursor
}
@defmethod[(get-handle) cpointer?]{
Returns a handle to the window for the current platform's GUI
Returns a handle to the ``outside'' of the window for the current platform's GUI
toolbox. The value that the pointer represents depends on the
platform:
@ -124,7 +144,7 @@ platform:
]
}
See also @method[window<%> get-client-handle].}
@defmethod[(get-height)