xmfbox.tcl 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988
  1. # xmfbox.tcl --
  2. #
  3. # Implements the "Motif" style file selection dialog for the
  4. # Unix platform. This implementation is used only if the
  5. # "::tk_strictMotif" flag is set.
  6. #
  7. # Copyright (c) 1996 Sun Microsystems, Inc.
  8. # Copyright (c) 1998-2000 Scriptics Corporation
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. namespace eval ::tk::dialog {}
  13. namespace eval ::tk::dialog::file {}
  14. # ::tk::MotifFDialog --
  15. #
  16. # Implements a file dialog similar to the standard Motif file
  17. # selection box.
  18. #
  19. # Arguments:
  20. # type "open" or "save"
  21. # args Options parsed by the procedure.
  22. #
  23. # Results:
  24. # When -multiple is set to 0, this returns the absolute pathname
  25. # of the selected file. (NOTE: This is not the same as a single
  26. # element list.)
  27. #
  28. # When -multiple is set to > 0, this returns a Tcl list of absolute
  29. # pathnames. The argument for -multiple is ignored, but for consistency
  30. # with Windows it defines the maximum amount of memory to allocate for
  31. # the returned filenames.
  32. proc ::tk::MotifFDialog {type args} {
  33. variable ::tk::Priv
  34. set dataName __tk_filedialog
  35. upvar ::tk::dialog::file::$dataName data
  36. set w [MotifFDialog_Create $dataName $type $args]
  37. # Set a grab and claim the focus too.
  38. ::tk::SetFocusGrab $w $data(sEnt)
  39. $data(sEnt) selection range 0 end
  40. # Wait for the user to respond, then restore the focus and
  41. # return the index of the selected button. Restore the focus
  42. # before deleting the window, since otherwise the window manager
  43. # may take the focus away so we can't redirect it. Finally,
  44. # restore any grab that was in effect.
  45. vwait ::tk::Priv(selectFilePath)
  46. set result $Priv(selectFilePath)
  47. ::tk::RestoreFocusGrab $w $data(sEnt) withdraw
  48. return $result
  49. }
  50. # ::tk::MotifFDialog_Create --
  51. #
  52. # Creates the Motif file dialog (if it doesn't exist yet) and
  53. # initialize the internal data structure associated with the
  54. # dialog.
  55. #
  56. # This procedure is used by ::tk::MotifFDialog to create the
  57. # dialog. It's also used by the test suite to test the Motif
  58. # file dialog implementation. User code shouldn't call this
  59. # procedure directly.
  60. #
  61. # Arguments:
  62. # dataName Name of the global "data" array for the file dialog.
  63. # type "Save" or "Open"
  64. # argList Options parsed by the procedure.
  65. #
  66. # Results:
  67. # Pathname of the file dialog.
  68. proc ::tk::MotifFDialog_Create {dataName type argList} {
  69. upvar ::tk::dialog::file::$dataName data
  70. MotifFDialog_Config $dataName $type $argList
  71. if {$data(-parent) eq "."} {
  72. set w .$dataName
  73. } else {
  74. set w $data(-parent).$dataName
  75. }
  76. # (re)create the dialog box if necessary
  77. #
  78. if {![winfo exists $w]} {
  79. MotifFDialog_BuildUI $w
  80. } elseif {[winfo class $w] ne "TkMotifFDialog"} {
  81. destroy $w
  82. MotifFDialog_BuildUI $w
  83. } else {
  84. set data(fEnt) $w.top.f1.ent
  85. set data(dList) $w.top.f2.a.l
  86. set data(fList) $w.top.f2.b.l
  87. set data(sEnt) $w.top.f3.ent
  88. set data(okBtn) $w.bot.ok
  89. set data(filterBtn) $w.bot.filter
  90. set data(cancelBtn) $w.bot.cancel
  91. }
  92. MotifFDialog_SetListMode $w
  93. # Dialog boxes should be transient with respect to their parent,
  94. # so that they will always stay on top of their parent window. However,
  95. # some window managers will create the window as withdrawn if the parent
  96. # window is withdrawn or iconified. Combined with the grab we put on the
  97. # window, this can hang the entire application. Therefore we only make
  98. # the dialog transient if the parent is viewable.
  99. if {[winfo viewable [winfo toplevel $data(-parent)]] } {
  100. wm transient $w $data(-parent)
  101. }
  102. MotifFDialog_FileTypes $w
  103. MotifFDialog_Update $w
  104. # Withdraw the window, then update all the geometry information
  105. # so we know how big it wants to be, then center the window in the
  106. # display (Motif style) and de-iconify it.
  107. ::tk::PlaceWindow $w
  108. wm title $w $data(-title)
  109. return $w
  110. }
  111. # ::tk::MotifFDialog_FileTypes --
  112. #
  113. # Checks the -filetypes option. If present this adds a list of radio-
  114. # buttons to pick the file types from.
  115. #
  116. # Arguments:
  117. # w Pathname of the tk_get*File dialogue.
  118. #
  119. # Results:
  120. # none
  121. proc ::tk::MotifFDialog_FileTypes {w} {
  122. upvar ::tk::dialog::file::[winfo name $w] data
  123. set f $w.top.f3.types
  124. destroy $f
  125. # No file types: use "*" as the filter and display no radio-buttons
  126. if {$data(-filetypes) eq ""} {
  127. set data(filter) *
  128. return
  129. }
  130. # The filetypes radiobuttons
  131. # set data(fileType) $data(-defaulttype)
  132. # Default type to first entry
  133. set initialTypeName [lindex $data(-filetypes) 0 0]
  134. if {$data(-typevariable) ne ""} {
  135. upvar #0 $data(-typevariable) typeVariable
  136. if {[info exists typeVariable]} {
  137. set initialTypeName $typeVariable
  138. }
  139. }
  140. set ix 0
  141. set data(fileType) 0
  142. foreach fltr $data(-filetypes) {
  143. set fname [lindex $fltr 0]
  144. if {[string first $initialTypeName $fname] == 0} {
  145. set data(fileType) $ix
  146. break
  147. }
  148. incr ix
  149. }
  150. MotifFDialog_SetFilter $w [lindex $data(-filetypes) $data(fileType)]
  151. #don't produce radiobuttons for only one filetype
  152. if {[llength $data(-filetypes)] == 1} {
  153. return
  154. }
  155. frame $f
  156. set cnt 0
  157. if {$data(-filetypes) ne {}} {
  158. foreach type $data(-filetypes) {
  159. set title [lindex [lindex $type 0] 0]
  160. set filter [lindex $type 1]
  161. radiobutton $f.b$cnt \
  162. -text $title \
  163. -variable ::tk::dialog::file::[winfo name $w](fileType) \
  164. -value $cnt \
  165. -command [list tk::MotifFDialog_SetFilter $w $type]
  166. pack $f.b$cnt -side left
  167. incr cnt
  168. }
  169. }
  170. $f.b$data(fileType) invoke
  171. pack $f -side bottom -fill both
  172. return
  173. }
  174. # This proc gets called whenever data(filter) is set
  175. #
  176. proc ::tk::MotifFDialog_SetFilter {w type} {
  177. upvar ::tk::dialog::file::[winfo name $w] data
  178. variable ::tk::Priv
  179. set data(filter) [lindex $type 1]
  180. set Priv(selectFileType) [lindex [lindex $type 0] 0]
  181. MotifFDialog_Update $w
  182. }
  183. # ::tk::MotifFDialog_Config --
  184. #
  185. # Iterates over the optional arguments to determine the option
  186. # values for the Motif file dialog; gives default values to
  187. # unspecified options.
  188. #
  189. # Arguments:
  190. # dataName The name of the global variable in which
  191. # data for the file dialog is stored.
  192. # type "Save" or "Open"
  193. # argList Options parsed by the procedure.
  194. proc ::tk::MotifFDialog_Config {dataName type argList} {
  195. upvar ::tk::dialog::file::$dataName data
  196. set data(type) $type
  197. # 1: the configuration specs
  198. #
  199. set specs {
  200. {-defaultextension "" "" ""}
  201. {-filetypes "" "" ""}
  202. {-initialdir "" "" ""}
  203. {-initialfile "" "" ""}
  204. {-parent "" "" "."}
  205. {-title "" "" ""}
  206. {-typevariable "" "" ""}
  207. }
  208. if {$type eq "open"} {
  209. lappend specs {-multiple "" "" "0"}
  210. }
  211. if {$type eq "save"} {
  212. lappend specs {-confirmoverwrite "" "" "1"}
  213. }
  214. set data(-multiple) 0
  215. set data(-confirmoverwrite) 1
  216. # 2: default values depending on the type of the dialog
  217. #
  218. if {![info exists data(selectPath)]} {
  219. # first time the dialog has been popped up
  220. set data(selectPath) [pwd]
  221. set data(selectFile) ""
  222. }
  223. # 3: parse the arguments
  224. #
  225. tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  226. if {$data(-title) eq ""} {
  227. if {$type eq "open"} {
  228. if {$data(-multiple) != 0} {
  229. set data(-title) "[mc {Open Multiple Files}]"
  230. } else {
  231. set data(-title) [mc "Open"]
  232. }
  233. } else {
  234. set data(-title) [mc "Save As"]
  235. }
  236. }
  237. # 4: set the default directory and selection according to the -initial
  238. # settings
  239. #
  240. if {$data(-initialdir) ne ""} {
  241. if {[file isdirectory $data(-initialdir)]} {
  242. set data(selectPath) [lindex [glob $data(-initialdir)] 0]
  243. } else {
  244. set data(selectPath) [pwd]
  245. }
  246. # Convert the initialdir to an absolute path name.
  247. set old [pwd]
  248. cd $data(selectPath)
  249. set data(selectPath) [pwd]
  250. cd $old
  251. }
  252. set data(selectFile) $data(-initialfile)
  253. # 5. Parse the -filetypes option. It is not used by the motif
  254. # file dialog, but we check for validity of the value to make sure
  255. # the application code also runs fine with the TK file dialog.
  256. #
  257. set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
  258. if {![info exists data(filter)]} {
  259. set data(filter) *
  260. }
  261. if {![winfo exists $data(-parent)]} {
  262. return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
  263. "bad window path name \"$data(-parent)\""
  264. }
  265. }
  266. # ::tk::MotifFDialog_BuildUI --
  267. #
  268. # Builds the UI components of the Motif file dialog.
  269. #
  270. # Arguments:
  271. # w Pathname of the dialog to build.
  272. #
  273. # Results:
  274. # None.
  275. proc ::tk::MotifFDialog_BuildUI {w} {
  276. set dataName [lindex [split $w .] end]
  277. upvar ::tk::dialog::file::$dataName data
  278. # Create the dialog toplevel and internal frames.
  279. #
  280. toplevel $w -class TkMotifFDialog
  281. set top [frame $w.top -relief raised -bd 1]
  282. set bot [frame $w.bot -relief raised -bd 1]
  283. pack $w.bot -side bottom -fill x
  284. pack $w.top -side top -expand yes -fill both
  285. set f1 [frame $top.f1]
  286. set f2 [frame $top.f2]
  287. set f3 [frame $top.f3]
  288. pack $f1 -side top -fill x
  289. pack $f3 -side bottom -fill x
  290. pack $f2 -expand yes -fill both
  291. set f2a [frame $f2.a]
  292. set f2b [frame $f2.b]
  293. grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
  294. -sticky news
  295. grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
  296. -sticky news
  297. grid rowconfigure $f2 0 -minsize 0 -weight 1
  298. grid columnconfigure $f2 0 -minsize 0 -weight 1
  299. grid columnconfigure $f2 1 -minsize 150 -weight 2
  300. # The Filter box
  301. #
  302. bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \
  303. <<AltUnderlined>> [list focus $f1.ent]
  304. entry $f1.ent
  305. pack $f1.lab -side top -fill x -padx 6 -pady 4
  306. pack $f1.ent -side top -fill x -padx 4 -pady 0
  307. set data(fEnt) $f1.ent
  308. # The file and directory lists
  309. #
  310. set data(dList) [MotifFDialog_MakeSList $w $f2a \
  311. [mc "&Directory:"] DList]
  312. set data(fList) [MotifFDialog_MakeSList $w $f2b \
  313. [mc "Fi&les:"] FList]
  314. # The Selection box
  315. #
  316. bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \
  317. <<AltUnderlined>> [list focus $f3.ent]
  318. entry $f3.ent
  319. pack $f3.lab -side top -fill x -padx 6 -pady 0
  320. pack $f3.ent -side top -fill x -padx 4 -pady 4
  321. set data(sEnt) $f3.ent
  322. # The buttons
  323. #
  324. set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel]
  325. set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
  326. set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \
  327. -width $maxWidth \
  328. -command [list tk::MotifFDialog_OkCmd $w]]
  329. set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc "&Filter"] \
  330. -width $maxWidth \
  331. -command [list tk::MotifFDialog_FilterCmd $w]]
  332. set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc "&Cancel"] \
  333. -width $maxWidth \
  334. -command [list tk::MotifFDialog_CancelCmd $w]]
  335. pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
  336. -side left
  337. # Create the bindings:
  338. #
  339. bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
  340. bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w]
  341. bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w]
  342. bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w]
  343. bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}}
  344. wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]
  345. }
  346. proc ::tk::MotifFDialog_SetListMode {w} {
  347. upvar ::tk::dialog::file::[winfo name $w] data
  348. if {$data(-multiple) != 0} {
  349. set selectmode extended
  350. } else {
  351. set selectmode browse
  352. }
  353. set f $w.top.f2.b
  354. $f.l configure -selectmode $selectmode
  355. }
  356. # ::tk::MotifFDialog_MakeSList --
  357. #
  358. # Create a scrolled-listbox and set the keyboard accelerator
  359. # bindings so that the list selection follows what the user
  360. # types.
  361. #
  362. # Arguments:
  363. # w Pathname of the dialog box.
  364. # f Frame widget inside which to create the scrolled
  365. # listbox. This frame widget already exists.
  366. # label The string to display on top of the listbox.
  367. # under Sets the -under option of the label.
  368. # cmdPrefix Specifies procedures to call when the listbox is
  369. # browsed or activated.
  370. proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} {
  371. bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \
  372. <<AltUnderlined>> [list focus $f.l]
  373. listbox $f.l -width 12 -height 5 -exportselection 0\
  374. -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
  375. scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview]
  376. scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]
  377. grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
  378. -padx 2 -pady 2
  379. grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
  380. grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
  381. grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
  382. grid rowconfigure $f 0 -weight 0 -minsize 0
  383. grid rowconfigure $f 1 -weight 1 -minsize 0
  384. grid columnconfigure $f 0 -weight 1 -minsize 0
  385. # bindings for the listboxes
  386. #
  387. set list $f.l
  388. bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w]
  389. bind $list <Double-ButtonRelease-1> \
  390. [list tk::MotifFDialog_Activate$cmdPrefix $w]
  391. bind $list <Return> "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \
  392. tk::MotifFDialog_Activate$cmdPrefix [list $w]"
  393. bindtags $list [list Listbox $list [winfo toplevel $list] all]
  394. ListBoxKeyAccel_Set $list
  395. return $f.l
  396. }
  397. # ::tk::MotifFDialog_InterpFilter --
  398. #
  399. # Interpret the string in the filter entry into two components:
  400. # the directory and the pattern. If the string is a relative
  401. # pathname, give a warning to the user and restore the pattern
  402. # to original.
  403. #
  404. # Arguments:
  405. # w pathname of the dialog box.
  406. #
  407. # Results:
  408. # A list of two elements. The first element is the directory
  409. # specified # by the filter. The second element is the filter
  410. # pattern itself.
  411. proc ::tk::MotifFDialog_InterpFilter {w} {
  412. upvar ::tk::dialog::file::[winfo name $w] data
  413. set text [string trim [$data(fEnt) get]]
  414. # Perform tilde substitution
  415. #
  416. set badTilde 0
  417. if {[string index $text 0] eq "~"} {
  418. set list [file split $text]
  419. set tilde [lindex $list 0]
  420. if {[catch {set tilde [glob $tilde]}]} {
  421. set badTilde 1
  422. } else {
  423. set text [eval file join [concat $tilde [lrange $list 1 end]]]
  424. }
  425. }
  426. # If the string is a relative pathname, combine it
  427. # with the current selectPath.
  428. set relative 0
  429. if {[file pathtype $text] eq "relative"} {
  430. set relative 1
  431. } elseif {$badTilde} {
  432. set relative 1
  433. }
  434. if {$relative} {
  435. tk_messageBox -icon warning -type ok \
  436. -message "\"$text\" must be an absolute pathname"
  437. $data(fEnt) delete 0 end
  438. $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  439. $data(filter)]
  440. return [list $data(selectPath) $data(filter)]
  441. }
  442. set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
  443. if {[file isdirectory $resolved]} {
  444. set dir $resolved
  445. set fil $data(filter)
  446. } else {
  447. set dir [file dirname $resolved]
  448. set fil [file tail $resolved]
  449. }
  450. return [list $dir $fil]
  451. }
  452. # ::tk::MotifFDialog_Update
  453. #
  454. # Load the files and synchronize the "filter" and "selection" fields
  455. # boxes.
  456. #
  457. # Arguments:
  458. # w pathname of the dialog box.
  459. #
  460. # Results:
  461. # None.
  462. proc ::tk::MotifFDialog_Update {w} {
  463. upvar ::tk::dialog::file::[winfo name $w] data
  464. $data(fEnt) delete 0 end
  465. $data(fEnt) insert 0 \
  466. [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
  467. $data(sEnt) delete 0 end
  468. $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  469. $data(selectFile)]
  470. MotifFDialog_LoadFiles $w
  471. }
  472. # ::tk::MotifFDialog_LoadFiles --
  473. #
  474. # Loads the files and directories into the two listboxes according
  475. # to the filter setting.
  476. #
  477. # Arguments:
  478. # w pathname of the dialog box.
  479. #
  480. # Results:
  481. # None.
  482. proc ::tk::MotifFDialog_LoadFiles {w} {
  483. upvar ::tk::dialog::file::[winfo name $w] data
  484. $data(dList) delete 0 end
  485. $data(fList) delete 0 end
  486. set appPWD [pwd]
  487. if {[catch {cd $data(selectPath)}]} {
  488. cd $appPWD
  489. $data(dList) insert end ".."
  490. return
  491. }
  492. # Make the dir and file lists
  493. #
  494. # For speed we only have one glob, which reduces the file system
  495. # calls (good for slow NFS networks).
  496. #
  497. # We also do two smaller sorts (files + dirs) instead of one large sort,
  498. # which gives a small speed increase.
  499. #
  500. set top 0
  501. set dlist ""
  502. set flist ""
  503. foreach f [glob -nocomplain .* *] {
  504. if {[file isdir ./$f]} {
  505. lappend dlist $f
  506. } else {
  507. foreach pat $data(filter) {
  508. if {[string match $pat $f]} {
  509. if {[string match .* $f]} {
  510. incr top
  511. }
  512. lappend flist $f
  513. break
  514. }
  515. }
  516. }
  517. }
  518. eval [list $data(dList) insert end] [lsort -dictionary $dlist]
  519. eval [list $data(fList) insert end] [lsort -dictionary $flist]
  520. # The user probably doesn't want to see the . files. We adjust the view
  521. # so that the listbox displays all the non-dot files
  522. $data(fList) yview $top
  523. cd $appPWD
  524. }
  525. # ::tk::MotifFDialog_BrowseDList --
  526. #
  527. # This procedure is called when the directory list is browsed
  528. # (clicked-over) by the user.
  529. #
  530. # Arguments:
  531. # w The pathname of the dialog box.
  532. #
  533. # Results:
  534. # None.
  535. proc ::tk::MotifFDialog_BrowseDList {w} {
  536. upvar ::tk::dialog::file::[winfo name $w] data
  537. focus $data(dList)
  538. if {[$data(dList) curselection] eq ""} {
  539. return
  540. }
  541. set subdir [$data(dList) get [$data(dList) curselection]]
  542. if {$subdir eq ""} {
  543. return
  544. }
  545. $data(fList) selection clear 0 end
  546. set list [MotifFDialog_InterpFilter $w]
  547. set data(filter) [lindex $list 1]
  548. switch -- $subdir {
  549. . {
  550. set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
  551. }
  552. .. {
  553. set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
  554. $data(filter)]
  555. }
  556. default {
  557. set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
  558. $data(selectPath) $subdir] $data(filter)]
  559. }
  560. }
  561. $data(fEnt) delete 0 end
  562. $data(fEnt) insert 0 $newSpec
  563. }
  564. # ::tk::MotifFDialog_ActivateDList --
  565. #
  566. # This procedure is called when the directory list is activated
  567. # (double-clicked) by the user.
  568. #
  569. # Arguments:
  570. # w The pathname of the dialog box.
  571. #
  572. # Results:
  573. # None.
  574. proc ::tk::MotifFDialog_ActivateDList {w} {
  575. upvar ::tk::dialog::file::[winfo name $w] data
  576. if {[$data(dList) curselection] eq ""} {
  577. return
  578. }
  579. set subdir [$data(dList) get [$data(dList) curselection]]
  580. if {$subdir eq ""} {
  581. return
  582. }
  583. $data(fList) selection clear 0 end
  584. switch -- $subdir {
  585. . {
  586. set newDir $data(selectPath)
  587. }
  588. .. {
  589. set newDir [file dirname $data(selectPath)]
  590. }
  591. default {
  592. set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
  593. }
  594. }
  595. set data(selectPath) $newDir
  596. MotifFDialog_Update $w
  597. if {$subdir ne ".."} {
  598. $data(dList) selection set 0
  599. $data(dList) activate 0
  600. } else {
  601. $data(dList) selection set 1
  602. $data(dList) activate 1
  603. }
  604. }
  605. # ::tk::MotifFDialog_BrowseFList --
  606. #
  607. # This procedure is called when the file list is browsed
  608. # (clicked-over) by the user.
  609. #
  610. # Arguments:
  611. # w The pathname of the dialog box.
  612. #
  613. # Results:
  614. # None.
  615. proc ::tk::MotifFDialog_BrowseFList {w} {
  616. upvar ::tk::dialog::file::[winfo name $w] data
  617. focus $data(fList)
  618. set data(selectFile) ""
  619. foreach item [$data(fList) curselection] {
  620. lappend data(selectFile) [$data(fList) get $item]
  621. }
  622. if {[llength $data(selectFile)] == 0} {
  623. return
  624. }
  625. $data(dList) selection clear 0 end
  626. $data(fEnt) delete 0 end
  627. $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  628. $data(filter)]
  629. $data(fEnt) xview end
  630. # if it's a multiple selection box, just put in the filenames
  631. # otherwise put in the full path as usual
  632. $data(sEnt) delete 0 end
  633. if {$data(-multiple) != 0} {
  634. $data(sEnt) insert 0 $data(selectFile)
  635. } else {
  636. $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  637. [lindex $data(selectFile) 0]]
  638. }
  639. $data(sEnt) xview end
  640. }
  641. # ::tk::MotifFDialog_ActivateFList --
  642. #
  643. # This procedure is called when the file list is activated
  644. # (double-clicked) by the user.
  645. #
  646. # Arguments:
  647. # w The pathname of the dialog box.
  648. #
  649. # Results:
  650. # None.
  651. proc ::tk::MotifFDialog_ActivateFList {w} {
  652. upvar ::tk::dialog::file::[winfo name $w] data
  653. if {[$data(fList) curselection] eq ""} {
  654. return
  655. }
  656. set data(selectFile) [$data(fList) get [$data(fList) curselection]]
  657. if {$data(selectFile) eq ""} {
  658. return
  659. } else {
  660. MotifFDialog_ActivateSEnt $w
  661. }
  662. }
  663. # ::tk::MotifFDialog_ActivateFEnt --
  664. #
  665. # This procedure is called when the user presses Return inside
  666. # the "filter" entry. It updates the dialog according to the
  667. # text inside the filter entry.
  668. #
  669. # Arguments:
  670. # w The pathname of the dialog box.
  671. #
  672. # Results:
  673. # None.
  674. proc ::tk::MotifFDialog_ActivateFEnt {w} {
  675. upvar ::tk::dialog::file::[winfo name $w] data
  676. set list [MotifFDialog_InterpFilter $w]
  677. set data(selectPath) [lindex $list 0]
  678. set data(filter) [lindex $list 1]
  679. MotifFDialog_Update $w
  680. }
  681. # ::tk::MotifFDialog_ActivateSEnt --
  682. #
  683. # This procedure is called when the user presses Return inside
  684. # the "selection" entry. It sets the ::tk::Priv(selectFilePath)
  685. # variable so that the vwait loop in tk::MotifFDialog will be
  686. # terminated.
  687. #
  688. # Arguments:
  689. # w The pathname of the dialog box.
  690. #
  691. # Results:
  692. # None.
  693. proc ::tk::MotifFDialog_ActivateSEnt {w} {
  694. variable ::tk::Priv
  695. upvar ::tk::dialog::file::[winfo name $w] data
  696. set selectFilePath [string trim [$data(sEnt) get]]
  697. if {$selectFilePath eq ""} {
  698. MotifFDialog_FilterCmd $w
  699. return
  700. }
  701. if {$data(-multiple) == 0} {
  702. set selectFilePath [list $selectFilePath]
  703. }
  704. if {[file isdirectory [lindex $selectFilePath 0]]} {
  705. set data(selectPath) [lindex [glob $selectFilePath] 0]
  706. set data(selectFile) ""
  707. MotifFDialog_Update $w
  708. return
  709. }
  710. set newFileList ""
  711. foreach item $selectFilePath {
  712. if {[file pathtype $item] ne "absolute"} {
  713. set item [file join $data(selectPath) $item]
  714. } elseif {![file exists [file dirname $item]]} {
  715. tk_messageBox -icon warning -type ok \
  716. -message [mc {Directory "%1$s" does not exist.} \
  717. [file dirname $item]]
  718. return
  719. }
  720. if {![file exists $item]} {
  721. if {$data(type) eq "open"} {
  722. tk_messageBox -icon warning -type ok \
  723. -message [mc {File "%1$s" does not exist.} $item]
  724. return
  725. }
  726. } elseif {$data(type) eq "save" && $data(-confirmoverwrite)} {
  727. set message [format %s%s \
  728. [mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \
  729. [mc {Replace existing file?}]]
  730. set answer [tk_messageBox -icon warning -type yesno \
  731. -message $message]
  732. if {$answer eq "no"} {
  733. return
  734. }
  735. }
  736. lappend newFileList $item
  737. }
  738. # Return selected filter
  739. if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
  740. && [info exists data(-filetypes)] && $data(-filetypes) ne ""} {
  741. upvar #0 $data(-typevariable) typeVariable
  742. set typeVariable [lindex $data(-filetypes) $data(fileType) 0]
  743. }
  744. if {$data(-multiple) != 0} {
  745. set Priv(selectFilePath) $newFileList
  746. } else {
  747. set Priv(selectFilePath) [lindex $newFileList 0]
  748. }
  749. # Set selectFile and selectPath to first item in list
  750. set Priv(selectFile) [file tail [lindex $newFileList 0]]
  751. set Priv(selectPath) [file dirname [lindex $newFileList 0]]
  752. }
  753. proc ::tk::MotifFDialog_OkCmd {w} {
  754. upvar ::tk::dialog::file::[winfo name $w] data
  755. MotifFDialog_ActivateSEnt $w
  756. }
  757. proc ::tk::MotifFDialog_FilterCmd {w} {
  758. upvar ::tk::dialog::file::[winfo name $w] data
  759. MotifFDialog_ActivateFEnt $w
  760. }
  761. proc ::tk::MotifFDialog_CancelCmd {w} {
  762. variable ::tk::Priv
  763. set Priv(selectFilePath) ""
  764. set Priv(selectFile) ""
  765. set Priv(selectPath) ""
  766. }
  767. proc ::tk::ListBoxKeyAccel_Set {w} {
  768. bind Listbox <Any-KeyPress> ""
  769. bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w]
  770. bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A]
  771. }
  772. proc ::tk::ListBoxKeyAccel_Unset {w} {
  773. variable ::tk::Priv
  774. catch {after cancel $Priv(lbAccel,$w,afterId)}
  775. unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId)
  776. }
  777. # ::tk::ListBoxKeyAccel_Key--
  778. #
  779. # This procedure maintains a list of recently entered keystrokes
  780. # over a listbox widget. It arranges an idle event to move the
  781. # selection of the listbox to the entry that begins with the
  782. # keystrokes.
  783. #
  784. # Arguments:
  785. # w The pathname of the listbox.
  786. # key The key which the user just pressed.
  787. #
  788. # Results:
  789. # None.
  790. proc ::tk::ListBoxKeyAccel_Key {w key} {
  791. variable ::tk::Priv
  792. if { $key eq "" } {
  793. return
  794. }
  795. append Priv(lbAccel,$w) $key
  796. ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w)
  797. catch {
  798. after cancel $Priv(lbAccel,$w,afterId)
  799. }
  800. set Priv(lbAccel,$w,afterId) [after 500 \
  801. [list tk::ListBoxKeyAccel_Reset $w]]
  802. }
  803. proc ::tk::ListBoxKeyAccel_Goto {w string} {
  804. variable ::tk::Priv
  805. set string [string tolower $string]
  806. set end [$w index end]
  807. set theIndex -1
  808. for {set i 0} {$i < $end} {incr i} {
  809. set item [string tolower [$w get $i]]
  810. if {[string compare $string $item] >= 0} {
  811. set theIndex $i
  812. }
  813. if {[string compare $string $item] <= 0} {
  814. set theIndex $i
  815. break
  816. }
  817. }
  818. if {$theIndex >= 0} {
  819. $w selection clear 0 end
  820. $w selection set $theIndex $theIndex
  821. $w activate $theIndex
  822. $w see $theIndex
  823. event generate $w <<ListboxSelect>>
  824. }
  825. }
  826. proc ::tk::ListBoxKeyAccel_Reset {w} {
  827. variable ::tk::Priv
  828. unset -nocomplain Priv(lbAccel,$w)
  829. }
  830. proc ::tk_getFileType {} {
  831. variable ::tk::Priv
  832. return $Priv(selectFileType)
  833. }