glib/glib.gerror.lisp

   1 (in-package :glib)
   2
   3 (defcstruct g-error
   4   (:domain g-quark)
   5   (:code :int)
   6   (:message (:string :free-from-foreign nil)))
   7 (defctype g-error (:struct g-error))
   8
   9 (defcfun g-error-new-literal :pointer
  10   (domain g-quark)
  11   (code :int)
  12   (message :string))
  13
  14 (defcfun g-error-free :void
  15   (error :pointer))
  16
  17 (defcfun g-error-copy :pointer
  18   (error :pointer))
  19
  20 (defcfun g-error-matches :boolean
  21   (error :pointer)
  22   (domain g-quark)
  23   (code :int))
  24
  25 (defcfun g-set-error-literal :void
  26   (err-ptr :pointer)
  27   (domain g-quark)
  28   (code :int)
  29   (message :string))
  30
  31 (defcfun g-propagate-error :void
  32   (dest-ptr :pointer)
  33   (src-ptr :pointer))
  34
  35 (defcfun g-clear-error :void
  36   (err-ptr :pointer))
  37
  38 (define-condition g-error-condition (error)
  39   ((domain :initarg :domain :initform nil :reader g-error-condition-domain)
  40    (code :initarg :code :initform nil :reader g-error-condition-code)
  41    (message :initarg :message :initform nil :reader g-error-condition-message))
  42   (:report (lambda (e stream)
  43              (format stream "GError was raised. Domain: ~S, code: ~S, message: ~A"
  44                      (g-error-condition-domain e)
  45                      (g-error-condition-code e)
  46                      (g-error-condition-message e)))))
  47
  48 (defun mayber-raise-g-error-condition (err)
  49   (unless (null-pointer-p err)
  50     (error 'g-error-condition
  51            :domain (foreign-slot-value err 'g-error :domain)
  52            :code (foreign-slot-value err 'g-error :code)
  53            :message (foreign-slot-value err 'g-error :message))))
  54
  55 (defmacro with-g-error ((err) &body body)
  56   `(with-foreign-object (,err :pointer)
  57      (setf (mem-ref ,err :pointer) (null-pointer))
  58      (unwind-protect
  59           (progn ,@body)
  60        (mayber-raise-g-error-condition (mem-ref ,err :pointer))
  61        (g-clear-error ,err))))
  62
  63 (defmacro with-catching-to-g-error ((err) &body body)
  64   `(handler-case
  65        (progn ,@body)
  66      (g-error-condition (e)
  67        (g-set-error-literal ,err
  68                             (g-error-condition-domain e)
  69                             (g-error-condition-code e)
  70                             (g-error-condition-message e)))))
  71
  72 ;; void                g_prefix_error                      (GError **err,
  73 ;;                                                          const gchar *format,
  74 ;;                                                          ...);
  75 ;; void                g_propagate_prefixed_error          (GError **dest,
  76 ;;                                                          GError *src,
  77 ;;                                                          const gchar *format,
  78 ;;                                                          ...);