X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/55212af123daea1d86d31da21cc1bee77651fb81..a92553bd87d94b64654a70a7293b3d46cfec4595:/glib/gerror.lisp diff --git a/glib/gerror.lisp b/glib/gerror.lisp index a1554a6..05bf4b5 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.4 2006/02/19 19:31:14 espen Exp $ (in-package "GLIB") @@ -65,6 +65,15 @@ (defun signal-gerror (gerror) (error condition :code (gerror-code gerror) :message (gerror-message gerror)))) +(deftype gerror-signal () 'gerror) + +(defmethod from-alien-form (gerror (type (eql 'gerror-signal)) &rest args) + (declare (ignore type args)) + `(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 @@ (define-condition debug-log-level (log-level) (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 @@ (defcallback log-handler (nil (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 @@ (progn ;; 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))