home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tk8.4 / choosedir.tcl < prev    next >
Text File  |  2002-07-22  |  9KB  |  284 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. # RCS: @(#) $Id: choosedir.tcl,v 1.15 2002/07/22 21:25:39 mdejong Exp $
  8.  
  9. # Make sure the tk::dialog namespace, in which all dialogs should live, exists
  10. namespace eval ::tk::dialog {}
  11. namespace eval ::tk::dialog::file {}
  12.  
  13. # Make the chooseDir namespace inside the dialog namespace
  14. namespace eval ::tk::dialog::file::chooseDir {
  15.     namespace import ::tk::msgcat::*
  16. }
  17.  
  18. # ::tk::dialog::file::chooseDir:: --
  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:: {args} {
  26.     variable ::tk::Priv
  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.  
  54.     # Dialog boxes should be transient with respect to their parent,
  55.     # so that they will always stay on top of their parent window.  However,
  56.     # some window managers will create the window as withdrawn if the parent
  57.     # window is withdrawn or iconified.  Combined with the grab we put on the
  58.     # window, this can hang the entire application.  Therefore we only make
  59.     # the dialog transient if the parent is viewable.
  60.  
  61.     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
  62.     wm transient $w $data(-parent)
  63.     }
  64.  
  65.     trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
  66.     $data(dirMenuBtn) configure \
  67.         -textvariable ::tk::dialog::file::${dataName}(selectPath)
  68.  
  69.     set data(filter) "*"
  70.     set data(previousEntryText) ""
  71.     ::tk::dialog::file::UpdateWhenIdle $w
  72.  
  73.     # Withdraw the window, then update all the geometry information
  74.     # so we know how big it wants to be, then center the window in the
  75.     # display and de-iconify it.
  76.  
  77.     ::tk::PlaceWindow $w widget $data(-parent)
  78.     wm title $w $data(-title)
  79.  
  80.     # Set a grab and claim the focus too.
  81.  
  82.     ::tk::SetFocusGrab $w $data(ent)
  83.     $data(ent) delete 0 end
  84.     $data(ent) insert 0 $data(selectPath)
  85.     $data(ent) selection range 0 end
  86.     $data(ent) icursor end
  87.  
  88.     # Wait for the user to respond, then restore the focus and
  89.     # return the index of the selected button.  Restore the focus
  90.     # before deleting the window, since otherwise the window manager
  91.     # may take the focus away so we can't redirect it.  Finally,
  92.     # restore any grab that was in effect.
  93.  
  94.     vwait ::tk::Priv(selectFilePath)
  95.  
  96.     ::tk::RestoreFocusGrab $w $data(ent) withdraw
  97.  
  98.     # Cleanup traces on selectPath variable
  99.     #
  100.  
  101.     foreach trace [trace vinfo data(selectPath)] {
  102.     trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
  103.     }
  104.     $data(dirMenuBtn) configure -textvariable {}
  105.  
  106.     # Return value to user
  107.     #
  108.     
  109.     return $Priv(selectFilePath)
  110. }
  111.  
  112. # ::tk::dialog::file::chooseDir::Config --
  113. #
  114. #    Configures the Tk choosedir dialog according to the argument list
  115. #
  116. proc ::tk::dialog::file::chooseDir::Config {dataName argList} {
  117.     upvar ::tk::dialog::file::$dataName data
  118.  
  119.     # 0: Delete all variable that were set on data(selectPath) the
  120.     # last time the file dialog is used. The traces may cause troubles
  121.     # if the dialog is now used with a different -parent option.
  122.     #
  123.     foreach trace [trace vinfo data(selectPath)] {
  124.     trace vdelete data(selectPath) [lindex $trace 0] [lindex $trace 1]
  125.     }
  126.  
  127.     # 1: the configuration specs
  128.     #
  129.     set specs {
  130.     {-mustexist "" "" 0}
  131.     {-initialdir "" "" ""}
  132.     {-parent "" "" "."}
  133.     {-title "" "" ""}
  134.     }
  135.  
  136.     # 2: default values depending on the type of the dialog
  137.     #
  138.     if {![info exists data(selectPath)]} {
  139.     # first time the dialog has been popped up
  140.     set data(selectPath) [pwd]
  141.     }
  142.  
  143.     # 3: parse the arguments
  144.     #
  145.     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  146.  
  147.     if {$data(-title) == ""} {
  148.     set data(-title) "[mc "Choose Directory"]"
  149.     }
  150.     
  151.     # Stub out the -multiple value for the dialog; it doesn't make sense for
  152.     # choose directory dialogs, but we have to have something there because we
  153.     # share so much code with the file dialogs.
  154.     set data(-multiple) 0
  155.  
  156.     # 4: set the default directory and selection according to the -initial
  157.     #    settings
  158.     #
  159.     if {$data(-initialdir) != ""} {
  160.     # Ensure that initialdir is an absolute path name.
  161.     if {[file isdirectory $data(-initialdir)]} {
  162.         set old [pwd]
  163.         cd $data(-initialdir)
  164.         set data(selectPath) [pwd]
  165.         cd $old
  166.     } else {
  167.         set data(selectPath) [pwd]
  168.     }
  169.     }
  170.  
  171.     if {![winfo exists $data(-parent)]} {
  172.     error "bad window path name \"$data(-parent)\""
  173.     }
  174. }
  175.  
  176. # Gets called when user presses Return in the "Selection" entry or presses OK.
  177. #
  178. proc ::tk::dialog::file::chooseDir::OkCmd {w} {
  179.     upvar ::tk::dialog::file::[winfo name $w] data
  180.  
  181.     # This is the brains behind selecting non-existant directories.  Here's
  182.     # the flowchart:
  183.     # 1.  If the icon list has a selection, join it with the current dir,
  184.     #     and return that value.
  185.     # 1a.  If the icon list does not have a selection ...
  186.     # 2.  If the entry is empty, do nothing.
  187.     # 3.  If the entry contains an invalid directory, then...
  188.     # 3a.   If the value is the same as last time through here, end dialog.
  189.     # 3b.   If the value is different than last time, save it and return.
  190.     # 4.  If entry contains a valid directory, then...
  191.     # 4a.   If the value is the same as the current directory, end dialog.
  192.     # 4b.   If the value is different from the current directory, change to
  193.     #       that directory.
  194.  
  195.     set selection [tk::IconList_Curselection $data(icons)]
  196.     if { [llength $selection] != 0 } {
  197.     set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]]
  198.     set iconText [file join $data(selectPath) $iconText]
  199.     ::tk::dialog::file::chooseDir::Done $w $iconText
  200.     } else {
  201.     set text [$data(ent) get]
  202.     if { [string equal $text ""] } {
  203.         return
  204.     }
  205.     set text [eval file join [file split [string trim $text]]]
  206.     if { ![file exists $text] || ![file isdirectory $text] } {
  207.         # Entry contains an invalid directory.  If it's the same as the
  208.         # last time they came through here, reset the saved value and end
  209.         # the dialog.  Otherwise, save the value (so we can do this test
  210.         # next time).
  211.         if { [string equal $text $data(previousEntryText)] } {
  212.         set data(previousEntryText) ""
  213.         ::tk::dialog::file::chooseDir::Done $w $text
  214.         } else {
  215.         set data(previousEntryText) $text
  216.         }
  217.     } else {
  218.         # Entry contains a valid directory.  If it is the same as the
  219.         # current directory, end the dialog.  Otherwise, change to that
  220.         # directory.
  221.         if { [string equal $text $data(selectPath)] } {
  222.         ::tk::dialog::file::chooseDir::Done $w $text
  223.         } else {
  224.         set data(selectPath) $text
  225.         }
  226.     }
  227.     }
  228.     return
  229. }
  230.  
  231. proc ::tk::dialog::file::chooseDir::DblClick {w} {
  232.     upvar ::tk::dialog::file::[winfo name $w] data
  233.     set selection [tk::IconList_Curselection $data(icons)]
  234.     if { [llength $selection] != 0 } {
  235.     set filenameFragment \
  236.         [tk::IconList_Get $data(icons) [lindex $selection 0]]
  237.     set file $data(selectPath)
  238.     if {[file isdirectory $file]} {
  239.         ::tk::dialog::file::ListInvoke $w [list $filenameFragment]
  240.         return
  241.     }
  242.     }
  243. }    
  244.  
  245. # Gets called when user browses the IconList widget (dragging mouse, arrow
  246. # keys, etc)
  247. #
  248. proc ::tk::dialog::file::chooseDir::ListBrowse {w text} {
  249.     upvar ::tk::dialog::file::[winfo name $w] data
  250.  
  251.     if {[string equal $text ""]} {
  252.     return
  253.     }
  254.  
  255.     set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
  256.     $data(ent) delete 0 end
  257.     $data(ent) insert 0 $file
  258. }
  259.  
  260. # ::tk::dialog::file::chooseDir::Done --
  261. #
  262. #    Gets called when user has input a valid filename.  Pops up a
  263. #    dialog box to confirm selection when necessary. Sets the
  264. #    Priv(selectFilePath) variable, which will break the "vwait"
  265. #    loop in tk_chooseDirectory and return the selected filename to the
  266. #    script that calls tk_getOpenFile or tk_getSaveFile
  267. #
  268. proc ::tk::dialog::file::chooseDir::Done {w {selectFilePath ""}} {
  269.     upvar ::tk::dialog::file::[winfo name $w] data
  270.     variable ::tk::Priv
  271.  
  272.     if {[string equal $selectFilePath ""]} {
  273.     set selectFilePath $data(selectPath)
  274.     }
  275.     if { $data(-mustexist) } {
  276.     if { ![file exists $selectFilePath] || \
  277.         ![file isdir $selectFilePath] } {
  278.         return
  279.     }
  280.     }
  281.     set Priv(selectFilePath) $selectFilePath
  282. }
  283.