DirList.tcl 2.7 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091
  1. # -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: DirList.tcl,v 1.3 2001/12/09 05:31:07 idiscovery Exp $
  4. #
  5. # Tix Demostration Program
  6. #
  7. # This sample program is structured in such a way so that it can be
  8. # executed from the Tix demo program "widget": it must have a
  9. # procedure called "RunSample". It should also have the "if" statment
  10. # at the end of this file so that it can be run as a standalone
  11. # program using tixwish.
  12. # This file demonstrates the use of the tixDirList widget -- you can
  13. # use it for the user to select a directory. For example, an installation
  14. # program can use the tixDirList widget to ask the user to select the
  15. # installation directory for an application.
  16. #
  17. proc RunSample {w} {
  18. # Create the tixDirList and the tixLabelEntry widgets on the on the top
  19. # of the dialog box
  20. #
  21. frame $w.top -border 1 -relief raised
  22. # Create the DirList widget. By default it will show the current
  23. # directory (returned by [pwd])
  24. #
  25. #
  26. tixDirList $w.top.dir
  27. # When the user presses the ".." button, the selected directory
  28. # is "transferred" into the entry widget
  29. #
  30. button $w.top.btn -text " >> " -pady 0 \
  31. -command "dlist:copy_name $w.top.dir"
  32. # We use a LabelEntry to hold the installation directory. The user
  33. # can choose from the DirList widget, or he can type in the directory
  34. # manually
  35. #
  36. tixLabelEntry $w.top.ent -label "Installation Directory:" -labelside top \
  37. -options {
  38. entry.width 25
  39. entry.textVariable demo_dlist_dir
  40. label.anchor w
  41. }
  42. bind [$w.top.ent subwidget entry] <Return> "dlist:okcmd $w"
  43. uplevel #0 set demo_dlist_dir [list [pwd]]
  44. pack $w.top.dir -side left -expand yes -fill both -padx 4 -pady 4
  45. pack $w.top.btn -side left -anchor s -padx 4 -pady 4
  46. pack $w.top.ent -side left -fill x -anchor s -padx 4 -pady 4
  47. # Use a ButtonBox to hold the buttons.
  48. #
  49. tixButtonBox $w.box -orientation horizontal
  50. $w.box add ok -text Ok -underline 0 -command "dlist:okcmd $w" \
  51. -width 6
  52. $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
  53. -width 6
  54. pack $w.box -side bottom -fill x
  55. pack $w.top -side top -fill both -expand yes
  56. }
  57. proc dlist:copy_name {w} {
  58. global demo_dlist_dir
  59. set demo_dlist_dir [$w cget -value]
  60. }
  61. proc dlist:okcmd {w} {
  62. global demo_dlist_dir
  63. tixDemo:Status "You have selected the directory $demo_dlist_dir"
  64. destroy $w
  65. }
  66. # This "if" statement makes it possible to run this script file inside or
  67. # outside of the main demo program "widget".
  68. #
  69. if {![info exists tix_demo_running]} {
  70. wm withdraw .
  71. set w .demo
  72. toplevel $w; wm transient $w ""
  73. RunSample $w
  74. bind $w <Destroy> "exit"
  75. }