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 exist 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. error "bad window path name \"$data(-parent)\""
  263. }
  264. }
  265. # ::tk::MotifFDialog_BuildUI --
  266. #
  267. # Builds the UI components of the Motif file dialog.
  268. #
  269. # Arguments:
  270. # w Pathname of the dialog to build.
  271. #
  272. # Results:
  273. # None.
  274. proc ::tk::MotifFDialog_BuildUI {w} {
  275. set dataName [lindex [split $w .] end]
  276. upvar ::tk::dialog::file::$dataName data
  277. # Create the dialog toplevel and internal frames.
  278. #
  279. toplevel $w -class TkMotifFDialog
  280. set top [frame $w.top -relief raised -bd 1]
  281. set bot [frame $w.bot -relief raised -bd 1]
  282. pack $w.bot -side bottom -fill x
  283. pack $w.top -side top -expand yes -fill both
  284. set f1 [frame $top.f1]
  285. set f2 [frame $top.f2]
  286. set f3 [frame $top.f3]
  287. pack $f1 -side top -fill x
  288. pack $f3 -side bottom -fill x
  289. pack $f2 -expand yes -fill both
  290. set f2a [frame $f2.a]
  291. set f2b [frame $f2.b]
  292. grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
  293. -sticky news
  294. grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
  295. -sticky news
  296. grid rowconfigure $f2 0 -minsize 0 -weight 1
  297. grid columnconfigure $f2 0 -minsize 0 -weight 1
  298. grid columnconfigure $f2 1 -minsize 150 -weight 2
  299. # The Filter box
  300. #
  301. bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \
  302. <<AltUnderlined>> [list focus $f1.ent]
  303. entry $f1.ent
  304. pack $f1.lab -side top -fill x -padx 6 -pady 4
  305. pack $f1.ent -side top -fill x -padx 4 -pady 0
  306. set data(fEnt) $f1.ent
  307. # The file and directory lists
  308. #
  309. set data(dList) [MotifFDialog_MakeSList $w $f2a \
  310. [mc "&Directory:"] DList]
  311. set data(fList) [MotifFDialog_MakeSList $w $f2b \
  312. [mc "Fi&les:"] FList]
  313. # The Selection box
  314. #
  315. bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \
  316. <<AltUnderlined>> [list focus $f3.ent]
  317. entry $f3.ent
  318. pack $f3.lab -side top -fill x -padx 6 -pady 0
  319. pack $f3.ent -side top -fill x -padx 4 -pady 4
  320. set data(sEnt) $f3.ent
  321. # The buttons
  322. #
  323. set maxWidth [::tk::mcmaxamp &OK &Filter &Cancel]
  324. set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
  325. set data(okBtn) [::tk::AmpWidget button $bot.ok -text [mc "&OK"] \
  326. -width $maxWidth \
  327. -command [list tk::MotifFDialog_OkCmd $w]]
  328. set data(filterBtn) [::tk::AmpWidget button $bot.filter -text [mc "&Filter"] \
  329. -width $maxWidth \
  330. -command [list tk::MotifFDialog_FilterCmd $w]]
  331. set data(cancelBtn) [::tk::AmpWidget button $bot.cancel -text [mc "&Cancel"] \
  332. -width $maxWidth \
  333. -command [list tk::MotifFDialog_CancelCmd $w]]
  334. pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
  335. -side left
  336. # Create the bindings:
  337. #
  338. bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
  339. bind $data(fEnt) <Return> [list tk::MotifFDialog_ActivateFEnt $w]
  340. bind $data(sEnt) <Return> [list tk::MotifFDialog_ActivateSEnt $w]
  341. bind $w <Escape> [list tk::MotifFDialog_CancelCmd $w]
  342. bind $w.bot <Destroy> {set ::tk::Priv(selectFilePath) {}}
  343. wm protocol $w WM_DELETE_WINDOW [list tk::MotifFDialog_CancelCmd $w]
  344. }
  345. proc ::tk::MotifFDialog_SetListMode {w} {
  346. upvar ::tk::dialog::file::[winfo name $w] data
  347. if {$data(-multiple) != 0} {
  348. set selectmode extended
  349. } else {
  350. set selectmode browse
  351. }
  352. set f $w.top.f2.b
  353. $f.l configure -selectmode $selectmode
  354. }
  355. # ::tk::MotifFDialog_MakeSList --
  356. #
  357. # Create a scrolled-listbox and set the keyboard accelerator
  358. # bindings so that the list selection follows what the user
  359. # types.
  360. #
  361. # Arguments:
  362. # w Pathname of the dialog box.
  363. # f Frame widget inside which to create the scrolled
  364. # listbox. This frame widget already exists.
  365. # label The string to display on top of the listbox.
  366. # under Sets the -under option of the label.
  367. # cmdPrefix Specifies procedures to call when the listbox is
  368. # browsed or activated.
  369. proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} {
  370. bind [::tk::AmpWidget label $f.lab -text $label -anchor w] \
  371. <<AltUnderlined>> [list focus $f.l]
  372. listbox $f.l -width 12 -height 5 -exportselection 0\
  373. -xscrollcommand [list $f.h set] -yscrollcommand [list $f.v set]
  374. scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview]
  375. scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview]
  376. grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
  377. -padx 2 -pady 2
  378. grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
  379. grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
  380. grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
  381. grid rowconfigure $f 0 -weight 0 -minsize 0
  382. grid rowconfigure $f 1 -weight 1 -minsize 0
  383. grid columnconfigure $f 0 -weight 1 -minsize 0
  384. # bindings for the listboxes
  385. #
  386. set list $f.l
  387. bind $list <<ListboxSelect>> [list tk::MotifFDialog_Browse$cmdPrefix $w]
  388. bind $list <Double-ButtonRelease-1> \
  389. [list tk::MotifFDialog_Activate$cmdPrefix $w]
  390. bind $list <Return> "tk::MotifFDialog_Browse$cmdPrefix [list $w]; \
  391. tk::MotifFDialog_Activate$cmdPrefix [list $w]"
  392. bindtags $list [list Listbox $list [winfo toplevel $list] all]
  393. ListBoxKeyAccel_Set $list
  394. return $f.l
  395. }
  396. # ::tk::MotifFDialog_InterpFilter --
  397. #
  398. # Interpret the string in the filter entry into two components:
  399. # the directory and the pattern. If the string is a relative
  400. # pathname, give a warning to the user and restore the pattern
  401. # to original.
  402. #
  403. # Arguments:
  404. # w pathname of the dialog box.
  405. #
  406. # Results:
  407. # A list of two elements. The first element is the directory
  408. # specified # by the filter. The second element is the filter
  409. # pattern itself.
  410. proc ::tk::MotifFDialog_InterpFilter {w} {
  411. upvar ::tk::dialog::file::[winfo name $w] data
  412. set text [string trim [$data(fEnt) get]]
  413. # Perform tilde substitution
  414. #
  415. set badTilde 0
  416. if {[string index $text 0] eq "~"} {
  417. set list [file split $text]
  418. set tilde [lindex $list 0]
  419. if {[catch {set tilde [glob $tilde]}]} {
  420. set badTilde 1
  421. } else {
  422. set text [eval file join [concat $tilde [lrange $list 1 end]]]
  423. }
  424. }
  425. # If the string is a relative pathname, combine it
  426. # with the current selectPath.
  427. set relative 0
  428. if {[file pathtype $text] eq "relative"} {
  429. set relative 1
  430. } elseif {$badTilde} {
  431. set relative 1
  432. }
  433. if {$relative} {
  434. tk_messageBox -icon warning -type ok \
  435. -message "\"$text\" must be an absolute pathname"
  436. $data(fEnt) delete 0 end
  437. $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  438. $data(filter)]
  439. return [list $data(selectPath) $data(filter)]
  440. }
  441. set resolved [::tk::dialog::file::JoinFile [file dirname $text] [file tail $text]]
  442. if {[file isdirectory $resolved]} {
  443. set dir $resolved
  444. set fil $data(filter)
  445. } else {
  446. set dir [file dirname $resolved]
  447. set fil [file tail $resolved]
  448. }
  449. return [list $dir $fil]
  450. }
  451. # ::tk::MotifFDialog_Update
  452. #
  453. # Load the files and synchronize the "filter" and "selection" fields
  454. # boxes.
  455. #
  456. # Arguments:
  457. # w pathname of the dialog box.
  458. #
  459. # Results:
  460. # None.
  461. proc ::tk::MotifFDialog_Update {w} {
  462. upvar ::tk::dialog::file::[winfo name $w] data
  463. $data(fEnt) delete 0 end
  464. $data(fEnt) insert 0 \
  465. [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
  466. $data(sEnt) delete 0 end
  467. $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  468. $data(selectFile)]
  469. MotifFDialog_LoadFiles $w
  470. }
  471. # ::tk::MotifFDialog_LoadFiles --
  472. #
  473. # Loads the files and directories into the two listboxes according
  474. # to the filter setting.
  475. #
  476. # Arguments:
  477. # w pathname of the dialog box.
  478. #
  479. # Results:
  480. # None.
  481. proc ::tk::MotifFDialog_LoadFiles {w} {
  482. upvar ::tk::dialog::file::[winfo name $w] data
  483. $data(dList) delete 0 end
  484. $data(fList) delete 0 end
  485. set appPWD [pwd]
  486. if {[catch {cd $data(selectPath)}]} {
  487. cd $appPWD
  488. $data(dList) insert end ".."
  489. return
  490. }
  491. # Make the dir and file lists
  492. #
  493. # For speed we only have one glob, which reduces the file system
  494. # calls (good for slow NFS networks).
  495. #
  496. # We also do two smaller sorts (files + dirs) instead of one large sort,
  497. # which gives a small speed increase.
  498. #
  499. set top 0
  500. set dlist ""
  501. set flist ""
  502. foreach f [glob -nocomplain .* *] {
  503. if {[file isdir ./$f]} {
  504. lappend dlist $f
  505. } else {
  506. foreach pat $data(filter) {
  507. if {[string match $pat $f]} {
  508. if {[string match .* $f]} {
  509. incr top
  510. }
  511. lappend flist $f
  512. break
  513. }
  514. }
  515. }
  516. }
  517. eval [list $data(dList) insert end] [lsort -dictionary $dlist]
  518. eval [list $data(fList) insert end] [lsort -dictionary $flist]
  519. # The user probably doesn't want to see the . files. We adjust the view
  520. # so that the listbox displays all the non-dot files
  521. $data(fList) yview $top
  522. cd $appPWD
  523. }
  524. # ::tk::MotifFDialog_BrowseDList --
  525. #
  526. # This procedure is called when the directory list is browsed
  527. # (clicked-over) by the user.
  528. #
  529. # Arguments:
  530. # w The pathname of the dialog box.
  531. #
  532. # Results:
  533. # None.
  534. proc ::tk::MotifFDialog_BrowseDList {w} {
  535. upvar ::tk::dialog::file::[winfo name $w] data
  536. focus $data(dList)
  537. if {[$data(dList) curselection] eq ""} {
  538. return
  539. }
  540. set subdir [$data(dList) get [$data(dList) curselection]]
  541. if {$subdir eq ""} {
  542. return
  543. }
  544. $data(fList) selection clear 0 end
  545. set list [MotifFDialog_InterpFilter $w]
  546. set data(filter) [lindex $list 1]
  547. switch -- $subdir {
  548. . {
  549. set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
  550. }
  551. .. {
  552. set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
  553. $data(filter)]
  554. }
  555. default {
  556. set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
  557. $data(selectPath) $subdir] $data(filter)]
  558. }
  559. }
  560. $data(fEnt) delete 0 end
  561. $data(fEnt) insert 0 $newSpec
  562. }
  563. # ::tk::MotifFDialog_ActivateDList --
  564. #
  565. # This procedure is called when the directory list is activated
  566. # (double-clicked) by the user.
  567. #
  568. # Arguments:
  569. # w The pathname of the dialog box.
  570. #
  571. # Results:
  572. # None.
  573. proc ::tk::MotifFDialog_ActivateDList {w} {
  574. upvar ::tk::dialog::file::[winfo name $w] data
  575. if {[$data(dList) curselection] eq ""} {
  576. return
  577. }
  578. set subdir [$data(dList) get [$data(dList) curselection]]
  579. if {$subdir eq ""} {
  580. return
  581. }
  582. $data(fList) selection clear 0 end
  583. switch -- $subdir {
  584. . {
  585. set newDir $data(selectPath)
  586. }
  587. .. {
  588. set newDir [file dirname $data(selectPath)]
  589. }
  590. default {
  591. set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
  592. }
  593. }
  594. set data(selectPath) $newDir
  595. MotifFDialog_Update $w
  596. if {$subdir ne ".."} {
  597. $data(dList) selection set 0
  598. $data(dList) activate 0
  599. } else {
  600. $data(dList) selection set 1
  601. $data(dList) activate 1
  602. }
  603. }
  604. # ::tk::MotifFDialog_BrowseFList --
  605. #
  606. # This procedure is called when the file list is browsed
  607. # (clicked-over) by the user.
  608. #
  609. # Arguments:
  610. # w The pathname of the dialog box.
  611. #
  612. # Results:
  613. # None.
  614. proc ::tk::MotifFDialog_BrowseFList {w} {
  615. upvar ::tk::dialog::file::[winfo name $w] data
  616. focus $data(fList)
  617. set data(selectFile) ""
  618. foreach item [$data(fList) curselection] {
  619. lappend data(selectFile) [$data(fList) get $item]
  620. }
  621. if {[llength $data(selectFile)] == 0} {
  622. return
  623. }
  624. $data(dList) selection clear 0 end
  625. $data(fEnt) delete 0 end
  626. $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  627. $data(filter)]
  628. $data(fEnt) xview end
  629. # if it's a multiple selection box, just put in the filenames
  630. # otherwise put in the full path as usual
  631. $data(sEnt) delete 0 end
  632. if {$data(-multiple) != 0} {
  633. $data(sEnt) insert 0 $data(selectFile)
  634. } else {
  635. $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
  636. [lindex $data(selectFile) 0]]
  637. }
  638. $data(sEnt) xview end
  639. }
  640. # ::tk::MotifFDialog_ActivateFList --
  641. #
  642. # This procedure is called when the file list is activated
  643. # (double-clicked) by the user.
  644. #
  645. # Arguments:
  646. # w The pathname of the dialog box.
  647. #
  648. # Results:
  649. # None.
  650. proc ::tk::MotifFDialog_ActivateFList {w} {
  651. upvar ::tk::dialog::file::[winfo name $w] data
  652. if {[$data(fList) curselection] eq ""} {
  653. return
  654. }
  655. set data(selectFile) [$data(fList) get [$data(fList) curselection]]
  656. if {$data(selectFile) eq ""} {
  657. return
  658. } else {
  659. MotifFDialog_ActivateSEnt $w
  660. }
  661. }
  662. # ::tk::MotifFDialog_ActivateFEnt --
  663. #
  664. # This procedure is called when the user presses Return inside
  665. # the "filter" entry. It updates the dialog according to the
  666. # text inside the filter entry.
  667. #
  668. # Arguments:
  669. # w The pathname of the dialog box.
  670. #
  671. # Results:
  672. # None.
  673. proc ::tk::MotifFDialog_ActivateFEnt {w} {
  674. upvar ::tk::dialog::file::[winfo name $w] data
  675. set list [MotifFDialog_InterpFilter $w]
  676. set data(selectPath) [lindex $list 0]
  677. set data(filter) [lindex $list 1]
  678. MotifFDialog_Update $w
  679. }
  680. # ::tk::MotifFDialog_ActivateSEnt --
  681. #
  682. # This procedure is called when the user presses Return inside
  683. # the "selection" entry. It sets the ::tk::Priv(selectFilePath)
  684. # variable so that the vwait loop in tk::MotifFDialog will be
  685. # terminated.
  686. #
  687. # Arguments:
  688. # w The pathname of the dialog box.
  689. #
  690. # Results:
  691. # None.
  692. proc ::tk::MotifFDialog_ActivateSEnt {w} {
  693. variable ::tk::Priv
  694. upvar ::tk::dialog::file::[winfo name $w] data
  695. set selectFilePath [string trim [$data(sEnt) get]]
  696. if {$selectFilePath eq ""} {
  697. MotifFDialog_FilterCmd $w
  698. return
  699. }
  700. if {$data(-multiple) == 0} {
  701. set selectFilePath [list $selectFilePath]
  702. }
  703. if {[file isdirectory [lindex $selectFilePath 0]]} {
  704. set data(selectPath) [lindex [glob $selectFilePath] 0]
  705. set data(selectFile) ""
  706. MotifFDialog_Update $w
  707. return
  708. }
  709. set newFileList ""
  710. foreach item $selectFilePath {
  711. if {[file pathtype $item] ne "absolute"} {
  712. set item [file join $data(selectPath) $item]
  713. } elseif {![file exists [file dirname $item]]} {
  714. tk_messageBox -icon warning -type ok \
  715. -message [mc {Directory "%1$s" does not exist.} \
  716. [file dirname $item]]
  717. return
  718. }
  719. if {![file exists $item]} {
  720. if {$data(type) eq "open"} {
  721. tk_messageBox -icon warning -type ok \
  722. -message [mc {File "%1$s" does not exist.} $item]
  723. return
  724. }
  725. } elseif {$data(type) eq "save" && $data(-confirmoverwrite)} {
  726. set message [format %s%s \
  727. [mc "File \"%1\$s\" already exists.\n\n" $selectFilePath] \
  728. [mc {Replace existing file?}]]
  729. set answer [tk_messageBox -icon warning -type yesno \
  730. -message $message]
  731. if {$answer eq "no"} {
  732. return
  733. }
  734. }
  735. lappend newFileList $item
  736. }
  737. # Return selected filter
  738. if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
  739. && [info exists data(-filetypes)] && $data(-filetypes) ne ""} {
  740. upvar #0 $data(-typevariable) typeVariable
  741. set typeVariable [lindex $data(-filetypes) $data(fileType) 0]
  742. }
  743. if {$data(-multiple) != 0} {
  744. set Priv(selectFilePath) $newFileList
  745. } else {
  746. set Priv(selectFilePath) [lindex $newFileList 0]
  747. }
  748. # Set selectFile and selectPath to first item in list
  749. set Priv(selectFile) [file tail [lindex $newFileList 0]]
  750. set Priv(selectPath) [file dirname [lindex $newFileList 0]]
  751. }
  752. proc ::tk::MotifFDialog_OkCmd {w} {
  753. upvar ::tk::dialog::file::[winfo name $w] data
  754. MotifFDialog_ActivateSEnt $w
  755. }
  756. proc ::tk::MotifFDialog_FilterCmd {w} {
  757. upvar ::tk::dialog::file::[winfo name $w] data
  758. MotifFDialog_ActivateFEnt $w
  759. }
  760. proc ::tk::MotifFDialog_CancelCmd {w} {
  761. variable ::tk::Priv
  762. set Priv(selectFilePath) ""
  763. set Priv(selectFile) ""
  764. set Priv(selectPath) ""
  765. }
  766. proc ::tk::ListBoxKeyAccel_Set {w} {
  767. bind Listbox <Any-KeyPress> ""
  768. bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w]
  769. bind $w <Any-KeyPress> [list tk::ListBoxKeyAccel_Key $w %A]
  770. }
  771. proc ::tk::ListBoxKeyAccel_Unset {w} {
  772. variable ::tk::Priv
  773. catch {after cancel $Priv(lbAccel,$w,afterId)}
  774. unset -nocomplain Priv(lbAccel,$w) Priv(lbAccel,$w,afterId)
  775. }
  776. # ::tk::ListBoxKeyAccel_Key--
  777. #
  778. # This procedure maintains a list of recently entered keystrokes
  779. # over a listbox widget. It arranges an idle event to move the
  780. # selection of the listbox to the entry that begins with the
  781. # keystrokes.
  782. #
  783. # Arguments:
  784. # w The pathname of the listbox.
  785. # key The key which the user just pressed.
  786. #
  787. # Results:
  788. # None.
  789. proc ::tk::ListBoxKeyAccel_Key {w key} {
  790. variable ::tk::Priv
  791. if { $key eq "" } {
  792. return
  793. }
  794. append Priv(lbAccel,$w) $key
  795. ListBoxKeyAccel_Goto $w $Priv(lbAccel,$w)
  796. catch {
  797. after cancel $Priv(lbAccel,$w,afterId)
  798. }
  799. set Priv(lbAccel,$w,afterId) [after 500 \
  800. [list tk::ListBoxKeyAccel_Reset $w]]
  801. }
  802. proc ::tk::ListBoxKeyAccel_Goto {w string} {
  803. variable ::tk::Priv
  804. set string [string tolower $string]
  805. set end [$w index end]
  806. set theIndex -1
  807. for {set i 0} {$i < $end} {incr i} {
  808. set item [string tolower [$w get $i]]
  809. if {[string compare $string $item] >= 0} {
  810. set theIndex $i
  811. }
  812. if {[string compare $string $item] <= 0} {
  813. set theIndex $i
  814. break
  815. }
  816. }
  817. if {$theIndex >= 0} {
  818. $w selection clear 0 end
  819. $w selection set $theIndex $theIndex
  820. $w activate $theIndex
  821. $w see $theIndex
  822. event generate $w <<ListboxSelect>>
  823. }
  824. }
  825. proc ::tk::ListBoxKeyAccel_Reset {w} {
  826. variable ::tk::Priv
  827. unset -nocomplain Priv(lbAccel,$w)
  828. }
  829. proc ::tk_getFileType {} {
  830. variable ::tk::Priv
  831. return $Priv(selectFileType)
  832. }