DirDlg.tcl 2.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: DirDlg.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
  4. #
  5. # DirDlg.tcl --
  6. #
  7. # Implements the Directory Selection Dialog widget.
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15. tixWidgetClass tixDirSelectDialog {
  16. -classname TixDirSelectDialog
  17. -superclass tixDialogShell
  18. -method {}
  19. -flag {
  20. -command
  21. }
  22. -configspec {
  23. {-command command Command ""}
  24. {-title title Title "Select A Directory"}
  25. }
  26. -default {
  27. {*ok.text "OK"}
  28. {*ok.underline 0}
  29. {*ok.width 6}
  30. {*cancel.text "Cancel"}
  31. {*cancel.underline 0}
  32. {*cancel.width 6}
  33. {*dirbox.borderWidth 1}
  34. {*dirbox.relief raised}
  35. }
  36. }
  37. proc tixDirSelectDialog:ConstructWidget {w} {
  38. upvar #0 $w data
  39. tixChainMethod $w ConstructWidget
  40. # the buttons
  41. frame $w.f -relief raised -bd 1
  42. set data(w:ok) [button $w.f.ok -command \
  43. "tixDirSelectDialog:OK $w"]
  44. set data(w:cancel) [button $w.f.cancel -command \
  45. "tixDirSelectDialog:Cancel $w"]
  46. pack $data(w:ok) $data(w:cancel) -side left -expand yes -padx 10 -pady 8
  47. pack $w.f -side bottom -fill x
  48. # the dir select box
  49. set data(w:dirbox) [tixDirSelectBox $w.dirbox \
  50. -command [list tixDirSelectDialog:DirBoxCmd $w]]
  51. pack $data(w:dirbox) -expand yes -fill both
  52. }
  53. proc tixDirSelectDialog:SetBindings {w} {
  54. upvar #0 $w data
  55. tixChainMethod $w SetBindings
  56. bind $w <Alt-Key-d> "focus [$data(w:dirbox) subwidget dircbx]"
  57. }
  58. proc tixDirSelectDialog:OK {w} {
  59. upvar #0 $w data
  60. wm withdraw $w
  61. $data(w:dirbox) subwidget dircbx invoke
  62. }
  63. proc tixDirSelectDialog:DirBoxCmd {w args} {
  64. upvar #0 $w data
  65. set value [tixEvent flag V]
  66. wm withdraw $w
  67. tixDirSelectDialog:CallCmd $w $value
  68. }
  69. proc tixDirSelectDialog:CallCmd {w value} {
  70. upvar #0 $w data
  71. if {$data(-command) != ""} {
  72. set bind(specs) "%V"
  73. set bind(%V) $value
  74. tixEvalCmdBinding $w $data(-command) bind $value
  75. }
  76. }
  77. proc tixDirSelectDialog:Cancel {w} {
  78. wm withdraw $w
  79. }