# choosedir.tcl -- # # Choose directory dialog implementation for Unix/Mac. # # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # Make sure the tk::dialog namespace, in which all dialogs should live, exists namespace eval ::tk::dialog {} namespace eval ::tk::dialog::file {} # Make the chooseDir namespace inside the dialog namespace namespace eval ::tk::dialog::file::chooseDir { namespace import -force ::tk::msgcat::* } # ::tk::dialog::file::chooseDir:: -- # # Implements the TK directory selection dialog. # # Arguments: # args Options parsed by the procedure. # proc ::tk::dialog::file::chooseDir:: {args} { variable ::tk::Priv set dataName __tk_choosedir upvar ::tk::dialog::file::$dataName data Config $dataName $args if {$data(-parent) eq "."} { set w .$dataName } else { set w $data(-parent).$dataName } # (re)create the dialog box if necessary # if {![winfo exists $w]} { ::tk::dialog::file::Create $w TkChooseDir } elseif {[winfo class $w] ne "TkChooseDir"} { destroy $w ::tk::dialog::file::Create $w TkChooseDir } else { set data(dirMenuBtn) $w.contents.f1.menu set data(dirMenu) $w.contents.f1.menu.menu set data(upBtn) $w.contents.f1.up set data(icons) $w.contents.icons set data(ent) $w.contents.f2.ent set data(okBtn) $w.contents.f2.ok set data(cancelBtn) $w.contents.f2.cancel set data(hiddenBtn) $w.contents.f2.hidden } if {$::tk::dialog::file::showHiddenBtn} { $data(hiddenBtn) configure -state normal grid $data(hiddenBtn) } else { $data(hiddenBtn) configure -state disabled grid remove $data(hiddenBtn) } # When using -mustexist, manage the OK button state for validity $data(okBtn) configure -state normal if {$data(-mustexist)} { $data(ent) configure -validate key \ -validatecommand [list ::tk::dialog::file::chooseDir::IsOK? $w %P] } else { $data(ent) configure -validate none } # Dialog boxes should be transient with respect to their parent, # so that they will always stay on top of their parent window. However, # some window managers will create the window as withdrawn if the parent # window is withdrawn or iconified. Combined with the grab we put on the # window, this can hang the entire application. Therefore we only make # the dialog transient if the parent is viewable. if {[winfo viewable [winfo toplevel $data(-parent)]] } { wm transient $w $data(-parent) } trace add variable data(selectPath) write \ [list ::tk::dialog::file::SetPath $w] $data(dirMenuBtn) configure \ -textvariable ::tk::dialog::file::${dataName}(selectPath) set data(filter) "*" set data(previousEntryText) "" ::tk::dialog::file::UpdateWhenIdle $w # Withdraw the window, then update all the geometry information # so we know how big it wants to be, then center the window in the # display (Motif style) and de-iconify it. ::tk::PlaceWindow $w widget $data(-parent) wm title $w $data(-title) # Set a grab and claim the focus too. ::tk::SetFocusGrab $w $data(ent) $data(ent) delete 0 end $data(ent) insert 0 $data(selectPath) $data(ent) selection range 0 end $data(ent) icursor end # Wait for the user to respond, then restore the focus and # return the index of the selected button. Restore the focus # before deleting the window, since otherwise the window manager # may take the focus away so we can't redirect it. Finally, # restore any grab that was in effect. vwait ::tk::Priv(selectFilePath) ::tk::RestoreFocusGrab $w $data(ent) withdraw # Cleanup traces on selectPath variable # foreach trace [trace info variable data(selectPath)] { trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] } $data(dirMenuBtn) configure -textvariable {} # Return value to user # return $Priv(selectFilePath) } # ::tk::dialog::file::chooseDir::Config -- # # Configures the Tk choosedir dialog according to the argument list # proc ::tk::dialog::file::chooseDir::Config {dataName argList} { upvar ::tk::dialog::file::$dataName data # 0: Delete all variable that were set on data(selectPath) the # last time the file dialog is used. The traces may cause troubles # if the dialog is now used with a different -parent option. # foreach trace [trace info variable data(selectPath)] { trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] } # 1: the configuration specs # set specs { {-mustexist "" "" 0} {-initialdir "" "" ""} {-parent "" "" "."} {-title "" "" ""} } # 2: default values depending on the type of the dialog # if {![info exists data(selectPath)]} { # first time the dialog has been popped up set data(selectPath) [pwd] } # 3: parse the arguments # tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList if {$data(-title) eq ""} { set data(-title) "[mc "Choose Directory"]" } # Stub out the -multiple value for the dialog; it doesn't make sense for # choose directory dialogs, but we have to have something there because we # share so much code with the file dialogs. set data(-multiple) 0 # 4: set the default directory and selection according to the -initial # settings # if {$data(-initialdir) ne ""} { # Ensure that initialdir is an absolute path name. if {[file isdirectory $data(-initialdir)]} { set old [pwd] cd $data(-initialdir) set data(selectPath) [pwd] cd $old } else { set data(selectPath) [pwd] } } if {![winfo exists $data(-parent)]} { return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ "bad window path name \"$data(-parent)\"" } } # Gets called when user presses Return in the "Selection" entry or presses OK. # proc ::tk::dialog::file::chooseDir::OkCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data # This is the brains behind selecting non-existant directories. Here's # the flowchart: # 1. If the icon list has a selection, join it with the current dir, # and return that value. # 1a. If the icon list does not have a selection ... # 2. If the entry is empty, do nothing. # 3. If the entry contains an invalid directory, then... # 3a. If the value is the same as last time through here, end dialog. # 3b. If the value is different than last time, save it and return. # 4. If entry contains a valid directory, then... # 4a. If the value is the same as the current directory, end dialog. # 4b. If the value is different from the current directory, change to # that directory. set selection [$data(icons) selection get] if {[llength $selection] != 0} { set iconText [$data(icons) get [lindex $selection 0]] set iconText [file join $data(selectPath) $iconText] Done $w $iconText } else { set text [$data(ent) get] if {$text eq ""} { return } set text [file join {*}[file split [string trim $text]]] if {![file exists $text] || ![file isdirectory $text]} { # Entry contains an invalid directory. If it's the same as the # last time they came through here, reset the saved value and end # the dialog. Otherwise, save the value (so we can do this test # next time). if {$text eq $data(previousEntryText)} { set data(previousEntryText) "" Done $w $text } else { set data(previousEntryText) $text } } else { # Entry contains a valid directory. If it is the same as the # current directory, end the dialog. Otherwise, change to that # directory. if {$text eq $data(selectPath)} { Done $w $text } else { set data(selectPath) $text } } } return } # Change state of OK button to match -mustexist correctness of entry # proc ::tk::dialog::file::chooseDir::IsOK? {w text} { upvar ::tk::dialog::file::[winfo name $w] data set ok [file isdirectory $text] $data(okBtn) configure -state [expr {$ok ? "normal" : "disabled"}] # always return 1 return 1 } proc ::tk::dialog::file::chooseDir::DblClick {w} { upvar ::tk::dialog::file::[winfo name $w] data set selection [$data(icons) selection get] if {[llength $selection] != 0} { set filenameFragment [$data(icons) get [lindex $selection 0]] set file $data(selectPath) if {[file isdirectory $file]} { ::tk::dialog::file::ListInvoke $w [list $filenameFragment] return } } } # Gets called when user browses the IconList widget (dragging mouse, arrow # keys, etc) # proc ::tk::dialog::file::chooseDir::ListBrowse {w text} { upvar ::tk::dialog::file::[winfo name $w] data if {$text eq ""} { return } set file [::tk::dialog::file::JoinFile $data(selectPath) $text] $data(ent) delete 0 end $data(ent) insert 0 $file } # ::tk::dialog::file::chooseDir::Done -- # # Gets called when user has input a valid filename. Pops up a # dialog box to confirm selection when necessary. Sets the # Priv(selectFilePath) variable, which will break the "vwait" # loop in tk_chooseDirectory and return the selected filename to the # script that calls tk_getOpenFile or tk_getSaveFile # proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} { upvar ::tk::dialog::file::[winfo name $w] data variable ::tk::Priv if {$selectFilePath eq ""} { set selectFilePath $data(selectPath) } if {$data(-mustexist) && ![file isdirectory $selectFilePath]} { return } set Priv(selectFilePath) $selectFilePath } Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
path: root/generic/tclPanic.c
Commit message (Expand)AuthorAgeFilesLines
* More whitespace cleanupdkf2024-05-101-1/+0
* Fix for [ef23a85ac6]: Tcl_PanicProc - Tcl9 & NaviServer.jan.nijtmans2024-04-251-15/+15
|\
| * Fix for [ef23a85ac6]: Tcl_PanicProc - Tcl9 & NaviServer.jan.nijtmans2024-04-251-18/+18
| |\
| | * Improve use of TCL_NORETURN, so no unnecessary warnings are produced any morejan.nijtmans2024-04-241-13/+13
| | * Possible fix for [ef23a85ac6]: Tcl_PanicProc - Tcl9 & NaviServerjan.nijtmans2024-04-231-2/+2
| |/ |/|
* | Correct spelling errors in comments and documentation, but also a non-comment...pooryorick2023-04-121-1/+1
|\ \ | |/
| * Correct spelling errors in comments and documentation, but also a non-comment pooryorick2023-04-121-1/+1
| * Remove "testpurify" and "testdebug" test commandsjan.nijtmans2021-04-291-0/+1
| * Merge 8.7 Signature change for Tcl_SetPanicProc() and Tcl_FindExecutable()jan.nijtmans2021-04-281-2/+2
* | Merge 9.0jan.nijtmans2021-02-171-3/+3
|\ \
| * \ Merge 8.7jan.nijtmans2020-12-081-3/+3
| |\ \ | | |/
| | * Add -finput-charset=UTF-8 and -fextended-identifiers to gcc (and clang). All ...jan.nijtmans2020-12-081-3/+3
* | | Merge trunkjan.nijtmans2020-03-171-1/+0
|\ \ \ | |/ /
| * | merge 8.7dgp2020-03-171-1/+0
| |\ \ | | |/
| | * TIP 569 - remove lint commentsdgp2020-03-171-2/+0
| | * Merge 8.7jan.nijtmans2019-09-141-1/+1
| | |\
| | * | Merge 8.7. Continue implementation for win32jan.nijtmans2019-08-021-1/+1
* | | | Merge trunk. Finish implementation.jan.nijtmans2019-09-301-1/+1
|\ \ \ \ | |/ / /
| * | | Merge 8.7jan.nijtmans2019-09-141-1/+1
| |\ \ \ | | | |/ | | |/|
| | * | Merge 8.7jan.nijtmans2018-12-081-2/+3
| | |\ \ | | | |/
| | * | Rebase TIP-414 to TIP-512: If Tcl_SetPanicProc doesn't have a stub entry, it ...jan.nijtmans2018-10-181-3/+2
| | |\ \
| | * \ \ merge 8.7jan.nijtmans2018-05-191-2/+3
| | |\ \ \
* | | \ \ \ Rebase to 9.0jan.nijtmans2019-08-191-2/+2
|\ \ \ \ \ \ | |/ / / / / |/| | | | |
* | | | | | Merge 8.7jan.nijtmans2018-11-151-1/+1
|\ \ \ \ \ \ | | |_|_|_|/ | |/| | | |
| * | | | | Merge 8.7jan.nijtmans2018-11-02