home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activepython / ActivePython-2.1.1.msi / Python21_tcl_tk8.3_choosedir.tcl < prev    next >
Encoding:
Text File  |  2001-07-26  |  8.1 KB  |  265 lines
  1. # choosedir.tcl --
  2. #
  3. #    Choose directory dialog implementation for Unix/Mac.
  4. #
  5. # Copyright (c) 1998-2000 by Scriptics Corporation.
  6. # All rights reserved.
  7. # 
  8. # RCS: @(#) $Id: choosedir.tcl,v 1.7 2000/04/19 23:12:56 hobbs Exp $
  9.  
  10. # Make sure the tk::dialog namespace, in which all dialogs should live, exists
  11. namespace eval ::tk::dialog {}
  12. namespace eval ::tk::dialog::file {}
  13.  
  14. # Make the chooseDir namespace inside the dialog namespace
  15. namespace eval ::tk::dialog::file::chooseDir {
  16. }
  17.  
  18. # ::tk::dialog::file::tkChooseDirectory --
  19. #
  20. #    Implements the TK directory selection dialog.
  21. #
  22. # Arguments:
  23. #    args        Options parsed by the procedure.
  24. #
  25. proc ::tk::dialog::file::chooseDir::tkChooseDirectory {args} {
  26.     global tkPriv
  27.     set dataName __tk_choosedir
  28.     upvar ::tk::dialog::file::$dataName data
  29.     ::tk::dialog::file::chooseDir::Config $dataName $args
  30.  
  31.     if {[string equal $data(-parent) .]} {
  32.         set w .$dataName
  33.     } else {
  34.         set w $data(-parent).$dataName
  35.     }
  36.  
  37.     # (re)create the dialog box if necessary
  38.     #
  39.     if {![winfo exists $w]} {
  40.     ::tk::dialog::file::Create $w TkChooseDir
  41.     } elseif {[string compare [winfo class $w] TkChooseDir]} {
  42.     destroy $w
  43.     ::tk::dialog::file::Create $w TkChooseDir
  44.     } else {
  45.     set data(dirMenuBtn) $w.f1.menu
  46.     set data(dirMenu) $w.f1.menu.menu
  47.     set data(upBtn) $w.f1.up
  48.     set data(icons) $w.icons
  49.     set data(ent) $w.f2.ent
  50.     set data(okBtn) $w.f2.ok
  51.     set data(cancelBtn) $w.f3.cancel
  52.     }
  53.     wm transient $w $data(-parent)
  54.  
  55.     trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
  56.     $data(dirMenuBtn) configure \
  57.         -textvariable ::tk::dialog::file::${dataName}(selectPath)
  58.  
  59.     set data(filter) "*"
  60.     set data(previousEntryText) ""
  61.     ::tk::dialog::file::UpdateWhenIdle $w
  62.  
  63.     # Withdraw the window, then update all the geometry information
  64.     # so we know how big it wants to be, then center the window in the
  65.     # display and de-iconify it.
  66.  
  67.     ::tk::PlaceWindow $w widget $data(-parent)
  68.     wm title $w $data(-title)
  69.  
  70.     # Set a grab and claim the focus too.
  71.  
  72.     ::tk::SetFocusGrab $w $data(ent)
  73.     $data(ent) delete 0 end
  74.     $data(ent) insert 0 $data(selectPath)
  75.     $data(ent) selection range 0 end
  76.     $data(ent) icursor end
  77.  
  78.     # Wait for the user to respond, then restore the focus and
  79.     # return the index of the selected button.  Restore the focus
  80.     # before deleting the window, since otherwise the window manager
  81.     # may take the focus away so we can't redirect it.  Finally,
  82.     # restore any grab that was in effect.
  83.  
  84.     tkwait variable tkPriv(selectFilePath)
  85.  
  86.     ::tk::RestoreFocusGrab $w $data(ent) withdraw
  87.  
  88.     # Cleanup traces on selectPath variable
  89.     #
  90.  
  91.     foreach trace [trace vinfo data(selectPath)] {
  92.     trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
  93.     }
  94.     $data(dirMenuBtn) configure -textvariable {}
  95.  
  96.     # Return value to user
  97.     #
  98.     
  99.     return $tkPriv(selectFilePath)
  100. }
  101.  
  102. # ::tk::dialog::file::chooseDir::Config --
  103. #
  104. #    Configures the Tk choosedir dialog according to the argument list
  105. #
  106. proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
  107.     upvar ::tk::dialog::file::$dataName data
  108.  
  109.     # 0: Delete all variable that were set on data(selectPath) the
  110.     # last time the file dialog is used. The traces may cause troubles
  111.     # if the dialog is now used with a different -parent option.
  112.     #
  113.     foreach trace [trace vinfo data(selectPath)] {
  114.     trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
  115.     }
  116.  
  117.     # 1: the configuration specs
  118.     #
  119.     set specs {
  120.     {-mustexist "" "" 0}
  121.     {-initialdir "" "" ""}
  122.     {-parent "" "" "."}
  123.     {-title "" "" ""}
  124.     }
  125.  
  126.     # 2: default values depending on the type of the dialog
  127.     #
  128.     if {![info exists data(selectPath)]} {
  129.     # first time the dialog has been popped up
  130.     set data(selectPath) [pwd]
  131.     }
  132.  
  133.     # 3: parse the arguments
  134.     #
  135.     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  136.  
  137.     if {$data(-title) == ""} {
  138.     set data(-title) "Choose Directory"
  139.     }
  140.  
  141.     # 4: set the default directory and selection according to the -initial
  142.     #    settings
  143.     #
  144.     if {$data(-initialdir) != ""} {
  145.     # Ensure that initialdir is an absolute path name.
  146.     if {[file isdirectory $data(-initialdir)]} {
  147.         set old [pwd]
  148.         cd $data(-initialdir)
  149.         set data(selectPath) [pwd]
  150.         cd $old
  151.     } else {
  152.         set data(selectPath) [pwd]
  153.     }
  154.     }
  155.  
  156.     if {![winfo exists $data(-parent)]} {
  157.     error "bad window path name \"$data(-parent)\""
  158.     }
  159. }
  160.  
  161. # Gets called when user presses Return in the "Selection" entry or presses OK.
  162. #
  163. proc ::tk::dialog::file::chooseDir::OkCmd {w} {
  164.     upvar ::tk::dialog::file::[winfo name $w] data
  165.  
  166.     # This is the brains behind selecting non-existant directories.  Here's
  167.     # the flowchart:
  168.     # 1.  If the icon list has a selection, join it with the current dir,
  169.     #     and return that value.
  170.     # 1a.  If the icon list does not have a selection ...
  171.     # 2.  If the entry is empty, do nothing.
  172.     # 3.  If the entry contains an invalid directory, then...
  173.     # 3a.   If the value is the same as last time through here, end dialog.
  174.     # 3b.   If the value is different than last time, save it and return.
  175.     # 4.  If entry contains a valid directory, then...
  176.     # 4a.   If the value is the same as the current directory, end dialog.
  177.     # 4b.   If the value is different from the current directory, change to
  178.     #       that directory.
  179.  
  180.     set iconText [tkIconList_Get $data(icons)]
  181.     if { ![string equal $iconText ""] } {
  182.     set iconText [file join $data(selectPath) $iconText]
  183.     ::tk::dialog::file::chooseDir::Done $w $iconText
  184.     } else {
  185.     set text [$data(ent) get]
  186.     if { [string equal $text ""] } {
  187.         return
  188.     }
  189.     set text [eval file join [file split [string trim $text]]]
  190.     if { ![file exists $text] || ![file isdirectory $text] } {
  191.         # Entry contains an invalid directory.  If it's the same as the
  192.         # last time they came through here, reset the saved value and end
  193.         # the dialog.  Otherwise, save the value (so we can do this test
  194.         # next time).
  195.         if { [string equal $text $data(previousEntryText)] } {
  196.         set data(previousEntryText) ""
  197.         ::tk::dialog::file::chooseDir::Done $w $text
  198.         } else {
  199.         set data(previousEntryText) $text
  200.         }
  201.     } else {
  202.         # Entry contains a valid directory.  If it is the same as the
  203.         # current directory, end the dialog.  Otherwise, change to that
  204.         # directory.
  205.         if { [string equal $text $data(selectPath)] } {
  206.         ::tk::dialog::file::chooseDir::Done $w $text
  207.         } else {
  208.         set data(selectPath) $text
  209.         }
  210.     }
  211.     }
  212.     return
  213. }
  214.  
  215. proc ::tk::dialog::file::chooseDir::DblClick {w} {
  216.     upvar ::tk::dialog::file::[winfo name $w] data
  217.     set text [tkIconList_Get $data(icons)]
  218.     if {[string compare $text ""]} {
  219.     set file $data(selectPath)
  220.     if {[file isdirectory $file]} {
  221.         ::tk::dialog::file::ListInvoke $w $text
  222.         return
  223.     }
  224.     }
  225. }    
  226.  
  227. # Gets called when user browses the IconList widget (dragging mouse, arrow
  228. # keys, etc)
  229. #
  230. proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
  231.     upvar ::tk::dialog::file::[winfo name $w] data
  232.  
  233.     if {[string equal $text ""]} {
  234.     return
  235.     }
  236.  
  237.     set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
  238.     $data(ent) delete 0 end
  239.     $data(ent) insert 0 $file
  240. }
  241.  
  242. # ::tk::dialog::file::chooseDir::Done --
  243. #
  244. #    Gets called when user has input a valid filename.  Pops up a
  245. #    dialog box to confirm selection when necessary. Sets the
  246. #    tkPriv(selectFilePath) variable, which will break the "tkwait"
  247. #    loop in tk_chooseDirectory and return the selected filename to the
  248. #    script that calls tk_getOpenFile or tk_getSaveFile
  249. #
  250. proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {
  251.     upvar ::tk::dialog::file::[winfo name $w] data
  252.     global tkPriv
  253.  
  254.     if {[string equal $selectFilePath ""]} {
  255.     set selectFilePath $data(selectPath)
  256.     }
  257.     if { $data(-mustexist) } {
  258.     if { ![file exists $selectFilePath] || \
  259.         ![file isdir $selectFilePath] } {
  260.         return
  261.     }
  262.     }
  263.     set tkPriv(selectFilePath) $selectFilePath
  264. }
  265.