Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/masterserver/data/tcl/irk/lib/irkutil.tcl @ 7730

Last change on this file since 7730 was 5781, checked in by rgrieder, 15 years ago

Reverted trunk again. We might want to find a way to delete these revisions again (x3n's changes are still available as diff in the commit mails).

  • Property svn:eol-style set to native
File size: 3.0 KB
Line 
1# irkutil.tcl:
2#
3# Utility procedures used throughout the IRK package.
4
5namespace eval ::irk {
6
7    # The randselect randomly selects an element of a given list.
8
9    proc randselect {l} {
10        lindex $l [expr int(floor(rand() * [llength $l]))]
11    }
12
13    # Remove a user from the list of users on a channel
14
15    proc removeFromChannel {token user chan} {
16        variable state
17
18        # If it's us that left the channel, forget the channel:
19
20        if {![string compare $state($token,nick) $user]} {
21            removeChannel $token $chan
22            return
23        }
24
25        # Try to retrieve the channel's user list:
26
27        if {[catch {set users $state($token,$chan,NAMES)}]} {
28            return
29        }
30        set idx [lsearch $users $user]
31        if {$idx == -1} {
32            return
33        }
34
35        # Remove the user:
36
37        set state($token,$chan,NAMES) [lreplace $users $idx $idx]
38    }
39
40    # Remove a user from all the channels I am on (for QUIT etc.)
41
42    proc removeFromAllChannels {token user} {
43        variable state
44
45        foreach chan $state($token,channels) {
46            removeFromChannel $token $user $chan
47        }
48    }
49
50    # Add a user to a channel I am on.
51
52    proc addToChannel {token user chan} {
53        variable state
54
55        lappend state($token,$chan,NAMES) $user
56    }
57
58    # Add a channel to the list of channels we're on:
59
60    proc addChannel {token chan} {
61        variable state
62
63        lappend state($token,channels) $chan
64    }
65
66    # Remove a channel from the list of channels we're on:
67
68    proc removeChannel {token chan} {
69        variable state
70
71        if {[catch {set channels $state($token,channels)}]} {
72            return
73        }
74        set idx [lsearch $channels $chan]
75        if {$idx == -1} {
76            return
77        }
78
79        # Remove this channel from the list of channels we're on:
80
81        set state($token,channels) [lreplace $channels $idx $idx]
82
83        # Forget all state for this channel:
84
85        array unset state $token,$chan,*
86    }
87
88    # This procedure cleans up all state associated with a connection:
89
90    proc forgetConnection {token} {
91        variable state
92
93        array unset state $token,*
94    }
95
96    # This procedure updates the channel names for all channels we're on
97    # due to a nick change.
98
99    proc replaceAllChannels {token nick newnick} {
100        variable state
101
102        # If we're not on any channels, then no need to replace.
103
104        if {![info exists state($token,channels)]} {
105            return
106        }
107
108        # Replace the old nick with the new nick in all the channels I'm on.
109
110        foreach chan $state($token,channels) {
111            if {[catch {set names $state($token,$chan,NAMES)}]} {
112                continue
113            }
114            set idx [lsearch $names $nick]
115            if {$idx != -1} {
116                set state($token,$chan,NAMES) \
117                        [lreplace $names $idx $idx $newnick]
118            }
119        }
120    }
121
122    # This procedure determines whether a nick is our nick.
123   
124    proc isus {token nick} {
125        variable state
126
127        if {![string compare $nick $state($token,nick)]} {
128            return 1
129        }
130        return 0
131    }
132
133    # This procedure cleans up input received as part of a CTCP action.
134
135    proc ctcpcleanup {l} {
136        if {[llength $l] > 1} {
137            set h [string range [lindex $l 0] 1 end]
138            set t [string range [lindex $l end] 0 end-1]
139            return [lreplace [lreplace $l 0 0 $h] end end $t]
140        }
141        return [string range $l 1 end-1]
142    }
143       
144}
Note: See TracBrowser for help on using the repository browser.