[mcclim-cvs] CVS mcclim/Backends/gtkairo

[afuchs]

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo
In directory clnet:/tmp/cvs-serv22716/Backends/gtkairo

Modified Files:
	cairo-ffi.lisp 
Log Message:
Commit Douglas Crosher's non-symbol case fixes:
 * defsystem :clouseau: avoid pathname directory namestrings in file component names;
    reworking to be more portable.
 * defsystem :clim-examples: add the stopwatch example.
 * Update support for the Scieneer CL.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp	2006/05/13 19:37:29	1.4
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp	2006/10/28 17:11:31	1.5
@@ -26,7 +26,12 @@
 
 
 (defmacro def-cairo-fun (name rtype &rest args)
-  (let* ((str (string-upcase name))
+  (let* (#-scl
+	 (str (string-upcase name))
+	 #+scl
+	 (str (if (eq ext:*case-mode* :upper)
+		  (string-upcase name)
+		  (string-downcase name)))
 	 (actual (intern (concatenate 'string "%-" str) :clim-gtkairo))
 	 (wrapper (intern str :clim-gtkairo))
 	 (argnames (mapcar #'car args)))
@@ -36,8 +41,12 @@
 	 , at args)
        (defun ,wrapper ,argnames
 	 (multiple-value-prog1
-	     (,actual , at argnames)
-	   (let ((status (cairo_status ,(car argnames))))
+	     #-scl (,actual , at argnames)
+	     #+scl 
+	     (ext:with-float-traps-masked (:underflow :overflow :inexact
+						      :divide-by-zero :invalid)
+	       (,actual , at argnames))
+	     (let ((status (cairo_status ,(car argnames))))
 	     (unless (eq status :success)
 	       (error "~A returned with status ~A" ,name status))))))))