Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv7770

Modified Files: README mcclim.asd package.lisp presentations.lisp stream-input.lisp system.lisp utils.lisp Log Message: Patches from dtc for Scieneer Common Lisp, and a few other fixes too.

--- /project/mcclim/cvsroot/mcclim/README 2004/12/20 15:47:32 1.2 +++ /project/mcclim/cvsroot/mcclim/README 2006/03/15 22:56:54 1.3 @@ -2,7 +2,9 @@

This is McCLIM, an implementation of the "Common Lisp Interface Manager CLIM II Specification." It currently works on X Windows using -CLX. It works with CMUCL, SBCL, CLISP, OpenMCL, Allegro CL and LispWorks. +CLX. It works with CMUCL, SBCL, CLISP, OpenMCL, Allegro CL, LispWorks, +and the Scieneer CL. + The INSTALL files in this directory give instructions for each Lisp implementation. Release notes for each release of McCLIM are in the ReleaseNotes directory. @@ -22,7 +24,7 @@

address-book - the canonical CLIM application clim-fig - a drawing program -postscript-test - shows of the CLIM PostScript stream +postscript-test - shows off the CLIM PostScript stream gadget-test - fun with CLIM gadgets calculator - a gadget-based calculator goatee-test - Hacks with Goatee, the Emacs-like editor used in McCLIM --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/15 15:38:39 1.9 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/03/15 22:56:54 1.10 @@ -85,6 +85,7 @@ :depends-on ("patch") :components ((:file #+cmu "fix-cmu" + #+scl "fix-scl" #+excl "fix-acl" #+sbcl "fix-sbcl" #+openmcl "fix-openmcl" @@ -101,6 +102,7 @@ :components ((:file #.(or #+(and :cmu :mp (not :pthread)) "mp-cmu" + #+scl "mp-scl" #+sb-thread "mp-sbcl" #+excl "mp-acl" #+openmcl "mp-openmcl" @@ -289,7 +291,7 @@ :depends-on (:clim ;; If we're on an implementation that ships CLX, use ;; it. Same if the user has loaded CLX already. - #+(or sbcl openmcl ecl clx allegro) :clim-clx + #+(or sbcl scl openmcl ecl clx allegro) :clim-clx #+gl :clim-opengl ;; OpenMCL and MCL support the beagle backend (native ;; OS X look&feel on OS X). --- /project/mcclim/cvsroot/mcclim/package.lisp 2006/01/28 00:38:04 1.52 +++ /project/mcclim/cvsroot/mcclim/package.lisp 2006/03/15 22:56:54 1.53 @@ -219,6 +219,7 @@ (gray-packages `(#+clisp ,@'(:gray) #+cmu ,@'(:ext) + #+scl ,@'(:ext) #+mcl ,@'(:ccl) #+allegro ,@'(:common-lisp :excl :stream) #+harlequin-common-lisp ,@'(:stream) --- /project/mcclim/cvsroot/mcclim/presentations.lisp 2006/03/15 15:38:39 1.74 +++ /project/mcclim/cvsroot/mcclim/presentations.lisp 2006/03/15 22:56:54 1.75 @@ -910,6 +910,7 @@

(defvar *standard-object-class* (find-class 'standard-object))

+#-scl (defmethod clim-mop:compute-applicable-methods-using-classes :around ((gf presentation-generic-function) classes) (multiple-value-bind (methods success) @@ -924,7 +925,24 @@ *standard-object-class*)) methods) t))))) - + +#+scl +(defmethod clim-mop:compute-applicable-methods-using-classes :around + ((gf presentation-generic-function) classes) + (multiple-value-bind (methods success non-class-positions) + (call-next-method) + (let ((ptype-class (car classes))) + (if (or (null success) + (not (typep ptype-class 'presentation-type-class))) + (values methods non-class-positions non-class-positions) + (values (remove-if #'(lambda (method) + (eq (car (clim-mop:method-specializers + method)) + *standard-object-class*)) + methods) + t + non-class-positions))))) + (defun method-applicable (method arguments) (loop for arg in arguments for specializer in (clim-mop:method-specializers method) --- /project/mcclim/cvsroot/mcclim/stream-input.lisp 2006/03/15 15:38:39 1.45 +++ /project/mcclim/cvsroot/mcclim/stream-input.lisp 2006/03/15 22:56:54 1.46 @@ -117,6 +117,15 @@ else do (handle-event (event-sheet event) event))))

+(defmethod stream-clear-input ((pane standard-input-stream)) + (setf (stream-unread-chars pane) nil) + (loop for event = (event-read-no-hang pane) + if (null event) + return nil + else + do (handle-event (event-sheet event) event)) + nil) + ;;; XXX The should be moved to protocol-classes.lisp and the ;;; standard-sheet-input-mixin superclass should be removed. (define-protocol-class extended-input-stream (fundamental-character-input-stream ;Gray stream @@ -384,6 +393,18 @@ do (stream-read-gesture estream) ; consume pointer gesture finally (return (characterp char)))))

+(defmethod stream-clear-input ((stream standard-extended-input-stream)) + (with-encapsulating-stream (estream stream) + (loop + with char and reason + do (setf (values char reason) (stream-read-gesture estream + :timeout 0 + :peek-p t)) + until (or (eq reason :eof) (eq reason :timeout)) + do (stream-read-gesture estream) ; consume pointer gesture + )) + nil) + ;;; stream-read-line returns a second value of t if terminated by eof. (defmethod stream-read-line ((stream standard-extended-input-stream)) (with-encapsulating-stream (estream stream) --- /project/mcclim/cvsroot/mcclim/system.lisp 2006/03/15 15:38:39 1.114 +++ /project/mcclim/cvsroot/mcclim/system.lisp 2006/03/15 22:56:54 1.115 @@ -80,6 +80,7 @@ ;; First possible patches "patch" #+cmu "Lisp-Dep/fix-cmu" + #+scl "Lisp-Dep/fix-scl" #+excl "Lisp-Dep/fix-acl" #+sbcl "Lisp-Dep/fix-sbcl" #+openmcl "Lisp-Dep/fix-openmcl" @@ -101,6 +102,7 @@ #+excl "Lisp-Dep/mp-acl" #+openmcl "Lisp-Dep/mp-openmcl" #+lispworks "Lisp-Dep/mp-lw" + #+scl "Lisp-Dep/mp-scl" #| fall back |# "Lisp-Dep/mp-nil") "utils" "defresource" --- /project/mcclim/cvsroot/mcclim/utils.lisp 2006/03/15 15:38:39 1.44 +++ /project/mcclim/cvsroot/mcclim/utils.lisp 2006/03/15 22:56:54 1.45 @@ -21,12 +21,12 @@

(defun get-environment-variable (string) #+excl (sys:getenv string) - #+cmu (cdr (assoc string ext:*environment-list* :test #'string=)) + #+(or cmu scl) (cdr (assoc string ext:*environment-list* :test #'string=)) #+clisp (ext:getenv (string string)) #+sbcl (sb-ext::posix-getenv string) #+openmcl (ccl::getenv string) #+lispworks (lw:environment-variable string) - #-(or excl cmu clisp sbcl openmcl lispworks) + #-(or excl cmu scl clisp sbcl openmcl lispworks) (error "GET-ENVIRONMENT-VARIABLE not implemented"))

;;; It would be nice to define this macro in terms of letf, but that