Peter Denno wrote:
Hi Shuan,
How about something like this (from test-gtk/test-dialogs.lisp):
(mk-button :label "Query for text"
:on-clicked
(callback (w e d)
(let ((dialog
(to-be
(mk-message-dialog
:md-name :rule-name-dialog
:message "Type something:"
:title "My Title"
:message-type :question
:buttons-type :ok-cancel
:content-area (mk-entry :auto-aupdate
t)))))
(setf (text (fm^ :message-response))
(md-value dialog))))))
The callback on the button creates a dialog, to-be pops it up (I think) and it
hangs around until you OK, at which point it grabs the value out of it an (in
this case) displays it in a textview.
I did not want to use GtkMessageDialog and in my application has done as
follows:
(def-widget dialog (window)
((content-area :accessor content-area :initarg :content-area :initform
nil)
(eval-response :accessor eval-response :initarg :eval-response
:initform (lambda (self resp) (print resp) ))
(buttons :accessor buttons :initarg :buttons :initform nil)
(buttons-id :accessor buttons-id :initarg :buttons-id :initform (c-in
nil)))
(markup)
()
:position :mouse
:new-args nil
)
(defmethod md-awaken :after ((self dialog))
(let ((response (gtk-dialog-run (id self))))
(funcall (eval-response self) self response)
)
(gtk-widget-destroy (id self))
(gtk-object-forget (id self) self)
(with-slots (content-area) self
(when content-area
(setf (md-value self) (md-value content-area))
(gtk-object-forget (id content-area) content-area))))
(def-c-output content-area ((self dialog))
(when new-value
(to-be new-value)
(let ((vbox (gtk-adds-dialog-vbox (id self))))
(gtk-box-pack-start vbox (id new-value) nil nil 5))))
(def-c-output buttons ((self dialog))
(when new-value
(setf (buttons-id self) (mapcar #'(lambda (b) (gtk-dialog-add-button
(id self) (car b) (car (cdr b)))) new-value))
)
)
(defmodel login-dialog (cgtk::dialog)
((username :accessor username :initarg :username :initform nil)
(db-type :accessor db-type :initarg :db-type :initform nil)
(db-other :accessor db-other :initarg :db-other :initform nil))
(:default-initargs
:content-area (c? (make-instance 'login-window :username (username
self)
:db-type (db-type self) :db-other (db-other self)))
:buttons '(("gtk-ok" -1) ("gtk-cancel" -2))
:eval-response (lambda (self x) (if (eql x -1) (setf (md-value
(content-area self)) (funcall (eval (get-md-value (content-area self)))
(content-area self)))))
)
)
I think that makes sense add widget dialog in dialogs.lisp. And inherit
rest dialogue widgets from it. I could do this work and send patch for
dialogs.lisp.
_______________________________________________
cells-gtk-devel site list
[email protected]
http://common-lisp.net/mailman/listinfo/cells-gtk-devel
