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 (defcfun (dialog-response-for-widget "gtk_dialog_get_response_for_widget") :int
  44   (dialog (g-object dialog))
  45   (widget (g-object widget)))
  46
  47 (export 'dialog-response-for-widget)
  48
  49 (defcfun (dialog-action-area "gtk_dialog_get_action_area") (g-object widget)
  50   (dialog (g-object dialog)))
  51
  52 (export 'dialog-action-area)
  53
  54 (defcfun (dialog-content-area "gtk_dialog_get_content_area") (g-object widget)
  55   (dialog (g-object dialog)))
  56
  57 (export 'dialog-content-area)
  58
  59 (defcfun (dialog-alternative-button-order-on-screen "gtk_alternative_dialog_button_order") :boolean
  60   (screen (g-object screen)))
  61
  62 (export 'dialog-alternative-button-order-on-screen)
  63
  64 (defcfun (dialog-set-alternative-button-order-from-array "gtk_dialog_set_alternative_button_order_from_array") :void
  65   (dialog (g-object dialog))
  66   (n-params :int)
  67   (new-order (:pointer response-type)))
  68
  69 (defun (setf dialog-alternative-button-order) (response-list dialog)
  70   (with-foreign-object (new-order 'response-type (length response-list))
  71     (loop
  72        for i from 0
  73        for response in response-list
  74        do (setf (mem-aref new-order 'response-type i) response))
  75     (dialog-set-alternative-button-order-from-array dialog (length response-list) new-order))
  76   response-list)
  77
  78 (export 'dialog-alternative-button-order)
  79
  80 (defmacro with-gtk-message-error-handler (&body body)
  81   (let ((dialog (gensym))
  82         (e (gensym)))
  83     `(handler-case
  84          (progn ,@body)
  85        (error (,e) (using* ((,dialog (make-instance 'message-dialog
  86                                                     :message-type :error :buttons :ok
  87                                                     :text (format nil "Error~%~A~%during execution of~%~A" ,e '(progn ,@body)))))
  88                            (dialog-run ,dialog)
  89                            (object-destroy ,dialog)
  90                            nil)))))
  91
  92 (export 'with-gtk-message-error-handler)