X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/112ac1d33aa8f9b7f3d2f9542d15431f152b1d35..4555db9042b279cf89ef06625e3a5d678a10a357:/glib/gerror.lisp diff --git a/glib/gerror.lisp b/glib/gerror.lisp index eafd9b0..5e0f56d 100644 --- a/glib/gerror.lisp +++ b/glib/gerror.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gerror.lisp,v 1.2 2005-04-23 16:48:50 espen Exp $ +;; $Id: gerror.lisp,v 1.5 2006-02-26 15:30:01 espen Exp $ (in-package "GLIB") @@ -65,6 +65,15 @@ (error condition :code (gerror-code gerror) :message (gerror-message gerror)))) +(deftype gerror-signal () 'gerror) + +(define-type-method from-alien-form ((type gerror-signal) gerror) + (declare (ignore type)) + `(let ((gerror ,(from-alien-form 'gerror gerror))) + (when gerror + (signal-gerror gerror)))) + + ;;; Message logging (eval-when (:compile-toplevel :load-toplevel :execute) @@ -106,10 +115,8 @@ (defparameter *fatal-log-levels* '(error-log-level critical-log-level)) -(defcallback log-handler (nil - (domain (copy-of string)) - (log-level log-levels) - (message (copy-of string))) +(define-callback log-handler nil + ((domain string) (log-level log-levels) (message string)) (let ((fatal-p (or (find :fatal log-level) (some @@ -123,7 +130,8 @@ (funcall (if fatal-p #'error #'warn) condition :domain domain :message message))) -(setf (extern-alien "log_handler" system-area-pointer) (callback log-handler)) +(setf (extern-alien "log_handler" system-area-pointer) + (callback-address log-handler)) #+glib2.6 @@ -134,6 +142,6 @@ ;; abort (SIGABORT being signaled). To make things even worse, SBCL ;; doesn't handle SIGABRT at all. (defbinding %log-set-default-handler () pointer - ((callback log-handler) pointer) + ((progn log-handler) callback) (nil null)) (%log-set-default-handler))