1# ini.tcl -- 2# 3# Querying and modifying old-style windows configuration files (.ini) 4# 5# Copyright (c) 2003-2007 Aaron Faupell <afaupell@users.sourceforge.net> 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# RCS: @(#) $Id: ini.tcl,v 1.15 2008/05/11 00:53:58 andreas_kupries Exp $ 11 12package provide inifile 0.2.3 13 14namespace eval ini { 15 variable nexthandle 0 16 variable commentchar \; 17} 18 19proc ::ini::open {ini {mode r+}} { 20 variable nexthandle 21 22 if { ![regexp {^(w|r)\+?$} $mode] } { 23 error "$mode is not a valid access mode" 24 } 25 26 ::set fh ini$nexthandle 27 ::set tmp [::open $ini $mode] 28 fconfigure $tmp -translation crlf 29 30 namespace eval ::ini::$fh { 31 variable data; array set data {} 32 variable comments; array set comments {} 33 variable sections; array set sections {} 34 } 35 ::set ::ini::${fh}::channel $tmp 36 ::set ::ini::${fh}::file [_normalize $ini] 37 ::set ::ini::${fh}::mode $mode 38 39 incr nexthandle 40 if { [string match "r*" $mode] } { 41 _loadfile $fh 42 } 43 return $fh 44} 45 46# close the file and delete all stored info about it 47# this does not save any changes. see ::ini::commit 48 49proc ::ini::close {fh} { 50 _valid_ns $fh 51 ::close [::set ::ini::${fh}::channel] 52 namespace delete ::ini::$fh 53} 54 55# write all changes to disk 56 57proc ::ini::commit {fh} { 58 _valid_ns $fh 59 namespace eval ::ini::$fh { 60 if { $mode == "r" } { 61 error "cannot write to read-only file" 62 } 63 ::close $channel 64 ::set channel [::open $file w] 65 ::set char $::ini::commentchar 66 #seek $channel 0 start 67 foreach sec [array names sections] { 68 if { [info exists comments($sec)] } { 69 puts $channel "$char [join $comments($sec) "\n$char "]\n" 70 } 71 puts $channel "\[$sec\]" 72 foreach key [lsort -dictionary [array names data [::ini::_globescape $sec]\000*]] { 73 ::set key [lindex [split $key \000] 1] 74 if {[info exists comments($sec\000$key)]} { 75 puts $channel "$char [join $comments($sec\000$key) "\n$char "]" 76 } 77 puts $channel "$key=$data($sec\000$key)" 78 } 79 puts $channel "" 80 } 81 catch { unset char sec key } 82 close $channel 83 ::set channel [::open $file r+] 84 } 85 return 86} 87 88# internal command to read in a file 89# see open and revert for public commands 90 91proc ::ini::_loadfile {fh} { 92 namespace eval ::ini::$fh { 93 ::set cur {} 94 ::set com {} 95 set char $::ini::commentchar 96 seek $channel 0 start 97 98 foreach line [split [read $channel] "\n"] { 99 if { [string match "$char*" $line] } { 100 lappend com [string trim [string range $line [string length $char] end]] 101 } elseif { [string match {\[*\]} $line] } { 102 ::set cur [string range $line 1 end-1] 103 if { $cur == "" } { continue } 104 ::set sections($cur) 1 105 if { $com != "" } { 106 ::set comments($cur) $com 107 ::set com {} 108 } 109 } elseif { [string match {*=*} $line] } { 110 ::set line [split $line =] 111 ::set key [string trim [lindex $line 0]] 112 if { $key == "" || $cur == "" } { continue } 113 ::set value [string trim [join [lrange $line 1 end] =]] 114 if { [regexp "^(\".*\")\s+${char}(.*)$" $value -> 1 2] } { 115 set value $1 116 lappend com $2 117 } 118 ::set data($cur\000$key) $value 119 if { $com != "" } { 120 ::set comments($cur\000$key) $com 121 ::set com {} 122 } 123 } 124 } 125 unset char cur com 126 catch { unset line key value 1 2 } 127 } 128} 129 130# internal command to escape glob special characters 131 132proc ::ini::_globescape {string} { 133 return [string map {* \\* ? \\? \\ \\\\ \[ \\\[ \] \\\]} $string] 134} 135 136# internal command to check if a section or key is nonexistant 137 138proc ::ini::_exists {fh sec args} { 139 if { ![info exists ::ini::${fh}::sections($sec)] } { 140 error "no such section \"$sec\"" 141 } 142 if { [llength $args] > 0 } { 143 ::set key [lindex $args 0] 144 if { ![info exists ::ini::${fh}::data($sec\000$key)] } { 145 error "can't read key \"$key\"" 146 } 147 } 148} 149 150# internal command to check validity of a handle 151 152if { [package vcompare [package provide Tcl] 8.4] < 0 } { 153 proc ::ini::_normalize {path} { 154 return $path 155 } 156 proc ::ini::_valid_ns {name} { 157 variable ::ini::${name}::data 158 if { ![info exists data] } { 159 error "$name is not an open INI file" 160 } 161 } 162} else { 163 proc ::ini::_normalize {path} { 164 file normalize $path 165 } 166 proc ::ini::_valid_ns {name} { 167 if { ![namespace exists ::ini::$name] } { 168 error "$name is not an open INI file" 169 } 170 } 171} 172 173# get and set the ini comment character 174 175proc ::ini::commentchar { {new {}} } { 176 variable commentchar 177 if {$new != ""} { 178 if {[string length $new] > 1} { 179 return -code error "comment char must be a single character" 180 } 181 ::set commentchar $new 182 } 183 return $commentchar 184} 185 186# return all section names 187 188proc ::ini::sections {fh} { 189 _valid_ns $fh 190 return [array names ::ini::${fh}::sections] 191} 192 193# return boolean indicating existance of section or key in section 194 195proc ::ini::exists {fh sec {key {}}} { 196 _valid_ns $fh 197 if { $key == "" } { 198 return [info exists ::ini::${fh}::sections($sec)] 199 } 200 return [info exists ::ini::${fh}::data($sec\000$key)] 201} 202 203# return all key names of section 204# error if section is nonexistant 205 206proc ::ini::keys {fh sec} { 207 _valid_ns $fh 208 _exists $fh $sec 209 ::set keys {} 210 foreach x [array names ::ini::${fh}::data [_globescape $sec]\000*] { 211 lappend keys [lindex [split $x \000] 1] 212 } 213 return $keys 214} 215 216# return all key value pairs of section 217# error if section is nonexistant 218 219proc ::ini::get {fh sec} { 220 _valid_ns $fh 221 _exists $fh $sec 222 upvar 0 ::ini::${fh}::data data 223 ::set r {} 224 foreach x [array names data [_globescape $sec]\000*] { 225 lappend r [lindex [split $x \000] 1] $data($x) 226 } 227 return $r 228} 229 230# return the value of a key 231# return default value if key or section is nonexistant otherwise error 232 233proc ::ini::value {fh sec key {default {}}} { 234 _valid_ns $fh 235 if {$default != "" && ![info exists ::ini::${fh}::data($sec\000$key)]} { 236 return $default 237 } 238 _exists $fh $sec $key 239 return [::set ::ini::${fh}::data($sec\000$key)] 240} 241 242# set the value of a key 243# new section or key names are created 244 245proc ::ini::set {fh sec key value} { 246 _valid_ns $fh 247 ::set sec [string trim $sec] 248 ::set key [string trim $key] 249 if { $sec == "" || $key == "" } { 250 error "section or key may not be empty" 251 } 252 ::set ::ini::${fh}::data($sec\000$key) $value 253 ::set ::ini::${fh}::sections($sec) 1 254 return $value 255} 256 257# delete a key or an entire section 258# may delete nonexistant keys and sections 259 260proc ::ini::delete {fh sec {key {}}} { 261 _valid_ns $fh 262 if { $key == "" } { 263 array unset ::ini::${fh}::data [_globescape $sec]\000* 264 array unset ::ini::${fh}::sections [_globescape $sec] 265 } 266 catch {unset ::ini::${fh}::data($sec\000$key)} 267} 268 269# read and set comments for sections and keys 270# may comment nonexistant sections and keys 271 272proc ::ini::comment {fh sec key args} { 273 _valid_ns $fh 274 upvar 0 ::ini::${fh}::comments comments 275 ::set r $sec 276 if { $key != "" } { append r \000$key } 277 if { [llength $args] == 0 } { 278 if { ![info exists comments($r)] } { return {} } 279 return $comments($r) 280 } 281 if { [llength $args] == 1 && [lindex $args 0] == "" } { 282 unset -nocomplain comments($r) 283 return {} 284 } 285 # take care of any embedded newlines 286 for {::set i 0} {$i < [llength $args]} {incr i} { 287 ::set args [eval [list lreplace $args $i $i] [split [lindex $args $i] \n]] 288 } 289 eval [list lappend comments($r)] $args 290} 291 292# return the physical filename for the handle 293 294proc ::ini::filename {fh} { 295 _valid_ns $fh 296 return [::set ::ini::${fh}::file] 297} 298 299# reload the file from disk losing all changes since the last commit 300 301proc ::ini::revert {fh} { 302 _valid_ns $fh 303 namespace eval ::ini::$fh { 304 array set data {} 305 array set comments {} 306 array set sections {} 307 } 308 if { ![string match "w*" $mode] } { 309 _loadfile $fh 310 } 311} 312