xmfbox.tcl 25 KB

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