[mcclim-cvs] CVS mcclim/Apps/Listener

[ahefner]

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

Modified Files:
	dev-commands.lisp 
Log Message:
Eliminate questionable call to a function in goatee. Change list styles
to keywords. For once, Athas' naive aversion toward double colons was 
not misguided.



--- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/02/03 12:08:51	1.49
+++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp	2008/02/03 12:22:38	1.50
@@ -1123,7 +1123,7 @@
      (show-hidden  'boolean :default nil :prompt "show hidden")
      (hide-garbage 'boolean :default t   :prompt "hide garbage")
      (show-all     'boolean :default nil :prompt "show all")
-     (style '(member items list) :default 'items :prompt "listing style")
+     (style '(member :items :list) :default 'items :prompt "listing style")
      (group-directories 'boolean :default t :prompt "group directories?")
      (full-names 'boolean :default nil :prompt "show full name?")
      (list-all-direct-subdirectories 'boolean :default nil :prompt "list all direct subdirectories?"))
@@ -1139,7 +1139,7 @@
     (with-text-family (t :sans-serif)      
       (invoke-as-heading
         (lambda ()
-          (format t "Directory contents of ")
+          (format t "Contents of ")
           (present (directory-namestring pathname) 'pathname)
           (when (pathname-type pathname)
             (format t " (only files of type ~a)" (pathname-type pathname)))))
@@ -1153,18 +1153,14 @@
         (unless show-all
           (setf group (filter-garbage-pathnames group show-hidden hide-garbage)))
         (ecase style
-          (items (abbreviating-format-items group :row-wise nil :x-spacing "  " :y-spacing 1
-                                            :printer (lambda (x stream)
-                                                       (declare (ignore stream))
-                                                       (pretty-pretty-pathname x *standard-output*
-                                                                               :long-name full-names)))
-                 #+NIL
-                 (format-items group :row-wise nil :x-spacing "  " :y-spacing 1
-                               :printer (lambda (x stream)
-                                          (declare (ignore stream))
-                                          (pretty-pretty-pathname x *standard-output* :long-name full-names)))
-                 (goatee::reposition-stream-cursor *standard-output*)) ; Hmm.
-          (list (dolist (ent group)
+          (:items
+           (abbreviating-format-items group :row-wise nil :x-spacing "  " :y-spacing 1
+                                      :printer (lambda (x stream)
+                                                 (pretty-pretty-pathname x stream
+                                                                         :long-name full-names)))           
+           (multiple-value-bind (x y) (stream-cursor-position *standard-output*)
+             (setf (stream-cursor-position *standard-output*) (values 0 y))))
+          (:list (dolist (ent group)
                   (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)))))))))