Thu Jun 4 22:48:44 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>

* initial commit

--- old-repl/src/get-widget.lisp 1970-01-01 01:00:00.000000000 +0100

+++ new-repl/src/get-widget.lisp 2014-10-30 08:04:14.000000000 +0100

@@ -0,0 +1,41 @@

+(in-package :cl-smoke.repl)

+

+(defclass get-widget (qt:dialog)

+ ((widget :initform nil

+ :accessor widget)

+ (label :initform (make-instance 'qt:label)

+ :reader label))

+ (:metaclass cxx:class))

+

+(defmethod initialize-instance :after ((get-widget get-widget) &key)

+ (let ((layout (make-instance 'qt:vbox-layout))

+ (get-button (make-instance 'qt:push-button :args '("Get"))))

+ (cxx:add-widget layout (label get-widget))

+ (cxx:add-widget layout get-button)

+ (cxx:set-checkable get-button t)

+ (qt:connect (qt:get-signal get-button "clicked()")

+ #'(lambda ()

+ (cxx:grab-mouse get-widget)

+ (setf (cxx:text get-button)

+ "Click on a widget.")))

+ (cxx:set-layout get-widget layout))

+ (cxx:set-window-title get-widget "Get Widget")

+ (cxx:set-mouse-tracking get-widget t))

+

+(defmethod cxx:mouse-press-event ((get-widget get-widget) event)

+ (cxx:release-mouse get-widget)

+ (setf (widget get-widget) (qt:application.widget-at (cxx:global-pos event)))

+ (cxx:done get-widget 0))

+

+

+(defmethod cxx:mouse-move-event ((get-widget get-widget) event)

+ (setf (cxx:text (label get-widget))

+ (format nil "~A~%" (qt:application.widget-at (cxx:global-pos event)))))

+

+

+(defun get-widget ()

+ "Returns the widget selected with the mouse."

+ (let ((get-widget (make-instance 'get-widget)))

+ (unwind-protect (cxx:exec get-widget) ;; run the dialog

+ (cxx:release-mouse get-widget))

+ (widget get-widget)))