tkfbox.tcl 53 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965
  1. # tkfbox.tcl --
  2. #
  3. # Implements the "TK" standard file selection dialog box. This
  4. # dialog box is used on the Unix platforms whenever the tk_strictMotif
  5. # flag is not set.
  6. #
  7. # The "TK" standard file selection dialog box is similar to the
  8. # file selection dialog box on Win95(TM). The user can navigate
  9. # the directories by clicking on the folder icons or by
  10. # selecting the "Directory" option menu. The user can select
  11. # files by clicking on the file icons or by entering a filename
  12. # in the "Filename:" entry.
  13. #
  14. # Copyright (c) 1994-1998 Sun Microsystems, Inc.
  15. #
  16. # See the file "license.terms" for information on usage and redistribution
  17. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  18. #
  19. package require Ttk
  20. #----------------------------------------------------------------------
  21. #
  22. # I C O N L I S T
  23. #
  24. # This is a pseudo-widget that implements the icon list inside the
  25. # ::tk::dialog::file:: dialog box.
  26. #
  27. #----------------------------------------------------------------------
  28. # ::tk::IconList --
  29. #
  30. # Creates an IconList widget.
  31. #
  32. proc ::tk::IconList {w args} {
  33. IconList_Config $w $args
  34. IconList_Create $w
  35. }
  36. proc ::tk::IconList_Index {w i} {
  37. upvar #0 ::tk::$w data ::tk::$w:itemList itemList
  38. if {![info exists data(list)]} {
  39. set data(list) {}
  40. }
  41. switch -regexp -- $i {
  42. "^-?[0-9]+$" {
  43. if {$i < 0} {
  44. set i 0
  45. }
  46. if {$i >= [llength $data(list)]} {
  47. set i [expr {[llength $data(list)] - 1}]
  48. }
  49. return $i
  50. }
  51. "^active$" {
  52. return $data(index,active)
  53. }
  54. "^anchor$" {
  55. return $data(index,anchor)
  56. }
  57. "^end$" {
  58. return [llength $data(list)]
  59. }
  60. "@-?[0-9]+,-?[0-9]+" {
  61. foreach {x y} [scan $i "@%d,%d"] {
  62. break
  63. }
  64. set item [$data(canvas) find closest \
  65. [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
  66. return [lindex [$data(canvas) itemcget $item -tags] 1]
  67. }
  68. }
  69. }
  70. proc ::tk::IconList_Selection {w op args} {
  71. upvar ::tk::$w data
  72. switch -exact -- $op {
  73. "anchor" {
  74. if {[llength $args] == 1} {
  75. set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]
  76. } else {
  77. return $data(index,anchor)
  78. }
  79. }
  80. "clear" {
  81. if {[llength $args] == 2} {
  82. foreach {first last} $args {
  83. break
  84. }
  85. } elseif {[llength $args] == 1} {
  86. set first [set last [lindex $args 0]]
  87. } else {
  88. error "wrong # args: should be [lindex [info level 0] 0] path\
  89. clear first ?last?"
  90. }
  91. set first [IconList_Index $w $first]
  92. set last [IconList_Index $w $last]
  93. if {$first > $last} {
  94. set tmp $first
  95. set first $last
  96. set last $tmp
  97. }
  98. set ind 0
  99. foreach item $data(selection) {
  100. if { $item >= $first } {
  101. set first $ind
  102. break
  103. }
  104. incr ind
  105. }
  106. set ind [expr {[llength $data(selection)] - 1}]
  107. for {} {$ind >= 0} {incr ind -1} {
  108. set item [lindex $data(selection) $ind]
  109. if { $item <= $last } {
  110. set last $ind
  111. break
  112. }
  113. }
  114. if { $first > $last } {
  115. return
  116. }
  117. set data(selection) [lreplace $data(selection) $first $last]
  118. event generate $w <<ListboxSelect>>
  119. IconList_DrawSelection $w
  120. }
  121. "includes" {
  122. set index [lsearch -exact $data(selection) [lindex $args 0]]
  123. return [expr {$index != -1}]
  124. }
  125. "set" {
  126. if { [llength $args] == 2 } {
  127. foreach {first last} $args {
  128. break
  129. }
  130. } elseif { [llength $args] == 1 } {
  131. set last [set first [lindex $args 0]]
  132. } else {
  133. error "wrong # args: should be [lindex [info level 0] 0] path\
  134. set first ?last?"
  135. }
  136. set first [IconList_Index $w $first]
  137. set last [IconList_Index $w $last]
  138. if { $first > $last } {
  139. set tmp $first
  140. set first $last
  141. set last $tmp
  142. }
  143. for {set i $first} {$i <= $last} {incr i} {
  144. lappend data(selection) $i
  145. }
  146. set data(selection) [lsort -integer -unique $data(selection)]
  147. event generate $w <<ListboxSelect>>
  148. IconList_DrawSelection $w
  149. }
  150. }
  151. }
  152. proc ::tk::IconList_CurSelection {w} {
  153. upvar ::tk::$w data
  154. return $data(selection)
  155. }
  156. proc ::tk::IconList_DrawSelection {w} {
  157. upvar ::tk::$w data
  158. upvar ::tk::$w:itemList itemList
  159. $data(canvas) delete selection
  160. $data(canvas) itemconfigure selectionText -fill black
  161. $data(canvas) dtag selectionText
  162. set cbg [ttk::style lookup TEntry -selectbackground focus]
  163. set cfg [ttk::style lookup TEntry -selectforeground focus]
  164. foreach item $data(selection) {
  165. set rTag [lindex [lindex $data(list) $item] 2]
  166. foreach {iTag tTag text serial} $itemList($rTag) {
  167. break
  168. }
  169. set bbox [$data(canvas) bbox $tTag]
  170. $data(canvas) create rect $bbox -fill $cbg -outline $cbg \
  171. -tags selection
  172. $data(canvas) itemconfigure $tTag -fill $cfg -tags selectionText
  173. }
  174. $data(canvas) lower selection
  175. return
  176. }
  177. proc ::tk::IconList_Get {w item} {
  178. upvar ::tk::$w data
  179. upvar ::tk::$w:itemList itemList
  180. set rTag [lindex [lindex $data(list) $item] 2]
  181. foreach {iTag tTag text serial} $itemList($rTag) {
  182. break
  183. }
  184. return $text
  185. }
  186. # ::tk::IconList_Config --
  187. #
  188. # Configure the widget variables of IconList, according to the command
  189. # line arguments.
  190. #
  191. proc ::tk::IconList_Config {w argList} {
  192. # 1: the configuration specs
  193. #
  194. set specs {
  195. {-command "" "" ""}
  196. {-multiple "" "" "0"}
  197. }
  198. # 2: parse the arguments
  199. #
  200. tclParseConfigSpec ::tk::$w $specs "" $argList
  201. }
  202. # ::tk::IconList_Create --
  203. #
  204. # Creates an IconList widget by assembling a canvas widget and a
  205. # scrollbar widget. Sets all the bindings necessary for the IconList's
  206. # operations.
  207. #
  208. proc ::tk::IconList_Create {w} {
  209. upvar ::tk::$w data
  210. ttk::frame $w
  211. ttk::entry $w.cHull -takefocus 0 -cursor {}
  212. set data(sbar) [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0]
  213. catch {$data(sbar) configure -highlightthickness 0}
  214. set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \
  215. -width 400 -height 120 -takefocus 1 -background white]
  216. pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2}
  217. pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0}
  218. pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2
  219. $data(sbar) configure -command [list $data(canvas) xview]
  220. $data(canvas) configure -xscrollcommand [list $data(sbar) set]
  221. # Initializes the max icon/text width and height and other variables
  222. #
  223. set data(maxIW) 1
  224. set data(maxIH) 1
  225. set data(maxTW) 1
  226. set data(maxTH) 1
  227. set data(numItems) 0
  228. set data(noScroll) 1
  229. set data(selection) {}
  230. set data(index,anchor) ""
  231. set fg [option get $data(canvas) foreground Foreground]
  232. if {$fg eq ""} {
  233. set data(fill) black
  234. } else {
  235. set data(fill) $fg
  236. }
  237. # Creates the event bindings.
  238. #
  239. bind $data(canvas) <Configure> [list tk::IconList_Arrange $w]
  240. bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y]
  241. bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y]
  242. bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y]
  243. bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y]
  244. bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y]
  245. bind $data(canvas) <B1-Enter> [list tk::CancelRepeat]
  246. bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
  247. bind $data(canvas) <Double-ButtonRelease-1> \
  248. [list tk::IconList_Double1 $w %x %y]
  249. bind $data(canvas) <Control-B1-Motion> {;}
  250. bind $data(canvas) <Shift-B1-Motion> \
  251. [list tk::IconList_ShiftMotion1 $w %x %y]
  252. bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1]
  253. bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1]
  254. bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1]
  255. bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1]
  256. bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w]
  257. bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A]
  258. bind $data(canvas) <Control-KeyPress> ";"
  259. bind $data(canvas) <Alt-KeyPress> ";"
  260. bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w]
  261. bind $data(canvas) <FocusOut> [list tk::IconList_FocusOut $w]
  262. return $w
  263. }
  264. # ::tk::IconList_AutoScan --
  265. #
  266. # This procedure is invoked when the mouse leaves an entry window
  267. # with button 1 down. It scrolls the window up, down, left, or
  268. # right, depending on where the mouse left the window, and reschedules
  269. # itself as an "after" command so that the window continues to scroll until
  270. # the mouse moves back into the window or the mouse button is released.
  271. #
  272. # Arguments:
  273. # w - The IconList window.
  274. #
  275. proc ::tk::IconList_AutoScan {w} {
  276. upvar ::tk::$w data
  277. variable ::tk::Priv
  278. if {![winfo exists $w]} return
  279. set x $Priv(x)
  280. set y $Priv(y)
  281. if {$data(noScroll)} {
  282. return
  283. }
  284. if {$x >= [winfo width $data(canvas)]} {
  285. $data(canvas) xview scroll 1 units
  286. } elseif {$x < 0} {
  287. $data(canvas) xview scroll -1 units
  288. } elseif {$y >= [winfo height $data(canvas)]} {
  289. # do nothing
  290. } elseif {$y < 0} {
  291. # do nothing
  292. } else {
  293. return
  294. }
  295. IconList_Motion1 $w $x $y
  296. set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
  297. }
  298. # Deletes all the items inside the canvas subwidget and reset the IconList's
  299. # state.
  300. #
  301. proc ::tk::IconList_DeleteAll {w} {
  302. upvar ::tk::$w data
  303. upvar ::tk::$w:itemList itemList
  304. $data(canvas) delete all
  305. unset -nocomplain data(selected) data(rect) data(list) itemList
  306. set data(maxIW) 1
  307. set data(maxIH) 1
  308. set data(maxTW) 1
  309. set data(maxTH) 1
  310. set data(numItems) 0
  311. set data(noScroll) 1
  312. set data(selection) {}
  313. set data(index,anchor) ""
  314. $data(sbar) set 0.0 1.0
  315. $data(canvas) xview moveto 0
  316. }
  317. # Adds an icon into the IconList with the designated image and text
  318. #
  319. proc ::tk::IconList_Add {w image items} {
  320. upvar ::tk::$w data
  321. upvar ::tk::$w:itemList itemList
  322. upvar ::tk::$w:textList textList
  323. foreach text $items {
  324. set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
  325. -tags [list icon $data(numItems) item$data(numItems)]]
  326. set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \
  327. -font $data(font) -fill $data(fill) \
  328. -tags [list text $data(numItems) item$data(numItems)]]
  329. set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \
  330. -tags [list rect $data(numItems) item$data(numItems)]]
  331. foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {
  332. break
  333. }
  334. set iW [expr {$x2 - $x1}]
  335. set iH [expr {$y2 - $y1}]
  336. if {$data(maxIW) < $iW} {
  337. set data(maxIW) $iW
  338. }
  339. if {$data(maxIH) < $iH} {
  340. set data(maxIH) $iH
  341. }
  342. foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {
  343. break
  344. }
  345. set tW [expr {$x2 - $x1}]
  346. set tH [expr {$y2 - $y1}]
  347. if {$data(maxTW) < $tW} {
  348. set data(maxTW) $tW
  349. }
  350. if {$data(maxTH) < $tH} {
  351. set data(maxTH) $tH
  352. }
  353. lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \
  354. $tH $data(numItems)]
  355. set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
  356. set textList($data(numItems)) [string tolower $text]
  357. incr data(numItems)
  358. }
  359. }
  360. # Places the icons in a column-major arrangement.
  361. #
  362. proc ::tk::IconList_Arrange {w} {
  363. upvar ::tk::$w data
  364. if {![info exists data(list)]} {
  365. if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
  366. set data(noScroll) 1
  367. $data(sbar) configure -command ""
  368. }
  369. return
  370. }
  371. set W [winfo width $data(canvas)]
  372. set H [winfo height $data(canvas)]
  373. set pad [expr {[$data(canvas) cget -highlightthickness] + \
  374. [$data(canvas) cget -bd]}]
  375. if {$pad < 2} {
  376. set pad 2
  377. }
  378. incr W -[expr {$pad*2}]
  379. incr H -[expr {$pad*2}]
  380. set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
  381. if {$data(maxTH) > $data(maxIH)} {
  382. set dy $data(maxTH)
  383. } else {
  384. set dy $data(maxIH)
  385. }
  386. incr dy 2
  387. set shift [expr {$data(maxIW) + 4}]
  388. set x [expr {$pad * 2}]
  389. set y [expr {$pad * 1}] ; # Why * 1 ?
  390. set usedColumn 0
  391. foreach sublist $data(list) {
  392. set usedColumn 1
  393. foreach {iTag tTag rTag iW iH tW tH} $sublist {
  394. break
  395. }
  396. set i_dy [expr {($dy - $iH)/2}]
  397. set t_dy [expr {($dy - $tH)/2}]
  398. $data(canvas) coords $iTag $x [expr {$y + $i_dy}]
  399. $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}]
  400. $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
  401. incr y $dy
  402. if {($y + $dy) > $H} {
  403. set y [expr {$pad * 1}] ; # *1 ?
  404. incr x $dx
  405. set usedColumn 0
  406. }
  407. }
  408. if {$usedColumn} {
  409. set sW [expr {$x + $dx}]
  410. } else {
  411. set sW $x
  412. }
  413. if {$sW < $W} {
  414. $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  415. $data(sbar) configure -command ""
  416. $data(canvas) xview moveto 0
  417. set data(noScroll) 1
  418. } else {
  419. $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  420. $data(sbar) configure -command [list $data(canvas) xview]
  421. set data(noScroll) 0
  422. }
  423. set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
  424. if {$data(itemsPerColumn) < 1} {
  425. set data(itemsPerColumn) 1
  426. }
  427. IconList_DrawSelection $w
  428. }
  429. # Gets called when the user invokes the IconList (usually by double-clicking
  430. # or pressing the Return key).
  431. #
  432. proc ::tk::IconList_Invoke {w} {
  433. upvar ::tk::$w data
  434. if {$data(-command) ne "" && [llength $data(selection)]} {
  435. uplevel #0 $data(-command)
  436. }
  437. }
  438. # ::tk::IconList_See --
  439. #
  440. # If the item is not (completely) visible, scroll the canvas so that
  441. # it becomes visible.
  442. proc ::tk::IconList_See {w rTag} {
  443. upvar ::tk::$w data
  444. upvar ::tk::$w:itemList itemList
  445. if {$data(noScroll)} {
  446. return
  447. }
  448. set sRegion [$data(canvas) cget -scrollregion]
  449. if {$sRegion eq ""} {
  450. return
  451. }
  452. if { $rTag < 0 || $rTag >= [llength $data(list)] } {
  453. return
  454. }
  455. set bbox [$data(canvas) bbox item$rTag]
  456. set pad [expr {[$data(canvas) cget -highlightthickness] + \
  457. [$data(canvas) cget -bd]}]
  458. set x1 [lindex $bbox 0]
  459. set x2 [lindex $bbox 2]
  460. incr x1 -[expr {$pad * 2}]
  461. incr x2 -[expr {$pad * 1}] ; # *1 ?
  462. set cW [expr {[winfo width $data(canvas)] - $pad*2}]
  463. set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
  464. set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
  465. set oldDispX $dispX
  466. # check if out of the right edge
  467. #
  468. if {($x2 - $dispX) >= $cW} {
  469. set dispX [expr {$x2 - $cW}]
  470. }
  471. # check if out of the left edge
  472. #
  473. if {($x1 - $dispX) < 0} {
  474. set dispX $x1
  475. }
  476. if {$oldDispX ne $dispX} {
  477. set fraction [expr {double($dispX)/double($scrollW)}]
  478. $data(canvas) xview moveto $fraction
  479. }
  480. }
  481. proc ::tk::IconList_Btn1 {w x y} {
  482. upvar ::tk::$w data
  483. focus $data(canvas)
  484. set i [IconList_Index $w @$x,$y]
  485. if {$i eq ""} {
  486. return
  487. }
  488. IconList_Selection $w clear 0 end
  489. IconList_Selection $w set $i
  490. IconList_Selection $w anchor $i
  491. }
  492. proc ::tk::IconList_CtrlBtn1 {w x y} {
  493. upvar ::tk::$w data
  494. if { $data(-multiple) } {
  495. focus $data(canvas)
  496. set i [IconList_Index $w @$x,$y]
  497. if {$i eq ""} {
  498. return
  499. }
  500. if { [IconList_Selection $w includes $i] } {
  501. IconList_Selection $w clear $i
  502. } else {
  503. IconList_Selection $w set $i
  504. IconList_Selection $w anchor $i
  505. }
  506. }
  507. }
  508. proc ::tk::IconList_ShiftBtn1 {w x y} {
  509. upvar ::tk::$w data
  510. if { $data(-multiple) } {
  511. focus $data(canvas)
  512. set i [IconList_Index $w @$x,$y]
  513. if {$i eq ""} {
  514. return
  515. }
  516. if {[IconList_Index $w anchor] eq ""} {
  517. IconList_Selection $w anchor $i
  518. }
  519. IconList_Selection $w clear 0 end
  520. IconList_Selection $w set anchor $i
  521. }
  522. }
  523. # Gets called on button-1 motions
  524. #
  525. proc ::tk::IconList_Motion1 {w x y} {
  526. variable ::tk::Priv
  527. set Priv(x) $x
  528. set Priv(y) $y
  529. set i [IconList_Index $w @$x,$y]
  530. if {$i eq ""} {
  531. return
  532. }
  533. IconList_Selection $w clear 0 end
  534. IconList_Selection $w set $i
  535. }
  536. proc ::tk::IconList_ShiftMotion1 {w x y} {
  537. upvar ::tk::$w data
  538. variable ::tk::Priv
  539. set Priv(x) $x
  540. set Priv(y) $y
  541. set i [IconList_Index $w @$x,$y]
  542. if {$i eq ""} {
  543. return
  544. }
  545. IconList_Selection $w clear 0 end
  546. IconList_Selection $w set anchor $i
  547. }
  548. proc ::tk::IconList_Double1 {w x y} {
  549. upvar ::tk::$w data
  550. if {[llength $data(selection)]} {
  551. IconList_Invoke $w
  552. }
  553. }
  554. proc ::tk::IconList_ReturnKey {w} {
  555. IconList_Invoke $w
  556. }
  557. proc ::tk::IconList_Leave1 {w x y} {
  558. variable ::tk::Priv
  559. set Priv(x) $x
  560. set Priv(y) $y
  561. IconList_AutoScan $w
  562. }
  563. proc ::tk::IconList_FocusIn {w} {
  564. upvar ::tk::$w data
  565. $w.cHull state focus
  566. if {![info exists data(list)]} {
  567. return
  568. }
  569. if {[llength $data(selection)]} {
  570. IconList_DrawSelection $w
  571. }
  572. }
  573. proc ::tk::IconList_FocusOut {w} {
  574. $w.cHull state !focus
  575. IconList_Selection $w clear 0 end
  576. }
  577. # ::tk::IconList_UpDown --
  578. #
  579. # Moves the active element up or down by one element
  580. #
  581. # Arguments:
  582. # w - The IconList widget.
  583. # amount - +1 to move down one item, -1 to move back one item.
  584. #
  585. proc ::tk::IconList_UpDown {w amount} {
  586. upvar ::tk::$w data
  587. if {![info exists data(list)]} {
  588. return
  589. }
  590. set curr [tk::IconList_CurSelection $w]
  591. if { [llength $curr] == 0 } {
  592. set i 0
  593. } else {
  594. set i [tk::IconList_Index $w anchor]
  595. if {$i eq ""} {
  596. return
  597. }
  598. incr i $amount
  599. }
  600. IconList_Selection $w clear 0 end
  601. IconList_Selection $w set $i
  602. IconList_Selection $w anchor $i
  603. IconList_See $w $i
  604. }
  605. # ::tk::IconList_LeftRight --
  606. #
  607. # Moves the active element left or right by one column
  608. #
  609. # Arguments:
  610. # w - The IconList widget.
  611. # amount - +1 to move right one column, -1 to move left one column.
  612. #
  613. proc ::tk::IconList_LeftRight {w amount} {
  614. upvar ::tk::$w data
  615. if {![info exists data(list)]} {
  616. return
  617. }
  618. set curr [IconList_CurSelection $w]
  619. if { [llength $curr] == 0 } {
  620. set i 0
  621. } else {
  622. set i [IconList_Index $w anchor]
  623. if {$i eq ""} {
  624. return
  625. }
  626. incr i [expr {$amount*$data(itemsPerColumn)}]
  627. }
  628. IconList_Selection $w clear 0 end
  629. IconList_Selection $w set $i
  630. IconList_Selection $w anchor $i
  631. IconList_See $w $i
  632. }
  633. #----------------------------------------------------------------------
  634. # Accelerator key bindings
  635. #----------------------------------------------------------------------
  636. # ::tk::IconList_KeyPress --
  637. #
  638. # Gets called when user enters an arbitrary key in the listbox.
  639. #
  640. proc ::tk::IconList_KeyPress {w key} {
  641. variable ::tk::Priv
  642. append Priv(ILAccel,$w) $key
  643. IconList_Goto $w $Priv(ILAccel,$w)
  644. catch {
  645. after cancel $Priv(ILAccel,$w,afterId)
  646. }
  647. set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
  648. }
  649. proc ::tk::IconList_Goto {w text} {
  650. upvar ::tk::$w data
  651. upvar ::tk::$w:textList textList
  652. if {![info exists data(list)]} {
  653. return
  654. }
  655. if {$text eq "" || $data(numItems) == 0} {
  656. return
  657. }
  658. if {[llength [IconList_CurSelection $w]]} {
  659. set start [IconList_Index $w anchor]
  660. } else {
  661. set start 0
  662. }
  663. set theIndex -1
  664. set less 0
  665. set len [string length $text]
  666. set len0 [expr {$len-1}]
  667. set i $start
  668. # Search forward until we find a filename whose prefix is a
  669. # case-insensitive match with $text
  670. while {1} {
  671. if {[string equal -nocase -length $len0 $textList($i) $text]} {
  672. set theIndex $i
  673. break
  674. }
  675. incr i
  676. if {$i == $data(numItems)} {
  677. set i 0
  678. }
  679. if {$i == $start} {
  680. break
  681. }
  682. }
  683. if {$theIndex > -1} {
  684. IconList_Selection $w clear 0 end
  685. IconList_Selection $w set $theIndex
  686. IconList_Selection $w anchor $theIndex
  687. IconList_See $w $theIndex
  688. }
  689. }
  690. proc ::tk::IconList_Reset {w} {
  691. variable ::tk::Priv
  692. unset -nocomplain Priv(ILAccel,$w)
  693. }
  694. #----------------------------------------------------------------------
  695. #
  696. # F I L E D I A L O G
  697. #
  698. #----------------------------------------------------------------------
  699. namespace eval ::tk::dialog {}
  700. namespace eval ::tk::dialog::file {
  701. namespace import -force ::tk::msgcat::*
  702. set ::tk::dialog::file::showHiddenBtn 0
  703. set ::tk::dialog::file::showHiddenVar 1
  704. }
  705. # ::tk::dialog::file:: --
  706. #
  707. # Implements the TK file selection dialog. This dialog is used when
  708. # the tk_strictMotif flag is set to false. This procedure shouldn't
  709. # be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
  710. #
  711. # Arguments:
  712. # type "open" or "save"
  713. # args Options parsed by the procedure.
  714. #
  715. proc ::tk::dialog::file:: {type args} {
  716. variable ::tk::Priv
  717. set dataName __tk_filedialog
  718. upvar ::tk::dialog::file::$dataName data
  719. Config $dataName $type $args
  720. if {$data(-parent) eq "."} {
  721. set w .$dataName
  722. } else {
  723. set w $data(-parent).$dataName
  724. }
  725. # (re)create the dialog box if necessary
  726. #
  727. if {![winfo exists $w]} {
  728. Create $w TkFDialog
  729. } elseif {[winfo class $w] ne "TkFDialog"} {
  730. destroy $w
  731. Create $w TkFDialog
  732. } else {
  733. set data(dirMenuBtn) $w.contents.f1.menu
  734. set data(dirMenu) $w.contents.f1.menu.menu
  735. set data(upBtn) $w.contents.f1.up
  736. set data(icons) $w.contents.icons
  737. set data(ent) $w.contents.f2.ent
  738. set data(typeMenuLab) $w.contents.f2.lab2
  739. set data(typeMenuBtn) $w.contents.f2.menu
  740. set data(typeMenu) $data(typeMenuBtn).m
  741. set data(okBtn) $w.contents.f2.ok
  742. set data(cancelBtn) $w.contents.f2.cancel
  743. set data(hiddenBtn) $w.contents.f2.hidden
  744. SetSelectMode $w $data(-multiple)
  745. }
  746. if {$::tk::dialog::file::showHiddenBtn} {
  747. $data(hiddenBtn) configure -state normal
  748. grid $data(hiddenBtn)
  749. } else {
  750. $data(hiddenBtn) configure -state disabled
  751. grid remove $data(hiddenBtn)
  752. }
  753. # Make sure subseqent uses of this dialog are independent [Bug 845189]
  754. unset -nocomplain data(extUsed)
  755. # Dialog boxes should be transient with respect to their parent,
  756. # so that they will always stay on top of their parent window. However,
  757. # some window managers will create the window as withdrawn if the parent
  758. # window is withdrawn or iconified. Combined with the grab we put on the
  759. # window, this can hang the entire application. Therefore we only make
  760. # the dialog transient if the parent is viewable.
  761. if {[winfo viewable [winfo toplevel $data(-parent)]]} {
  762. wm transient $w $data(-parent)
  763. }
  764. # Add traces on the selectPath variable
  765. #
  766. trace add variable data(selectPath) write \
  767. [list ::tk::dialog::file::SetPath $w]
  768. $data(dirMenuBtn) configure \
  769. -textvariable ::tk::dialog::file::${dataName}(selectPath)
  770. # Cleanup previous menu
  771. #
  772. $data(typeMenu) delete 0 end
  773. $data(typeMenuBtn) configure -state normal -text ""
  774. # Initialize the file types menu
  775. #
  776. if {[llength $data(-filetypes)]} {
  777. # Default type and name to first entry
  778. set initialtype [lindex $data(-filetypes) 0]
  779. set initialTypeName [lindex $initialtype 0]
  780. if {$data(-typevariable) ne ""} {
  781. upvar #0 $data(-typevariable) typeVariable
  782. if {[info exists typeVariable]} {
  783. set initialTypeName $typeVariable
  784. }
  785. }
  786. foreach type $data(-filetypes) {
  787. set title [lindex $type 0]
  788. set filter [lindex $type 1]
  789. $data(typeMenu) add command -label $title \
  790. -command [list ::tk::dialog::file::SetFilter $w $type]
  791. # string first avoids glob-pattern char issues
  792. if {[string first ${initialTypeName} $title] == 0} {
  793. set initialtype $type
  794. }
  795. }
  796. SetFilter $w $initialtype
  797. $data(typeMenuBtn) configure -state normal
  798. $data(typeMenuLab) configure -state normal
  799. } else {
  800. set data(filter) "*"
  801. $data(typeMenuBtn) configure -state disabled -takefocus 0
  802. $data(typeMenuLab) configure -state disabled
  803. }
  804. UpdateWhenIdle $w
  805. # Withdraw the window, then update all the geometry information
  806. # so we know how big it wants to be, then center the window in the
  807. # display (Motif style) and de-iconify it.
  808. ::tk::PlaceWindow $w widget $data(-parent)
  809. wm title $w $data(-title)
  810. # Set a grab and claim the focus too.
  811. ::tk::SetFocusGrab $w $data(ent)
  812. $data(ent) delete 0 end
  813. $data(ent) insert 0 $data(selectFile)
  814. $data(ent) selection range 0 end
  815. $data(ent) icursor end
  816. # Wait for the user to respond, then restore the focus and
  817. # return the index of the selected button. Restore the focus
  818. # before deleting the window, since otherwise the window manager
  819. # may take the focus away so we can't redirect it. Finally,
  820. # restore any grab that was in effect.
  821. vwait ::tk::Priv(selectFilePath)
  822. ::tk::RestoreFocusGrab $w $data(ent) withdraw
  823. # Cleanup traces on selectPath variable
  824. #
  825. foreach trace [trace info variable data(selectPath)] {
  826. trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  827. }
  828. $data(dirMenuBtn) configure -textvariable {}
  829. return $Priv(selectFilePath)
  830. }
  831. # ::tk::dialog::file::Config --
  832. #
  833. # Configures the TK filedialog according to the argument list
  834. #
  835. proc ::tk::dialog::file::Config {dataName type argList} {
  836. upvar ::tk::dialog::file::$dataName data
  837. set data(type) $type
  838. # 0: Delete all variable that were set on data(selectPath) the
  839. # last time the file dialog is used. The traces may cause troubles
  840. # if the dialog is now used with a different -parent option.
  841. foreach trace [trace info variable data(selectPath)] {
  842. trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  843. }
  844. # 1: the configuration specs
  845. #
  846. set specs {
  847. {-defaultextension "" "" ""}
  848. {-filetypes "" "" ""}
  849. {-initialdir "" "" ""}
  850. {-initialfile "" "" ""}
  851. {-parent "" "" "."}
  852. {-title "" "" ""}
  853. {-typevariable "" "" ""}
  854. }
  855. # The "-multiple" option is only available for the "open" file dialog.
  856. #
  857. if {$type eq "open"} {
  858. lappend specs {-multiple "" "" "0"}
  859. }
  860. # The "-confirmoverwrite" option is only for the "save" file dialog.
  861. #
  862. if {$type eq "save"} {
  863. lappend specs {-confirmoverwrite "" "" "1"}
  864. }
  865. # 2: default values depending on the type of the dialog
  866. #
  867. if {![info exists data(selectPath)]} {
  868. # first time the dialog has been popped up
  869. set data(selectPath) [pwd]
  870. set data(selectFile) ""
  871. }
  872. # 3: parse the arguments
  873. #
  874. tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  875. if {$data(-title) eq ""} {
  876. if {$type eq "open"} {
  877. set data(-title) [mc "Open"]
  878. } else {
  879. set data(-title) [mc "Save As"]
  880. }
  881. }
  882. # 4: set the default directory and selection according to the -initial
  883. # settings
  884. #
  885. if {$data(-initialdir) ne ""} {
  886. # Ensure that initialdir is an absolute path name.
  887. if {[file isdirectory $data(-initialdir)]} {
  888. set old [pwd]
  889. cd $data(-initialdir)
  890. set data(selectPath) [pwd]
  891. cd $old
  892. } else {
  893. set data(selectPath) [pwd]
  894. }
  895. }
  896. set data(selectFile) $data(-initialfile)
  897. # 5. Parse the -filetypes option
  898. #
  899. set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
  900. if {![winfo exists $data(-parent)]} {
  901. error "bad window path name \"$data(-parent)\""
  902. }
  903. # Set -multiple to a one or zero value (not other boolean types
  904. # like "yes") so we can use it in tests more easily.
  905. if {$type eq "save"} {
  906. set data(-multiple) 0
  907. } elseif {$data(-multiple)} {
  908. set data(-multiple) 1
  909. } else {
  910. set data(-multiple) 0
  911. }
  912. }
  913. proc ::tk::dialog::file::Create {w class} {
  914. set dataName [lindex [split $w .] end]
  915. upvar ::tk::dialog::file::$dataName data
  916. variable ::tk::Priv
  917. global tk_library
  918. toplevel $w -class $class
  919. if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
  920. pack [ttk::frame $w.contents] -expand 1 -fill both
  921. #set w $w.contents
  922. # f1: the frame with the directory option menu
  923. #
  924. set f1 [ttk::frame $w.contents.f1]
  925. bind [::tk::AmpWidget ttk::label $f1.lab -text [mc "&Directory:"]] \
  926. <<AltUnderlined>> [list focus $f1.menu]
  927. set data(dirMenuBtn) $f1.menu
  928. if {![info exists data(selectPath)]} {
  929. set data(selectPath) ""
  930. }
  931. set data(dirMenu) $f1.menu.menu
  932. ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \
  933. -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName]
  934. [menu $data(dirMenu) -tearoff 0] add radiobutton -label "" -variable \
  935. [format %s(selectPath) ::tk::dialog::file::$dataName]
  936. set data(upBtn) [ttk::button $f1.up]
  937. if {![info exists Priv(updirImage)]} {
  938. set Priv(updirImage) [image create bitmap -data {
  939. #define updir_width 28
  940. #define updir_height 16
  941. static char updir_bits[] = {
  942. 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
  943. 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
  944. 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
  945. 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
  946. 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
  947. 0xf0, 0xff, 0xff, 0x01};}]
  948. }
  949. $data(upBtn) configure -image $Priv(updirImage)
  950. $f1.menu configure -takefocus 1;# -highlightthickness 2
  951. pack $data(upBtn) -side right -padx 4 -fill both
  952. pack $f1.lab -side left -padx 4 -fill both
  953. pack $f1.menu -expand yes -fill both -padx 4
  954. # data(icons): the IconList that list the files and directories.
  955. #
  956. if {$class eq "TkFDialog"} {
  957. if { $data(-multiple) } {
  958. set fNameCaption [mc "File &names:"]
  959. } else {
  960. set fNameCaption [mc "File &name:"]
  961. }
  962. set fTypeCaption [mc "Files of &type:"]
  963. set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  964. } else {
  965. set fNameCaption [mc "&Selection:"]
  966. set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
  967. }
  968. set data(icons) [::tk::IconList $w.contents.icons \
  969. -command $iconListCommand -multiple $data(-multiple)]
  970. bind $data(icons) <<ListboxSelect>> \
  971. [list ::tk::dialog::file::ListBrowse $w]
  972. # f2: the frame with the OK button, cancel button, "file name" field
  973. # and file types field.
  974. #
  975. set f2 [ttk::frame $w.contents.f2]
  976. bind [::tk::AmpWidget ttk::label $f2.lab -text $fNameCaption -anchor e]\
  977. <<AltUnderlined>> [list focus $f2.ent]
  978. # -pady 0
  979. set data(ent) [ttk::entry $f2.ent]
  980. # The font to use for the icons. The default Canvas font on Unix
  981. # is just deviant.
  982. set ::tk::$w.contents.icons(font) [$data(ent) cget -font]
  983. # Make the file types bits only if this is a File Dialog
  984. if {$class eq "TkFDialog"} {
  985. set data(typeMenuLab) [::tk::AmpWidget ttk::label $f2.lab2 \
  986. -text $fTypeCaption -anchor e]
  987. # -pady [$f2.lab cget -pady]
  988. set data(typeMenuBtn) [ttk::menubutton $f2.menu \
  989. -menu $f2.menu.m]
  990. # -indicatoron 1
  991. set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
  992. # $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w
  993. bind $data(typeMenuLab) <<AltUnderlined>> [list \
  994. focus $data(typeMenuBtn)]
  995. }
  996. # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
  997. # is true. Create it disabled so the binding doesn't trigger if it
  998. # isn't shown.
  999. if {$class eq "TkFDialog"} {
  1000. set text [mc "Show &Hidden Files and Directories"]
  1001. } else {
  1002. set text [mc "Show &Hidden Directories"]
  1003. }
  1004. set data(hiddenBtn) [::tk::AmpWidget ttk::checkbutton $f2.hidden \
  1005. -text $text -state disabled \
  1006. -variable ::tk::dialog::file::showHiddenVar \
  1007. -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
  1008. # -anchor w -padx 3
  1009. # the okBtn is created after the typeMenu so that the keyboard traversal
  1010. # is in the right order, and add binding so that we find out when the
  1011. # dialog is destroyed by the user (added here instead of to the overall
  1012. # window so no confusion about how much <Destroy> gets called; exactly
  1013. # once will do). [Bug 987169]
  1014. set data(okBtn) [::tk::AmpWidget ttk::button $f2.ok \
  1015. -text [mc "&OK"] -default active];# -pady 3]
  1016. bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
  1017. set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \
  1018. -text [mc "&Cancel"] -default normal];# -pady 3]
  1019. # grid the widgets in f2
  1020. #
  1021. grid $f2.lab $f2.ent $data(okBtn) -padx 4 -pady 3 -sticky ew
  1022. grid configure $f2.ent -padx 2
  1023. if {$class eq "TkFDialog"} {
  1024. grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
  1025. -padx 4 -sticky ew
  1026. grid configure $data(typeMenuBtn) -padx 0
  1027. grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
  1028. } else {
  1029. grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
  1030. }
  1031. grid columnconfigure $f2 1 -weight 1
  1032. # Pack all the frames together. We are done with widget construction.
  1033. #
  1034. pack $f1 -side top -fill x -pady 4
  1035. pack $f2 -side bottom -pady 4 -fill x
  1036. pack $data(icons) -expand yes -fill both -padx 4 -pady 1
  1037. # Set up the event handlers that are common to Directory and File Dialogs
  1038. #
  1039. wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
  1040. $data(upBtn) configure -command [list ::tk::dialog::file::UpDirCmd $w]
  1041. $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
  1042. bind $w <KeyPress-Escape> [list $data(cancelBtn) invoke]
  1043. bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
  1044. # Set up event handlers specific to File or Directory Dialogs
  1045. #
  1046. if {$class eq "TkFDialog"} {
  1047. bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
  1048. $data(okBtn) configure -command [list ::tk::dialog::file::OkCmd $w]
  1049. bind $w <Alt-t> [format {
  1050. if {[%s cget -state] eq "normal"} {
  1051. focus %s
  1052. }
  1053. } $data(typeMenuBtn) $data(typeMenuBtn)]
  1054. } else {
  1055. set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
  1056. bind $data(ent) <Return> $okCmd
  1057. $data(okBtn) configure -command $okCmd
  1058. bind $w <Alt-s> [list focus $data(ent)]
  1059. bind $w <Alt-o> [list $data(okBtn) invoke]
  1060. }
  1061. bind $w <Alt-h> [list $data(hiddenBtn) invoke]
  1062. bind $data(ent) <Tab> [list ::tk::dialog::file::CompleteEnt $w]
  1063. # Build the focus group for all the entries
  1064. #
  1065. ::tk::FocusGroup_Create $w
  1066. ::tk::FocusGroup_BindIn $w $data(ent) [list \
  1067. ::tk::dialog::file::EntFocusIn $w]
  1068. ::tk::FocusGroup_BindOut $w $data(ent) [list \
  1069. ::tk::dialog::file::EntFocusOut $w]
  1070. }
  1071. # ::tk::dialog::file::SetSelectMode --
  1072. #
  1073. # Set the select mode of the dialog to single select or multi-select.
  1074. #
  1075. # Arguments:
  1076. # w The dialog path.
  1077. # multi 1 if the dialog is multi-select; 0 otherwise.
  1078. #
  1079. # Results:
  1080. # None.
  1081. proc ::tk::dialog::file::SetSelectMode {w multi} {
  1082. set dataName __tk_filedialog
  1083. upvar ::tk::dialog::file::$dataName data
  1084. if { $multi } {
  1085. set fNameCaption [mc "File &names:"]
  1086. } else {
  1087. set fNameCaption [mc "File &name:"]
  1088. }
  1089. set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  1090. ::tk::SetAmpText $w.contents.f2.lab $fNameCaption
  1091. ::tk::IconList_Config $data(icons) \
  1092. [list -multiple $multi -command $iconListCommand]
  1093. return
  1094. }
  1095. # ::tk::dialog::file::UpdateWhenIdle --
  1096. #
  1097. # Creates an idle event handler which updates the dialog in idle
  1098. # time. This is important because loading the directory may take a long
  1099. # time and we don't want to load the same directory for multiple times
  1100. # due to multiple concurrent events.
  1101. #
  1102. proc ::tk::dialog::file::UpdateWhenIdle {w} {
  1103. upvar ::tk::dialog::file::[winfo name $w] data
  1104. if {[info exists data(updateId)]} {
  1105. return
  1106. } else {
  1107. set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
  1108. }
  1109. }
  1110. # ::tk::dialog::file::Update --
  1111. #
  1112. # Loads the files and directories into the IconList widget. Also
  1113. # sets up the directory option menu for quick access to parent
  1114. # directories.
  1115. #
  1116. proc ::tk::dialog::file::Update {w} {
  1117. # This proc may be called within an idle handler. Make sure that the
  1118. # window has not been destroyed before this proc is called
  1119. if {![winfo exists $w]} {
  1120. return
  1121. }
  1122. set class [winfo class $w]
  1123. if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
  1124. return
  1125. }
  1126. set dataName [winfo name $w]
  1127. upvar ::tk::dialog::file::$dataName data
  1128. variable ::tk::Priv
  1129. global tk_library
  1130. unset -nocomplain data(updateId)
  1131. if {![info exists Priv(folderImage)]} {
  1132. set Priv(folderImage) [image create photo -data {
  1133. R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
  1134. QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
  1135. set Priv(fileImage) [image create photo -data {
  1136. R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
  1137. rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
  1138. }
  1139. set folder $Priv(folderImage)
  1140. set file $Priv(fileImage)
  1141. set appPWD [pwd]
  1142. if {[catch {
  1143. cd $data(selectPath)
  1144. }]} {
  1145. # We cannot change directory to $data(selectPath). $data(selectPath)
  1146. # should have been checked before ::tk::dialog::file::Update is called, so
  1147. # we normally won't come to here. Anyways, give an error and abort
  1148. # action.
  1149. tk_messageBox -type ok -parent $w -icon warning -message \
  1150. [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
  1151. cd $appPWD
  1152. return
  1153. }
  1154. # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
  1155. # so the user may still click and cause havoc ...
  1156. #
  1157. set entCursor [$data(ent) cget -cursor]
  1158. set dlgCursor [$w cget -cursor]
  1159. $data(ent) configure -cursor watch
  1160. $w configure -cursor watch
  1161. update idletasks
  1162. ::tk::IconList_DeleteAll $data(icons)
  1163. set showHidden $::tk::dialog::file::showHiddenVar
  1164. # Make the dir list. Note that using an explicit [pwd] (instead of '.') is
  1165. # better in some VFS cases.
  1166. ::tk::IconList_Add $data(icons) $folder [GlobFiltered [pwd] d 1]
  1167. if {$class eq "TkFDialog"} {
  1168. # Make the file list if this is a File Dialog, selecting all but
  1169. # 'd'irectory type files.
  1170. #
  1171. ::tk::IconList_Add $data(icons) $file \
  1172. [GlobFiltered [pwd] {f b c l p s}]
  1173. }
  1174. ::tk::IconList_Arrange $data(icons)
  1175. # Update the Directory: option menu
  1176. #
  1177. set list ""
  1178. set dir ""
  1179. foreach subdir [file split $data(selectPath)] {
  1180. set dir [file join $dir $subdir]
  1181. lappend list $dir
  1182. }
  1183. $data(dirMenu) delete 0 end
  1184. set var [format %s(selectPath) ::tk::dialog::file::$dataName]
  1185. foreach path $list {
  1186. $data(dirMenu) add command -label $path -command [list set $var $path]
  1187. }
  1188. # Restore the PWD to the application's PWD
  1189. #
  1190. cd $appPWD
  1191. if {$class eq "TkFDialog"} {
  1192. # Restore the Open/Save Button if this is a File Dialog
  1193. #
  1194. if {$data(type) eq "open"} {
  1195. ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1196. } else {
  1197. ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1198. }
  1199. }
  1200. # turn off the busy cursor.
  1201. #
  1202. $data(ent) configure -cursor $entCursor
  1203. $w configure -cursor $dlgCursor
  1204. }
  1205. # ::tk::dialog::file::SetPathSilently --
  1206. #
  1207. # Sets data(selectPath) without invoking the trace procedure
  1208. #
  1209. proc ::tk::dialog::file::SetPathSilently {w path} {
  1210. upvar ::tk::dialog::file::[winfo name $w] data
  1211. trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1212. set data(selectPath) $path
  1213. trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1214. }
  1215. # This proc gets called whenever data(selectPath) is set
  1216. #
  1217. proc ::tk::dialog::file::SetPath {w name1 name2 op} {
  1218. if {[winfo exists $w]} {
  1219. upvar ::tk::dialog::file::[winfo name $w] data
  1220. UpdateWhenIdle $w
  1221. # On directory dialogs, we keep the entry in sync with the currentdir.
  1222. if {[winfo class $w] eq "TkChooseDir"} {
  1223. $data(ent) delete 0 end
  1224. $data(ent) insert end $data(selectPath)
  1225. }
  1226. }
  1227. }
  1228. # This proc gets called whenever data(filter) is set
  1229. #
  1230. proc ::tk::dialog::file::SetFilter {w type} {
  1231. upvar ::tk::dialog::file::[winfo name $w] data
  1232. upvar ::tk::$data(icons) icons
  1233. set data(filterType) $type
  1234. set data(filter) [lindex $type 1]
  1235. $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1
  1236. # If we aren't using a default extension, use the one suppled
  1237. # by the filter.
  1238. if {![info exists data(extUsed)]} {
  1239. if {[string length $data(-defaultextension)]} {
  1240. set data(extUsed) 1
  1241. } else {
  1242. set data(extUsed) 0
  1243. }
  1244. }
  1245. if {!$data(extUsed)} {
  1246. # Get the first extension in the list that matches {^\*\.\w+$}
  1247. # and remove all * from the filter.
  1248. set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
  1249. if {$index >= 0} {
  1250. set data(-defaultextension) \
  1251. [string trimleft [lindex $data(filter) $index] "*"]
  1252. } else {
  1253. # Couldn't find anything! Reset to a safe default...
  1254. set data(-defaultextension) ""
  1255. }
  1256. }
  1257. $icons(sbar) set 0.0 0.0
  1258. UpdateWhenIdle $w
  1259. }
  1260. # tk::dialog::file::ResolveFile --
  1261. #
  1262. # Interpret the user's text input in a file selection dialog.
  1263. # Performs:
  1264. #
  1265. # (1) ~ substitution
  1266. # (2) resolve all instances of . and ..
  1267. # (3) check for non-existent files/directories
  1268. # (4) check for chdir permissions
  1269. # (5) conversion of environment variable references to their
  1270. # contents (once only)
  1271. #
  1272. # Arguments:
  1273. # context: the current directory you are in
  1274. # text: the text entered by the user
  1275. # defaultext: the default extension to add to files with no extension
  1276. # expandEnv: whether to expand environment variables (yes by default)
  1277. #
  1278. # Return vaue:
  1279. # [list $flag $directory $file]
  1280. #
  1281. # flag = OK : valid input
  1282. # = PATTERN : valid directory/pattern
  1283. # = PATH : the directory does not exist
  1284. # = FILE : the directory exists by the file doesn't
  1285. # exist
  1286. # = CHDIR : Cannot change to the directory
  1287. # = ERROR : Invalid entry
  1288. #
  1289. # directory : valid only if flag = OK or PATTERN or FILE
  1290. # file : valid only if flag = OK or PATTERN
  1291. #
  1292. # directory may not be the same as context, because text may contain
  1293. # a subdirectory name
  1294. #
  1295. proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
  1296. set appPWD [pwd]
  1297. set path [JoinFile $context $text]
  1298. # If the file has no extension, append the default. Be careful not
  1299. # to do this for directories, otherwise typing a dirname in the box
  1300. # will give back "dirname.extension" instead of trying to change dir.
  1301. if {
  1302. ![file isdirectory $path] && ([file ext $path] eq "") &&
  1303. ![string match {$*} [file tail $path]]
  1304. } then {
  1305. set path "$path$defaultext"
  1306. }
  1307. if {[catch {file exists $path}]} {
  1308. # This "if" block can be safely removed if the following code
  1309. # stop generating errors.
  1310. #
  1311. # file exists ~nonsuchuser
  1312. #
  1313. return [list ERROR $path ""]
  1314. }
  1315. if {[file exists $path]} {
  1316. if {[file isdirectory $path]} {
  1317. if {[catch {cd $path}]} {
  1318. return [list CHDIR $path ""]
  1319. }
  1320. set directory [pwd]
  1321. set file ""
  1322. set flag OK
  1323. cd $appPWD
  1324. } else {
  1325. if {[catch {cd [file dirname $path]}]} {
  1326. return [list CHDIR [file dirname $path] ""]
  1327. }
  1328. set directory [pwd]
  1329. set file [file tail $path]
  1330. set flag OK
  1331. cd $appPWD
  1332. }
  1333. } else {
  1334. set dirname [file dirname $path]
  1335. if {[file exists $dirname]} {
  1336. if {[catch {cd $dirname}]} {
  1337. return [list CHDIR $dirname ""]
  1338. }
  1339. set directory [pwd]
  1340. cd $appPWD
  1341. set file [file tail $path]
  1342. # It's nothing else, so check to see if it is an env-reference
  1343. if {$expandEnv && [string match {$*} $file]} {
  1344. set var [string range $file 1 end]
  1345. if {[info exist ::env($var)]} {
  1346. return [ResolveFile $context $::env($var) $defaultext 0]
  1347. }
  1348. }
  1349. if {[regexp {[*?]} $file]} {
  1350. set flag PATTERN
  1351. } else {
  1352. set flag FILE
  1353. }
  1354. } else {
  1355. set directory $dirname
  1356. set file [file tail $path]
  1357. set flag PATH
  1358. # It's nothing else, so check to see if it is an env-reference
  1359. if {$expandEnv && [string match {$*} $file]} {
  1360. set var [string range $file 1 end]
  1361. if {[info exist ::env($var)]} {
  1362. return [ResolveFile $context $::env($var) $defaultext 0]
  1363. }
  1364. }
  1365. }
  1366. }
  1367. return [list $flag $directory $file]
  1368. }
  1369. # Gets called when the entry box gets keyboard focus. We clear the selection
  1370. # from the icon list . This way the user can be certain that the input in the
  1371. # entry box is the selection.
  1372. #
  1373. proc ::tk::dialog::file::EntFocusIn {w} {
  1374. upvar ::tk::dialog::file::[winfo name $w] data
  1375. if {[$data(ent) get] ne ""} {
  1376. $data(ent) selection range 0 end
  1377. $data(ent) icursor end
  1378. } else {
  1379. $data(ent) selection clear
  1380. }
  1381. if {[winfo class $w] eq "TkFDialog"} {
  1382. # If this is a File Dialog, make sure the buttons are labeled right.
  1383. if {$data(type) eq "open"} {
  1384. ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1385. } else {
  1386. ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1387. }
  1388. }
  1389. }
  1390. proc ::tk::dialog::file::EntFocusOut {w} {
  1391. upvar ::tk::dialog::file::[winfo name $w] data
  1392. $data(ent) selection clear
  1393. }
  1394. # Gets called when user presses Return in the "File name" entry.
  1395. #
  1396. proc ::tk::dialog::file::ActivateEnt {w} {
  1397. upvar ::tk::dialog::file::[winfo name $w] data
  1398. set text [$data(ent) get]
  1399. if {$data(-multiple)} {
  1400. foreach t $text {
  1401. VerifyFileName $w $t
  1402. }
  1403. } else {
  1404. VerifyFileName $w $text
  1405. }
  1406. }
  1407. # Verification procedure
  1408. #
  1409. proc ::tk::dialog::file::VerifyFileName {w filename} {
  1410. upvar ::tk::dialog::file::[winfo name $w] data
  1411. set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)]
  1412. foreach {flag path file} $list {
  1413. break
  1414. }
  1415. switch -- $flag {
  1416. OK {
  1417. if {$file eq ""} {
  1418. # user has entered an existing (sub)directory
  1419. set data(selectPath) $path
  1420. $data(ent) delete 0 end
  1421. } else {
  1422. SetPathSilently $w $path
  1423. if {$data(-multiple)} {
  1424. lappend data(selectFile) $file
  1425. } else {
  1426. set data(selectFile) $file
  1427. }
  1428. Done $w
  1429. }
  1430. }
  1431. PATTERN {
  1432. set data(selectPath) $path
  1433. set data(filter) $file
  1434. }
  1435. FILE {
  1436. if {$data(type) eq "open"} {
  1437. tk_messageBox -icon warning -type ok -parent $w \
  1438. -message [mc "File \"%1\$s\" does not exist." \
  1439. [file join $path $file]]
  1440. $data(ent) selection range 0 end
  1441. $data(ent) icursor end
  1442. } else {
  1443. SetPathSilently $w $path
  1444. if {$data(-multiple)} {
  1445. lappend data(selectFile) $file
  1446. } else {
  1447. set data(selectFile) $file
  1448. }
  1449. Done $w
  1450. }
  1451. }
  1452. PATH {
  1453. tk_messageBox -icon warning -type ok -parent $w \
  1454. -message [mc "Directory \"%1\$s\" does not exist." $path]
  1455. $data(ent) selection range 0 end
  1456. $data(ent) icursor end
  1457. }
  1458. CHDIR {
  1459. tk_messageBox -type ok -parent $w -icon warning -message \
  1460. [mc "Cannot change to the directory\
  1461. \"%1\$s\".\nPermission denied." $path]
  1462. $data(ent) selection range 0 end
  1463. $data(ent) icursor end
  1464. }
  1465. ERROR {
  1466. tk_messageBox -type ok -parent $w -icon warning -message \
  1467. [mc "Invalid file name \"%1\$s\"." $path]
  1468. $data(ent) selection range 0 end
  1469. $data(ent) icursor end
  1470. }
  1471. }
  1472. }
  1473. # Gets called when user presses the Alt-s or Alt-o keys.
  1474. #
  1475. proc ::tk::dialog::file::InvokeBtn {w key} {
  1476. upvar ::tk::dialog::file::[winfo name $w] data
  1477. if {[$data(okBtn) cget -text] eq $key} {
  1478. $data(okBtn) invoke
  1479. }
  1480. }
  1481. # Gets called when user presses the "parent directory" button
  1482. #
  1483. proc ::tk::dialog::file::UpDirCmd {w} {
  1484. upvar ::tk::dialog::file::[winfo name $w] data
  1485. if {$data(selectPath) ne "/"} {
  1486. set data(selectPath) [file dirname $data(selectPath)]
  1487. }
  1488. }
  1489. # Join a file name to a path name. The "file join" command will break
  1490. # if the filename begins with ~
  1491. #
  1492. proc ::tk::dialog::file::JoinFile {path file} {
  1493. if {[string match {~*} $file] && [file exists $path/$file]} {
  1494. return [file join $path ./$file]
  1495. } else {
  1496. return [file join $path $file]
  1497. }
  1498. }
  1499. # Gets called when user presses the "OK" button
  1500. #
  1501. proc ::tk::dialog::file::OkCmd {w} {
  1502. upvar ::tk::dialog::file::[winfo name $w] data
  1503. set filenames {}
  1504. foreach item [::tk::IconList_CurSelection $data(icons)] {
  1505. lappend filenames [::tk::IconList_Get $data(icons) $item]
  1506. }
  1507. if {([llength $filenames] && !$data(-multiple)) || \
  1508. ($data(-multiple) && ([llength $filenames] == 1))} {
  1509. set filename [lindex $filenames 0]
  1510. set file [JoinFile $data(selectPath) $filename]
  1511. if {[file isdirectory $file]} {
  1512. ListInvoke $w [list $filename]
  1513. return
  1514. }
  1515. }
  1516. ActivateEnt $w
  1517. }
  1518. # Gets called when user presses the "Cancel" button
  1519. #
  1520. proc ::tk::dialog::file::CancelCmd {w} {
  1521. upvar ::tk::dialog::file::[winfo name $w] data
  1522. variable ::tk::Priv
  1523. bind $data(okBtn) <Destroy> {}
  1524. set Priv(selectFilePath) ""
  1525. }
  1526. # Gets called when user destroys the dialog directly [Bug 987169]
  1527. #
  1528. proc ::tk::dialog::file::Destroyed {w} {
  1529. upvar ::tk::dialog::file::[winfo name $w] data
  1530. variable ::tk::Priv
  1531. set Priv(selectFilePath) ""
  1532. }
  1533. # Gets called when user browses the IconList widget (dragging mouse, arrow
  1534. # keys, etc)
  1535. #
  1536. proc ::tk::dialog::file::ListBrowse {w} {
  1537. upvar ::tk::dialog::file::[winfo name $w] data
  1538. set text {}
  1539. foreach item [::tk::IconList_CurSelection $data(icons)] {
  1540. lappend text [::tk::IconList_Get $data(icons) $item]
  1541. }
  1542. if {[llength $text] == 0} {
  1543. return
  1544. }
  1545. if {$data(-multiple)} {
  1546. set newtext {}
  1547. foreach file $text {
  1548. set fullfile [JoinFile $data(selectPath) $file]
  1549. if { ![file isdirectory $fullfile] } {
  1550. lappend newtext $file
  1551. }
  1552. }
  1553. set text $newtext
  1554. set isDir 0
  1555. } else {
  1556. set text [lindex $text 0]
  1557. set file [JoinFile $data(selectPath) $text]
  1558. set isDir [file isdirectory $file]
  1559. }
  1560. if {!$isDir} {
  1561. $data(ent) delete 0 end
  1562. $data(ent) insert 0 $text
  1563. if {[winfo class $w] eq "TkFDialog"} {
  1564. if {$data(type) eq "open"} {
  1565. ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1566. } else {
  1567. ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1568. }
  1569. }
  1570. } elseif {[winfo class $w] eq "TkFDialog"} {
  1571. ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1572. }
  1573. }
  1574. # Gets called when user invokes the IconList widget (double-click,
  1575. # Return key, etc)
  1576. #
  1577. proc ::tk::dialog::file::ListInvoke {w filenames} {
  1578. upvar ::tk::dialog::file::[winfo name $w] data
  1579. if {[llength $filenames] == 0} {
  1580. return
  1581. }
  1582. set file [JoinFile $data(selectPath) [lindex $filenames 0]]
  1583. set class [winfo class $w]
  1584. if {$class eq "TkChooseDir" || [file isdirectory $file]} {
  1585. set appPWD [pwd]
  1586. if {[catch {cd $file}]} {
  1587. tk_messageBox -type ok -parent $w -icon warning -message \
  1588. [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]
  1589. } else {
  1590. cd $appPWD
  1591. set data(selectPath) $file
  1592. }
  1593. } else {
  1594. if {$data(-multiple)} {
  1595. set data(selectFile) $filenames
  1596. } else {
  1597. set data(selectFile) $file
  1598. }
  1599. Done $w
  1600. }
  1601. }
  1602. # ::tk::dialog::file::Done --
  1603. #
  1604. # Gets called when user has input a valid filename. Pops up a
  1605. # dialog box to confirm selection when necessary. Sets the
  1606. # tk::Priv(selectFilePath) variable, which will break the "vwait"
  1607. # loop in ::tk::dialog::file:: and return the selected filename to the
  1608. # script that calls tk_getOpenFile or tk_getSaveFile
  1609. #
  1610. proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
  1611. upvar ::tk::dialog::file::[winfo name $w] data
  1612. variable ::tk::Priv
  1613. if {$selectFilePath eq ""} {
  1614. if {$data(-multiple)} {
  1615. set selectFilePath {}
  1616. foreach f $data(selectFile) {
  1617. lappend selectFilePath [JoinFile $data(selectPath) $f]
  1618. }
  1619. } else {
  1620. set selectFilePath [JoinFile $data(selectPath) $data(selectFile)]
  1621. }
  1622. set Priv(selectFile) $data(selectFile)
  1623. set Priv(selectPath) $data(selectPath)
  1624. if {($data(type) eq "save") && $data(-confirmoverwrite) && [file exists $selectFilePath]} {
  1625. set reply [tk_messageBox -icon warning -type yesno -parent $w \
  1626. -message [mc "File \"%1\$s\" already exists.\nDo you want\
  1627. to overwrite it?" $selectFilePath]]
  1628. if {$reply eq "no"} {
  1629. return
  1630. }
  1631. }
  1632. if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
  1633. && [info exists data(-filetypes)] && [llength $data(-filetypes)]
  1634. && [info exists data(filterType)] && $data(filterType) ne ""} {
  1635. upvar #0 $data(-typevariable) typeVariable
  1636. set typeVariable [lindex $data(filterType) 0]
  1637. }
  1638. }
  1639. bind $data(okBtn) <Destroy> {}
  1640. set Priv(selectFilePath) $selectFilePath
  1641. }
  1642. proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} {
  1643. # $dir == where to search
  1644. # $type == what to look for ('d' or 'f b c l p s')
  1645. # $overrideFilter == whether to ignore the filter
  1646. variable showHiddenVar
  1647. upvar 1 data(filter) filter
  1648. if {$filter eq "*" || $overrideFilter} {
  1649. set patterns [list *]
  1650. if {$showHiddenVar} {
  1651. lappend patterns .*
  1652. }
  1653. } elseif {[string is list $filter]} {
  1654. set patterns $filter
  1655. } else {
  1656. # Invalid list; assume we can use non-whitespace sequences as words
  1657. set patterns [regexp -inline -all {\S+} $filter]
  1658. }
  1659. set opts [list -tails -directory $dir -type $type -nocomplain]
  1660. set result {}
  1661. catch {
  1662. # We have a catch because we might have a really bad pattern (e.g.,
  1663. # with an unbalanced brace); even [glob -nocomplain] doesn't like it.
  1664. # Using a catch ensures that it just means we match nothing instead of
  1665. # throwing a nasty error at the user...
  1666. foreach f [glob {*}$opts -- {*}$patterns] {
  1667. if {$f eq "." || $f eq ".."} {
  1668. continue
  1669. }
  1670. # See ticket [1641721], $f might be a link pointing to a dir
  1671. if {$type != "d" && [file isdir [file join $dir $f]]} {
  1672. continue
  1673. }
  1674. lappend result $f
  1675. }
  1676. }
  1677. return [lsort -dictionary -unique $result]
  1678. }
  1679. proc ::tk::dialog::file::CompleteEnt {w} {
  1680. upvar ::tk::dialog::file::[winfo name $w] data
  1681. set f [$data(ent) get]
  1682. if {$data(-multiple)} {
  1683. if {![string is list $f] || [llength $f] != 1} {
  1684. return -code break
  1685. }
  1686. set f [lindex $f 0]
  1687. }
  1688. # Get list of matching filenames and dirnames
  1689. set files [if {[winfo class $w] eq "TkFDialog"} {
  1690. GlobFiltered $data(selectPath) {f b c l p s}
  1691. }]
  1692. set dirs2 {}
  1693. foreach d [GlobFiltered $data(selectPath) d] {lappend dirs2 $d/}
  1694. set targets [concat \
  1695. [lsearch -glob -all -inline $files $f*] \
  1696. [lsearch -glob -all -inline $dirs2 $f*]]
  1697. if {[llength $targets] == 1} {
  1698. # We have a winner!
  1699. set f [lindex $targets 0]
  1700. } elseif {$f in $targets || [llength $targets] == 0} {
  1701. if {[string length $f] > 0} {
  1702. bell
  1703. }
  1704. return
  1705. } elseif {[llength $targets] > 1} {
  1706. # Multiple possibles
  1707. if {[string length $f] == 0} {
  1708. return
  1709. }
  1710. set t0 [lindex $targets 0]
  1711. for {set len [string length $t0]} {$len>0} {} {
  1712. set allmatch 1
  1713. foreach s $targets {
  1714. if {![string equal -length $len $s $t0]} {
  1715. set allmatch 0
  1716. break
  1717. }
  1718. }
  1719. incr len -1
  1720. if {$allmatch} break
  1721. }
  1722. set f [string range $t0 0 $len]
  1723. }
  1724. if {$data(-multiple)} {
  1725. set f [list $f]
  1726. }
  1727. $data(ent) delete 0 end
  1728. $data(ent) insert 0 $f
  1729. return -code break
  1730. }