From 0363772b05a3395a9e79e21c2bb81121bcec0575 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 25 Aug 2012 08:09:17 +0000 Subject: [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. --- ChangeLog | 11 +++++++- library/tkfbox.tcl | 74 ++++++++++++++++++++++++++++++++++-------------------- 2 files changed, 57 insertions(+), 28 deletions(-) diff --git a/ChangeLog b/ChangeLog index d540456..18e1c73 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,15 @@ +2012-08-24 Donal K. Fellows + + * 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 - * unix/tkUnixWm.c: [Bugs 3554026,3561016] Stop crash with tearoff menus. + * unix/tkUnixWm.c: [Bugs 3554026,3561016]: Stop crash with tearoff + menus. 2012-08-17 Jan Nijtmans diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index bf6cf87..b848371 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -16,7 +16,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # - + #---------------------------------------------------------------------- # # I C O N L I S T @@ -759,7 +759,7 @@ proc ::tk::IconList_Reset {w} { unset -nocomplain Priv(ILAccel,$w) } - + #---------------------------------------------------------------------- # # F I L E D I A L O G @@ -1260,34 +1260,16 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] 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 + # 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. + # 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_Add $data(icons) $file \ + [GlobFiltered [pwd] {f b c l p s}] } ::tk::IconList_Arrange $data(icons) @@ -1812,3 +1794,41 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { bind $data(okBtn) {} 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 {[catch { + set patterns [lreplace $filter 0 -1] + }]} then { + # Invalid list; assume we can use non-whitespace sequences as words + set patterns [regexp -inline -all {\S+} $filter] + } + + set cmd [list glob -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 [eval $cmd $patterns] { + if {$f eq "." || $f eq ".."} { + continue + } + lappend result $f + } + } + return [lsort -dictionary -unique $result] +} -- cgit v0.12 From 34d3fa8298631ce5cbfb4be427b0681c3ad1475c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 28 Aug 2012 13:59:07 +0000 Subject: [Bug 3562426]: Context menu goes out of edge of screen.

PLEASE DON'T PUT THIS ASIDE TO A MISTAKE BRANCH OR SOMETHING! It's simply a fork, in fossil there's nothing wrong with that!

--- ChangeLog | 5 +++++ generic/tkMenuDraw.c | 2 ++ 2 files changed, 7 insertions(+) diff --git a/ChangeLog b/ChangeLog index 52d9739..89865de 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2012-08-28 Jan Nijtmans + + * generic/tkMenuDraw.c: [Bug 3562426]: Context menu goes out of edge of + screen. + 2012-08-17 Jan Nijtmans * win/nmakehlp.c: Add "-V" option, in order to be able diff --git a/generic/tkMenuDraw.c b/generic/tkMenuDraw.c index 7c69548..d4634cd 100644 --- a/generic/tkMenuDraw.c +++ b/generic/tkMenuDraw.c @@ -896,12 +896,14 @@ TkPostTearoffMenu(interp, menuPtr, x, y) Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY, &vRootWidth, &vRootHeight); + vRootWidth -= Tk_ReqWidth(menuPtr->tkwin); if (x > vRootX + vRootWidth) { x = vRootX + vRootWidth; } if (x < vRootX) { x = vRootX; } + vRootHeight -= Tk_ReqHeight(menuPtr->tkwin); if (y > vRootY + vRootHeight) { y = vRootY + vRootHeight; } -- cgit v0.12