/[tcldrop]/tcldrop/modules/channels/channels_arraydb.tcl
ViewVC logotype

Diff of /tcldrop/modules/channels/channels_arraydb.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by fireegl, Tue Dec 2 04:22:44 2003 UTC revision 1.2 by fireegl, Tue Dec 2 09:01:46 2003 UTC
# Line 28  Line 28 
28    
29  namespace eval ::tcldrop::channels::arraydb {  namespace eval ::tcldrop::channels::arraydb {
30          # Provide the channels::arraydb module:          # Provide the channels::arraydb module:
31          variable version {0.1}          variable version {0.8}
32          variable rcsid {$Id$}          variable rcsid {$Id$}
33          package provide tcldrop::channels::arraydb $version          package provide tcldrop::channels::arraydb $version
34          # Initialize variables:          # Initialize variables:
35            variable Udefs
36            array set Udefs {}
37          variable Channels          variable Channels
38          array set Channels {}          array set Channels {}
39            # Set the internal defaults:
40            ::tcldrop::SetDefault chanfile {tcldrop.chan}
41  }  }
42    
 # Set the internal defaults:  
 ::tcldrop::SetDefault chanfile {tcldrop.chan}  
   
43  proc ::tcldrop::channels::arraydb::channel {command channel opts} {  proc ::tcldrop::channels::arraydb::channel {command channel opts} {
         # FixMe: Change the args variable name in the rest of this proc...  
         set args $opts  
44          variable Channels          variable Channels
45          set lowerchannel [string tolower $channel]          set lowerchannel [string tolower $channel]
46          switch -- $command {          switch -- $command {
47                  {add} {                  {add} {
48                          if {[llength $args] > 1} {                          if {[llength $opts] > 1} {
49                                  set options $args                                  set options $opts
50                          } else {                          } else {
51                                  set options [lindex $args 0]                                  set options [lindex $opts 0]
52                          }                          }
53                          # Add the channel:                          # Add the channel:
54                          set Channels($lowerchannel) [list name $channel]                          set Channels($lowerchannel) [list name $channel]
55                          # Call ourself again to set the options:                          # Call ourself again to set the options:
56                          channel set $channel $options                          channel set $channel $options
57                            SetUdefDefaults
58                  }                  }
59                  {set} {                  {set} {
60                          # In the case of "set", $args is already in the form we can use.                          # In the case of "set", $opts is already in the form we can use.
61                          set options $args                          set options $opts
62                          array set chaninfo $Channels($lowerchannel)                          array set chaninfo $Channels($lowerchannel)
63                          set setnext 0                          set setnext 0
64                          foreach o $options {                          foreach o $options {
# Line 89  proc ::tcldrop::channels::arraydb::chann Line 89  proc ::tcldrop::channels::arraydb::chann
89                                                  }                                                  }
90                                          }                                          }
91                                  } else {                                  } else {
92                                          switch -- [set type [::tcldrop::channels::UdefType [set name [string trimleft $o {+-}]]]] {                                          switch -- [set type [UdefType [set name [string trimleft $o {+-}]]]] {
93                                                  {flag} {                                                  {flag} {
94                                                          switch -- [string index $o 0] {                                                          switch -- [string index $o 0] {
95                                                                  {+} { set chaninfo($name) 1 }                                                                  {+} { set chaninfo($name) 1 }
# Line 121  proc ::tcldrop::channels::arraydb::chann Line 121  proc ::tcldrop::channels::arraydb::chann
121                  {get} {                  {get} {
122                          if {[info exists Channels($lowerchannel)]} {                          if {[info exists Channels($lowerchannel)]} {
123                                  array set chaninfo $Channels($lowerchannel)                                  array set chaninfo $Channels($lowerchannel)
124                                  if {[info exists chaninfo($args)]} {                                  if {[info exists chaninfo($opts)]} {
125                                          return $chaninfo($args)                                          return $chaninfo($opts)
126                                  } else {                                  } else {
127                                          return -code error "Unknown channel setting: $args"                                          return -code error "Unknown channel setting: $opts"
128                                  }                                  }
129                          } else {                          } else {
130                                  return -code error "no such channel record: $channel"                                  return -code error "no such channel record: $channel"
# Line 159  proc ::tcldrop::channels::arraydb::count Line 159  proc ::tcldrop::channels::arraydb::count
159  }  }
160    
161  # Saves the channel info to $chanfile:  # Saves the channel info to $chanfile:
162  proc ::tcldrop::channels::arraydb::savechannels {opts} {  proc ::tcldrop::channels::arraydb::savechannels {{opts {}}} {
         set args $opts  
163          set fid [open $::chanfile w]          set fid [open $::chanfile w]
164          if {[lsearch $args -flush] != -1} { set flush 1 } else { set flush 0          if {[lsearch $opts -flush] != -1} { set flush 1 } else { set flush 0
165                  fconfigure $fid -blocking 0 -buffering full                  fconfigure $fid -blocking 0 -buffering full
166          }          }
167          variable Channels          variable Channels
# Line 185  proc ::tcldrop::channels::arraydb::loadc Line 184  proc ::tcldrop::channels::arraydb::loadc
184          } else {          } else {
185                  putlog "no chanfile exists..yet."                  putlog "no chanfile exists..yet."
186          }          }
187          ::tcldrop::channels::SetUdefDefaults          SetUdefDefaults
188  }  }
189    
190  # Returns 1 if a channel exists in the channel database, or 0 if it doesn't:  # Returns 1 if a channel exists in the channel database, or 0 if it doesn't:
# Line 201  proc ::tcldrop::channels::arraydb::valid Line 200  proc ::tcldrop::channels::arraydb::valid
200  #    Module: channels  #    Module: channels
201  #  #
202  # channame2dname <channel-name>  # channame2dname <channel-name>
 # chandname2name <channel-dname>  
203    # chandname2name <channel-dname>
204    
205    # Gives the type of the udef given in $name:
206    # It returns one of the following: int, flag, str, list, or unknown.
207    proc ::tcldrop::channels::arraydb::UdefType {name} {
208            variable Udefs
209            if {[info exists Udefs($name)]} {
210                    return $Udefs($name)
211            } else {
212                    return {unknown}
213            }
214    }
215    
216    proc ::tcldrop::channels::arraydb::SetUdefDefaults {{name {*}}} {
217            variable Channels
218            variable UdefDefaults
219            foreach c [array names Channels] {
220                    array set chaninfo $Channels($c)
221                    foreach n [array names UdefDefaults $name] {
222                            if {![info exists chaninfo($n)]} {
223                                    # It's not already set, so we set it to the default:
224                                    set chaninfo($n) $UdefDefaults($n)
225                                    set Channels($c) [array get chaninfo]
226                            }
227                    }
228                    array unset chaninfo
229            }
230    }
231    
232    # Note, types for udef's should be: flag, int, str, and list.
233    # In the case of lists, the channel command should provide lappend, lreplace, and lremove commands.
234    
235    # Defines a new udef:
236    proc ::tcldrop::channels::arraydb::setudef {type name {default {}}} {
237            # Store the default for this udef:
238            variable UdefDefaults
239            switch -- $type {
240                    {flag} {
241                            switch -- $default {
242                                    {1} - {+} { set UdefDefaults($name) 1 }
243                                    {0} - {-} - {default} { set UdefDefaults($name) 0 }
244                            }
245                    }
246                    {int} {
247                            if {$default != {}} {
248                                    set UdefDefaults($name) $default
249                            } else {
250                                    set UdefDefaults($name) 0
251                            }
252                    }
253                    {str} - {list} { set UdefDefaults($name) $default }
254                    {default} {
255                            # FixMe: Give an invalid type error.
256                    }
257            }
258            # Store the udef itself:
259            variable Udefs
260            set Udefs($name) [string tolower $type]
261            # Apply the default to all channels that don't already have it set:
262            SetUdefDefaults $name
263    }
264    
265    #  renudef <flag/int> <oldname> <newname>
266    #    Description: renames a user defined channel flag or integer setting.
267    #    Returns: nothing
268    #    Module: channels
269    # Proc written by Papillon@EFNet.
270    # FixMe: This proc is untested and unmodified from what he sent me.
271    proc ::tcldrop::channels::arraydb::renudef {type oldname newname} {
272            variable Channels
273            variable Udefs
274            variable UdefDefaults
275            if {[info exists Udefs($oldname)] && [string compare -nocase $Udefs($oldname) $type]} {
276                    #just delete this loop if you don't want it to rename the udef in all channels
277                    foreach c [array names Channels] {
278                            array set chaninfo $Channels($c)
279                            foreach n [array names UdefDefaults $oldname] {
280                                    if {[info exists chaninfo($n)]} {
281                                            set chaninfo($newname) $UdefDefaults($n)
282                                            set Channels($c) [array get chaninfo]
283                                            array unset Channels $n
284                                    }
285                            }
286                            array unset chaninfo
287                    }
288    
289                    set tempUdefs($newname) $Udefs($oldname)
290                    set tempDefaults($newname) $Udefs($oldname)
291                    array unset Udefs $oldname
292                    array unset UdefDefaults $oldname
293                    array set Udefs [array get tempUdefs]
294                    array set UdefDefaults [array get tempDefaults]
295            }
296    }
297    
298    
299    #  deludef <flag/int> <name>
300    #    Description: deletes a user defined channel flag or integer setting.
301    #    Returns: nothing
302    #    Module: channels
303    # Proc written by Papillon@EFNet.
304    # FixMe: This proc is untested and unmodified from what he sent me.
305    proc ::tcldrop::channels::arraydb::deludef {type name} {
306            variable Channels
307            variable Udefs
308            variable UdefDefaults
309            if {[info exists Udefs($name)] && [string compare -nocase $Udefs($name) $type]} {
310                    #just delete this loop if you don't want it to remove the udef from all channels
311                    foreach c [array names Channels] {
312                            array set chaninfo $Channels($c)
313                            foreach n [array names UdefDefaults $name] {
314                                    if {[info exists chaninfo($n)]} {
315                                            array unset Channels $n
316                                    }
317                            }
318                            array unset chaninfo
319                    }
320                    array unset Udefs $name
321                    array unset UdefDefaults $name
322            }
323    }

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26