[mcclim-cvs] CVS mcclim

tmoore tmoore at common-lisp.net
Wed Mar 15 22:56:54 UTC 2006


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




More information about the Mcclim-cvs mailing list