Changeset 2772 for trunk/gui

Timestamp:

Jan 25, 2012 7:53:36 PM (12 years ago)

Author:

mmc

Message:

Fixed the Rappture::filexfer::upload command to support ordinary file
uploads with the file name taken from the remote side. If the <id>
argument is @@dir, then the remote file is loaded into the given directory
dir. The name of the remote file comes from the new --provenance flag
for filexfer. If the help info for importfile/exportfile doesn't have
that flag, then this defaults to the old behavior and returns the contents
of the file without renaming it to the desired location.

File:

• trunk/gui/scripts/filexfer.tcl (modified) (6 diffs)

trunk/gui/scripts/filexfer.tcl

@@ -51 +51 @@
         }
         if {[file executable $path]} {
+            # the new filexfer has a --provenance arg for file names
+            set info [exec $path --help]
+            if {[regexp -- {--provenance} $info]} {
+                lappend path --provenance
+            }
             set commands($op) $path
         } else {
@@ -132 +137 @@
 # information.  If anything goes wrong, the same callback is used
 # to post errors near the widget that invoked this operation.
+#
+# The <id> is usually a Rappture path for the control that is being
+# uploaded into.  It is passed along to the <callback>, so that code
+# knows where to put the result.  If <id> is "@@<dir>", then the file
+# is uploaded into the specified directory <dir> using the name that
+# comes from the remote upload.
 # ----------------------------------------------------------------------
 proc Rappture::filexfer::upload {tool controlList callback} {
@@ -173 +184 @@
             set changed ""
             set errs ""
-            foreach file $job(output) {
+            foreach line [split $job(output) \n] {
+                # the new filexfer reports "file <= desktopName"
+                # the old one just reports "file"
+                set remote ""
+                if {![regexp {(.+) +<= +(.+)} $line match file remote]} {
+                    set file [string trim $line]
+                }
+
                 # load the uploaded for this control
                 set status [catch {
@@ -180 +198 @@
                     set info [read $fid]
                     close $fid
-                    file delete -force $file
+                    if {[string match @@* $file2path($file)]} {
+                        if {$remote ne "" && $remote ne "@CLIPBOARD"} {
+                            set dir [string range $file2path($file) 2 end]
+                            if {$dir eq ""} { set dir [pwd] }
+                            set newloc [file join $dir $remote]
+                            file rename -force -- $file $newloc
+                        }
+                    } else {
+                        file delete -force $file
+                    }
                 } result]
 
@@ -187 +214 @@
                 } else {
                     lappend changed $file2path($file)
-                    uplevel #0 [list $callback path $file2path($file) data $info]
+                    set cmd [list $callback path $file2path($file) local $file data $info]
+                    if {$remote ne ""} {
+                        lappend cmd remote $remote
+                    }
+                    uplevel #0 $cmd
                 }
             }
@@ -226 +257 @@
                     uplevel #0 [list $callback error "Error loading file [file tail $file]: $err"]
                 } else {
-                    uplevel #0 [list $callback path $path data $info]
+                    uplevel #0 [list $callback path $path data $info filename $file]
                 }
             }