Index: README
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/README,v
retrieving revision 1.2
diff -c -r1.2 README
*** README	20 Dec 2004 15:47:32 -0000	1.2
--- README	14 Mar 2006 02:15:55 -0000
***************
*** 2,8 ****
  
  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.
  The INSTALL files in this directory give instructions for each Lisp
  implementation. Release notes for each release of McCLIM are in the
  ReleaseNotes directory.
--- 2,10 ----
  
  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, 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,28 ****
  
  address-book - the canonical CLIM application
  clim-fig - a drawing program
! postscript-test - shows of 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
--- 24,30 ----
  
  address-book - the canonical CLIM application
  clim-fig - a drawing program
! 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
Index: mcclim.asd
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/mcclim.asd,v
retrieving revision 1.8
diff -c -r1.8 mcclim.asd
*** mcclim.asd	10 Mar 2006 21:58:13 -0000	1.8
--- mcclim.asd	14 Mar 2006 02:15:56 -0000
***************
*** 85,90 ****
--- 85,91 ----
              :depends-on ("patch")
              :components
              ((:file   #+cmu       "fix-cmu"
+ 		      #+scl       "fix-scl"
                        #+excl      "fix-acl"
                        #+sbcl      "fix-sbcl"
                        #+openmcl   "fix-openmcl"
***************
*** 101,106 ****
--- 102,108 ----
                            :components
                            ((:file #.(or
                                       #+(and :cmu :mp (not :pthread))  "mp-cmu"
+                                      #+scl                     "mp-scl"
                                       #+sb-thread               "mp-sbcl"
                                       #+excl                    "mp-acl"
                                       #+openmcl                 "mp-openmcl"
***************
*** 289,295 ****
      :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
                   #+gl                        :clim-opengl
                   ;; OpenMCL and MCL support the beagle backend (native
                   ;; OS X look&feel on OS X).
--- 291,297 ----
      :depends-on (:clim
                   ;; If we're on an implementation that ships CLX, use
                   ;; it. Same if the user has loaded CLX already.
!                  #+(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).
Index: package.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/package.lisp,v
retrieving revision 1.52
diff -c -r1.52 package.lisp
*** package.lisp	28 Jan 2006 00:38:04 -0000	1.52
--- package.lisp	14 Mar 2006 02:15:56 -0000
***************
*** 219,224 ****
--- 219,225 ----
          (gray-packages
           `(#+clisp                 ,@'(:gray)
             #+cmu                   ,@'(:ext)
+            #+scl                   ,@'(:ext)
  	   #+mcl                   ,@'(:ccl)
             #+allegro               ,@'(:common-lisp :excl :stream)
             #+harlequin-common-lisp ,@'(:stream)
Index: presentations.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/presentations.lisp,v
retrieving revision 1.73
diff -c -r1.73 presentations.lisp
*** presentations.lisp	12 Mar 2006 23:09:27 -0000	1.73
--- presentations.lisp	14 Mar 2006 02:15:57 -0000
***************
*** 910,915 ****
--- 910,916 ----
  
  (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,930 ****
  				     *standard-object-class*))
  			     methods)
  		  t)))))
!   
  (defun method-applicable (method arguments)
    (loop for arg in arguments
  	for specializer in (clim-mop:method-specializers method)
--- 925,948 ----
  				     *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)
Index: system.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/system.lisp,v
retrieving revision 1.113
diff -c -r1.113 system.lisp
*** system.lisp	10 Mar 2006 21:58:13 -0000	1.113
--- system.lisp	14 Mar 2006 02:15:57 -0000
***************
*** 80,85 ****
--- 80,86 ----
    ;; 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"
***************
*** 100,105 ****
--- 101,107 ----
        #+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"
Index: utils.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/utils.lisp,v
retrieving revision 1.43
diff -c -r1.43 utils.lisp
*** utils.lisp	10 Mar 2006 21:58:13 -0000	1.43
--- utils.lisp	14 Mar 2006 02:15:57 -0000
***************
*** 21,32 ****
  
  (defun get-environment-variable (string)
    #+excl (sys:getenv string)
!   #+cmu (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)
    (error "GET-ENVIRONMENT-VARIABLE not implemented"))
  
  ;;; It would be nice to define this macro in terms of letf, but that
--- 21,32 ----
  
  (defun get-environment-variable (string)
    #+excl (sys:getenv 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 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
Index: Apps/Listener/dev-commands.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp,v
retrieving revision 1.32
diff -c -r1.32 dev-commands.lisp
*** Apps/Listener/dev-commands.lisp	6 Dec 2005 16:21:58 -0000	1.32
--- Apps/Listener/dev-commands.lisp	14 Mar 2006 02:15:58 -0000
***************
*** 672,678 ****
    #+clisp (clos:specializer-direct-generic-functions specializer)
    #+openmcl-partial-mop
    (openmcl-mop:specializer-direct-generic-functions specializer)
!   #-(or PCL SBCL clisp openmcl-partial-mop)
    (error "Sorry, not supported in your CL implementation. See the function X-SPECIALIZER-DIRECT-GENERIC-FUNCTION if you are interested in fixing this."))
  
  (defun class-funcs (class)
--- 672,679 ----
    #+clisp (clos:specializer-direct-generic-functions specializer)
    #+openmcl-partial-mop
    (openmcl-mop:specializer-direct-generic-functions specializer)
!   #+scl (clos:specializer-direct-generic-functions specializer)
!   #-(or PCL SBCL scl clisp openmcl-partial-mop)
    (error "Sorry, not supported in your CL implementation. See the function X-SPECIALIZER-DIRECT-GENERIC-FUNCTION if you are interested in fixing this."))
  
  (defun class-funcs (class)
***************
*** 941,950 ****
    "Return the number of internal symbols in PACKAGE."
    ;; We take only the first value, the symbol count, and discard the second, the
    ;; hash table capacity
!   #+cmu  (values (lisp::internal-symbol-count package))
    #+sbcl (values (sb-int:package-internal-symbol-count package))
    #+clisp (svref (sys::%record-ref *package* 1) 2)
!   #-(or cmu sbcl clisp) (portable-internal-symbol-count package))
  
  (defun portable-external-symbol-count (package)
    (let ((n 0))
--- 942,951 ----
    "Return the number of internal symbols in PACKAGE."
    ;; We take only the first value, the symbol count, and discard the second, the
    ;; hash table capacity
!   #+(or cmu scl)  (values (lisp::internal-symbol-count package))
    #+sbcl (values (sb-int:package-internal-symbol-count package))
    #+clisp (svref (sys::%record-ref *package* 1) 2)
!   #-(or cmu scl sbcl clisp) (portable-internal-symbol-count package))
  
  (defun portable-external-symbol-count (package)
    (let ((n 0))
***************
*** 955,964 ****
  
  (defun count-external-symbols (package)
    "Return the number of external symbols in PACKAGE."
!   #+cmu  (values (lisp::external-symbol-count package))
    #+sbcl (values (sb-int:package-external-symbol-count package))
    #+clisp (svref (sys::%record-ref *package* 0) 2)
!   #-(or cmu sbcl clisp) (portable-external-symbol-count package))
  
  (defun package-grapher (stream package inferior-fun)
    "Draw package hierarchy graphs for `Show Package Users' and `Show Used Packages'."
--- 956,965 ----
  
  (defun count-external-symbols (package)
    "Return the number of external symbols in PACKAGE."
!   #+(or cmu scl)  (values (lisp::external-symbol-count package))
    #+sbcl (values (sb-int:package-external-symbol-count package))
    #+clisp (svref (sys::%record-ref *package* 0) 2)
!   #-(or cmu scl sbcl clisp) (portable-external-symbol-count package))
  
  (defun package-grapher (stream package inferior-fun)
    "Draw package hierarchy graphs for `Show Package Users' and `Show Used Packages'."
Index: Apps/Listener/listener.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp,v
retrieving revision 1.22
diff -c -r1.22 listener.lisp
*** Apps/Listener/listener.lisp	6 Dec 2005 16:21:11 -0000	1.22
--- Apps/Listener/listener.lisp	14 Mar 2006 02:15:58 -0000
***************
*** 72,87 ****
    (declare (ignore frame))
    (let* ((*standard-output* pane)
           (username (or #+cmu (cdr (assoc :user ext:*environment-list*))
  		       #+allegro (sys:getenv "USER")
! 		       #-(or allegro cmu) (getenv "USER")
                         "luser"))  ; sorry..
           (sitename (machine-instance))
!          (memusage #+cmu (lisp::dynamic-usage)
                     #+sbcl  (sb-kernel:dynamic-usage)
                     #+lispworks (getf (system:room-values) :total-allocated)
  		   #+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes))
                     #+clisp (values (sys::%room))
!                    #-(or cmu sbcl lispworks openmcl clisp) 0))
      (with-text-family (T :serif)
        (formatting-table (T :x-spacing '(3 :character))
          (formatting-row (T)                        
--- 72,89 ----
    (declare (ignore frame))
    (let* ((*standard-output* pane)
           (username (or #+cmu (cdr (assoc :user ext:*environment-list*))
+ 		       #+scl (cdr (assoc "USER" ext:*environment-list*
+ 					 :test 'string=))
  		       #+allegro (sys:getenv "USER")
! 		       #-(or allegro cmu scl) (getenv "USER")
                         "luser"))  ; sorry..
           (sitename (machine-instance))
!          (memusage #+(or cmu scl) (lisp::dynamic-space-usage)
                     #+sbcl  (sb-kernel:dynamic-usage)
                     #+lispworks (getf (system:room-values) :total-allocated)
  		   #+openmcl (+ (ccl::%usedbytes) (ccl::%freebytes))
                     #+clisp (values (sys::%room))
!                    #-(or cmu scl sbcl lispworks openmcl clisp) 0))
      (with-text-family (T :serif)
        (formatting-table (T :x-spacing '(3 :character))
          (formatting-row (T)                        
Index: Apps/Listener/util.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp,v
retrieving revision 1.19
diff -c -r1.19 util.lisp
*** Apps/Listener/util.lisp	13 Oct 2005 14:32:13 -0000	1.19
--- Apps/Listener/util.lisp	14 Mar 2006 02:15:58 -0000
***************
*** 63,68 ****
--- 63,69 ----
  (defun getenv (var)
    (or 
     #+cmu (cdr (assoc var ext:*environment-list*))
+    #+scl (cdr (assoc var ext:*environment-list* :test #'string=))
     #+sbcl (sb-ext:posix-getenv var)
     #+lispworks (lw:environment-variable var)
     #+openmcl (ccl::getenv var)
***************
*** 73,78 ****
--- 74,80 ----
  (defun change-directory (pathname)
    "Ensure that the current directory seen by RUN-PROGRAM has changed, and update *default-pathname-defaults*"
    #+CMU (unix:unix-chdir (namestring pathname))
+   #+scl (unix:unix-chdir (ext:unix-namestring pathname))
    #+clisp (ext:cd pathname)
    ; SBCL FIXME?
   (setf *default-pathname-defaults* pathname))
***************
*** 85,91 ****
  ;;; LIST-DIRECTORY is a wrapper for the CL DIRECTORY function, which really doesn't
  ;;; do what I'd like (resolves symbolic links, tends to be horribly buggy, etc.)
  
! #+CMU
  (defun list-directory (pathname)
    (directory pathname :truenamep nil))
  
--- 87,93 ----
  ;;; LIST-DIRECTORY is a wrapper for the CL DIRECTORY function, which really doesn't
  ;;; do what I'd like (resolves symbolic links, tends to be horribly buggy, etc.)
  
! #+(or CMU scl)
  (defun list-directory (pathname)
    (directory pathname :truenamep nil))
  
***************
*** 143,149 ****
    (directory pathname :directories-are-files nil))
  
  ;; Fallback to ANSI CL
! #-(OR CMU SBCL OPENMCL ALLEGRO)
  (defun list-directory (pathname)
    (directory pathname))
  
--- 145,151 ----
    (directory pathname :directories-are-files nil))
  
  ;; Fallback to ANSI CL
! #-(OR CMU scl SBCL OPENMCL ALLEGRO)
  (defun list-directory (pathname)
    (directory pathname))
  
***************
*** 167,174 ****
  ;;; (see above)
  
  (defun run-program (program args &key (wait T) (output *standard-output*) (input *standard-input*))    
!   #+CMU (ext:run-program program args :input input
!                                        :output output :wait wait)
  
    #+SBCL (sb-ext:run-program program args :input input :search T
                                            :output output :wait wait)
--- 169,176 ----
  ;;; (see above)
  
  (defun run-program (program args &key (wait T) (output *standard-output*) (input *standard-input*))    
!   #+(or CMU scl) (ext:run-program program args :input input
! 				  :output output :wait wait)
  
    #+SBCL (sb-ext:run-program program args :input input :search T
                                            :output output :wait wait)
***************
*** 179,185 ****
                 :wait wait)
    #+clisp (ext:run-program program :arguments args :wait wait)
  
!   #-(or CMU SBCL lispworks clisp)
    (format T "~&Sorry, don't know how to run programs in your CL.~%"))
  
  ;;;; CLIM/UI utilities
--- 181,187 ----
                 :wait wait)
    #+clisp (ext:run-program program :arguments args :wait wait)
  
!   #-(or CMU scl SBCL lispworks clisp)
    (format T "~&Sorry, don't know how to run programs in your CL.~%"))
  
  ;;;; CLIM/UI utilities
***************
*** 256,280 ****
  
  (defun gen-wild-pathname (pathname)
    "Build a pathname with appropriate :wild components for the directory listing."
!   (make-pathname :host   (pathname-host pathname)
!                  :device (pathname-device pathname)
!                  :directory (pathname-directory pathname)
!                  :name (or (pathname-name pathname) :wild)
                   :type (or (pathname-type pathname) :wild)
                   :version (or #+allegro :unspecific
                                :wild
                                ;#-SBCL (pathname-version pathname)
                                ;#+SBCL :newest
!                               )))
  
  (defun strip-filespec (pathname)
    "Removes name, type, and version components from a pathname."
!   (make-pathname :host   (pathname-host pathname)
!                  :device (pathname-device pathname)
!                  :directory (pathname-directory pathname)
!                  :name nil
                   :type nil
!                  :version nil))
  
  ;; Oops, should I be doing something with relative pathnames here?
  (defun parent-directory (pathname)
--- 258,280 ----
  
  (defun gen-wild-pathname (pathname)
    "Build a pathname with appropriate :wild components for the directory listing."
!   (make-pathname :name (or (pathname-name pathname) :wild)
                   :type (or (pathname-type pathname) :wild)
                   :version (or #+allegro :unspecific
                                :wild
                                ;#-SBCL (pathname-version pathname)
                                ;#+SBCL :newest
!                               )
! 		 #+scl :query #+scl nil
! 		 :defaults pathname))
  
  (defun strip-filespec (pathname)
    "Removes name, type, and version components from a pathname."
!   (make-pathname :name nil
                   :type nil
!                  :version nil
! 		 #+scl :query #+scl nil
! 		 :defaults pathname))
  
  ;; Oops, should I be doing something with relative pathnames here?
  (defun parent-directory (pathname)
***************
*** 282,293 ****
    (let ((dir (pathname-directory (truename (strip-filespec pathname)))))
      (when (and (eq (first dir) :absolute)
                 (not (zerop (length (rest dir)))))
!       (make-pathname :host   (pathname-host pathname)
!                      :device (pathname-device pathname)
!                      :directory `(:absolute ,@(nreverse (rest (reverse (rest dir)))))
!                      :name (pathname-name pathname)
!                      :type (pathname-type pathname)
!                      :version (pathname-version pathname)))))
  
  
  ;;;; Abbreviating item formatter
--- 282,289 ----
    (let ((dir (pathname-directory (truename (strip-filespec pathname)))))
      (when (and (eq (first dir) :absolute)
                 (not (zerop (length (rest dir)))))
!       (make-pathname :directory `(:absolute ,@(nreverse (rest (reverse (rest dir)))))
! 		     :defaults pathname))))
  
  
  ;;;; Abbreviating item formatter
