repos
/
repl
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
initial commit
Annotate for file src/get-widget.lisp
2009-06-04 tobias
1
(in-package :cl-smoke.repl)
20:48:44 '
2
'
3
(defclass get-widget (qt:dialog)
'
4
((widget :initform nil
'
5
:accessor widget)
'
6
(label :initform (make-instance 'qt:label)
'
7
:reader label))
'
8
(:metaclass cxx:class))
'
9
'
10
(defmethod initialize-instance :after ((get-widget get-widget) &key)
'
11
(let ((layout (make-instance 'qt:vbox-layout))
'
12
(get-button (make-instance 'qt:push-button :args '("Get"))))
'
13
(cxx:add-widget layout (label get-widget))
'
14
(cxx:add-widget layout get-button)
'
15
(cxx:set-checkable get-button t)
'
16
(qt:connect (qt:get-signal get-button "clicked()")
'
17
#'(lambda ()
'
18
(cxx:grab-mouse get-widget)
'
19
(setf (cxx:text get-button)
'
20
"Click on a widget.")))
'
21
(cxx:set-layout get-widget layout))
'
22
(cxx:set-window-title get-widget "Get Widget")
'
23
(cxx:set-mouse-tracking get-widget t))
'
24
'
25
(defmethod cxx:mouse-press-event ((get-widget get-widget) event)
'
26
(cxx:release-mouse get-widget)
'
27
(setf (widget get-widget) (qt:application.widget-at (cxx:global-pos event)))
'
28
(cxx:done get-widget 0))
'
29
'
30
'
31
(defmethod cxx:mouse-move-event ((get-widget get-widget) event)
'
32
(setf (cxx:text (label get-widget))
'
33
(format nil "~A~%" (qt:application.widget-at (cxx:global-pos event)))))
'
34
'
35
'
36
(defun get-widget ()
'
37
"Returns the widget selected with the mouse."
'
38
(let ((get-widget (make-instance 'get-widget)))
'
39
(unwind-protect (cxx:exec get-widget) ;; run the dialog
'
40
(cxx:release-mouse get-widget))
'
41
(widget get-widget)))