arcadia 0.12.2 → 0.13.0

data/tcl/tkfbox/tkfbox.tcl~

@@ -0,0 +1 @@
+# tkfbox.tcl --
    return [mtkFDialog open $args]
  
    return [mtkFDialog save $args]
    global tkPriv data
    
    if [info exists data] {unset data}
    create-file-dialog
    mtkFDialog_Config $type $argList
    mtkFDialog_SetPath $data(selectPath)
    # 6. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.
    wm withdraw .tkfd
    update idletasks
    set x [expr [winfo screenwidth .tkfd]/2 - [winfo reqwidth .tkfd]/2 \
    set y [expr [winfo screenheight .tkfd]/2 - [winfo reqheight .tkfd]/2 \
    wm geom .tkfd [winfo reqwidth .tkfd]x[winfo reqheight .tkfd]+$x+$y
    wm deiconify .tkfd
    wm title .tkfd $data(-title)
    # 7. Set a grab and claim the focus too.
    set oldFocus [focus]
    set oldGrab [grab current .tkfd]
    if {$oldGrab != ""} {
    }
    #Mick: changed to grab global
    grab  .tkfd
    wm transient .tkfd .
    focus .tkfd.f2.ent
    .tkfd.f2.ent delete 0 end
    .tkfd.f2.ent insert 0 $data(selectFile)
    .tkfd.f2.ent select from 0
    .tkfd.f2.ent select to   end
    .tkfd.f2.ent icursor end
   # Ensure the window is fronted
   raise .tkfd
    
    # 8. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.
    tkwait variable tkPriv(selectFilePath)
    catch {focus $oldFocus}
    grab release .tkfd
    wm withdraw .tkfd
    if {$oldGrab != ""} {
    }
    update
    return $tkPriv(selectFilePath)
    global LIBRARY data tkPriv
    if [winfo exists .tkfd] {destroy .tkfd}
    toplevel .tkfd  -class mtkFDialog
    wm protocol .tkfd WM_DELETE_WINDOW "mtkFDialog_CancelCmd"
    # f1: the frame with the directory option menu
    #
    set f1 [frame .tkfd.f1]
    label .tkfd.f1.lab -text "Directory:" -under 0
    tk_optionMenu .tkfd.f1.menu data(selectPath) ""
    .tkfd.f1.menu config -takefocus 1 -highlightthickness 2
    button .tkfd.f1.up -bitmap @[file join $LIBRARY updir.xbm]
 
    pack .tkfd.f1.up -side right -padx 4 -fill both
    pack .tkfd.f1.lab -side left -padx 4 -fill both
    pack .tkfd.f1.menu -expand yes -fill both -padx 4
    # .tkfd.icons: the IconList that list the files and directories.
    #
    tkIconList .tkfd.icons\
    # f2: the frame with the OK button and the "file name" field
    #
    frame .tkfd.f2
    label .tkfd.f2.lab -text "File name:" -anchor e -width 14 -under 6
    entry .tkfd.f2.ent -bg white
    # f3: the frame with the cancel button and the file types field
    #
    frame .tkfd.f3
    label .tkfd.f3.lab -text "Files of type:" \
    menubutton .tkfd.f3.menu -indicatoron 1 -menu .tkfd.f3.menu.m
    menu .tkfd.f3.menu.m -tearoff 0
    .tkfd.f3.menu config -takefocus 1 -highlightthickness 2 \
    # the okBtn is created after the typeMenu so that the keyboard traversal
    # is in the right order
    button .tkfd.f2.ok     -text OK     -under 0 -width 6
    button .tkfd.f3.cancel -text Cancel -under 0 -width 6
    # pack the widgets in f2 and f3
    #
    pack .tkfd.f2.ok  -side right -padx 4 -anchor e
    pack .tkfd.f2.lab -side left -padx 4
    pack .tkfd.f2.ent -expand yes -fill both -padx 2 -pady 2
    
    pack .tkfd.f3.cancel -side right -padx 4 -anchor w
    pack .tkfd.f3.lab -side left -padx 4
    pack .tkfd.f3.menu -expand yes -fill x -side right
    # Pack all the frames together. We are done with widget construction.
    #
    pack .tkfd.f1 -side top -fill x -pady 4
    pack .tkfd.f3 -side bottom -fill x
    pack .tkfd.f2 -side bottom -fill x
    pack .tkfd.icons -expand yes -fill both -padx 4 -pady 2
    # Set up the event handlers
    #
    bind .tkfd.f2.ent <Return>  "mtkFDialog_ActivateEnt"
    
    .tkfd.f1.up     config -command "mtkFDialog_UpDirCmd"
    .tkfd.f2.ok     config -command "mtkFDialog_OkCmd"
    .tkfd.f3.cancel config -command "mtkFDialog_CancelCmd"
    bind .tkfd <Alt-d> "focus .tkfd.f1.menu"
    bind .tkfd <Alt-t> "focus .tkfd.f3.menu"
    bind .tkfd <Alt-n> "focus .tkfd.f2.ent"
    bind .tkfd <KeyPress-Escape> "tkButtonInvoke .tkfd.f3.cancel"
    bind .tkfd <Alt-o> "mtkFDialog_InvokeBtn Open"
    bind .tkfd <Alt-s> "mtkFDialog_InvokeBtn Save"
    # Build the focus group for all the entries
    #
    tkFocusGroup_Create .tkfd
    tkFocusGroup_BindIn .tkfd  .tkfd.f2.ent "mtkFDialog_EntFocusIn"
    tkFocusGroup_BindOut .tkfd .tkfd.f2.ent "mtkFDialog_EntFocusOut"
    # Create images for use in directory lists
    if ![info exists tkPriv(folderImage)] {
    }
    global data
    set data(type) $type
    
    # 1: the configuration specs
    #
    set specs {
    }
    
    # 3: parse the arguments
    #
    tclParseConfigSpec data $specs "" $argList
    
    if  {$data(-title) == ""} {
    }
    
    # Mick Changes: Sets the initialdir to the path of initialfile 
    #   if initialdir not set.
    # Always wipes the dir path of initialfile
    if { $data(-initialfile) != {} } {
    }
    
    # 4: set the default directory and selection according to the -initial
    #    settings
    #
    if { $data(-initialdir) == ""} {
    } else {
    }
    # 5. Parse the -filetypes option
    #
    set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]
    if {$data(-filetypes) == {}} {
    } else {
    }
    wm transient .tkfd $data(-parent)
    if ![winfo exists $data(-parent)] {
    }
    global data tcl_platform
    set data(selectPath) $path
    set appPWD [pwd]
    if {  $tcl_platform(platform) == "windows" && $data(selectPath) == "My Computer"} {
          mtkFDialog_Update
          my-cd "$appPWD"
          return
         }
          mtkFDialog_Update
          my-cd "$appPWD"
          return
         }
   
    
    if [catch "my-cd \"$data(selectPath)\""] {
    }
    # Update the Directory: option menu
    #
    set list ""
    # Mick: allow PCs to select other drives
    global tcl_platform
    switch -- $tcl_platform(platform) {
      "windows" {set list [list "My Computer"]}
      "macintosh" {set list [list "Desktop"]}
    }
    set dir ""
    foreach subdir [file split $data(selectPath)] {
    }
    .tkfd.f1.menu.menu delete 0 end
    foreach path $list {
    }
    # Restore the PWD to the application's PWD
    #
    my-cd "$appPWD"
    # Change the displayed directory
    mtkFDialog_Update
    global data tkPriv tcl_platform
    # If this is the Mac Desktop or PC "My Computer", just show the lists
     tkf_show-toplevel
          return
         }
          tkf_show-toplevel
          return
         }
    # if the flter isnt set yet, delay the update
    if {$data(-filetypes) != {}} {
    }
    
    set folder $tkPriv(folderImage)
    set file   $tkPriv(fileImage)
     # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
    # so the user may still click and cause havoc ...
    #
    set entCursor [.tkfd.f2.ent cget -cursor]
    set dlgCursor [.tkfd         cget -cursor]
    .tkfd.f2.ent config -cursor watch
    .tkfd         config -cursor watch
    update idletasks
    
    tkIconList_DeleteAll
    my-cd "$data(selectPath)"
    set globlist [lsort -dictionary [glob -nocomplain .* *]]
    delete globlist "."
    delete globlist ".."
    # Make the dir list
    #
    foreach f  $globlist {
    }
    # Make the file list
    #
    if { $data(filter)!= "*"} {
    }
    set top 0
    foreach f $globlist {
    }
    tkIconList_Arrange
    # turn off the busy cursor.
    #
    .tkfd.f2.ent config -cursor $entCursor
    .tkfd config -cursor $dlgCursor
    global data
    set data(filter) [lindex $type 1]
    .tkfd.f3.menu config -text [lindex $type 0] -indicatoron 1
    .tkfd.icons.sbar set 0.0 0.0
    # mick
    set oldfile [eval ".tkfd.f2.ent get"]
    if { $oldfile == {}} {set oldfile $data(selectFile)}
    set data(selectFile) [file rootname $oldfile][file extension [lindex $type 1]]
    .tkfd.f2.ent delete 0 end
    .tkfd.f2.ent insert 0 $data(selectFile)
    .tkfd.f2.ent select from 0
    .tkfd.f2.ent select to   end
    .tkfd.f2.ent icursor end
    mtkFDialog_Update
    set appPWD [pwd]
    set path [file join $context $text]
    if [catch {file exists $path}] {
    }
    if [file exists $path] {
    } else {
    }
    return [list $flag $directory $file]
    global data
    if { [.tkfd.f2.ent get] != ""} {
    } else {
    }
    tkIconList_Unselect
    if {$data(type) == "open"} {
    } else {
    }
    .tkfd.f2.ent selection clear
    global data
    set text [string trim [.tkfd.f2.ent get]]
    set list [mtkFDialogResolveFile $data(selectPath) $text]
    set flag [lindex $list 0]
    set path [lindex $list 1]
    set file [lindex $list 2]
    
    case $flag {
    }
    if ![string compare [.tkfd.f2.ok cget -text] $key] {
    }
    global data tcl_platform
    switch -- $tcl_platform(platform) {
               if { $data(selectPath) != "Desktop"} {
    }
    global data
    set text [tkIconList_Get]
    if { $text != ""} {
    }
    mtkFDialog_ActivateEnt
    global tkPriv
    set tkPriv(selectFilePath) ""
    global data
    if {$text == ""} {
    }
    set file [file join $data(selectPath) $text]
    if ![file isdirectory $file] {
    } else {
    }
    global data
    if {$text == ""} {
    }
    set file [file join $data(selectPath) $text]
    if [file isdirectory $file] {
    } else {
    }
    global data tkPriv
    if ![string compare $selectFilePath ""] {
    }
    set tkPriv(selectFilePath) $selectFilePath
    global data
    #	Configure the widget variables of IconList, according to the command
    #	line arguments.
    #
    # 1: the configuration specs
    #
    set specs {
    }
    
    # 2: parse the arguments
    #
    tclParseConfigSpec data $specs "" $args
    
    #	Creates an IconList widget by assembling a canvas widget and a
    #	scrollbar widget. Sets all the bindings necessary for the IconList's
    #	operations.
    
    frame $w
    scrollbar $w.sbar -orient horizontal -highlightthickness 0 -takefocus 0
    canvas $w.canvas -bd 2 -relief sunken -width 400 -height 120 -takefocus 1 -bg white
    pack $w.sbar -side bottom -fill x -padx 2
    pack $w.canvas -expand yes -fill both
    
    $w.sbar config -command "$w.canvas xview"
    $w.canvas config -xscrollcommand "$w.sbar set"
    # Initializes the max icon/text width and height and other variables
    #
    set data(maxIW) 1
    set data(maxIH) 1
    set data(maxTW) 1
    set data(maxTH) 1
    set data(numItems) 0
    set data(curItem)  {}
    set data(noScroll) 1
    # Creates the event bindings.
    #
    bind $w.canvas <Configure> "tkIconList_Arrange"
    bind $w.canvas <1>         "tkIconList_Btn1    %x %y"
    bind $w.canvas <B1-Motion> "tkIconList_Motion1 %x %y"
    bind $w.canvas <Double-1>  "tkIconList_Double1 %x %y"
    bind $w.canvas <ButtonRelease-1> "tkCancelRepeat"
    bind $w.canvas <B1-Leave>  "tkIconList_Leave1 %x %y"
    bind $w.canvas <B1-Enter>  "tkCancelRepeat"
    bind $w.canvas <Up>        "tkIconList_UpDown -1"
    bind $w.canvas <Down>      "tkIconList_UpDown 1"
    bind $w.canvas <Left>      "tkIconList_LeftRight -1"
    bind $w.canvas <Right>     "tkIconList_LeftRight  1"
    bind $w.canvas <Return>    "tkIconList_ReturnKey"
    bind $w.canvas <KeyPress>  "tkIconList_KeyPress %A"
    bind $w.canvas <Control-KeyPress> ";"
    bind $w.canvas <Alt-KeyPress>  ";"
    bind $w.canvas <FocusIn>   "tkIconList_FocusIn"
    return $w
    global tkPriv data
    set w .tkfd.icons
    if {![winfo exists $w]} return
    set x $tkPriv(x)
    set y $tkPriv(y)
    if $data(noScroll) {
    }
    if {$x >= [winfo width $w.canvas]} {
    } elseif {$x < 0} {
    } elseif {$y >= [winfo height $w.canvas]} {
    } elseif {$y < 0} {
    } else {
    }
    tkIconList_Motion1 $x $y
    set tkPriv(afterId) [after 50 tkIconList_AutoScan]
    global data itemList
    .tkfd.icons.canvas delete all
    catch {unset data(selected)}
    catch {unset data(rect)}
    catch {unset data(list)}
    catch {unset itemList}
    set data(numItems) 0
    set data(curItem)  {}
    global data itemList textList
    set w .tkfd.icons
    set iTag [$w.canvas create image 0 0 -image $image -anchor nw]
    set tTag [$w.canvas create text  0 0 -text  $text  -anchor nw]
    set rTag [$w.canvas create rect  0 0 0 0 -fill "" -outline ""]
    
    set b [$w.canvas bbox $iTag]
    set iW [expr [lindex $b 2]-[lindex $b 0]]
    set iH [expr [lindex $b 3]-[lindex $b 1]]
    if {$data(maxIW) < $iW} {
    }
    if {$data(maxIH) < $iH} {
    }
    
    set b [$w.canvas bbox $tTag]
    set tW [expr [lindex $b 2]-[lindex $b 0]]
    set tH [expr [lindex $b 3]-[lindex $b 1]]
    if {$data(maxTW) < $tW} {
    }
    if {$data(maxTH) < $tH} {
    }
    
    lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW $tH $data(numItems)]
    set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
    set textList($data(numItems)) [string tolower $text]
    incr data(numItems)
    global data
    set w .tkfd.icons
    if ![info exists data(list)] {
    }
    set W [winfo width  $w.canvas]
    set H [winfo height $w.canvas]
    set pad [expr [$w.canvas cget -highlightthickness] + \
    incr W -[expr $pad*2]
    incr H -[expr $pad*2]
    set dx [expr $data(maxIW) + $data(maxTW) + 4]
    if {$data(maxTH) > $data(maxIH)} {
    } else {
    }
    set shift [expr $data(maxIW) + 4]
    set x [expr $pad * 2]
    set y [expr $pad * 1]
    set usedColumn 0
    foreach pair $data(list) {
    }
    if {$usedColumn} {
    } else {
    }
    if {$sW < $W} {
    } else {
    }
    set data(itemsPerColumn) [expr ($H-$pad)/$dy]
    if {$data(itemsPerColumn) < 1} {
    }
    if {$data(curItem) != {}} {
    }
    global data
    set w .tkfd.icons
    if {$data(-command) != "" && [info exists data(selected)]} {
    }
    global data itemList
    set w .tkfd.icons
    if $data(noScroll) {
    }
    set sRegion [$w.canvas cget -scrollregion]
    if ![string compare $sRegion {}] {
    }
    if ![info exists itemList($rTag)] {
    }
    set bbox [$w.canvas bbox $rTag]
    set pad [expr [$w.canvas cget -highlightthickness] + \
    set x1 [lindex $bbox 0]
    set x2 [lindex $bbox 2]
    incr x1 -[expr $pad * 2]
    incr x2 -[expr $pad * 1]
    set cW [expr [winfo width $w.canvas] - $pad*2]
    set scrollW [expr [lindex $sRegion 2]-[lindex $sRegion 0]+1]
    set dispX [expr int([lindex [$w.canvas xview] 0]*$scrollW)]
    set oldDispX $dispX
    # check if out of the right edge
    #
    if {[expr $x2 - $dispX] >= $cW} {
    }
    # check if out of the left edge
    #
    if {[expr $x1 - $dispX] < 0} {
    }
    if {$oldDispX != $dispX} {
    }
    global data
    set w .tkfd.icons
    tkIconList_Select [$w.canvas find closest \
    global data itemList
    set w .tkfd.icons
    if ![info exists itemList($rTag)] {
    }
    set iTag   [lindex $itemList($rTag) 0]
    set tTag   [lindex $itemList($rTag) 1]
    set text   [lindex $itemList($rTag) 2]
    set serial [lindex $itemList($rTag) 3]
    if ![info exists data(rect)] {
        set data(rect) [$w.canvas create rect 0 0 0 0 \
    }
    $w.canvas lower $data(rect)
    set bbox [$w.canvas bbox $tTag]
    eval $w.canvas coords $data(rect) $bbox
    set data(curItem) $serial
    set data(selected) $text
    
    if {$callBrowse} {
    }
    global data
    set w .tkfd.icons
    if [info exists data(rect)] {
    }
    if [info exists data(selected)] {
    }
    set data(curItem)  {}
    global data
    set w .tkfd.icons
    if [info exists data(selected)] {
    } else {
    }
    global data
    focus .tkfd.icons.canvas
    tkIconList_SelectAtXY  $x $y
    global tkPriv
    set tkPriv(x) $x
    set tkPriv(y) $y
    tkIconList_SelectAtXY $x $y
    global data
    if {$data(curItem) != {}} {
    }
    tkIconList_Invoke
    global tkPriv
    set tkPriv(x) $x
    set tkPriv(y) $y
    tkIconList_AutoScan
    global data
    if ![info exists data(list)] {
    }
    if {$data(curItem) == {}} {
    }
    global data
    if ![info exists data(list)] {
    }
    if {$data(curItem) == {}} {
    } else {
    }
    if [string compare $rTag ""] {
    }
    global data
    if ![info exists data(list)] {
    }
    if {$data(curItem) == {}} {
    } else {
    }
    if [string compare $rTag ""] {
    }
    global tkPriv
    set w .tkfd.icons
    append tkPriv(ILAccel,$w) $key
    tkIconList_Goto $tkPriv(ILAccel,$w)
    catch {
    }
    set tkPriv(ILAccel,$w,afterId) [after 500 tkIconList_Reset]
    global data textList tkPriv
    
    if ![info exists data(list)] {
    }
    if {[string length $text] == 0} {
    }
    if {$data(curItem) == {} || $data(curItem) == 0} {
    } else {
    }
    set text [string tolower $text]
    set theIndex -1
    set less 0
    set len [string length $text]
    set len0 [expr $len-1]
    set i $start
    # Search forward until we find a filename whose prefix is an exact match
    # with $text
    while 1 {
    }
    if {$theIndex > -1} {
    }
    global tkPriv
    set w .tkfd.icons
    catch {unset tkPriv(ILAccel,$w)}
    global data
    mtkFDialog_SetPath $data(selectDrive)
    global data tkPriv tcl_platform
    # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
    # so the user may still click and cause havoc ...
    #
    set entCursor [.tkfd.f2.ent cget -cursor]
    set dlgCursor [.tkfd cget -cursor]
    .tkfd.f2.ent config -cursor watch
    .tkfd         config -cursor watch
    update idletasks
    
    tkIconList_DeleteAll
    # Make the dir list
    #
    foreach drv [file volume] {
    }
    tkIconList_Arrange 
    # Update the Directory: option menu
    #
    .tkfd.f1.menu.menu delete 0 end
    set var data(selectPath)
    switch -- $tcl_platform(platform) {
      windows {set label "My Computer"}
      macintosh {set label "Desktop"}
   }
  
    .tkfd.f1.menu.menu add command -label $label -command [list set $var  $label]
    # turn off the busy cursor.
    .tkfd.f2.ent config -cursor $entCursor
    .tkfd         config -cursor $dlgCursor
    global tcl_platform
    
    if {[lindex $path 1] != ""} {
    }
    if  { $tcl_platform(platform) == "macintosh" && $path == "Desktop" } {return}
    
    cd "$path"
    global mtkfCURRDIR
    if ![info exists mtkfCURRDIR] {set mtkfCURRDIR [pwd]}
    return $mtkfCURRDIR
   set oldgrab [grab current]
   if { $oldgrab != {}} {grab release $oldgrab}
   if {$parent != {}} {
   } else { 
   }
   if { $oldgrab != {}} {grab -global $oldgrab}
    upvar $var list
    set ix [lsearch -exact $list $value]
   
    if {$ix >= 0} {
    } 
    return $list