gtk/gtk.dialog.lisp

   1 (in-package :gtk)
   2
   3 (defcfun (dialog-run "gtk_dialog_run") response-type
   4   (dialog (g-object dialog)))
   5
   6 (export 'dialog-run)
   7
   8 (defcfun (dialog-response "gtk_dialog_response") :void
   9   (dialog (g-object dialog))
  10   (response response-type))
  11
  12 (export 'dialog-response)
  13
  14 (defcfun (dialog-add-button "gtk_dialog_add_button") (g-object widget)
  15   (dialog (g-object dialog))
  16   (button-text :string)
  17   (response response-type))
  18
  19 (export 'dialog-add-button)
  20
  21 (defcfun (dialog-add-action-widget "gtk_dialog_add_action_widget") :void
  22   (dialog (g-object dialog))
  23   (child (g-object widget))
  24   (response response-type))
  25
  26 (export 'dialog-add-action-widget)
  27
  28 (defcfun (dialog-set-response-sensitive "gtk_dialog_set_response_sensitive") :void
  29   (dialog (g-object dialog))
  30   (response response-type)
  31   (setting :boolean))
  32
  33 (export 'dialog-set-response-sensitive)
  34
  35 (defcfun (dialog-response-for-widget "gtk_dialog_get_response_for_widget") :int
  36   (dialog (g-object dialog))
  37   (widget (g-object widget)))
  38
  39 (export 'dialog-response-for-widget)
  40
  41 (defcfun (dialog-alternative-button-order-on-screen "gtk_alternative_dialog_button_order") :boolean
  42   (screen (g-object screen)))
  43
  44 (export 'dialog-alternative-button-order-on-screen)
  45
  46 (defcfun (dialog-set-alternative-button-order-from-array "gtk_dialog_set_alternative_button_order_from_array") :void
  47   (dialog (g-object dialog))
  48   (n-params :int)
  49   (new-order (:pointer response-type)))
  50
  51 (defun set-dialog-alternative-button-order (dialog response-list)
  52   (with-foreign-object (new-order 'response-type (length response-list))
  53     (loop
  54        for i from 0
  55        for response in response-list
  56        do (setf (mem-aref new-order 'response-type i) response))
  57     (dialog-set-alternative-button-order-from-array dialog (length response-list) new-order))
  58   response-list)
  59
  60 (export 'set-dialog-alternative-button-order)
  61
  62 (defmacro with-gtk-message-error-handler (&body body)
  63   (let ((dialog (gensym))
  64         (e (gensym)))
  65     `(handler-case
  66          (progn ,@body)
  67        (error (,e) (using* ((,dialog (make-instance 'message-dialog
  68                                                     :message-type :error :buttons :ok
  69                                                     :text (format nil "Error~%~A~%during execution of~%~A" ,e '(progn ,@body)))))
  70                            (dialog-run ,dialog)
  71                            (object-destroy ,dialog)
  72                            nil)))))
  73
  74 (export 'with-gtk-message-error-handler)