add get-client-handle' to
window<%>'
This commit is contained in:
parent
adfa67206d
commit
81cbf1ae1f
|
@ -139,6 +139,8 @@
|
||||||
[do-set-status-text (lambda (s)
|
[do-set-status-text (lambda (s)
|
||||||
(when status-message
|
(when status-message
|
||||||
(send status-message set-label s)))])
|
(send status-message set-label s)))])
|
||||||
|
(override
|
||||||
|
[get-client-handle (lambda () (send wx-panel get-client-handle))])
|
||||||
(sequence
|
(sequence
|
||||||
(super-init (lambda () (set! wx (mk-wx finish)) wx)
|
(super-init (lambda () (set! wx (mk-wx finish)) wx)
|
||||||
(lambda () wx-panel) (lambda () mid-panel)
|
(lambda () wx-panel) (lambda () mid-panel)
|
||||||
|
|
|
@ -116,7 +116,7 @@
|
||||||
get-client-size get-size get-width get-height get-x get-y
|
get-client-size get-size get-width get-height get-x get-y
|
||||||
get-cursor set-cursor popup-menu
|
get-cursor set-cursor popup-menu
|
||||||
show is-shown? on-superwindow-show refresh
|
show is-shown? on-superwindow-show refresh
|
||||||
get-handle))
|
get-handle get-client-handle))
|
||||||
|
|
||||||
(define-keywords window%-keywords [enabled #t])
|
(define-keywords window%-keywords [enabled #t])
|
||||||
|
|
||||||
|
@ -173,6 +173,7 @@
|
||||||
[get-plain-label (lambda () (and (string? label) (wx:label->plain-label label)))]
|
[get-plain-label (lambda () (and (string? label) (wx:label->plain-label label)))]
|
||||||
|
|
||||||
[get-handle (lambda () (send wx get-handle))]
|
[get-handle (lambda () (send wx get-handle))]
|
||||||
|
[get-client-handle (lambda () (send wx get-client-handle))]
|
||||||
|
|
||||||
[accept-drop-files
|
[accept-drop-files
|
||||||
(entry-point
|
(entry-point
|
||||||
|
|
|
@ -727,6 +727,7 @@
|
||||||
(send (get-parent) end-no-cursor-rects))
|
(send (get-parent) end-no-cursor-rects))
|
||||||
|
|
||||||
(define/public (get-handle) (get-cocoa))
|
(define/public (get-handle) (get-cocoa))
|
||||||
|
(define/public (get-client-handle) (get-cocoa-content))
|
||||||
|
|
||||||
(define/public (popup-menu m x y)
|
(define/public (popup-menu m x y)
|
||||||
(send m do-popup (get-cocoa-content) (get-cocoa-window) x (flip-client y)
|
(send m do-popup (get-cocoa-content) (get-cocoa-window) x (flip-client y)
|
||||||
|
|
|
@ -612,6 +612,7 @@
|
||||||
(define/public (on-drop-file path) (void))
|
(define/public (on-drop-file path) (void))
|
||||||
|
|
||||||
(define/public (get-handle) (get-gtk))
|
(define/public (get-handle) (get-gtk))
|
||||||
|
(define/public (get-client-handle) (get-client-gtk))
|
||||||
|
|
||||||
(define/public (popup-menu m x y)
|
(define/public (popup-menu m x y)
|
||||||
(let ([gx (box x)]
|
(let ([gx (box x)]
|
||||||
|
|
|
@ -249,6 +249,7 @@
|
||||||
(define/public (on-set-focus) (void))
|
(define/public (on-set-focus) (void))
|
||||||
(define/public (on-kill-focus) (void))
|
(define/public (on-kill-focus) (void))
|
||||||
(define/public (get-handle) hwnd)
|
(define/public (get-handle) hwnd)
|
||||||
|
(define/public (get-client-handle) (get-client-hwnd))
|
||||||
|
|
||||||
(define enabled? #t)
|
(define enabled? #t)
|
||||||
(define parent-enabled? #t)
|
(define parent-enabled? #t)
|
||||||
|
|
|
@ -41,6 +41,20 @@
|
||||||
[ph-used?s (map (lambda (x) (box #f)) names)]
|
[ph-used?s (map (lambda (x) (box #f)) names)]
|
||||||
[struct-decl-for (lambda (id)
|
[struct-decl-for (lambda (id)
|
||||||
(and (identifier? id)
|
(and (identifier? id)
|
||||||
|
(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)))))])
|
||||||
|
(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))]
|
(let* ([s (symbol->string (syntax-e id))]
|
||||||
[m (regexp-match-positions "make-" s)])
|
[m (regexp-match-positions "make-" s)])
|
||||||
(and m
|
(and m
|
||||||
|
@ -49,13 +63,7 @@
|
||||||
(string->symbol (string-append (substring s 0 (caar m))
|
(string->symbol (string-append (substring s 0 (caar m))
|
||||||
(substring s (cdar m) (string-length s))))
|
(substring s (cdar m) (string-length s))))
|
||||||
id)])
|
id)])
|
||||||
(let ([v (syntax-local-value name (lambda () #f))])
|
(get-struct name))))))))]
|
||||||
(and v
|
|
||||||
(struct-declaration-info? v)
|
|
||||||
(let ([decl (extract-struct-info v)])
|
|
||||||
(and (cadr decl)
|
|
||||||
(andmap values (list-ref decl 4))
|
|
||||||
decl)))))))))]
|
|
||||||
[append-ids null]
|
[append-ids null]
|
||||||
[same-special-id? (lambda (a b)
|
[same-special-id? (lambda (a b)
|
||||||
;; Almost module-or-top-identifier=?,
|
;; Almost module-or-top-identifier=?,
|
||||||
|
|
|
@ -44,7 +44,9 @@
|
||||||
(datum->syntax orig (syntax-e orig) stx orig))
|
(datum->syntax orig (syntax-e orig) stx orig))
|
||||||
(syntax-case stx ()
|
(syntax-case stx ()
|
||||||
[(self arg ...) (datum->syntax 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 ...))))
|
(syntax-e (syntax (arg ...))))
|
||||||
stx
|
stx
|
||||||
stx)]
|
stx)]
|
||||||
|
|
|
@ -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)
|
@defmethod[(get-client-size)
|
||||||
(values (integer-in 0 10000)
|
(values (integer-in 0 10000)
|
||||||
(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?]{
|
@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
|
toolbox. The value that the pointer represents depends on the
|
||||||
platform:
|
platform:
|
||||||
|
|
||||||
|
@ -124,7 +144,7 @@ platform:
|
||||||
|
|
||||||
]
|
]
|
||||||
|
|
||||||
}
|
See also @method[window<%> get-client-handle].}
|
||||||
|
|
||||||
|
|
||||||
@defmethod[(get-height)
|
@defmethod[(get-height)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user