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-default-response "gtk_dialog_set_default_response") :void
  29   (dialog (g-object dialog))
  30   (response response-type))
  31
  32 (defun (setf dialog-default-response) (response dialog)
  33   (dialog-set-default-response dialog response)
  34   response)
  35
  36 (export 'dialog-default-response)
  37
  38 (defcfun (dialog-set-response-sensitive "gtk_dialog_set_response_sensitive") :void
  39   (dialog (g-object dialog))
  40   (response response-type)
  41   (setting :boolean))
  42
  43 (export 'dialog-set-response-sensitive)
  44
  45 (defcfun (dialog-response-for-widget "gtk_dialog_get_response_for_widget") :int
  46   (dialog (g-object dialog))
  47   (widget (g-object widget)))
  48
  49 (export 'dialog-response-for-widget)
  50
  51 (defcfun (dialog-alternative-button-order-on-screen "gtk_alternative_dialog_button_order") :boolean
  52   (screen (g-object screen)))
  53
  54 (export 'dialog-alternative-button-order-on-screen)
  55
  56 (defcfun (dialog-set-alternative-button-order-from-array "gtk_dialog_set_alternative_button_order_from_array") :void
  57   (dialog (g-object dialog))
  58   (n-params :int)
  59   (new-order (:pointer response-type)))
  60
  61 (defun (setf dialog-alternative-button-order) (response-list dialog)
  62   (with-foreign-object (new-order 'response-type (length response-list))
  63     (loop
  64        for i from 0
  65        for response in response-list
  66        do (setf (mem-aref new-order 'response-type i) response))
  67     (dialog-set-alternative-button-order-from-array dialog (length response-list) new-order))
  68   response-list)
  69
  70 (export 'dialog-alternative-button-order)
  71
  72 (defmacro with-gtk-message-error-handler (&body body)
  73   (let ((dialog (gensym))
  74         (e (gensym)))
  75     `(handler-case
  76          (progn ,@body)
  77        (error (,e) (using* ((,dialog (make-instance 'message-dialog
  78                                                     :message-type :error :buttons :ok
  79                                                     :text (format nil "Error~%~A~%during execution of~%~A" ,e '(progn ,@body)))))
  80                            (dialog-run ,dialog)
  81                            (object-destroy ,dialog)
  82                            nil)))))
  83
  84 (export 'with-gtk-message-error-handler)