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

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

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

revision 1.13 by fireegl, Tue Dec 2 04:22:44 2003 UTC revision 1.14 by fireegl, Tue Dec 2 09:01:46 2003 UTC
# Line 30  namespace eval ::tcldrop::channels { Line 30  namespace eval ::tcldrop::channels {
30          variable version {0.8}          variable version {0.8}
31          variable rcsid {$Id$}          variable rcsid {$Id$}
32          package provide tcldrop::channels $version          package provide tcldrop::channels $version
         # Initialize variables:  
         variable Udefs  
         array set Udefs {}  
33          # Export all the commands that should be available to 3rd-party scripters:          # Export all the commands that should be available to 3rd-party scripters:
34          namespace export channel channels loadchannels savechannels validchan setudef renudef deludef countchannels          namespace export channel channels loadchannels savechannels validchan setudef renudef deludef countchannels
35          # Set the default channel database module:          # Set the default channel database module:
# Line 59  namespace eval ::tcldrop::channels { Line 56  namespace eval ::tcldrop::channels {
56  ::tcldrop::SetDefault global-exempt-time 29  ::tcldrop::SetDefault global-exempt-time 29
57  ::tcldrop::SetDefault global-chanset [list -autoop -autovoice -bitch -cycle +dontkickops +dynamicbans +dynamicexempts +dynamicinvites -enforcebans -greet -inactive -nodesynch -protectfriends -protectops -revenge -revengebot -secret -seen +shared -statuslog +userbans +userexempts +userinvites -protecthalfops -autohalfop]  ::tcldrop::SetDefault global-chanset [list -autoop -autovoice -bitch -cycle +dontkickops +dynamicbans +dynamicexempts +dynamicinvites -enforcebans -greet -inactive -nodesynch -protectfriends -protectops -revenge -revengebot -secret -seen +shared -statuslog +userbans +userexempts +userinvites -protecthalfops -autohalfop]
58    
 # Gives the type of the udef given in $name:  
 # It returns one of the following: int, flag, str, list, or unknown.  
 proc ::tcldrop::channels::UdefType {name} {  
         variable Udefs  
         if {[info exists Udefs($name)]} {  
                 return $Udefs($name)  
         } else {  
                 return {unknown}  
         }  
 }  
   
59  proc ::tcldrop::channels::channel {command channel args} {  proc ::tcldrop::channels::channel {command channel args} {
60          foreach a [binds channels channel] {          foreach a [binds channels channel] {
61                  foreach {type flags mask count proc} $a {}                  foreach {type flags mask count proc} $a {}
# Line 154  proc ::tcldrop::channels::savechannels { Line 140  proc ::tcldrop::channels::savechannels {
140          }          }
141  }  }
142    
 proc ::tcldrop::channels::SetUdefDefaults {{name {*}}} {  
         variable Channels  
         variable UdefDefaults  
         foreach c [array names Channels] {  
                 array set chaninfo $Channels($c)  
                 foreach n [array names UdefDefaults $name] {  
                         if {![info exists chaninfo($n)]} {  
                                 # It's not already set, so we set it to the default:  
                                 set chaninfo($n) $UdefDefaults($n)  
                                 set Channels($c) [array get chaninfo]  
                         }  
                 }  
                 array unset chaninfo  
         }  
 }  
   
143  # Loads the channel info from $chanfile:  # Loads the channel info from $chanfile:
144  proc ::tcldrop::channels::loadchannels {} {  proc ::tcldrop::channels::loadchannels {} {
145          foreach a [binds channels loadchannels] {          foreach a [binds channels loadchannels] {
# Line 189  proc ::tcldrop::channels::loadchannels { Line 159  proc ::tcldrop::channels::loadchannels {
159          } else {          } else {
160                  return -code error {No channel database module has been loaded.}                  return -code error {No channel database module has been loaded.}
161          }          }
         SetUdefDefaults  
162  }  }
163    
164  # 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 218  proc ::tcldrop::channels::validchan {cha Line 187  proc ::tcldrop::channels::validchan {cha
187    
188  # Defines a new udef:  # Defines a new udef:
189  proc ::tcldrop::channels::setudef {type name {default {}}} {  proc ::tcldrop::channels::setudef {type name {default {}}} {
190          # Store the default for this udef:          foreach a [binds channels setudef] {
191          variable UdefDefaults                  foreach {bindtype flags mask count proc} $a {}
192          switch -- $type {                  if {[set lev [catch { $proc $type $name } val]]} {
193                  {flag} {                          putlog "Error in script: $proc: $val"
194                          switch -- $default {                          puterrlog "$::errorInfo"
                                 {1} - {+} { set UdefDefaults($name) 1 }  
                                 {0} - {-} - {default} { set UdefDefaults($name) 0 }  
                         }  
                 }  
                 {int} {  
                         if {$default != {}} {  
                                 set UdefDefaults($name) $default  
                         } else {  
                                 set UdefDefaults($name) 0  
                         }  
195                  }                  }
196                  {str} - {list} { set UdefDefaults($name) $default }                  ::tcldrop::countbind $bindtype $mask $proc
197                  {default} {                  if {![info exists retval]} {
198                          # FixMe: Give an invalid type error.                          set retlev $lev
199                            set retval $val
200                  }                  }
201          }          }
202          # Store the udef itself:          if {[info exists retval]} {
203          variable Udefs                  return -code $retlev $retval
204          set Udefs($name) [string tolower $type]          } else {
205          # Apply the default to all channels that don't already have it set:                  return -code error {No channel database module has been loaded.}
206          SetUdefDefaults $name          }
207  }  }
208    
209  #  renudef <flag/int> <oldname> <newname>  #  renudef <flag/int> <oldname> <newname>
# Line 253  proc ::tcldrop::channels::setudef {type Line 213  proc ::tcldrop::channels::setudef {type
213  # Proc written by Papillon@EFNet.  # Proc written by Papillon@EFNet.
214  # FixMe: This proc is untested and unmodified from what he sent me.  # FixMe: This proc is untested and unmodified from what he sent me.
215  proc ::tcldrop::channels::renudef {type oldname newname} {  proc ::tcldrop::channels::renudef {type oldname newname} {
216          variable Channels          foreach a [binds channels renudef] {
217          variable Udefs                  foreach {bindtype flags mask count proc} $a {}
218          variable UdefDefaults                  if {[set lev [catch { $proc $type $oldname $newname } val]]} {
219          if {[info exists Udefs($oldname)] && [string compare -nocase $Udefs($oldname) $type]} {                          putlog "Error in script: $proc: $val"
220                  #just delete this loop if you don't want it to rename the udef in all channels                          puterrlog "$::errorInfo"
221                  foreach c [array names Channels] {                  }
222                          array set chaninfo $Channels($c)                  ::tcldrop::countbind $bindtype $mask $proc
223                          foreach n [array names UdefDefaults $oldname] {                  if {![info exists retval]} {
224                                  if {[info exists chaninfo($n)]} {                          set retlev $lev
225                                          set chaninfo($newname) $UdefDefaults($n)                          set retval $val
                                         set Channels($c) [array get chaninfo]  
                                         array unset Channels $n  
                                 }  
                         }  
                         array unset chaninfo  
226                  }                  }
227            }
228                  set tempUdefs($newname) $Udefs($oldname)          if {[info exists retval]} {
229                  set tempDefaults($newname) $Udefs($oldname)                  return -code $retlev $retval
230                  array unset Udefs $oldname          } else {
231                  array unset UdefDefaults $oldname                  return -code error {No channel database module has been loaded.}
                 array set Udefs [array get tempUdefs]  
                 array set UdefDefaults [array get tempDefaults]  
232          }          }
233  }  }
234    
   
235  #  deludef <flag/int> <name>  #  deludef <flag/int> <name>
236  #    Description: deletes a user defined channel flag or integer setting.  #    Description: deletes a user defined channel flag or integer setting.
237  #    Returns: nothing  #    Returns: nothing
# Line 287  proc ::tcldrop::channels::renudef {type Line 239  proc ::tcldrop::channels::renudef {type
239  # Proc written by Papillon@EFNet.  # Proc written by Papillon@EFNet.
240  # FixMe: This proc is untested and unmodified from what he sent me.  # FixMe: This proc is untested and unmodified from what he sent me.
241  proc ::tcldrop::channels::deludef {type name} {  proc ::tcldrop::channels::deludef {type name} {
242          variable Channels          foreach a [binds channels deludef] {
243          variable Udefs                  foreach {bindtype flags mask count proc} $a {}
244          variable UdefDefaults                  if {[set lev [catch { $proc $type $name } val]]} {
245          if {[info exists Udefs($name)] && [string compare -nocase $Udefs($name) $type]} {                          putlog "Error in script: $proc: $val"
246                  #just delete this loop if you don't want it to remove the udef from all channels                          puterrlog "$::errorInfo"
                 foreach c [array names Channels] {  
                         array set chaninfo $Channels($c)  
                         foreach n [array names UdefDefaults $name] {  
                                 if {[info exists chaninfo($n)]} {  
                                         array unset Channels $n  
                                 }  
                         }  
                         array unset chaninfo  
247                  }                  }
248                    ::tcldrop::countbind $bindtype $mask $proc
249                  array unset Udefs $name                  if {![info exists retval]} {
250                  array unset UdefDefaults $name                          set retlev $lev
251                            set retval $val
252                    }
253            }
254            if {[info exists retval]} {
255                    return -code $retlev $retval
256            } else {
257                    return -code error {No channel database module has been loaded.}
258          }          }
259  }  }
260    
# Line 322  if {![info exists numversion]} { return Line 273  if {![info exists numversion]} { return
273    
274  # Note, these settings are defined here, but their actual functions are in the irc module (or possibly other modules).  # Note, these settings are defined here, but their actual functions are in the irc module (or possibly other modules).
275  namespace eval ::tcldrop::channels {  namespace eval ::tcldrop::channels {
276            set dbpriority 1
277            # Load all of the database modules..
278            foreach n $channeldbs {
279                    loadmodule "channels::$n"
280                    foreach c [namespace export] {
281                            if {[info commands "::tcldrop::channels::${n}::$c"] != {}} {
282                                    bind channels {+|+} $c "::tcldrop::channels::${n}::$c" -priority $dbpriority
283                            }
284                    }
285                    incr dbpriority
286            }
287          setudef str chanmode ${global-chanmode}          setudef str chanmode ${global-chanmode}
288          setudef int idle-kick ${global-idle-kick}          setudef int idle-kick ${global-idle-kick}
289          setudef int stopnethack-mode ${global-stopnethack-mode}          setudef int stopnethack-mode ${global-stopnethack-mode}
# Line 349  namespace eval ::tcldrop::channels { Line 311  namespace eval ::tcldrop::channels {
311                          setudef flag [string range $n 1 end] [string index $n 0]                          setudef flag [string range $n 1 end] [string index $n 0]
312                  }                  }
313          }          }
         set dbpriority 1  
         # Load all of the database modules..  
         foreach n $channeldbs {  
                 loadmodule "channels::$n"  
                 foreach c [namespace export] {  
                         if {[info commands "::tcldrop::channels::${n}::$c"] != {}} {  
                                 bind channels {+|+} $c "::tcldrop::channels::${n}::$c" -priority $dbpriority  
                         }  
                 }  
                 incr dbpriority  
         }  
314          unset dbpriority n c          unset dbpriority n c
315  }  }
316    

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

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