choosedir.tcl 9.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310
  1. # choosedir.tcl --
  2. #
  3. # Choose directory dialog implementation for Unix/Mac.
  4. #
  5. # Copyright (c) 1998-2000 by Scriptics Corporation.
  6. # All rights reserved.
  7. # Make sure the tk::dialog namespace, in which all dialogs should live, exists
  8. namespace eval ::tk::dialog {}
  9. namespace eval ::tk::dialog::file {}
  10. # Make the chooseDir namespace inside the dialog namespace
  11. namespace eval ::tk::dialog::file::chooseDir {
  12. namespace import -force ::tk::msgcat::*
  13. }
  14. # ::tk::dialog::file::chooseDir:: --
  15. #
  16. # Implements the TK directory selection dialog.
  17. #
  18. # Arguments:
  19. # args Options parsed by the procedure.
  20. #
  21. proc ::tk::dialog::file::chooseDir:: {args} {
  22. variable ::tk::Priv
  23. set dataName __tk_choosedir
  24. upvar ::tk::dialog::file::$dataName data
  25. Config $dataName $args
  26. if {$data(-parent) eq "."} {
  27. set w .$dataName
  28. } else {
  29. set w $data(-parent).$dataName
  30. }
  31. # (re)create the dialog box if necessary
  32. #
  33. if {![winfo exists $w]} {
  34. ::tk::dialog::file::Create $w TkChooseDir
  35. } elseif {[winfo class $w] ne "TkChooseDir"} {
  36. destroy $w
  37. ::tk::dialog::file::Create $w TkChooseDir
  38. } else {
  39. set data(dirMenuBtn) $w.contents.f1.menu
  40. set data(dirMenu) $w.contents.f1.menu.menu
  41. set data(upBtn) $w.contents.f1.up
  42. set data(icons) $w.contents.icons
  43. set data(ent) $w.contents.f2.ent
  44. set data(okBtn) $w.contents.f2.ok
  45. set data(cancelBtn) $w.contents.f2.cancel
  46. set data(hiddenBtn) $w.contents.f2.hidden
  47. }
  48. if {$::tk::dialog::file::showHiddenBtn} {
  49. $data(hiddenBtn) configure -state normal
  50. grid $data(hiddenBtn)
  51. } else {
  52. $data(hiddenBtn) configure -state disabled
  53. grid remove $data(hiddenBtn)
  54. }
  55. # When using -mustexist, manage the OK button state for validity
  56. $data(okBtn) configure -state normal
  57. if {$data(-mustexist)} {
  58. $data(ent) configure -validate key \
  59. -validatecommand [list ::tk::dialog::file::chooseDir::IsOK? $w %P]
  60. } else {
  61. $data(ent) configure -validate none
  62. }
  63. # Dialog boxes should be transient with respect to their parent,
  64. # so that they will always stay on top of their parent window. However,
  65. # some window managers will create the window as withdrawn if the parent
  66. # window is withdrawn or iconified. Combined with the grab we put on the
  67. # window, this can hang the entire application. Therefore we only make
  68. # the dialog transient if the parent is viewable.
  69. if {[winfo viewable [winfo toplevel $data(-parent)]] } {
  70. wm transient $w $data(-parent)
  71. }
  72. trace add variable data(selectPath) write \
  73. [list ::tk::dialog::file::SetPath $w]
  74. $data(dirMenuBtn) configure \
  75. -textvariable ::tk::dialog::file::${dataName}(selectPath)
  76. set data(filter) "*"
  77. set data(previousEntryText) ""
  78. ::tk::dialog::file::UpdateWhenIdle $w
  79. # Withdraw the window, then update all the geometry information
  80. # so we know how big it wants to be, then center the window in the
  81. # display (Motif style) and de-iconify it.
  82. ::tk::PlaceWindow $w widget $data(-parent)
  83. wm title $w $data(-title)
  84. # Set a grab and claim the focus too.
  85. ::tk::SetFocusGrab $w $data(ent)
  86. $data(ent) delete 0 end
  87. $data(ent) insert 0 $data(selectPath)
  88. $data(ent) selection range 0 end
  89. $data(ent) icursor end
  90. # Wait for the user to respond, then restore the focus and
  91. # return the index of the selected button. Restore the focus
  92. # before deleting the window, since otherwise the window manager
  93. # may take the focus away so we can't redirect it. Finally,
  94. # restore any grab that was in effect.
  95. vwait ::tk::Priv(selectFilePath)
  96. ::tk::RestoreFocusGrab $w $data(ent) withdraw
  97. # Cleanup traces on selectPath variable
  98. #
  99. foreach trace [trace info variable data(selectPath)] {
  100. trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  101. }
  102. if {[winfo exists $data(dirMenuBtn)]} {
  103. $data(dirMenuBtn) configure -textvariable {}
  104. }
  105. # Return value to user
  106. #
  107. return $Priv(selectFilePath)
  108. }
  109. # ::tk::dialog::file::chooseDir::Config --
  110. #
  111. # Configures the Tk choosedir dialog according to the argument list
  112. #
  113. proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
  114. upvar ::tk::dialog::file::$dataName data
  115. # 0: Delete all variable that were set on data(selectPath) the
  116. # last time the file dialog is used. The traces may cause troubles
  117. # if the dialog is now used with a different -parent option.
  118. #
  119. foreach trace [trace info variable data(selectPath)] {
  120. trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  121. }
  122. # 1: the configuration specs
  123. #
  124. set specs {
  125. {-mustexist "" "" 0}
  126. {-initialdir "" "" ""}
  127. {-parent "" "" "."}
  128. {-title "" "" ""}
  129. }
  130. # 2: default values depending on the type of the dialog
  131. #
  132. if {![info exists data(selectPath)]} {
  133. # first time the dialog has been popped up
  134. set data(selectPath) [pwd]
  135. }
  136. # 3: parse the arguments
  137. #
  138. tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  139. if {$data(-title) eq ""} {
  140. set data(-title) "[mc "Choose Directory"]"
  141. }
  142. # Stub out the -multiple value for the dialog; it doesn't make sense for
  143. # choose directory dialogs, but we have to have something there because we
  144. # share so much code with the file dialogs.
  145. set data(-multiple) 0
  146. # 4: set the default directory and selection according to the -initial
  147. # settings
  148. #
  149. if {$data(-initialdir) ne ""} {
  150. # Ensure that initialdir is an absolute path name.
  151. if {[file isdirectory $data(-initialdir)]} {
  152. set old [pwd]
  153. cd $data(-initialdir)
  154. set data(selectPath) [pwd]
  155. cd $old
  156. } else {
  157. set data(selectPath) [pwd]
  158. }
  159. }
  160. if {![winfo exists $data(-parent)]} {
  161. return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
  162. "bad window path name \"$data(-parent)\""
  163. }
  164. }
  165. # Gets called when user presses Return in the "Selection" entry or presses OK.
  166. #
  167. proc ::tk::dialog::file::chooseDir::OkCmd {w} {
  168. upvar ::tk::dialog::file::[winfo name $w] data
  169. # This is the brains behind selecting non-existant directories. Here's
  170. # the flowchart:
  171. # 1. If the icon list has a selection, join it with the current dir,
  172. # and return that value.
  173. # 1a. If the icon list does not have a selection ...
  174. # 2. If the entry is empty, do nothing.
  175. # 3. If the entry contains an invalid directory, then...
  176. # 3a. If the value is the same as last time through here, end dialog.
  177. # 3b. If the value is different than last time, save it and return.
  178. # 4. If entry contains a valid directory, then...
  179. # 4a. If the value is the same as the current directory, end dialog.
  180. # 4b. If the value is different from the current directory, change to
  181. # that directory.
  182. set selection [$data(icons) selection get]
  183. if {[llength $selection] != 0} {
  184. set iconText [$data(icons) get [lindex $selection 0]]
  185. set iconText [file join $data(selectPath) $iconText]
  186. Done $w $iconText
  187. } else {
  188. set text [$data(ent) get]
  189. if {$text eq ""} {
  190. return
  191. }
  192. set text [file join {*}[file split [string trim $text]]]
  193. if {![file exists $text] || ![file isdirectory $text]} {
  194. # Entry contains an invalid directory. If it's the same as the
  195. # last time they came through here, reset the saved value and end
  196. # the dialog. Otherwise, save the value (so we can do this test
  197. # next time).
  198. if {$text eq $data(previousEntryText)} {
  199. set data(previousEntryText) ""
  200. Done $w $text
  201. } else {
  202. set data(previousEntryText) $text
  203. }
  204. } else {
  205. # Entry contains a valid directory. If it is the same as the
  206. # current directory, end the dialog. Otherwise, change to that
  207. # directory.
  208. if {$text eq $data(selectPath)} {
  209. Done $w $text
  210. } else {
  211. set data(selectPath) $text
  212. }
  213. }
  214. }
  215. return
  216. }
  217. # Change state of OK button to match -mustexist correctness of entry
  218. #
  219. proc ::tk::dialog::file::chooseDir::IsOK? {w text} {
  220. upvar ::tk::dialog::file::[winfo name $w] data
  221. set ok [file isdirectory $text]
  222. $data(okBtn) configure -state [expr {$ok ? "normal" : "disabled"}]
  223. # always return 1
  224. return 1
  225. }
  226. proc ::tk::dialog::file::chooseDir::DblClick {w} {
  227. upvar ::tk::dialog::file::[winfo name $w] data
  228. set selection [$data(icons) selection get]
  229. if {[llength $selection] != 0} {
  230. set filenameFragment [$data(icons) get [lindex $selection 0]]
  231. set file $data(selectPath)
  232. if {[file isdirectory $file]} {
  233. ::tk::dialog::file::ListInvoke $w [list $filenameFragment]
  234. return
  235. }
  236. }
  237. }
  238. # Gets called when user browses the IconList widget (dragging mouse, arrow
  239. # keys, etc)
  240. #
  241. proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
  242. upvar ::tk::dialog::file::[winfo name $w] data
  243. if {$text eq ""} {
  244. return
  245. }
  246. set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
  247. $data(ent) delete 0 end
  248. $data(ent) insert 0 $file
  249. }
  250. # ::tk::dialog::file::chooseDir::Done --
  251. #
  252. # Gets called when user has input a valid filename. Pops up a
  253. # dialog box to confirm selection when necessary. Sets the
  254. # Priv(selectFilePath) variable, which will break the "vwait"
  255. # loop in tk_chooseDirectory and return the selected filename to the
  256. # script that calls tk_getOpenFile or tk_getSaveFile
  257. #
  258. proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {
  259. upvar ::tk::dialog::file::[winfo name $w] data
  260. variable ::tk::Priv
  261. if {$selectFilePath eq ""} {
  262. set selectFilePath $data(selectPath)
  263. }
  264. if {$data(-mustexist) && ![file isdirectory $selectFilePath]} {
  265. return
  266. }
  267. set Priv(selectFilePath) $selectFilePath
  268. }