arcadia 0.11.1.4 → 0.12.0

data/tcl/{bwidget-1.9.5 → bwidget-1.9.6}/listbox.tcl

@@ -1,7 +1,7 @@
 # ----------------------------------------------------------------------------
 #  listbox.tcl
 #  This file is part of Unifix BWidget Toolkit
-#  $Id: listbox.tcl,v 1.29.2.6 2011/06/23 09:17:19 oehhar Exp $
+#  $Id: listbox.tcl,v 1.29.2.7 2012/04/12 12:46:47 oehhar Exp $
 # ----------------------------------------------------------------------------
 #  Index of commands:
 #     - ListBox::create
@@ -568,6 +568,7 @@ proc ListBox::selection { path cmd args } {
     variable $path
     upvar 0  $path data
 
+    set oldsel $data(selitems);
     switch -- $cmd {
         set {
             set data(selitems) {}
@@ -608,8 +609,10 @@ proc ListBox::selection { path cmd args } {
             return
         }
     }
-
-    _redraw_idle $path 1
+    if {[string compare $oldsel $data(selitems)]} {
+        _redraw_idle $path 1
+    }
+    return;
 }
 
 

data/tcl/{bwidget-1.9.5 → bwidget-1.9.6}/pkgIndex.tcl

@@ -1,7 +1,7 @@
 if {[catch {package require Tcl}]} return
-package ifneeded BWidget 1.9.5 "\
+package ifneeded BWidget 1.9.6 "\
     package require Tk 8.1.1;\
-    [list tclPkgSetup $dir BWidget 1.9.5 {
+    [list tclPkgSetup $dir BWidget 1.9.6 {
 {arrow.tcl source {ArrowButton ArrowButton::create ArrowButton::use}}
 {labelframe.tcl source {LabelFrame LabelFrame::create LabelFrame::use}}
 {labelentry.tcl source {LabelEntry LabelEntry::create LabelEntry::use}}

data/tcl/{bwidget-1.9.5 → bwidget-1.9.6}/widget.tcl

@@ -1,7 +1,7 @@
 # ----------------------------------------------------------------------------
 #  widget.tcl
 #  This file is part of Unifix BWidget Toolkit
-#  $Id: widget.tcl,v 1.35 2009/07/02 16:22:18 oehhar Exp $
+#  $Id: widget.tcl,v 1.35.2.1 2011/11/14 14:33:29 oehhar Exp $
 # ----------------------------------------------------------------------------
 #  Index of commands:
 #     - Widget::tkinclude
@@ -1435,7 +1435,7 @@ proc Widget::focusOK { w } {
 	} elseif {$value == 1} {
 	    return [winfo viewable $w]
 	} else {
-	    set value [uplevel \#0 $value $w]
+	    set value [uplevel \#0 [list $value $w]]
             if {$value != ""} {
 		return $value
 	    }

data/tcl/fsdialog/fsdialog.tcl

@@ -1,5 +1,5 @@
 # Copyright (C) Schelte Bron.  Freely redistributable.
-# Version 1.14 - 27 Jun 2009
+# Version 1.15 - 19 Aug 2012
 
 # File names containing <TAB> will mess up the layout. Tab char = \u2409
 
@@ -348,11 +348,13 @@ proc ::ttk::dialog::file::ChangeDir {w dir} {
     
     set data(history) [lrange $data(history) 0 $data(histpos)]
     set cwd [lindex $data(history) $data(histpos)]
-    set data(selectPath) [file normalize [file join $cwd $dir]]
+    set data(selectPath) [file normalize [JoinFile $cwd $dir]]
     lappend data(history) $data(selectPath)
     if {[incr data(histpos)]} {
 	$data(prevBtn) state !disabled
-	set data(selectFile) ""
+	if {$data(type) ne "save"} {
+	    set data(selectFile) ""
+	}
     }
     $data(nextBtn) state disabled
     
@@ -440,7 +442,7 @@ proc ::ttk::dialog::file::Update {w} {
     foreach f [eval [linsert $filter 0 glob -nocomplain -tails \
       -directory $cwd -type {f l c b p}]] {
 	# Links can still be directories. Skip those.
-	if {[file isdirectory [file join $cwd $f]]} continue
+	if {[file isdirectory [JoinFile $cwd $f]]} continue
 	lappend flist [list $f file]
     }
     
@@ -520,7 +522,7 @@ proc ::ttk::dialog::file::FileList1 {w} {
     foreach f $data(list) {
 	lassign $f name type size date mode uid gid
 	if {![info exists users($uid)] || ![info exists groups($gid)]} {
-	    set fname [file join $cwd $name]
+	    set fname [JoinFile $cwd $name]
 	    # May fail for dead links
 	    if {![catch {array set attr [file attributes $fname]}]} {
 		if {[info exists attr(-owner)]} {
@@ -670,10 +672,10 @@ proc ::ttk::dialog::file::sort {w list} {
     foreach f $list {
 	set file [lindex $f 0]
 	# Use lstat in case the destination doesn't exists
-	file lstat [file join $cwd $file] stat
+	file lstat [JoinFile $cwd $file] stat
 	if {$stat(type) eq "link"} {
 	    # This may fail if the link points to nothing
-	    if {![catch {file stat [file join $cwd $file] dest}]} {
+	    if {![catch {file stat [JoinFile $cwd $file] dest}]} {
 		array set stat [array get dest]
 		if {$stat(type) eq "file"} {
 		    set stat(type) link
@@ -809,6 +811,17 @@ proc ::ttk::dialog::file::maxfont {family max} {
     return [list $family $size]
 }
 
+# Join a file name to a path name. The "file join" command will break
+# if the filename begins with ~
+#
+proc ::ttk::dialog::file::JoinFile {path file} {
+    if {[string match {~*} $file] && [file exists $path/$file]} {
+	return [file join $path ./$file]
+    } else {
+	return [file join $path $file]
+    }
+}
+
 proc ::ttk::dialog::file::UpDirCmd {w} {
     set dataName [winfo name $w]
     upvar ::ttk::dialog::file::$dataName data
@@ -851,14 +864,18 @@ proc ::ttk::dialog::file::HomeDirCmd {w} {
 proc ::ttk::dialog::file::NewDirCmd {win} {
     set dataName [winfo name $win]
     upvar ::ttk::dialog::file::$dataName data
-    
-    set dir [lindex $data(history) $data(histpos)]
-    
+
+    if {[info exists data(history)]} {
+	set dir [lindex $data(history) $data(histpos)]
+    } else {
+	set dir $data(selectPath)
+    }
+
     toplevel $win.new
     wm title $win.new [mc "New Folder"]
     set w [ttk::frame $win.new.f]
     pack $w -expand 1 -fill both
-    
+
     ttk::label $w.prompt -anchor w -justify left \
       -text [mc "Create new folder in"]:\n$dir
     ttk::entry $w.box -width 36 -validate all \
@@ -900,15 +917,22 @@ proc ::ttk::dialog::file::NewDirVCmd {w str} {
 
 proc ::ttk::dialog::file::NewDirExit {w {save 0}} {
     upvar ::ttk::dialog::file::[winfo name $w] data
-    
+
     if {$save} {
-	set dir [lindex $data(history) $data(histpos)]
+	if {[info exists data(history)]} {
+	    set dir [lindex $data(history) $data(histpos)]
+	} else {
+	    set dir $data(selectPath)
+	}
+
 	set newdir [file join $dir [$w.new.f.box get]]
 	if {[catch {file mkdir $newdir} err]} {
 	    tk_messageBox -type ok -parent $w.new -icon error -message "$err"
 	    return
-	} else {
+	} elseif {[winfo class $w] eq "TkFDialog"} {
 	    ChangeDir $w $newdir
+	} else {
+	    treeUpdate $w $newdir
 	}
     }
     destroy $w.new
@@ -936,10 +960,10 @@ proc ::ttk::dialog::file::Done {w} {
 	    if {[file extension $file] eq ""} {
 		append file $data(-defaultextension)
 	    }
-	    lappend path [file join $cwd $file]
+	    lappend path [JoinFile $cwd $file]
 	}
     } else {
-	set file [file join $cwd $data(selectFile)]
+	set file [JoinFile $cwd $data(selectFile)]
 	if {[file extension $file] eq ""} {
 	    append file $data(-defaultextension)
 	}
@@ -1257,7 +1281,10 @@ proc ::ttk::dialog::file::tkFDialog {type args} {
     wm title $w $data(-title)
     
     ::tk::SetFocusGrab $w $data(location)
-    
+
+    # Make sure the application doesn't hang if the toplevel is destroyed
+    bind $w <Destroy> {set ::ttk::dialog::file::selectFilePath -1}
+
     set data(active) $w
     tkwait variable ::ttk::dialog::file::selectFilePath
     unset data(active)
@@ -1329,7 +1356,7 @@ proc ::ttk::dialog::file::Config {dataName type argList} {
 	set dir [file normalize [file join [pwd] $data(-initialdir)]]
 	set path $dir
 	while {[file exists $path] && [file type $path] eq "link"} {
-	    set path [file normalize [file join \
+	    set path [file normalize [JoinFile \
 	      [file dirname $path] [file link $path]]]
 	}
 	if {[file isdirectory $path]} {
@@ -1403,12 +1430,14 @@ proc ::ttk::dialog::file::treeCreate {w} {
     pack $f2.f -fill both -expand 1 -padx 8 -pady 4
     
     set f3 [ttk::frame $w.f3]
+    ttk::button $f3.new -text [mc "New Folder"]... \
+      -command [list ::ttk::dialog::file::NewDirCmd $w]
     ttk::button $f3.ok -text [mc OK] -default active \
       -command [list ::ttk::dialog::file::TreeDone $w]
     ttk::button $f3.cancel -text [mc Cancel] \
       -command [list ::ttk::dialog::file::Cancel $w]
-    grid x $f3.ok $f3.cancel -sticky ew -padx {4 8} -pady 8
-    grid columnconfigure $f3 {1 2} -uniform buttons -minsize 80
+    grid x $f3.new $f3.ok $f3.cancel -sticky ew -padx {4 8} -pady 8
+    # grid columnconfigure $f3 {2 3} -uniform buttons -minsize 80
     grid columnconfigure $f3 0 -weight 1
     
     pack $f1 -side top -fill x
@@ -1439,8 +1468,10 @@ proc ::ttk::dialog::file::treeUpdate {w dir} {
     $txt mark set subdir end
     
     foreach d $list {
+	# File split may produce terms starting with "./", strip those
+	if {[string match {./*} $d]} {set d [string range $d 2 end]}
 	treeOpen $w $parent subdir $d
-	set parent [file join $parent $d]
+	set parent [JoinFile $parent $d]
     }
     $txt yview subdir-5l
     TreeSelect $w subdir
@@ -1492,7 +1523,7 @@ proc ::ttk::dialog::file::treeOpen {w path {index insert} {subdir .}} {
 	$txt insert insert "\n"
 	# Insert the line with the appropriate tags
 	$txt insert insert $tabs [list $path]
-	file stat [file join $path $d] stat
+	file stat [JoinFile $path $d] stat
 	if {$stat(nlink) != 2} {
 	    set img [$txt image create insert -name diropen \
 	      -image ::ttk::dialog::image::diropen -padx 3]
@@ -1589,7 +1620,7 @@ proc ::ttk::dialog::file::TreeSelect {w index} {
 	$data(text) tag add sel $index1-1c $index2+1c
 	set path [lsearch -inline [$data(text) tag names $index1] /*]
 	set dir [$data(text) get $index1+1c $index2]
-	set data(selectPath) [file join $path $dir]
+	set data(selectPath) [JoinFile $path $dir]
     }
 }
 
@@ -1609,10 +1640,10 @@ proc ::ttk::dialog::file::TreeRelease1 {w} {
 	$txt mark set selmark sel.first
 	switch -glob $name {
 	    *::diropen {
-		treeOpen $w [file join $path $dir] $index
+		treeOpen $w [JoinFile $path $dir] $index
 	    }
 	    *::dirclose {
-		treeClose $w [file join $path $dir]
+		treeClose $w [JoinFile $path $dir]
 	    }
 	}
 	$txt tag remove sel 1.0 end
@@ -1672,6 +1703,9 @@ proc ttk::chooseDirectory {args} {
     
     ::ttk::dialog::file::treeUpdate $w $data(-initialdir)
     
+    # Make sure the application doesn't hang if the toplevel is destroyed
+    bind $w <Destroy> {set ::ttk::dialog::file::selectFilePath -1}
+
     tkwait variable ::ttk::dialog::file::selectFilePath
     
     ::tk::RestoreFocusGrab $w $data(text) withdraw