diff -cr oommf11b2/app/mmsolve/any2ppm.tcl oommf/app/mmsolve/any2ppm.tcl
*** oommf11b2/app/mmsolve/any2ppm.tcl	Wed Dec 24 12:53:35 2003
--- oommf/app/mmsolve/any2ppm.tcl	Sat Mar 20 00:21:18 2004
***************
*** 60,90 ****
      # lowercase.  This provides the conventional extension for
      # all the cases I know about.
      if {[string match jpeg* [string tolower $outFormat]]} {
! 	set ext jpg
      } elseif {[string match tiff* [string tolower $outFormat]]} {
! 	set ext tif
      } else {
! 	if {![regexp -nocase -- {^ *([a-z]+)} $outFormat dum ext]} {
! 	    set ext ppm  ;# Safety default
! 	}
! 	set ext [string tolower $ext]
      }
      set outname [file rootname $inname].$ext
      if {!$force_overwrite && [file exists $outname]} {
! 	set basename $outname
! 	set outname {}
! 	for {set i 1} {$i<100} {incr i} {
! 	    set testname ${basename}-$i
! 	    if {![file exists $testname]} {
! 		set outname $testname
! 		break
! 	    }
! 	}
      }
      return $outname
  }
  
! proc write_ppm_chan { chanid pic } {
      # The Tk photo interface does not have a "write to channel" option.
      set width [image width $pic] ; set height [image height $pic]
      puts $chanid "P3"
--- 60,90 ----
      # lowercase.  This provides the conventional extension for
      # all the cases I know about.
      if {[string match jpeg* [string tolower $outFormat]]} {
!         set ext jpg
      } elseif {[string match tiff* [string tolower $outFormat]]} {
!         set ext tif
      } else {
!         if {![regexp -nocase -- {^ *([a-z]+)} $outFormat dum ext]} {
!             set ext ppm  ;# Safety default
!         }
!         set ext [string tolower $ext]
      }
      set outname [file rootname $inname].$ext
      if {!$force_overwrite && [file exists $outname]} {
!         set basename $outname
!         set outname {}
!         for {set i 1} {$i<100} {incr i} {
!             set testname ${basename}-$i
!             if {![file exists $testname]} {
!                 set outname $testname
!                 break
!             }
!         }
      }
      return $outname
  }
  
! proc write_p3_chan { chanid pic } {
      # The Tk photo interface does not have a "write to channel" option.
      set width [image width $pic] ; set height [image height $pic]
      puts $chanid "P3"
***************
*** 92,100 ****
      puts $chanid "255"
      set rtop [expr {$height-1}] ; set ctop [expr {$width-1}]
      for {set r 0} {$r<$height} {incr r} {
! 	for {set c 0} {$c<$width} {incr c} {
! 	    puts $chanid [$pic get $c $r]
! 	}
      }
      flush $chanid
  }
--- 92,100 ----
      puts $chanid "255"
      set rtop [expr {$height-1}] ; set ctop [expr {$width-1}]
      for {set r 0} {$r<$height} {incr r} {
!         for {set c 0} {$c<$width} {incr c} {
!             puts $chanid [$pic get $c $r]
!         }
      }
      flush $chanid
  }
***************
*** 108,133 ****
  switch -exact -- $outSpec {
      {} {set outmode automatic}
      {-} {
! 	set outmode fixed
! 	set outname {}
! 	set outchan stdout
! 	fconfigure $outchan -translation auto \
! 		-buffering full -buffersize $BUFSIZ
      }
      default {
! 	set outmode fixed
! 	set outname $outSpec
! 	if {$useChanOutput} {
! 	    if {[catch {open $outname "w"} msg]} {
! 		puts stderr "Unable to open output file $outname: $msg"
! 		incr errcount
! 		exit $errcount
! 	    } else {
! 		set outchan $msg
! 		fconfigure $outchan -translation auto \
! 			-buffering full -buffersize $BUFSIZ
! 	    }
! 	}
      }
  }
  
--- 108,133 ----
  switch -exact -- $outSpec {
      {} {set outmode automatic}
      {-} {
!         set outmode fixed
!         set outname {}
!         set outchan stdout
!         fconfigure $outchan -translation auto \
!                 -buffering full -buffersize $BUFSIZ
      }
      default {
!         set outmode fixed
!         set outname $outSpec
!         if {$useChanOutput} {
!             if {[catch {open $outname "w"} msg]} {
!                 puts stderr "Unable to open output file $outname: $msg"
!                 incr errcount
!                 exit $errcount
!             } else {
!                 set outchan $msg
!                 fconfigure $outchan -translation auto \
!                         -buffering full -buffersize $BUFSIZ
!             }
!         }
      }
  }
  
***************
*** 137,243 ****
  }
  foreach inname $inList {
      if {[string match {} $inname]} {
! 	# Read from stdin
! 	if {!$noinfo} { puts stderr "Processing input from stdin" }
! 	fconfigure stdin -translation binary
! 	set data [read stdin]
! 	if {[catch {set pic [image create photo -data $data]} errmsg]} {
! 	    puts stderr "ERROR: $errmsg"
! 	    incr errcount
! 	    continue
! 	}
      } else {
! 	# Read from file
! 	if {![file readable $inname]} {
! 	    puts stderr "Unable to open input file $inname; Skipping."
! 	    incr errcount
! 	    continue
! 	}
! 	if {!$noinfo} { puts stderr "Processing input file $inname" }
! 	if {[catch {set pic [image create photo -file $inname]} errmsg]} {
! 	    puts stderr "ERROR: $errmsg"
! 	    incr errcount
! 	    continue
! 	}
      }
  
      if {!$noinfo} { puts stderr "Processing output..." }
      if {[string match automatic $outmode]} {
! 	if {[string match {} $inname]} {
! 	    set outname {}
! 	    set outchan stdout
! 	} else {
! 	    set outname [make_ppm_name $inname]
! 	    if {[string match {} $outname]} {
! 		puts stderr "Unable to generate unique output name; Skipping."
! 		incr errcount
! 		continue
! 	    }
! 	    if {$useChanOutput} {
! 		if {[catch {open $outname "w"} outchan]} {
! 		    puts stderr "Unable to open output file $outname; Skipping."
! 		    incr errcount
! 		    continue	    
! 		}
! 		fconfigure $outchan -translation auto \
! 			-buffering full -buffersize $BUFSIZ
! 		set loopOpen 1
! 	    }
! 	}
      }
  
      if {$useChanOutput} {
!  	# Use above PPM write to channel routine rather than Tk photo
! 	# write command, which writes to a file rather than a channel.
! 	if {[catch {write_ppm_chan $outchan $pic} errmsg]} {    
! 	    puts stderr " PPM WRITE ERROR: $errmsg"
! 	    incr errcount
! 	}
! 	flush $outchan
! 	if {$loopOpen} {
! 	    close $outchan
! 	    unset outchan
! 	}
      } else {
! 	# Use Tk image photo write command.
! 	if {[string match {} $outname]} {
! 	    # Use temporary file to fake stdout output
! 	    Oc_TempFile New temp -stem any2ppm
! 	    set tempname [$temp AbsoluteName]
! 	} else {
! 	    set tempname $outname
! 	}
! 	if {[catch {$pic write $tempname -format $outFormat} errmsg]} {
! 	    puts stderr " $outFormat WRITE ERROR: $errmsg"
! 	    incr errcount
! 	    if {![string match {} outname] && [file exists $outname]} {
! 		catch {file delete $outname}
! 	    }
! 	    exit [incr errcount]
! 	}
! 	if {[string match {} $outname]} {
! 	    # Copy results from $tempname to $outchan
! 	    # (which *should* be stdout!)
! 	    set tempchan [$temp Handle]
! 	    fconfigure $tempchan -translation binary
! 	    fconfigure $outchan -translation binary 
! 	    if {[catch {fcopy $tempchan $outchan} msg]} {
! 		puts stderr "FATAL ERROR: $msg"
! 		exit [incr errcount]
! 	    }
! 	    $temp Delete
! 	    flush $outchan
! 	}	
      }
  
      if {!$noinfo} {
! 	if {[info exists outchan] && [string match stdout $outchan]} {
! 	    puts stderr "Output written to <stdout>"
! 	} elseif {[info exists outname]} {
! 	    puts stderr "Output written to $outname"
! 	} else {
! 	    puts stderr "Unknown output (programming error?)"
! 	}
      }
  
  }
--- 137,268 ----
  }
  foreach inname $inList {
      if {[string match {} $inname]} {
!         # Read from stdin
!         if {!$noinfo} { puts stderr "Processing input from stdin" }
!         fconfigure stdin -translation binary
!         set data [read stdin]
!         if {[catch {set pic [image create photo -data $data]} errmsg]} {
! 	    # Unable to process data using 'photo -data' option.  Try
! 	    # using the -file option instead
!             Oc_TempFile New temp -stem any2ppm
!             set tempname [$temp AbsoluteName]
!             $temp Claim
!             $temp Delete
! 	    set tempchan [open $tempname w]
!             fconfigure $tempchan -translation binary
!             if {[catch {puts -nonewline $tempchan $data} msg]} {
!                 puts stderr "FATAL ERROR: $msg"
!                 catch {close $tempchan}
!                 catch {file delete $tempname}
!                 exit [incr errcount]
!             }
!             close $tempchan
! 	    if {[catch {set pic [image create photo -file $tempname]} msg]} {
! 		puts stderr "ERROR: $errmsg"
! 		puts stderr "ERROR: $msg"
! 		incr errcount
! 		file delete $tempname
! 		continue
! 	    }
!             file delete $tempname
!         }
      } else {
!         # Read from file
!         if {![file readable $inname]} {
!             puts stderr "Unable to open input file $inname; Skipping."
!             incr errcount
!             continue
!         }
!         if {!$noinfo} { puts stderr "Processing input file $inname" }
!         if {[catch {set pic [image create photo -file $inname]} errmsg]} {
!             puts stderr "ERROR: $errmsg"
!             incr errcount
!             continue
!         }
      }
  
      if {!$noinfo} { puts stderr "Processing output..." }
      if {[string match automatic $outmode]} {
!         if {[string match {} $inname]} {
!             set outname {}
!             set outchan stdout
!         } else {
!             set outname [make_ppm_name $inname]
!             if {[string match {} $outname]} {
!                 puts stderr "Unable to generate unique output name; Skipping."
!                 incr errcount
!                 continue
!             }
!             if {$useChanOutput} {
!                 if {[catch {open $outname "w"} outchan]} {
!                     puts stderr "Unable to open output file $outname;\
!                             Skipping."
!                     incr errcount
!                     continue    
!                 }
!                 fconfigure $outchan -translation auto \
!                         -buffering full -buffersize $BUFSIZ
!                 set loopOpen 1
!             }
!         }
      }
  
      if {$useChanOutput} {
!         # Use above PPM P3 write proc to write to channel routine rather
!         # than Tk photo write command, which writes to a file rather
!         # than a channel, and apparently doesn't know P3 anyway.
!         if {[catch {write_p3_chan $outchan $pic} errmsg]} {
!             puts stderr " PPM P3 WRITE ERROR: $errmsg"
!             incr errcount
!         }
!         flush $outchan
!         if {$loopOpen} {
!             close $outchan
!             unset outchan
!         }
      } else {
!         # Use Tk image photo write command.
!         if {[string match {} $outname]} {
!             # Use temporary file to fake stdout output
!             Oc_TempFile New temp -stem any2ppm
!             set tempname [$temp AbsoluteName]
!             $temp Claim
!             $temp Delete
!         } else {
!             set tempname $outname
!         }
!         if {[catch {$pic write $tempname -format $outFormat} errmsg]} {
!             puts stderr " $outFormat WRITE ERROR: $errmsg"
!             incr errcount
!             catch {file delete $tempname}
!             exit [incr errcount]
!         }
!         if {[string match {} $outname]} {
!             # Copy results from $tempname to $outchan
!             # (which *should* be stdout!)
!             set tempchan [open $tempname r]
!             fconfigure $tempchan -translation binary
!             fconfigure $outchan -translation binary
!             if {[catch {fcopy $tempchan $outchan} msg]} {
!                 puts stderr "FATAL ERROR: $msg"
!                 catch {close $tempchan}
!                 catch {file delete $tempname}
!                 exit [incr errcount]
!             }
!             close $tempchan
!             file delete $tempname
!             flush $outchan
!         }       
      }
  
      if {!$noinfo} {
!         if {[info exists outchan] && [string match stdout $outchan]} {
!             puts stderr "Output written to <stdout>"
!         } elseif {[info exists outname]} {
!             puts stderr "Output written to $outname"
!         } else {
!             puts stderr "Unknown output (programming error?)"
!         }
      }
  
  }