[mcclim-devel] Patch: Update support for the Scieneer CL.
Douglas Crosher
dtc at scieneer.com
Tue Oct 17 20:42:02 EDT 2006
* Update support for the Scieneer CL.
-------------- next part --------------
Index: Lisp-Dep/fix-scl.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Lisp-Dep/fix-scl.lisp,v
retrieving revision 1.1
diff -u -u -r1.1 fix-scl.lisp
--- Lisp-Dep/fix-scl.lisp 15 Mar 2006 22:56:55 -0000 1.1
+++ Lisp-Dep/fix-scl.lisp 18 Oct 2006 00:14:17 -0000
@@ -128,14 +128,12 @@
(defpackage :clim-mop
- (:use :common-lisp :clos))
+ (:use :clos))
(eval-when (:compile-toplevel :load-toplevel :execute)
(loop for sym being the symbols of :clim-mop
do (export sym :clim-mop)))
-(in-package :clim-mop)
-
(eval-when (:compile-toplevel :load-toplevel :execute)
(export '(clim-lisp-patch::defconstant
clim-lisp-patch::defclass)
Index: Experimental/freetype/freetype-package.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-package.lisp,v
retrieving revision 1.2
diff -u -u -r1.2 freetype-package.lisp
--- Experimental/freetype/freetype-package.lisp 5 Jun 2005 20:50:29 -0000 1.2
+++ Experimental/freetype/freetype-package.lisp 18 Oct 2006 00:14:16 -0000
@@ -1,6 +1,6 @@
(defpackage :mcclim-freetype
(:use :climi :clim :clim-lisp)
(:export :*freetype-font-path*)
- (:import-from #+cmucl :alien
+ (:import-from #+(or cmu scl) :alien
#+sbcl :sb-alien
:slot :make-alien :alien :deref))
Index: Backends/gtkairo/cairo-ffi.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp,v
retrieving revision 1.4
diff -u -u -r1.4 cairo-ffi.lisp
--- Backends/gtkairo/cairo-ffi.lisp 13 May 2006 19:37:29 -0000 1.4
+++ Backends/gtkairo/cairo-ffi.lisp 18 Oct 2006 00:14:12 -0000
@@ -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))))))))
Index: Apps/Scigraph/dwim/dwim-system.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/dwim-system.lisp,v
retrieving revision 1.2
diff -u -u -r1.2 dwim-system.lisp
--- Apps/Scigraph/dwim/dwim-system.lisp 3 Nov 2003 14:02:28 -0000 1.2
+++ Apps/Scigraph/dwim/dwim-system.lisp 18 Oct 2006 00:14:08 -0000
@@ -100,6 +100,7 @@
#+(or allegro sbcl) #.(if (fboundp 'compile-file-pathname)
(pathname-type (compile-file-pathname "foo"))
"fasl")
+ #+scl (pathname-type (compile-file-pathname "foo"))
#+lucid (car lcl:*load-binary-pathname-types*)
#+(and (not genera)
(not allegro)
@@ -124,7 +125,8 @@
#+GENERA "GENERA"
#+LUCID "LUCID"
#+ALLEGRO "ALLEGRO"
- #+SBCL "SBCL")
+ #+SBCL "SBCL"
+ #+scl "SCL")
(GUI
#+(and mcl (not clim)) "MAC"
#+(and genera (not clim)) "DW"
Index: Apps/Scigraph/dwim/extensions.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/extensions.lisp,v
retrieving revision 1.6
diff -u -u -r1.6 extensions.lisp
--- Apps/Scigraph/dwim/extensions.lisp 23 Mar 2006 10:09:50 -0000 1.6
+++ Apps/Scigraph/dwim/extensions.lisp 18 Oct 2006 00:14:08 -0000
@@ -105,7 +105,9 @@
(:genera (let ((symbol (intern string :scl)))
(and (boundp symbol) (symbol-value symbol))))
(:openmcl (ccl::getenv string))
- (:sbcl (sb-ext:posix-getenv string))))
+ (:sbcl (sb-ext:posix-getenv string))
+ (:scl (cdr (assoc string ext:*environment-list* :test #'string=)))
+ ))
#+allegro
;;>> Allegro 4.2 supports SYSTEM:GETENV. How do I set an environment variable?
@@ -328,7 +330,8 @@
((or :allegro :sbcl)
#.(if (fboundp 'compile-file-pathname)
(pathname-type (compile-file-pathname "foo"))
- "fasl"))
+ "fasl"))
+ (:scl (pathname-type (compile-file-pathname "foo")))
(:lucid (car lcl:*load-binary-pathname-types*))
(:mcl #.(pathname-type ccl:*.fasl-pathname*))
))
Index: Apps/Scigraph/dwim/load-dwim.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/load-dwim.lisp,v
retrieving revision 1.3
diff -u -u -r1.3 load-dwim.lisp
--- Apps/Scigraph/dwim/load-dwim.lisp 3 Nov 2003 14:02:28 -0000 1.3
+++ Apps/Scigraph/dwim/load-dwim.lisp 18 Oct 2006 00:14:08 -0000
@@ -64,7 +64,8 @@
#+genera si:*default-binary-file-type*
#+(or allegro sbcl) #.(if (fboundp 'compile-file-pathname)
(pathname-type (compile-file-pathname "foo"))
- "fasl")
+ "fasl")
+ #+scl (pathname-type (compile-file-pathname "foo"))
#+lucid (car lcl:*load-binary-pathname-types*)
#+(and (not genera)
(not allegro)
@@ -88,7 +89,8 @@
#+LUCID "LUCID"
#+ALLEGRO "ALLEGRO"
#+OPENMCL "OPENMCL"
- #+SBCL "SBCL")
+ #+SBCL "SBCL"
+ #+scl "SCL")
(GUI
#+(and mcl (not clim)) "MAC"
#+(and genera (not clim)) "DW"
Index: Apps/Scigraph/dwim/macros.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Scigraph/dwim/macros.lisp,v
retrieving revision 1.7
diff -u -u -r1.7 macros.lisp
--- Apps/Scigraph/dwim/macros.lisp 8 Aug 2004 21:11:17 -0000 1.7
+++ Apps/Scigraph/dwim/macros.lisp 18 Oct 2006 00:14:08 -0000
@@ -82,7 +82,7 @@
(mapcar #'(lambda (v) (if (symbolp v) v (car v))) let-vars)))
`(let ,forms (declare (dynamic-extent ,@(get-vars forms))) , at body)))
-#-(or openmcl-native-threads sb-thread)
+#-(or openmcl-native-threads sb-thread scl)
(defmacro without-interrupts (&body body)
#FEATURE-CASE
((:genera `(scl::without-interrupts , at body))
@@ -90,7 +90,7 @@
(:allegro `(excl:without-interrupts , at body))
(:mcl `(ccl:without-interrupts , at body))))
-#+(or openmcl-native-threads sb-thread)
+#+(or openmcl-native-threads sb-thread scl)
(progn
(defparameter *dwim-giant-lock* (clim-sys:make-lock "dwim giant lock"))
(defmacro without-interrupts (&body body)
More information about the mcclim-devel
mailing list