Open Mash Cross Reference
mash/tcl/mb/ui-import.tcl

   # ui-import.tcl --
   #
   #       Handles UI for importing external objects like GIFs and PostScript
   #       MBImportTool is formerly known as ImportTool (from windows.tcl)
   #
   # Copyright (c) 1997-2002 The Regents of the University of California.
   # All rights reserved.
   #
   # Redistribution and use in source and binary forms, with or without
  # modification, are permitted provided that the following conditions are met:
  #
  # A. Redistributions of source code must retain the above copyright notice,
  #    this list of conditions and the following disclaimer.
  # B. Redistributions in binary form must reproduce the above copyright notice,
  #    this list of conditions and the following disclaimer in the documentation
  #    and/or other materials provided with the distribution.
  # C. Neither the names of the copyright holders nor the names of its
  #    contributors may be used to endorse or promote products derived from this
  #    software without specific prior written permission.
  #
  # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
  # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
  # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  #
  #   @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/mb/ui-import.tcl,v 1.24 2002/02/03 04:27:17 lim Exp $
  
  
  import MBTool Dialog ProgressBox Configuration
  
  Class MBImportTool -superclass MBTool -configuration {
          imageOffset {0 0}
  }
  
  MBImportTool instproc init {toolbar mgr sender} {
          $self next $toolbar $mgr $sender
          $self instvar filetypes_ fileNames_
          global tcl_platform
          if { $tcl_platform(platform) != "windows" } {
                  set filetypes_ {
                          { {Graphics Files}
                          { .GIF .gif .ps .PS .eps .EPS} }
                          { {GIF Files} {.gif .GIF} }
                          { {Postscript Files} {.ps .PS .eps .EPS} }
                  }
          } else {
                  set filetypes_ {
                          { {GIF Files} {.gif .GIF} }
                  }
          }
          set fileNames_ ""
          $self set lastdir_ [pwd]
  }
  
  #
  # Prompts to load image
  #
  MBImportTool instproc PromptForFile {canvas page_id} {
          $self instvar fileNames_ filetypes_ lastdir_
          set fileNames_ [Dialog transient Dialog/MBImport \
                                  -directory "$lastdir_" \
                                  -title {Select file to import} \
                                  -filetypes $filetypes_]
          if {$fileNames_!=""} {
                  set lastdir_ [file dirname [lindex $fileNames_ 0]]
                  #puts "lastdir_ set to $lastdir_"
                  return 0
          } else {
                  return -1
          }
  }
  
  MBImportTool instproc CreateFromFile {filename canvas pt1 pt2} {
          global tcl_platform
          $self instvar mgr_
  
          # REVIEW: use a more intelligent way to guess the file type?
          # for now, we use the extension to determine the file type
          set type [$self getType $filename]
          set sender [$mgr_ sender]
          if { [string compare $type gif] == 0} {
                  set lastImg_ [eval $sender create_item image \
                                  $pt1 [list $filename]]
          } elseif { ![string compare $type ps] || \
                          ![string compare $type eps] } {
                  if { $tcl_platform(platform) != "windows" } {
                          set lastImg_ [eval $sender create_item \
                                          pscript $pt1 $pt2 \
                                          -file $filename]
                  } else {
                          #puts stderr "Postcript files are not supported under windows"
                           Dialog transient MessageBox \
                                           -image Icons(warning) -type ok \
                                          -text "Postscript files are not supported under windows"
                         return -1
                 }
         } else {
                 DbgOut "Unknown format"
                 return -1
         }
         $self instvar mgr_ toolbar_
         $toolbar_ add_item [[$mgr_ page_manager] current_page] $lastImg_
 
         return 1
 }
 
 MBImportTool instproc getType { fileName } {
     # REVIEW: use a more intelligent way to guess the file type?
     # for now, we use the extension to determine the file type
     return [string tolower [lindex [split $fileName "."] end]]
 }
 
 MBImportTool instproc restore {} {
         set first_ ""
         set canv_mark_ ""
         set fileNames_ ""
 }
 
 # define the first corner for image types with fixed size, the
 # image is placed, otherwise it would be placed the second corner is defined
 #
 # this instproc assumes fileNames_ has only one item
 MBImportTool instproc defineFirst {canvas pt} {
         $self instvar first_ canv_mark_ fileNames_
 
         #puts stderr "defineFirst $fileNames_"
         if {$fileNames_==""} {
                 return
         }
 
         set w [$canvas get_win]
         # since we cannot resize gif (for now) insert the picture immediately
         if {[string compare [$self getType $fileNames_] "gif"] == 0} {
  puts "foo"
                 $self CreateFromFile $fileNames_ $canvas $pt $pt
  puts "af foo"
                 $self restore
                 return
         }
         # no postscript for now
         global tcl_platform
         if {$tcl_platform(platform)=="windows"} {
                 Dialog transient MessageBox -type ok \
                                 -text "postscript not supported for windows yet"
                 $self restore
                 return
         }
         # otherwise, by default allow the user to sketch the rectangle ($can_mark_)
         # to specify the bounding box.
         set first_ $pt
         set canv_mark_ [eval $canvas create rect $pt $pt]
         bind $w <B1-Motion> \
                     "$self stretch $canvas \[$canvas canvasxy %x %y\]"
         bind $w <ButtonRelease-1> \
                     "$self end $canvas \[$canvas canvasxy %x %y\]"
 }
 
 MBImportTool instproc stretch {canvas pt} {
         $self instvar first_ canv_mark_
         eval $canvas coord $canv_mark_ $first_ $pt
 }
 
 MBImportTool instproc end {canvas pt} {
         $self instvar first_ canv_mark_ fileNames_
         $self CreateFromFile [list $fileNames_] $canvas $first_ $pt
         $canvas delete $canv_mark_
 
         set w [$canvas get_win]
         # don't want further clicking to have any effect
         # user should click the image button for new images
         $self restore
 }
 
 MBImportTool instproc activate {page_id args} {
         puts "in $class activate $page_id <$args>"
         $self instvar first_ canv_mark_
         set first_ ""
         set canv_mark_ ""
 
         $self next page_id
         $self instvar lastImg_ mgr_
         set canv [[$mgr_ page_manager] page2canv $page_id]
         set w [$canv get_win]
 
         $canv resetBindings
         $canv config -cursor cross
 
         if {$args=={}} {
                 if {-1 == [$self PromptForFile $canv $page_id]} {
                         $self restore
                         return
                 }
         }
 
         $self instvar fileNames_
         set theRest [lrange $fileNames_ 1 end]
         set firstCorner [string trim [$self get_option imageOffset]]
         if {$firstCorner=="none"} {
                 set firstCorner [list 0.0 0.0]
         }
         set fileNames_ [lindex $fileNames_ 0]
 
         # put each of them on a new page with name equals slide name
         # fill up the full scrollregion
         if {$theRest != ""} {
                 set progbox [ProgressBox .mbimportprogress \
                                 -text "Importing Files ..." \
                                 -min 0 -max [expr [llength $theRest] + 1] \
                                 -value 0 ]
                 $progbox center
                 update idletasks
         }
         set i 0
         foreach path $theRest {
                 set pagename [file rootname [file tail $path]]
                 #FIXME: should be using pageMgr to create page...
                 $self instvar toolbar_
                 set menu [[$toolbar_ set mbui_] set menu_]
                 set pgid [$menu create_new_page $pagename]
                 eval [$mgr_ sender] -page $pgid \
                         create_item image $firstCorner [list $path]
                 incr i
                 $progbox configure -text "Importing $path"
                 $progbox configure -value $i
                 update idletasks
         }
         incr i
         # puts gifs at 0,0 by default
         if { ([$self getType $fileNames_]=="gif") && \
                         ("none"!=[string trim \
                         [$self get_option imageOffset]])} {
                 $self defineFirst $canv $firstCorner
                 if {$theRest!={}} {
                         $progbox configure -text "Importing $path"
                         $progbox configure -value $i
                         update idletasks
                         destroy $progbox
                 }
                 $self restore
                 return
         }
 
         bind $w <Button-1> \
                         "$self defineFirst $canv \[$canv canvasxy %x %y\]"
         bind $w <B1-Motion> ""
         bind $w <ButtonRelease-1> ""
 }
 
 # --
 #  FileDialog combo for selecting files to import
 #    result values are:
 #               1) "" if cancel pressed
 #               2) a list of files selected if "import all" pressed
 #               3) a list of one file if "import" pressed or double click
 # --
 
 WidgetClass Dialog/MBImport -superclass Dialog -configspec {
         {-filetypes fileTypes FileTypes "" config_filetypes cget_filetypes }
         {-directory directory Directory "" config_directory cget_directory }
 } -default {
         { *background WidgetDefault }
 }
 
 Dialog/MBImport instproc config_filetypes { args } {
         return [eval [$self subwidget filebox] config_filetypes $args]
 }
 
 Dialog/MBImport instproc cget_filetypes { args } {
         return [eval [$self subwidget filebox] cget_filetypes $args]
 }
 
 Dialog/MBImport instproc config_directory { args } {
         return [eval [$self subwidget filebox] config_directory $args]
 }
 
 Dialog/MBImport instproc cget_directory { args } {
         return [eval [$self subwidget filebox] cget_directory $args]
 }
 
 Dialog/MBImport instproc build_widget { path } {
         $self next $path
 
         frame   $path.frame
         set filebox [FileBox $path.filebox -command "$self import; $self ignore_args" -browsecmd "$self ignore_args"]
 
 #       $self subwidget filebox configure \
 #                       -browsecmd "$self browse; $self ignore_args"
         set butbox [frame $path.buttonbox]
         button $butbox.imp -underline 0 -text "Import" \
                         -command "$self import; $self ignore_args"
         button $butbox.all -underline 8 -text "Import All" -command \
                         "$self import_all"
         button $butbox.cancel -underline 0 -text "Cancel" \
                         -command "$self cancel"
 
         bind $path <KeyPress-Escape> "$self cancel"
         pack $butbox.imp $butbox.all $butbox.cancel -side left \
                         -padx 5 -pady 2
         pack $butbox -side bottom -in $path.frame -anchor e
         pack $path.filebox -side top -fill both -expand 1 -in $path.frame
         pack $path.frame -side left -fill both -expand 1
 }
 
 Dialog/MBImport instproc import {} {
         set filebox [$self subwidget filebox]
         set file [$filebox cget -filename]
         if { $file=="" } return
         set path [file join [$filebox cget -directory] $file]
         if {![file exists $path]} {
                 #puts stderr "File \"$path\" does not exist."
                 Dialog transient MessageBox -image Icons(warning) -type ok \
                                 -text "File \"$path\" does not exist."
                 return
         }
         $self tkvar result_
         $self config -result [list $path]
 }
 
 # used to compare strings that have a number at the end
 # this is dead slow, but presumably we don't do this often
 proc alphaNumericCmp {str1 str2} {
         if {$str1==$str2} { return 0 }
         if {[ regexp {[a-zA-Z]*0*([0-9]*)\.[a-zA-Z0-9]*} $str1 {} n1 ] && \
                         [ regexp {[a-zA-Z]*0*([0-9]*)\.[a-zA-Z0-9]*} $str2 {} n2]} {
                 #puts "1: $str1 2: $str2, n1:$n1 n2:$n2 ret [expr $n1 - $n2]"
                 return [expr {$n1 - $n2}]
         }
 }
 
 Dialog/MBImport instproc import_all {} {
         set appPWD [pwd]
         set filebox [$self subwidget filebox]
         set dir [$filebox cget -directory]
         if [catch {
                 cd $dir
         }] {
                 # We cannot change directory to $dir.
                 # give an error and abort action.
                 Dialog transient MessageBox -type ok -text \
                                 "Cannot change to the directory \"$dir\".\
                                 \nPermission denied." -image Icons(warning)
                 cd $appPWD
                 return
         }
         set filter [$filebox current_filter]
         set files [lsort -command alphaNumericCmp [eval glob -nocomplain $filter]]
         if {0==[llength $files]} { return }
         # The glob pattern might result in multiple matches, esp. if the
         #  file system is case insensitive, like win95
         #  make sure each file is listed only once
         #puts "before uniquify: $files"
         set prevFile ""
         foreach f $files {
                 if {$f!=$prevFile} {
                         lappend tmplist $f
                 }
                 set prevFile $f
         }
         if [info exists tmplist] { puts "after uniquify: $tmplist" }
         # glob patten have no path names, add them back
         foreach f $tmplist {
                 lappend paths [file join $dir $f]
         }
         cd $appPWD
         # get out only when there are 1 or more files
         if {$paths==""} {
                 return
         }
         #puts "import_all setting result to $paths"
         $self tkvar result_
         $self config -result $paths
 }
 
 Dialog/MBImport instproc cancel { } {
         $self tkvar result_
         $self config -result ""
 }