diff -Naur Listener_org/dev-commands.lisp Listener_mgr/dev-commands.lisp --- Listener_org/dev-commands.lisp 2005-04-21 05:41:24.000000000 +0200 +++ Listener_mgr/dev-commands.lisp 2005-08-30 01:41:33.895740000 +0200 @@ -1028,7 +1028,9 @@ (terpri stream)) (defun sort-pathnames (list sort-by) - list) ; <--- FIXME + (case sort-by ; <--- FIXME + ('name (sort list #'string-lessp :key #'file-namestring)) + (t list))) (defun split-sort-pathnames (list group-dirs sort-by) (mapcar (lambda (x) (sort-pathnames x sort-by)) @@ -1064,7 +1066,7 @@ :provide-output-destination-keyword t) ((pathname 'pathname #+nil(or 'string 'pathname) :prompt "pathname") &key - #+NIL (sort-by '(member name size modify none) :default 'name) + (sort-by '(member name size modify none) :default 'name) (show-hidden 'boolean :default nil :prompt "show hidden") (hide-garbage 'boolean :default T :prompt "hide garbage") (show-all 'boolean :default nil :prompt "show all") @@ -1075,20 +1077,22 @@ (let* ((pathname (if (wild-pathname-p pathname) ; Forgot why I did this.. (merge-pathnames pathname) pathname)) - (dir (list-directory (gen-wild-pathname pathname)))) + (dir (list-directory-with-all-subdirectories (gen-wild-pathname pathname)))) (with-text-family (T :sans-serif) (invoke-as-heading (lambda () (format T "Directory contents of ") - (present pathname))) + (present (directory-namestring pathname) 'pathname) + (when (pathname-type pathname) + (format T " (only files of type ~a)" (pathname-type pathname))))) (when (parent-directory pathname) - (with-output-as-presentation (T (parent-directory pathname) 'clim:pathname) + (with-output-as-presentation (T (strip-filespec (parent-directory pathname)) 'clim:pathname) (draw-icon T (standard-icon "up-folder.xpm") :extra-spacing 3) (format T "Parent Directory~%"))) - (dolist (group (split-sort-pathnames dir group-directories :none #+NIL sort-by)) + (dolist (group (split-sort-pathnames dir group-directories sort-by)) (unless show-all (setf group (filter-garbage-pathnames group show-hidden hide-garbage))) (ecase style @@ -1105,7 +1109,8 @@ (goatee::reposition-stream-cursor *standard-output*) (vertical-gap T)) (list (dolist (ent group) - (let ((ent (merge-pathnames ent pathname))) ; This is for CMUCL, see above. (fixme!) + (let ((ent (merge-pathnames ent pathname))) ;; This is for CMUCL, see above. (fixme!) + ;; And breaks some things for SBCL.. (mgr) (pretty-pretty-pathname ent *standard-output* :long-name full-names))))))))) #+nil ; OBSOLETE diff -Naur Listener_org/file-types.lisp Listener_mgr/file-types.lisp --- Listener_org/file-types.lisp 2003-11-09 22:12:05.000000000 +0100 +++ Listener_mgr/file-types.lisp 2005-08-29 19:27:12.374781000 +0200 @@ -133,7 +133,8 @@ ;; ICON-OF is measurably slow here in CMUCL. Interesting.. (defmethod icon-of ((pathname pathname)) - (cond ((not (probe-file pathname)) (standard-icon "invalid.xpm")) + (cond ((wild-pathname-p pathname) (standard-icon "wild.xpm")) + ((not (probe-file pathname)) (standard-icon "invalid.xpm")) ((directoryp pathname) *folder-icon*) ;; FIXME: use inode mime types (T (let ((mime-class (find-class (pathname-mime-type pathname) nil))) (if mime-class diff -Naur Listener_org/icons/CVS/Root Listener_mgr/icons/CVS/Root --- Listener_org/icons/CVS/Root 2005-08-30 00:19:14.250680000 +0200 +++ Listener_mgr/icons/CVS/Root 2005-01-12 17:54:07.000000000 +0100 @@ -1 +1 @@ -:ext:mretzlaff@common-lisp.net:/project/mcclim/cvsroot +:pserver:anonymous@common-lisp.net:/project/mcclim/cvsroot diff -Naur Listener_org/icons/wild.xpm Listener_mgr/icons/wild.xpm --- Listener_org/icons/wild.xpm 1970-01-01 01:00:00.000000000 +0100 +++ Listener_mgr/icons/wild.xpm 2005-08-29 16:50:18.287100000 +0200 @@ -0,0 +1,114 @@ +/* XPM */ +static char * wild_xpm[] = { +"16 16 95 2", +" c None", +". c #484848", +"+ c #4A4A4A", +"@ c #494949", +"# c #474747", +"$ c #4B4B4B", +"% c #E1E1E1", +"& c #E9E9E9", +"* c #E7E7E7", +"= c #DFDFDF", +"- c #D5D5D5", +"; c #505050", +"> c #707070", +", c #D4D4D4", +"' c #E3E3E3", +") c #F0F0F0", +"! c #F2F2F2", +"~ c #F1F1F1", +"{ c #EBEBEB", +"] c #D3D3D3", +"^ c #B1B1B1", +"/ c #5D5D5D", +"( c #D6D6D6", +"_ c #DBDBDB", +": c #EEEEEE", +"< c #F0EDED", +"[ c #F2D7D7", +"} c #EDEDED", +"| c #C0C0C0", +"1 c #A1A1A1", +"2 c #565656", +"3 c #E4E4E4", +"4 c #FBF4F4", +"5 c #FEFEFE", +"6 c #FEE5E5", +"7 c #FF3D3D", +"8 c #FFFFFF", +"9 c #FDFAFA", +"0 c #D0D0D0", +"a c #B5B5B5", +"b c #9D9D9D", +"c c #E5E5E5", +"d c #EFEFEF", +"e c #FE7A7A", +"f c #FFB8B8", +"g c #FFE5E5", +"h c #FF7A7A", +"i c #C3C3C3", +"j c #A4A4A4", +"k c #F1EFEF", +"l c #FEADAD", +"m c #FF5050", +"n c #FF5757", +"o c #FDADAD", +"p c #E5E3E3", +"q c #C9C9C9", +"r c #ABABAB", +"s c #FAFAFA", +"t c #FECCCC", +"u c #FF4646", +"v c #FDFDFD", +"w c #ACACAC", +"x c #E0E0E0", +"y c #EDEAEA", +"z c #FE7979", +"A c #FE4444", +"B c #FF8787", +"C c #FF4444", +"D c #DFDDDD", +"E c #C5C5C5", +"F c #D7D7D7", +"G c #FFE9E9", +"H c #FFEAEA", +"I c #FEB0B0", +"J c #BEBEBE", +"K c #A7A7A7", +"L c #DCDCDC", +"M c #FBFBFB", +"N c #FDE9E9", +"O c #FE5D5D", +"P c #FAE6E6", +"Q c #F9F9F9", +"R c #CACACA", +"S c #B3B3B3", +"T c #A0A0A0", +"U c #B2B2B2", +"V c #E8E8E8", +"W c #B9B9B9", +"X c #A3A3A3", +"Y c #BABABA", +"Z c #CBCBCB", +"` c #D2D2D2", +" . c #C8C8C8", +".. c #B8B8B8", +"+. c #A9A9A9", +" . + + @ + + @ ", +" # $ % & & & * = - ; # ", +" # > , ' ) ! ! ~ { ] ^ / + ", +" @ ( _ { : < [ < } = | 1 2 ", +"# 3 3 & 4 5 6 7 6 8 9 0 a b @ ", +"+ c ! d e f g 7 g f h _ i j + ", +"+ c ! k l m n 7 n m o p q r + ", +"+ ' ! ) s t u 7 u t v 3 q w + ", +"# x : y z A B 7 B C z D E w + ", +"$ F & * o G 6 7 6 H I ( J K + ", +". , 0 L : M N O P Q { R S T + ", +" + U i ( = V * 3 L 0 W X 2 ", +" + / X Y Z ` , ` ...j / + ", +" + + T +.^ S ^ r 1 + + ", +" + + + + + + + ", +" "}; diff -Naur Listener_org/util.lisp Listener_mgr/util.lisp --- Listener_org/util.lisp 2005-02-22 04:10:27.000000000 +0100 +++ Listener_mgr/util.lisp 2005-08-30 01:43:56.829011000 +0200 @@ -118,6 +118,8 @@ #+SBCL (defun list-directory (pathname) + (directory pathname) + #+nil ;; ugh. is too ughy. (mgr) (let* ((pathname (strip-filespec pathname)) ;; ugh. (dir (sb-posix:opendir pathname)) (list nil)) @@ -141,6 +143,19 @@ (defun list-directory (pathname) (directory pathname)) +;;; Calls LIST-DIRECTORY and appends the subdirectories of the directory +;;; PATHNAME to the output of LIST-DIRECTORY if PATHNAME is a wild pathname. + +(defun list-directory-with-all-subdirectories (pathname) + (let ((file-list (list-directory pathname))) + (if (wild-pathname-p pathname) + (nconc file-list + (delete-if (lambda (directory) + (member directory file-list :test #'equal)) + (delete-if-not #'directoryp + (list-directory (gen-wild-pathname + (strip-filespec pathname)))))) + file-list))) ;;; A farce of a "portable" run-program, which grows as I need options from ;;; the CMUCL run-program.