From 00bea44538377a5e0d130a2e73bc4d7db5636a62 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Tue, 11 Nov 2003 22:48:13 +0000
Subject:         * library/tkfbox.tcl (::tk::dialog::file::Update): optimize
 the         dir/files list separation by using the -tails, -directory and    
     -type option of 'glob'.  Also passes the glob the -filetypes        
 filters instead of calling string match over each file.         [Patch
 #833819]

---
 ChangeLog          |  6 ++++++
 library/tkfbox.tcl | 52 ++++++++++++++++++----------------------------------
 2 files changed, 24 insertions(+), 34 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 223f401..fbe7d29 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2003-11-11  Jeff Hobbs  <jeffh@ActiveState.com>
 
+	* library/tkfbox.tcl (::tk::dialog::file::Update): optimize the
+	dir/files list separation by using the -tails, -directory and
+	-type option of 'glob'.  Also passes the glob the -filetypes
+	filters instead of calling string match over each file.
+	[Patch #833819]
+
 	* generic/tkListbox.c (ListboxDeleteSubCmd, ListboxListVarProc):
 	free itemconfig data when removing it from table. [Bug #836483]
 
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index 6fc0253..4d46903 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -11,7 +11,7 @@
 #	files by clicking on the file icons or by entering a filename
 #	in the "Filename:" entry.
 #
-# RCS: @(#) $Id: tkfbox.tcl,v 1.39 2003/10/29 09:36:42 dkf Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.40 2003/11/11 22:48:14 hobbs Exp $
 #
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
 #
@@ -1195,8 +1195,7 @@ proc ::tk::dialog::file::Update {w} {
 	return
     }
     set class [winfo class $w]
-    if { [string compare $class TkFDialog] && \
-	    [string compare $class TkChooseDir] } {
+    if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
 	return
     }
 
@@ -1225,9 +1224,8 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
 	# should have been checked before ::tk::dialog::file::Update is called, so
 	# we normally won't come to here. Anyways, give an error and abort
 	# action.
-	tk_messageBox -type ok -parent $w -message \
-	    "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]"\
-	    -icon warning
+	tk_messageBox -type ok -parent $w -message -icon warning \
+	    [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
 	cd $appPWD
 	return
     }
@@ -1240,47 +1238,33 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
     $data(ent) config -cursor watch
     $w         config -cursor watch
     update idletasks
-    
+
     ::tk::IconList_DeleteAll $data(icons)
 
     # Make the dir list
     #
-    set completeFileList [lsort -dictionary -unique [glob -nocomplain .* *]]
+    set dirs [lsort -dictionary -unique \
+		     [glob -tails -directory . -type d -nocomplain .* *]]
     set dirList {}
-    foreach f $completeFileList {
-	if {[string equal $f .]} {
-	    continue
-	}
-	if {[string equal $f ..]} {
+    foreach d $dirs {
+	if {$d eq "." || $d eq ".."} {
 	    continue
 	}
-	if {[file isdir ./$f]} {
-	    lappend dirList $f
-	}
+	lappend dirList $d
     }
     ::tk::IconList_Add $data(icons) $folder $dirList
-    if { [string equal $class TkFDialog] } {
-	# Make the file list if this is a File Dialog
+
+    if {$class eq "TkFDialog"} {
+	# Make the file list if this is a File Dialog, selecting all
+	# but 'd'irectory type files.
 	#
+	set cmd [list glob -tails -directory . -type {f b c l p s} -nocomplain]
 	if {[string equal $data(filter) *]} {
-	    set files $completeFileList
+	    lappend cmd .* *
 	} else {
-	    set files {}
-	    foreach f $completeFileList {
-		foreach pat $data(filter) {
-		    if { [string match $pat $f] } {
-			lappend files $f
-			break
-		    }
-		}
-	    }
-	}
-	set fileList {}
-	foreach f $files {
-	    if {![file isdir ./$f]} {
-		lappend fileList $f
-	    }
+	    eval [list lappend cmd] $data(filter)
 	}
+	set fileList [lsort -dictionary -unique [eval $cmd]]
 	::tk::IconList_Add $data(icons) $file $fileList
     }
 
-- 
cgit v0.12