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