* Update support for the Scieneer CL.
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 @@ ,@args) (defun ,wrapper ,argnames (multiple-value-prog1 - (,actual ,@argnames) - (let ((status (cairo_status ,(car argnames)))) + #-scl (,actual ,@argnames) + #+scl + (ext:with-float-traps-masked (:underflow :overflow :inexact + :divide-by-zero :invalid) + (,actual ,@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))) ,@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 ,@body)) @@ -90,7 +90,7 @@ (:allegro `(excl:without-interrupts ,@body)) (:mcl `(ccl:without-interrupts ,@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)
Douglas Crosher wrote:
- Update support for the Scieneer CL.
Thanks! I committed this patch and the "Fix system pathnames" and "add the stopwatch example" patches.
One comment from David Lichteblau on #lisp (see http://www.ircbrowse.com/channel/lisp/20061028?utime=3371045114#utime_reques... for context): Setting floating point traps in def-cairo-fun is probably not right; it might be better to do it in with-cairo-floats. I left it as it the way your patch does it and added a small explanation for people trying to understand the code.
I'm not certain about the symbol name case patches (on the basis of hugeness and maintainability), so I will leave them out for this release. I hope leaving them out doesn't discourage you from sending more of your high-quality patches. I would like to find a solution that makes all users (including the ones of "modern mode" lisps) happy, but right now I prefer to get that release done before we fall back to 1-year time slots. (-:
Cheers,
Andreas Fuchs wrote:
Douglas Crosher wrote:
- Update support for the Scieneer CL.
Thanks! I committed this patch and the "Fix system pathnames" and "add the stopwatch example" patches.
Thank you.
One comment from David Lichteblau on #lisp (see http://www.ircbrowse.com/channel/lisp/20061028?utime=3371045114#utime_reques... for context): Setting floating point traps in def-cairo-fun is probably not right; it might be better to do it in with-cairo-floats. I left it as it the way your patch does it and added a small explanation for people trying to understand the code.
Thank you for pointing this out. The attached patch implements 'with-cairo-floats for the SCL and also CMUCL.
I'm not certain about the symbol name case patches (on the basis of hugeness and maintainability), so I will leave them out for this release. I hope leaving them out doesn't discourage you from sending more of your high-quality patches. I would like to find a solution that makes all users (including the ones of "modern mode" lisps) happy, but right now I prefer to get that release done before we fall back to 1-year time slots. (-:
'Modern mode' is a Franz term and may be trademark. Some customers prefer the ANSI CL symbol names in lower case, and I'll just call it a non-standard lower case mode, and the SCL supports this as an option. Since the changes are all neutral in ANSI upper case mode it would seem harmless to integrate them, and they have been developed and continue to be supported by Scieneer. Further I believe Franz offer ACL for free evaluation and this could be used to maintain McCLIM support for these changes. The modified source code is available from the SCL freeware collection, and ACL modern mode patches are also welcome, see: http://www.scieneer.com/s/product.html?code=56150
Regards Douglas Crosher
Index: Backends/gtkairo/cairo-ffi.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo-ffi.lisp,v retrieving revision 1.6 diff -u -r1.6 cairo-ffi.lisp --- Backends/gtkairo/cairo-ffi.lisp 28 Oct 2006 17:49:24 -0000 1.6 +++ Backends/gtkairo/cairo-ffi.lisp 28 Oct 2006 23:47:24 -0000 @@ -41,14 +41,8 @@ ,@args) (defun ,wrapper ,argnames (multiple-value-prog1 - ;; FIXME: This should probably go into with-cairo-floats. - ;; (see http://www.ircbrowse.com/channel/lisp/20061028?utime=3371045114#utime_reques...) - #-scl (,actual ,@argnames) - #+scl - (ext:with-float-traps-masked (:underflow :overflow :inexact - :divide-by-zero :invalid) - (,actual ,@argnames)) - (let ((status (cairo_status ,(car argnames)))) + (,actual ,@argnames) + (let ((status (cairo_status ,(car argnames)))) (unless (eq status :success) (error "~A returned with status ~A" ,name status))))))))
Index: Backends/gtkairo/gtk-ffi.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp,v retrieving revision 1.7 diff -u -r1.7 gtk-ffi.lisp --- Backends/gtkairo/gtk-ffi.lisp 13 May 2006 19:37:29 -0000 1.7 +++ Backends/gtkairo/gtk-ffi.lisp 28 Oct 2006 23:47:25 -0000 @@ -85,12 +95,19 @@ ;; reset all options afterwards, I get lisp errors like f-p-i-o for, say, ;; (ATAN -13 13/2) in McCLIM. Isn't SBCL responsible for calling C code ;; with the with the modes C code expects? Or does cairo change them? +#-(or scl cmu) (defmacro with-cairo-floats ((&optional) &body body) `(unwind-protect (progn #+sbcl (sb-int:set-floating-point-modes :traps nil) ,@body) #+sbcl (apply #'sb-int:set-floating-point-modes *normal-modes*))) +;;; +#+(or scl cmu) +(defmacro with-cairo-floats ((&optional) &body body) + `(ext:with-float-traps-masked (:underflow :overflow :inexact + :divide-by-zero :invalid) + ,@body))
;; Note: There's no need for locking in single threaded mode for most ;; functions, except that the main loop functions try to release the
-
Andreas Fuchs -
Douglas Crosher