/[cl-xmpp]/cl-xmpp/multi-user-chat.lisp
ViewVC logotype

Contents of /cl-xmpp/multi-user-chat.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Wed Jul 9 21:02:40 2008 UTC (5 years, 9 months ago) by ehuelsmann
Branch: MAIN
CVS Tags: HEAD
Collected Ravenpack Int'l patches as submitted by Kevin Crosbie (kcrosbie at ravenpack.com).
1 ;;;; $Id: multi-user-chat.lisp,v 1.1 2008/07/09 21:02:40 ehuelsmann Exp $
2 ;;;; $Source: /tiger/var/lib/cvsroots/cl-xmpp/cl-xmpp/multi-user-chat.lisp,v $
3
4 (in-package :cl-xmpp)
5
6 ;;
7 ;; Multi User Chat
8 ;;
9 ;;<presence
10 ;; from='crone1@shakespeare.lit/desktop'
11 ;; to='darkcave@macbeth.shakespeare.lit/firstwitch'>
12 ;; <x xmlns='http://jabber.org/protocol/muc'/>
13 ;;</presence>
14
15 (defmethod create-chatroom ((connection connection) &key from room priority)
16 (with-xml-output (connection)
17 (cxml:with-element "presence"
18 (cxml:attribute "to" room)
19 (cxml:attribute "from" from)
20 (when priority
21 (cxml:with-element "priority"
22 (cxml:text "0")))
23 (cxml:with-element "x"
24 (cxml:attribute "xmlns" "http://jabber.org/protocol/muc")))))
25
26 ;;<presence
27 ;; from='hag66@shakespeare.lit/pda'
28 ;; to='darkcave@macbeth.shakespeare.lit/thirdwitch'/>
29
30 (defmethod join-chatroom ((connection connection) &key from room password)
31 (with-xml-output (connection)
32 (cxml:with-element "presence"
33 (cxml:attribute "to" room)
34 (cxml:attribute "from" from)
35 (when password
36 (cxml:with-element "x"
37 (cxml:attribute "xmlns" "http://jabber.org/protocol/muc")
38 (cxml:with-element "password"
39 (cxml:text password)))))))
40
41 ;;<presence
42 ;; from='hag66@shakespeare.lit/pda'
43 ;; to='darkcave@macbeth.shakespeare.lit/thirdwitch'
44 ;; type='unavailable'/>
45
46 (defmethod leave-chatroom ((connection connection) &key from room)
47 (with-xml-output (connection)
48 (cxml:with-element "presence"
49 (cxml:attribute "to" room)
50 (cxml:attribute "from" from)
51 (cxml:attribute "type" "unavailable"))))
52
53 ;;<message
54 ;; from='crone1@shakespeare.lit/desktop'
55 ;; to='darkcave@macbeth.shakespeare.lit'>
56 ;; <x xmlns='http://jabber.org/protocol/muc#user'>
57 ;; <invite to='hecate@shakespeare.lit'>
58 ;; <reason>
59 ;; Hey Hecate, this is the place for all good witches!
60 ;; </reason>
61 ;; </invite>
62 ;; </x>
63 ;;</message>
64
65 (defmethod invite-to-chatroom ((connection connection)
66 &key from room to reason)
67 (with-xml-output (connection)
68 (cxml:with-element "message"
69 (cxml:attribute "to" room)
70 (cxml:attribute "from" from)
71 (cxml:with-element "x"
72 (cxml:attribute "xmlns" "http://jabber.org/protocol/muc#user")
73 (cxml:with-element "invite"
74 (cxml:attribute "to" to)
75 (cxml:with-element "reason"
76 (cxml:text reason)))))))
77
78
79 ;;<iq from='fluellen@shakespeare.lit/pda'
80 ;; id='kick1'
81 ;; to='harfleur@henryv.shakespeare.lit'
82 ;; type='set'>
83 ;; <query xmlns=''>
84 ;; <item nick='pistol' role='none'>
85 ;; <reason>Avaunt, you cullion!</reason>
86 ;; </item>
87 ;; </query>
88 ;;</iq>
89
90 (defmethod kick-from-chatroom ((connection connection)
91 &key to room reason)
92 (with-xml-output (connection)
93 (with-iq-query (connection :to room :type "set"
94 :xmlns "http://jabber.org/protocol/muc#admin")
95 (cxml:with-element "item"
96 (cxml:attribute "nick" to)
97 (cxml:attribute "role" "none")
98 (cxml:with-element "reason"
99 (cxml:text reason))))))
100
101
102 ;;<iq from='crone1@shakespeare.lit/desktop'
103 ;; id='member1'
104 ;; to='darkcave@macbeth.shakespeare.lit'
105 ;; type='set'>
106 ;; <query xmlns='http://jabber.org/protocol/muc#admin'>
107 ;; <item affiliation='member'
108 ;; jid='hag66@shakespeare.lit'/>
109 ;; </query>
110 ;;</iq>
111
112 (defmethod set-room-affiliation ((connection connection)
113 &key room to affiliation)
114 (with-xml-output (connection)
115 (with-iq-query (connection :to room :type "set"
116 :xmlns "http://jabber.org/protocol/muc#admin")
117 (cxml:with-element "item"
118 (cxml:attribute "affiliation" affiliation)
119 (cxml:attribute "jid" to)))))
120
121
122 (defmethod grant-room-membership ((connection connection) &key room to)
123 (set-room-affiliation connection :room room :to to :affiliation "member"))
124
125
126 (defmethod revoke-room-membership ((connection connection) &key room to)
127 (set-room-affiliation connection :room room :to to :affiliation "none"))
128
129
130 ;;<message
131 ;; from='hag66@shakespeare.lit/pda'
132 ;; to='darkcave@macbeth.shakespeare.lit'
133 ;; type='groupchat'>
134 ;; <body>Harpier cries: 'tis time, 'tis time.</body>
135 ;;</message>
136
137 (defmethod broadcast-room ((connection connection) &key from room message)
138 (with-xml-output (connection)
139 (cxml:with-element "message"
140 (cxml:attribute "from" from)
141 (cxml:attribute "to" room)
142 (cxml:attribute "type" "groupchat")
143 (cxml:with-element "body"
144 (cxml:text message)))))
145
146 (defmacro with-form-field (type var &optional (value ""))
147 `(cxml:with-element "field"
148 ,(when type
149 `(cxml:attribute "type" ,type))
150 ,(when var
151 `(cxml:attribute "var" ,var))
152 (cxml:with-element "value"
153 (cxml:text ,(or value "")))))
154
155 ;; For now these are just the settings that I want to use. It would be easy
156 ;; to change this method so that it takes a list of arguments and looks up
157 ;; nodes/data-types in some structure.
158 (defmethod default-room-config ((connection connection) &key room)
159 (with-xml-output (connection)
160 (with-iq-query (connection :type "set" :to room
161 :xmlns "http://jabber.org/protocol/muc#owner")
162 (cxml:with-element "x"
163 (cxml:attribute "xmlns" "jabber:x:data")
164 (cxml:attribute "type" "submit")
165 (with-form-field "hidden" "FORM_TYPE"
166 "http://jabber.org/protocol/muc#roomconfig")
167 (with-form-field "text-single" "muc#roomconfig_roomname")
168 (with-form-field "boolean" "muc#roomconfig_persistentroom" "0")
169 (with-form-field "boolean" "muc#roomconfig_publicroom" "0")
170 (with-form-field "boolean" "public_list" "0")
171 (with-form-field "boolean" "muc#roomconfig_passwordprotectedroom" "0")
172 (with-form-field "text-private" "muc#roomconfig_roomsecret")
173 (with-form-field "list-single" "muc#roomconfig_whois" "moderators")
174 (with-form-field "boolean" "muc#roomconfig_membersonly" "1")
175 (with-form-field "boolean" "muc#roomconfig_moderatedroom" "0")
176 (with-form-field "boolean" "members_by_default" "0")
177 (with-form-field "boolean" "muc#roomconfig_changesubject" "0")
178 (with-form-field "boolean" "allow_private_messages" "0")
179 (with-form-field "boolean" "allow_query_users" "0")
180 (with-form-field "boolean" "muc#roomconfig_allowinvites" "0")))))
181
182
183 ;;<message
184 ;; from='wiccarocks@shakespeare.lit/laptop'
185 ;; to='darkcave@macbeth.shakespeare.lit'
186 ;; type='groupchat'>
187 ;; <subject>Fire Burn and Cauldron Bubble!</subject>
188 ;;</message>
189
190 (defmethod set-chatroom-subject ((connection connection)
191 &key from room subject)
192 (with-xml-output (connection)
193 (cxml:with-element "message"
194 (cxml:attribute "from" from)
195 (cxml:attribute "to" room)
196 (cxml:attribute "type" "groupchat")
197 (cxml:with-element "subject"
198 (cxml:text subject)))))
199
200
201 ;;<iq from='crone1@shakespeare.lit/desktop'
202 ;; id='begone'
203 ;; to='heath@macbeth.shakespeare.lit'
204 ;; type='set'>
205 ;; <query xmlns='http://jabber.org/protocol/muc#owner'>
206 ;; <destroy jid='darkcave@macbeth.shakespeare.lit'>
207 ;; <reason>Macbeth doth come.</reason>
208 ;; </destroy>
209 ;; </query>
210 ;;</iq>
211
212 (defmethod destroy-chatroom ((connection connection) &key room reason)
213 (with-xml-output (connection)
214 (with-iq-query (connection :type "set" :to room
215 :xmlns "http://jabber.org/protocol/muc#owner")
216 (cxml:with-element "destroy"
217 (cxml:attribute "jid" room)
218 (when reason
219 (cxml:with-element "reason"
220 (cxml:text reason)))))))
221
222
223 ;;<iq from='crone1@shakespeare.lit/desktop'
224 ;; id='voice2'
225 ;; to='darkcave@macbeth.shakespeare.lit'
226 ;; type='set'>
227 ;; <query xmlns='http://jabber.org/protocol/muc#admin'>
228 ;; <item nick='thirdwitch'
229 ;; role='visitor'/>
230 ;; </query>
231 ;;</iq>
232
233 (defmethod revoke-voice ((connection connection) &key room nickname)
234 (with-xml-output (connection)
235 (with-iq-query (connection :type "set" :to room
236 :xmlns "http://jabber.org/protocol/muc#admin")
237 (cxml:with-element "item"
238 (cxml:attribute "nick" nickname)
239 (cxml:attribute "role" "visitor")))))
240

  ViewVC Help
Powered by ViewVC 1.1.5