Tk Source Code

Check-in [89300ed4]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:[Bug 3558535]: Factor out the filtered-sorted globbing code into one procedure that knows how to avoid nasty problems when non-list filters are used.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 89300ed44c0f143a842176443e53b85dbf29f16c
User & Date: dkf 2012-08-24 14:59:46
References
2015-05-25
04:50 Ticket [1641721f] tk_getOpenFile shows symlinks to directories twice status still Open with 7 other changes artifact: 872dd553 user: anonymous
Context
2012-08-25
01:54
3554026 3561016 Better fix from Emiliano Gavilan check-in: 5b17b729 user: dgp tags: core-8-5-branch
2012-08-24
15:12
[Bug 3558535]: Factor out the filtered-sorted globbing code into one procedure that knows how to avoid nasty problems when non-list filters are used. check-in: f3b0b975 user: dkf tags: trunk
14:59
[Bug 3558535]: Factor out the filtered-sorted globbing code into one procedure that knows how to avoid nasty problems when non-list filters are used. check-in: 89300ed4 user: dkf tags: core-8-5-branch
2012-08-23
21:41
3554026,3561016 Stop crash with tearoff menus. check-in: 2163407f user: dgp tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.









1
2
3

4
5
6
7
8
9
10








2012-08-23  Don Porter  <[email protected]>

	* unix/tkUnixWm.c: [Bugs 3554026,3561016] Stop crash with tearoff menus.


2012-08-17  Jan Nijtmans  <[email protected]>

	* win/nmakehlp.c: Add "-V<num>" option, in order to be able
	to detect partial version numbers.

2012-08-15  Jan Nijtmans  <[email protected]>
>
>
>
>
>
>
>
>


|
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
2012-08-24  Donal K. Fellows  <[email protected]>

	* library/tkfbox.tcl (GlobFiltered): [Bug 3558535]: Factor out the
	filtered-sorted globbing code into one procedure that knows how to
	avoid nasty problems when non-list filters are used. This allows the
	rest of the [tk_getOpenFile] implementation to be ignorant of the
	considerable complexities of globbing.

2012-08-23  Don Porter  <[email protected]>

	* unix/tkUnixWm.c: [Bugs 3554026,3561016]: Stop crash with tearoff
	menus.

2012-08-17  Jan Nijtmans  <[email protected]>

	* win/nmakehlp.c: Add "-V<num>" option, in order to be able
	to detect partial version numbers.

2012-08-15  Jan Nijtmans  <[email protected]>

Changes to library/tkfbox.tcl.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require Ttk

#----------------------------------------------------------------------
#
#		      I C O N   L I S T
#
# This is a pseudo-widget that implements the icon list inside the
# ::tk::dialog::file:: dialog box.
#







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require Ttk

#----------------------------------------------------------------------
#
#		      I C O N   L I S T
#
# This is a pseudo-widget that implements the icon list inside the
# ::tk::dialog::file:: dialog box.
#
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
}

proc ::tk::IconList_Reset {w} {
    variable ::tk::Priv

    unset -nocomplain Priv(ILAccel,$w)
}

#----------------------------------------------------------------------
#
#		      F I L E   D I A L O G
#
#----------------------------------------------------------------------

namespace eval ::tk::dialog {}







|







782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
}

proc ::tk::IconList_Reset {w} {
    variable ::tk::Priv

    unset -nocomplain Priv(ILAccel,$w)
}

#----------------------------------------------------------------------
#
#		      F I L E   D I A L O G
#
#----------------------------------------------------------------------

namespace eval ::tk::dialog {}
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358

1359
1360
1361
1362
1363
1364
1365
    $w         configure -cursor watch
    update idletasks

    ::tk::IconList_DeleteAll $data(icons)

    set showHidden $::tk::dialog::file::showHiddenVar

    # Make the dir list
    # Using -directory [pwd] is better in some VFS cases.
    set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
    if {$showHidden} { lappend cmd .* }
    set dirs [lsort -dictionary -unique [eval $cmd]]
    set dirList {}
    foreach d $dirs {
	if {$d eq "." || $d eq ".."} {
	    continue
	}
	lappend dirList $d
    }
    ::tk::IconList_Add $data(icons) $folder $dirList

    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 [pwd] \
		-type {f b c l p s} -nocomplain]
	if {$data(filter) eq "*"} {
	    lappend cmd *
	    if {$showHidden} {
		lappend cmd .*
	    }
	} else {
	    eval [list lappend cmd] $data(filter)
	}
	set fileList [lsort -dictionary -unique [eval $cmd]]
	::tk::IconList_Add $data(icons) $file $fileList

    }

    ::tk::IconList_Arrange $data(icons)

    # Update the Directory: option menu
    #
    set list ""







|
|
<
<
<
<
<
<
<
<
<
<
|


|
|

<
<
<
<
<
<
<
<
<
<
<
|
>







1322
1323
1324
1325
1326
1327
1328
1329
1330










1331
1332
1333
1334
1335
1336











1337
1338
1339
1340
1341
1342
1343
1344
1345
    $w         configure -cursor watch
    update idletasks

    ::tk::IconList_DeleteAll $data(icons)

    set showHidden $::tk::dialog::file::showHiddenVar

    # Make the dir list. Note that using an explicit [pwd] (instead of '.') is
    # better in some VFS cases.










    ::tk::IconList_Add $data(icons) $folder [GlobFiltered [pwd] d 1]

    if {$class eq "TkFDialog"} {
	# Make the file list if this is a File Dialog, selecting all but
	# 'd'irectory type files.
	#











	::tk::IconList_Add $data(icons) $file \
	    [GlobFiltered [pwd] {f b c l p s}]
    }

    ::tk::IconList_Arrange $data(icons)

    # Update the Directory: option menu
    #
    set list ""
1879
1880
1881
1882
1883
1884
1885
1886






































1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
	    upvar #0 $data(-typevariable) typeVariable
	    set typeVariable [lindex $data(filterType) 0]
	}
    }
    bind $data(okBtn) <Destroy> {}
    set Priv(selectFilePath) $selectFilePath
}







































proc ::tk::dialog::file::CompleteEnt {w} {
    upvar ::tk::dialog::file::[winfo name $w] data
    set f [$data(ent) get]
    if {$data(-multiple)} {
	if {[catch {llength $f} len] || $len != 1} {
	    return -code break
	}
	set f [lindex $f 0]
    }

    # Get list of matching filenames and dirnames
    set globF [list glob -tails -directory $data(selectPath) \
		-type {f b c l p s} -nocomplain]
    set globD [list glob -tails -directory $data(selectPath) -type d \
		       -nocomplain *]
    if {$data(filter) eq "*"} {
	lappend globF *
	if {$::tk::dialog::file::showHiddenVar} {
	    lappend globF .*
	    lappend globD .*
	}
	if {[winfo class $w] eq "TkFDialog"} {
	    set files [lsort -dictionary -unique [{*}$globF]]
	} else {
	    set files {}
	}
	set dirs [lsort -dictionary -unique [{*}$globD]]
    } else {
	if {$::tk::dialog::file::showHiddenVar} {
	    lappend globD .*
	}
	if {[winfo class $w] eq "TkFDialog"} {
	    set files [lsort -dictionary -unique [{*}$globF {*}$data(filter)]]
	} else {
	    set files {}
	}
	set dirs [lsort -dictionary -unique [{*}$globD]]
    }
    # Filter specials
    set dirs [lsearch -all -not -exact -inline $dirs .]
    set dirs [lsearch -all -not -exact -inline $dirs ..]
    set dirs2 {}
    foreach d $dirs {lappend dirs2 $d/}

    set targets [concat \
	    [lsearch -glob -all -inline $files $f*] \
	    [lsearch -glob -all -inline $dirs2 $f*]]

    if {[llength $targets] == 1} {
	# We have a winner!








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




|






<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
|
<
<
|
<
<
<
<
<

|







1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915










1916










1917


1918





1919
1920
1921
1922
1923
1924
1925
1926
1927
	    upvar #0 $data(-typevariable) typeVariable
	    set typeVariable [lindex $data(filterType) 0]
	}
    }
    bind $data(okBtn) <Destroy> {}
    set Priv(selectFilePath) $selectFilePath
}

proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} {
    # $dir == where to search
    # $type == what to look for ('d' or 'f b c l p s')
    # $overrideFilter == whether to ignore the filter

    variable showHiddenVar
    upvar 1 data(filter) filter

    if {$filter eq "*" || $overrideFilter} {
	set patterns [list *]
	if {$showHiddenVar} {
	    lappend patterns .*
	}
    } elseif {[string is list $filter]} {
	set patterns $filter
    } else {
	# Invalid list; assume we can use non-whitespace sequences as words
	set patterns [regexp -inline -all {\S+} $filter]
    }

    set opts [list -tails -directory $dir -type $type -nocomplain]

    set result {}
    catch {
	# We have a catch because we might have a really bad pattern (e.g.,
	# with an unbalanced brace); even [glob -nocomplain] doesn't like it.
	# Using a catch ensures that it just means we match nothing instead of
	# throwing a nasty error at the user...
	foreach f [glob {*}$opts -- {*}$patterns] {
	    if {$f eq "." || $f eq ".."} {
		continue
	    }
	    lappend result $f
	}
    }
    return [lsort -dictionary -unique $result]
}

proc ::tk::dialog::file::CompleteEnt {w} {
    upvar ::tk::dialog::file::[winfo name $w] data
    set f [$data(ent) get]
    if {$data(-multiple)} {
	if {![string is list $f] || [llength $f] != 1} {
	    return -code break
	}
	set f [lindex $f 0]
    }

    # Get list of matching filenames and dirnames










    set files [if {[winfo class $w] eq "TkFDialog"} {










	GlobFiltered $data(selectPath) {f b c l p s}


    }]





    set dirs2 {}
    foreach d [GlobFiltered $data(selectPath) d] {lappend dirs2 $d/}

    set targets [concat \
	    [lsearch -glob -all -inline $files $f*] \
	    [lsearch -glob -all -inline $dirs2 $f*]]

    if {[llength $targets] == 1} {
	# We have a winner!