[mcclim-cvs] CVS mcclim/Examples

[crhodes]

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

Modified Files:
	method-browser.lisp 
Log Message:
Use a bit more of clim-mop in the method browser.  May now work on 
scieneer.


--- /project/mcclim/cvsroot/mcclim/Examples/method-browser.lisp	2005/03/06 20:35:40	1.2
+++ /project/mcclim/cvsroot/mcclim/Examples/method-browser.lisp	2006/03/29 09:36:30	1.3
@@ -46,11 +46,11 @@
 ;;;   * Portable MOP provided by CLIM-MOP package
 
 ;;; TODO:
-;;;   * EQL specializers on implementations other than SBCL/CMUCL
-;;;   * Nicer, more clever display of methods than simply listing them in a row.
-;;;     To do this right really involes some nonportable fun and a codewalker.
-;;;     You could probably write something that just understood the standard
-;;;     method combination and qualifiers with substantially less work.
+;;;   * Nicer, more clever display of methods than simply listing them
+;;;     in a row.  To do this right really involes some nonportable
+;;;     fun and a codewalker.  You could probably write something that
+;;;     just understood the standard method combination and qualifiers
+;;;     with substantially less work.
 ;;;   * Change focus behavior of McCLIM text entry gadget
 ;;;   * Implement focus-aware cursor shapes in McCLIM and/or Goatee
 ;;;     (actually I did this ages ago, but let it rot away on my disk..)
@@ -67,23 +67,19 @@
          collect (remove-duplicates (mapcar (lambda (specs) (nth index specs))
                                             specializers)))))
 
+;;; FIXME: why is this necessary?  I'm pretty sure the #+CMU clause
+;;; here has been superseded by events for quite a while now.  (Should
+;;; clim-mop:class not cater for these implementation differences?)
 (defun classp (x)
   (or (typep x 'cl:class)
-      #+CMU (typep x 'pcl::class)))
-
-(defun eql-specializer-p (x)
-  #+SBCL (typep x 'sb-mop:eql-specializer)
-  #+CMU  (typep x 'pcl:eql-specializer))
-
-(defun eql-specializer-object (x)
-  #+SBCL (sb-mop:eql-specializer-object x)
-  #+CMU  (pcl::eql-specializer-object x))
+      #+CMU (typep x 'pcl::class)
+      #+scl (typep x 'clos::std-class)))
 
 (defun compute-applicable-methods-from-specializers (gf specializers)
   (clim-mop:compute-applicable-methods gf
      (mapcar (lambda (spec)
-               (cond ((eql-specializer-p spec)
-                      (eql-specializer-object spec))
+               (cond ((typep spec 'clim-mop:eql-specializer)
+                      (clim-mop:eql-specializer-object spec))
                      ((classp spec)
                       (clim-mop:class-prototype spec))
                      (t (error "Can't compute effective methods, specializer ~A is not understood." spec))))
@@ -104,17 +100,17 @@
                             (classp b))
                        (string< (class-name a)
                                 (class-name b)))
-                      ((and (eql-specializer-p a)
-                            (not (eql-specializer-p b)))
+                      ((and (typep a 'clim-mop:eql-specializer)
+                            (not (typep b 'clim-mop:eql-specializer)))
                        nil)
-                      ((and (not (eql-specializer-p a))
-                            (eql-specializer-p b))
+                      ((and (not (typep a 'clim-mop:eql-specializer))
+                            (typep b 'clim-mop:eql-specializer))
                        t)
-                      ((and (eql-specializer-p a)
-                            (eql-specializer-p b))
+                      ((and (typep a 'clim-mop:eql-specializer)
+                            (typep b 'clim-mop:eql-specializer))
                        (string<
-                        (princ-to-string (eql-specializer-object a))
-                        (princ-to-string (eql-specializer-object b))))
+                        (princ-to-string (clim-mop:eql-specializer-object a))
+                        (princ-to-string (clim-mop:eql-specializer-object b))))
                       (t (warn "Received specializer of unknown type")
                          nil) ))))
           (compute-gf-specializers gf)))
@@ -135,8 +131,8 @@
   "Pretty print the name of a method specializer"
   (cond ((classp spec)
          (princ-to-string (class-name spec)))
-        ((eql-specializer-p spec)
-         (format nil "(EQL '~A)" (eql-specializer-object spec)))
+        ((typep spec 'clim-mop:eql-specializer)
+         (format nil "(EQL '~A)" (clim-mop:eql-specializer-object spec)))
         (t (princ-to-string spec))))
 
 (defun maybe-find-gf (name)
@@ -174,7 +170,7 @@
 ;; commands within your application, a menu bar, etc.
 
 ;; The :panes option is typically used to define and name the important
-;; elements of your interface. CLIM provides some syntactic sugare, for
+;; elements of your interface. CLIM provides some syntactic sugar, for
 ;; example (arg-pane :vrack-pane) below is equivalent to
 ;; (arg-pane (make-pane 'vrack-pane)).