[cells-gtk-devel] Modal Dialogs

[Novikov Leonid]

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.