Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/ChangeLog,v
retrieving revision 1.115
diff -u -r1.115 ChangeLog
--- ChangeLog	17 Oct 2008 05:32:35 -0000	1.115
+++ ChangeLog	9 Nov 2008 18:11:26 -0000
@@ -1,13 +1,24 @@
+2008-11-09  Georg Lehner <jorge@magma.com.ni>
+
+	* traverse.tcl: Added options -notroot, -sort, -order and the
+	* traverse.man: method basedir.  Allows traversal without
+	  including the basedir, sorting before traversing and resetting
+	  the basedir of a traverser object.  This required changes to the
+	  Init method and to the next method (order).
+	  Also: fixed error handling in the next method to comply with the
+	  man page.  An error while globbing files or directories now
+	  invokes the errorcmd handler, or is ignored.
+
 2008-10-16  1.11  <andreas_kupries@users.sourceforge.net>
 
 	*
 	* Released and tagged Tcllib 1.11 ========================
-	* 
+	*
 
 2008-10-10  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
 
 	* multiop.test: Canonicalized sorting of two test results.
-	* multi.test: 
+	* multi.test:
 
 2008-09-03  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
 
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/pkgIndex.tcl,v
retrieving revision 1.32
diff -u -r1.32 pkgIndex.tcl
--- pkgIndex.tcl	4 Sep 2008 02:24:47 -0000	1.32
+++ pkgIndex.tcl	7 Nov 2008 18:10:01 -0000
@@ -2,7 +2,7 @@
 package ifneeded fileutil 1.13.4 [list source [file join $dir fileutil.tcl]]
 
 if {![package vsatisfies [package provide Tcl] 8.3]} {return}
-package ifneeded fileutil::traverse 0.4 [list source [file join $dir traverse.tcl]]
+package ifneeded fileutil::traverse 0.5 [list source [file join $dir traverse.tcl]]
 
 if {![package vsatisfies [package provide Tcl] 8.4]} {return}
 package ifneeded fileutil::multi     0.1   [list source [file join $dir multi.tcl]]
Index: traverse.man
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/traverse.man,v
retrieving revision 1.3
diff -u -r1.3 traverse.man
--- traverse.man	24 Oct 2007 19:28:36 -0000	1.3
+++ traverse.man	9 Nov 2008 18:42:00 -0000
@@ -1,9 +1,9 @@
 [comment {-*- text -*- doctools manpage}]
-[manpage_begin fileutil_traverse n 0.4]
+[manpage_begin fileutil_traverse n 0.5]
 [moddesc   {file utilities}]
 [titledesc {Iterative directory traversal}]
 [require Tcl 8.3]
-[require fileutil::traverse [opt 0.4]]
+[require fileutil::traverse [opt 0.5]]
 [description]
 [keywords {directory traversal} traversal]
 [para]
@@ -83,6 +83,12 @@
 able to incrementally traverse a directory hierarchy in an event-based
 manner.
 
+[call [cmd \$traverser] [method basedir] [arg path]]
+
+This method (re)sets the basedir of the traverser.  In some cases it may
+be desired to re-use a traverser on different directories.
+
+
 [list_end]
 
 
@@ -119,6 +125,25 @@
 to the caller, i.e. however invoked the [method next]. Any other
 results from the callback are ignored.
 
+[opt_def "-notroot boolean"]
+
+By default, the base (or root) directory of the traverser is included
+in the iteration.  If [opt "-notroot [const True]"] is given, the traverser
+will not include the root, but rather start with the content of the root.
+
+[opt_def "-sort collation_order"]
+
+Before traversing a directory, it is sorted by [const collation_order].
+Allowed values are [const ascii] and [const dictionary] and an empty string,
+which indicates no sorting.  The collation is done by [cmd lsort].
+
+[opt_def -order direction]
+
+This options allows to specify the direction of ordering ff [opt -sort]
+is given a non-empty string.  Allowed values are [const increasing], which
+is the default, and [const decreasing].
+
+
 [list_end]
 
 
Index: traverse.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/traverse.tcl,v
retrieving revision 1.6
diff -u -r1.6 traverse.tcl
--- traverse.tcl	28 Feb 2008 07:11:34 -0000	1.6
+++ traverse.tcl	8 Nov 2008 07:46:50 -0000
@@ -22,6 +22,8 @@
 }
 package require control  ; # Helpers for control structures
 
+package require fileutil ; # Helpers for file access
+
 snit::type ::fileutil::traverse {
 
     # Incremental directory traversal.
@@ -31,11 +33,16 @@
     # next    filevar                         -> boolean
     # foreach filevar script
     # files                                   -> list (path ...)
+    # basedir path                            -> set new basedirectory
 
     # Options
     # -prefilter command-prefix
     # -filter    command-prefix
     # -errorcmd  command-prefix
+    # -notroot   boolean
+    # -sort      {}|ascii|dictionary          -> do lsort on each directory
+    #                                            unless sort is empty
+    # -order     increasing|decreasing        -> order of lsort
 
     # Use cases
     #
@@ -81,7 +88,7 @@
     # but allowed to pass to the caller, usually of 'next'.
 
     # Note: Low-level functionality, version and platform dependent is
-    # implemented in procedures, and conditioally defined for optimal
+    # implemented in procedures, and conditionally defined for optimal
     # use of features, etc. ...
 
     # Note: Traversal is done in depth-first pre-order.
@@ -96,6 +103,13 @@
     option -filter    -default {} -readonly 1
     option -prefilter -default {} -readonly 1
     option -errorcmd  -default {} -readonly 1
+    option -notroot   -default false -readonly 1 -type {snit::boolean}
+    option -sort      -default {} -readonly 1 -type {
+	snit::enum -values {{} ascii dictionary }
+    }
+    option -order     -default increasing -readonly 1 -type {
+	snit::enum -values {increasing decreasing}
+    }
 
     constructor {basedir args} {
 	set _base $basedir
@@ -103,6 +117,11 @@
 	return
     }
 
+    method basedir path {
+	set _base $path
+	$self Init
+    }
+
     method files {} {
 	set files {}
 	$self foreach f {lappend files $f}
@@ -158,8 +177,8 @@
 	# next one.
 
 	if {[llength $_results]} {
-	    set top      [lindex   $_results end]
-	    set _results [lreplace $_results end end]
+	    set top      [lindex   $_results 0]
+	    set _results [lrange $_results 1 end]
 	    set currentfile $top
 	    return 1
 	}
@@ -173,8 +192,8 @@
 	# the result stack contains at least one path we can return.
 
 	while {[llength $_pending]} {
-	    set top      [lindex   $_pending end]
-	    set _pending [lreplace $_pending end end]
+	    set top      [lindex   $_pending 0]
+	    set _pending [lrange $_pending 1 end]
 
 	    # Directory accessible? Skip if not.
 	    if {![ACCESS $top]} {
@@ -185,7 +204,16 @@
 	    # Expand the result stack with all files in the directory,
 	    # modulo filtering.
 
-	    foreach f [GLOBF $top] {
+	    set code [catch {GLOBF $top} files]
+	    if {$code} {Error $top $files; continue}
+
+	    if {[llength $options(-sort)]} {
+		set files [lsort -$options(-sort) \
+			      -$options(-order) \
+			      $files]
+	    }
+
+	    foreach f $files {
 		if {![Valid $f]} continue
 		lappend _results $f
 	    }
@@ -195,7 +223,16 @@
 	    # processing stack with the same directories, if not seen
 	    # yet and modulo pre-filtering.
 
-	    foreach f [GLOBD $top] {
+	    set code [catch {GLOBD $top} dirs]
+	    if {$code} {Error $top $dirs; continue}
+	    if {[llength $options(-sort)]} {
+		set dirs [lsort -$options(-sort) \
+			      -$options(-order) \
+			      $dirs]
+	    }
+
+	    foreach f $dirs {
+		# LEG:Note: unix specific
 		if {
 		    [string equal [file tail $f]  "."] ||
 		    [string equal [file tail $f] ".."]
@@ -217,8 +254,8 @@
 	    # Stop expanding if we have paths to return.
 
 	    if {[llength $_results]} {
-		set top    [lindex   $_results end]
-		set _results [lreplace $_results end end]
+		set top    [lindex   $_results 0]
+		set _results [lrange $_results 1 end]
 		set currentfile $top
 		return 1
 	    }
@@ -252,13 +289,23 @@
     ## Internal helpers.
 
     method Init {} {
-	# Path ok as result?
-	if {[Valid $_base]} {
+
+	# do away with with not-directory start values
+	if {[Valid $_base] && ![file isdirectory $_base]} {
 	    lappend _results $_base
+	    set _init 1
+	    return
 	}
 
-	# Expansion allowed by prefilter?
-	if {[file isdirectory $_base] && [Recurse $_base]} {
+	# from here we deal with a directory
+	# Path ok as result?
+	if !{$options(-notroot)} {
+	    lappend _results $_base
+	    
+	    # Expansion allowed by prefilter?
+	    if {[Recurse $_base]} {lappend _pending $_base}
+	} else {
+	    # -notroot: inconditional traversal of base
 	    lappend _pending $_base
 	}
 
@@ -414,4 +461,4 @@
 # ### ### ### ######### ######### #########
 ## Ready
 
-package provide fileutil::traverse 0.4
+package provide fileutil::traverse 0.5

