home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / config.tcl < prev    next >
Text File  |  1996-11-28  |  4KB  |  116 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1993 by Westmount Technology B.V., Delft, The Netherlands.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Westmount Technology B.V.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #       File            : @(#)config.tcl    /main/titanic/3
  17. #       Original date   : 1-3-1993
  18. #       Description     : Common procedures for retrieving information from
  19. #              configuration-files.
  20. #---------------------------------------------------------------------------
  21. # SccsId = @(#)config.tcl    /main/titanic/3   28 Nov 1996 Copyright 1994 Westmount Technology
  22.  
  23.  
  24. #
  25. # read 1 line from the configuration file 'file' into 'var'.
  26. # strip of the comments
  27. #
  28. proc get_config_line {file var} {
  29.     upvar $var result
  30.     set result ""
  31.     while { [gets $file line] != -1 } {
  32.     # strip of comment
  33.     if {[regsub -all {(\\\\)*(\\#)|(\\\\)*#.*$} $line {\1\2\3} line_list]} {
  34.         set line $line_list
  35.     }
  36.     if { [string trim $line] == "" } continue
  37.     # join lines ending with \ 
  38.     if {[regsub {(([^\\])(\\\\)*)\\$} $line {\1} line_list]} {
  39.         set line $line_list
  40.         set result $result$line
  41.         continue
  42.     } else {
  43.         set result $result$line
  44.         break
  45.     }
  46.     }
  47.     if { $result == "" } {
  48.     return -1
  49.     } else {
  50.     return 0
  51.     }
  52. }
  53.  
  54. #
  55. # remove whitespace around the seperators in a string
  56. #
  57. proc sep_clean {str {sep {|}} {space {     }}} {
  58.     # without the extra \'s, the condition must look like:
  59.     #regsub -all {(\\\\)*(\\.)?[$space]*([^|$sep]|$)[$space]*} $str {\1\2\3} result
  60.     #                      ^^ creates a loop
  61.     if {[regsub -all "(\\\\\\\\)*(\\\\.)?\[$space\]*(\[$sep\]|\$)\[$space\]*" $str {\1\2\3} result]} {
  62.     return [string trimleft $result $space]
  63.     }
  64.     return [string trimleft $str $space]
  65. }
  66.  
  67. #
  68. # read the configuration file with name "file_name" into array "arr"
  69. # Default it is assumed that the first column is unique. If the key consists
  70. # of more columns then 'keys' defines the number of columns that form the
  71. # key.
  72. #
  73. proc read_configuration_file {file_name arr {keys 1} {sep {|}}} {
  74.     upvar $arr larr
  75.     set file [open $file_name]
  76.     set line_list ""
  77.     while { [get_config_line $file line] != -1 } {
  78.     # remove whitespace around the seperators
  79.     set line [sep_clean $line $sep]
  80.     # substitute \a with a
  81.     if {[regsub -all {\\n} $line {\1} line_list]} {
  82.         set line $line_list
  83.     }
  84.  
  85.     set line_list [split $line $sep]
  86.     set index [lrange $line_list 0 [expr $keys-1]]
  87.     set line_list [lrange $line_list $keys end]
  88.     if { $index != "" } {
  89.         set larr($index) $line_list
  90.     }
  91.     }
  92.     close $file
  93. }
  94.  
  95. #
  96. # read the configuration file with name "fileName"  
  97. #
  98. proc readConfigurationFile {fileName {sep {|}}} {
  99.     set file [open $fileName]
  100.     set lineList ""
  101.     set fileList ""
  102.     while { [get_config_line $file line] != -1 } {
  103.     # remove whitespace around the seperators
  104.     set line [sep_clean $line $sep]
  105.     # substitute \a with a
  106.     if {[regsub -all {\\n} $line {\1} lineList]} {
  107.         set line $lineList
  108.     }
  109.  
  110.     set lineList [split $line $sep]
  111.     lappend fileList $lineList
  112.     }
  113.     close $file
  114.     return $fileList
  115. }
  116.