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