[mcclim-cvs] CVS mcclim/Apps/Listener

[rschlatte]

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener
In directory clnet:/tmp/cvs-serv17422/Apps/Listener

Modified Files:
	dev-commands.lisp util.lisp 
Log Message:
cleanup parent-directory, remove filtermap


--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/01/26 05:09:39	1.47
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/01/31 11:06:40	1.48
@@ -555,9 +555,9 @@
          (initfunc (clim-mop:slot-definition-initfunction slot))
          (initform (clim-mop:slot-definition-initform slot))
          (direct-slots (direct-slot-definitions class name))
-         (readers (reduce #'append (filtermap direct-slots #'clim-mop:slot-definition-readers)))
-         (writers (reduce #'append (filtermap direct-slots #'clim-mop:slot-definition-writers)))
-         (documentation (first (filtermap direct-slots (lambda (x) (documentation x t)))))
+         (readers (mapcan #'clim-mop:slot-definition-readers direct-slots))
+         (writers (mapcan #'clim-mop:slot-definition-writers direct-slots))
+         (documentation (first (mapcan (lambda (x) (list (documentation x t))) direct-slots)))
          (*standard-output* stream))
 
   (macrolet ((with-ink ((var) &body body)
@@ -1146,7 +1146,7 @@
             (format t " (only files of type ~a)" (pathname-type pathname)))))
     
       (when (parent-directory pathname)
-        (with-output-as-presentation (t (strip-filespec (parent-directory pathname)) 'clim:pathname :single-box t)
+        (with-output-as-presentation (t (parent-directory pathname) 'clim:pathname :single-box t)
           (draw-icon t (standard-icon "up-folder.xpm") :extra-spacing 3)
           (format t "Parent Directory~%")))
 
--- /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp	2007/02/05 03:28:05	1.22
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/util.lisp	2008/01/31 11:06:40	1.23
@@ -20,11 +20,6 @@
 ;;; Boston, MA  02111-1307  USA.
 
 
-
-(defun filtermap (list func &optional (filter #'null))
-  (declare (type (function (t) t) func))
-  (delete-if filter (mapcar func list)))
-
 ;(defmacro multiple-value-prog2 (&body body)  `(progn ,(first body) (multiple-value-prog1 ,@(rest body))))
 
 ;; multiple-value-or, ugh. Normal OR drops values except from the last form.
@@ -275,14 +270,15 @@
 		 #+scl :query #+scl nil
 		 :defaults pathname))
 
-;; Oops, should I be doing something with relative pathnames here?
 (defun parent-directory (pathname)
   "Returns a pathname designating the directory 'up' from PATHNAME"
-  (let ((dir (pathname-directory (truename (strip-filespec pathname)))))
+  (let ((dir (pathname-directory (truename pathname))))
     (when (and (eq (first dir) :absolute)
-               (not (zerop (length (rest dir)))))
-      (make-pathname :directory `(:absolute ,@(nreverse (rest (reverse (rest dir)))))
-		     :defaults pathname))))
+               (rest dir))
+      ;; merge-pathnames merges :back, but not :up
+      (strip-filespec
+       (merge-pathnames (make-pathname :directory '(:relative :back))
+                        (truename pathname))))))
 
 
 ;;;; Abbreviating item formatter