home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tclsrc / stringfile.tcl < prev    next >
Encoding:
Text File  |  1993-11-19  |  1.6 KB  |  55 lines
  1. #
  2. # string_file --
  3. #
  4. # Functions to read and write strings from a file that has not been opened.
  5. #------------------------------------------------------------------------------
  6. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: stringfile.tcl,v 3.0 1993/11/19 07:00:41 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. #@package: TclX-stringfile_functions read_file write_file
  20.  
  21. proc read_file {fileName args} {
  22.     if {$fileName == "-nonewline"} {
  23.         set flag $fileName
  24.         set fileName [lvarpop args]
  25.     } else {
  26.         set flag {}
  27.     }
  28.     set fp [open $fileName]
  29.     set stat [catch {
  30.         eval read $flag $fp $args
  31.     } result]
  32.     close $fp
  33.     if {$stat != 0} {
  34.         global errorInfo errorCode
  35.         error $result $errorInfo $errorCode
  36.     }
  37.     return $result
  38. } 
  39.  
  40. proc write_file {fileName args} {
  41.     set fp [open $fileName w]
  42.     
  43.     set stat [catch {
  44.         foreach string $args {
  45.             puts $fp $string
  46.         }
  47.     } result]
  48.     close $fp
  49.     if {$stat != 0} {
  50.         global errorInfo errorCode
  51.         error $result $errorInfo $errorCode
  52.     }
  53. }
  54.  
  55.