1# $Id$
2
3package require msgcat
4
5namespace eval mute {
6    ::msgcat::mcload [file join [file dirname [info script]] msgs]
7
8    if {![::plugins::is_registered mute]} {
9	::plugins::register mute \
10			    -namespace [namespace current] \
11			    -source [info script] \
12			    -description [::msgcat::mc "Whether the Multi-User Text Editor plugin is loaded."] \
13			    -loadcommand [namespace code load] \
14			    -unloadcommand [namespace code unload]
15	return
16    }
17
18}
19
20proc mute::load {} {
21    set ::NS(mute_ancestor) "http://jabber.org/protocol/mute#ancestor"
22    set ::NS(mute_editor) "http://jabber.org/protocol/mute#editor"
23
24    hook::add roster_create_groupchat_user_menu_hook \
25	      [namespace current]::editor::add_user_menu_item 49
26    hook::add chat_create_user_menu_hook \
27	      [namespace current]::editor::add_user_menu_item 49
28    hook::add roster_jid_popup_menu_hook \
29	      [namespace current]::editor::add_user_menu_item 49
30
31    ::xmpp::iq::register set * $::NS(mute_editor) \
32			 [namespace current]::editor::recv_set_iq
33    ::xmpp::iq::register get * $::NS(mute_ancestor) \
34			 [namespace current]::ancestor::recv_get_iq
35    ::xmpp::iq::register set * $::NS(mute_ancestor) \
36			 [namespace current]::ancestor::recv_set_iq
37}
38
39proc mute::unload {} {
40    hook::remove roster_create_groupchat_user_menu_hook \
41		 [namespace current]::editor::add_user_menu_item 49
42    hook::remove chat_create_user_menu_hook \
43		 [namespace current]::editor::add_user_menu_item 49
44    hook::remove roster_jid_popup_menu_hook \
45		 [namespace current]::editor::add_user_menu_item 49
46
47    ::xmpp::iq::unregister set * $::NS(mute_editor)
48    ::xmpp::iq::unregister get * $::NS(mute_ancestor)
49    ::xmpp::iq::unregister set * $::NS(mute_ancestor)
50
51    catch {unset ::NS(mute_ancestor)}
52    catch {unset ::NS(mute_editor)}
53
54    namespace delete [namespace current]::editor
55    namespace delete [namespace current]::ancestor
56}
57
58namespace eval mute::editor {}
59
60proc mute::editor::get_winid {xlib jid id} {
61    return [win_id mute [list $xlib $jid]//@mute@//$id]
62}
63
64proc mute::editor::add_user_menu_item {m xlib jid} {
65    $m add command \
66	-label [::msgcat::mc "MUTE"] \
67	-command [list [namespace current]::list_request $xlib $jid]
68}
69
70proc mute::editor::list_request {xlib jid} {
71    ::xmpp::sendIQ $xlib get \
72	-query [::xmpp::xml::create list \
73			-xmlns $::NS(mute_ancestor)] \
74	-to $jid \
75	-command [list [namespace current]::list_recv $xlib $jid]
76}
77
78proc mute::editor::list_recv {xlib jid status xml} {
79    variable txts
80
81    if {$status != "ok"} {
82	after idle [list MessageDlg .mute_list_error -icon error \
83			 -message [::msgcat::mc "Error getting list: %s" \
84						[error_to_string $xml]] \
85			 -type ok]
86	return ""
87    }
88
89    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
90
91    set ids {}
92    foreach subel $subels {
93	::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
94	set id [::xmpp::xml::getAttr $sattrs id]
95	lappend ids $id
96	set desc($id) [::xmpp::xml::getAttr $sattrs desc]
97    }
98
99    set w .mute_invite
100
101    if {[winfo exists $w]} {
102	destroy $w
103    }
104
105    Dialog $w -title [::msgcat::mc "List of texts from %s" $jid] \
106	-separator 1 -anchor e -default 0
107
108    foreach id $ids {
109	$w add -text "$id: $desc($id)" \
110	    -command [list [namespace current]::subscribe_request $xlib $jid $id]
111    }
112
113    $w add -text Cancel -command [list destroy $w]
114
115    $w draw
116}
117
118proc mute::editor::subscribe_request {xlib jid id} {
119    ::xmpp::sendIQ $xlib set \
120	-query [::xmpp::xml::create subscribe \
121			-xmlns $::NS(mute_ancestor) \
122			-subelement [::xmpp::xml::create item \
123					    -attrs [list id $id]]] \
124	-to $jid \
125	-command [list [namespace current]::subscribe_recv $xlib $jid $id]
126}
127
128proc mute::editor::subscribe_recv {xlib jid id status xml} {
129    variable txts
130
131    if {$status != "ok"} {
132	after idle [list MessageDlg .mute_list_error -icon error \
133			 -message [::msgcat::mc "Error getting list: %s" \
134						[error_to_string $xml]] \
135			 -type ok]
136	return ""
137    }
138}
139
140proc mute::editor::open_win {xlib jid id} {
141    variable txts
142
143    set w [get_winid $xlib $jid $id]
144    if {[winfo exists $w]} {
145	return
146    }
147
148    add_win $w -title [::msgcat::mc "Edit %s" $id] \
149	       -tabtitle [::msgcat::mc "Edit %s" $id] \
150	       -class Mute
151
152    set bbox [ButtonBox $w.bbox -spacing 10 -padx 10]
153    pack $bbox -side bottom -anchor e
154
155    $bbox add -text [::msgcat::mc "Commit current version"] \
156	-command [list [namespace current]::commit $xlib $jid $id]
157    $bbox add -text [::msgcat::mc "Revert to master version"] \
158	-command [list [namespace current]::revert $xlib $jid $id]
159
160    set sep [Separator::create $w.sep -orient horizontal]
161    pack $sep -pady 2m -fill x -side bottom
162
163    set sw [ScrolledWindow $w.sw]
164    set text [text $w.text]
165    pack $sw -side top -anchor w -expand yes -fill both
166    $sw setwidget $text
167}
168
169proc mute::editor::get_textw {xlib jid id} {
170    return "[get_winid $xlib $jid $id].text"
171}
172
173proc mute::editor::set_text {xlib jid id text} {
174    variable txts
175
176    set txts(text,$xlib,$jid,$id) $text
177    set t [get_textw $xlib $jid $id]
178
179    $t delete 1.0 end
180    $t insert 0.0 $text
181}
182
183proc mute::editor::revert {xlib jid id} {
184    variable txts
185
186    set text $txts(text,$xlib,$jid,$id)
187    set tw [get_textw $xlib $jid $id]
188
189    lassign [split [$tw index insert] .] line pos
190    $tw delete 1.0 end
191    $tw insert 0.0 $text
192    $tw mark set insert "$line.$pos"
193}
194
195proc mute::editor::commit {xlib jid id} {
196    variable txts
197
198    set orig $txts(text,$xlib,$jid,$id)
199
200    set tw [get_textw $xlib $jid $id]
201    set edit [$tw get 1.0 "end -1 chars"]
202
203    if {[cindex $edit end] != "\n"} {
204	set edit "$edit\n"
205    }
206
207    # TODO: check temp files
208    set fn "/tmp/mute[rand 1000000]"
209
210    set fd [open $fn.orig w]
211    fconfigure $fd -encoding utf-8
212    puts -nonewline $fd $orig
213    close $fd
214
215    set fd [open $fn.edit w]
216    fconfigure $fd -encoding utf-8
217    puts -nonewline $fd $edit
218    close $fd
219
220    catch { exec diff -u $fn.orig $fn.edit > $fn.diff }
221
222    set fd [open $fn.diff r]
223    fconfigure $fd -encoding utf-8
224    gets $fd
225    gets $fd
226    set diff [read $fd]
227    close $fd
228
229    file delete $fn.orig $fn.edit $fn.diff
230
231    if {$diff != ""} {
232	::xmpp::sendIQ $xlib set \
233	    -query [::xmpp::xml::create patch \
234			    -xmlns $::NS(mute_ancestor) \
235			    -attrs [list id $id] \
236			    -cdata $diff] \
237	    -to $jid \
238	    -command [list [namespace current]::patch_res $xlib $jid $id]
239    }
240}
241
242proc mute::editor::patch_res {xlib jid id status xml} {
243    variable txts
244
245    if {$status != "ok"} {
246	after idle [list MessageDlg .mute_list_error -icon error \
247			 -message [::msgcat::mc "Error patching: %s" \
248						[error_to_string $xml]] \
249			 -type ok]
250	return ""
251    }
252
253    set text $txts(text,$xlib,$jid,$id)
254
255    set tw [get_textw $xlib $jid $id]
256
257    lassign [split [$tw index insert] .] line pos
258    $tw delete 1.0 end
259    $tw insert 0.0 $text
260    $tw mark set insert "$line.$pos"
261}
262
263proc mute::editor::patch {xlib jid id patch} {
264    variable txts
265
266    set tw [get_textw $xlib $jid $id]
267
268    if {![info exists txts(text,$xlib,$jid,$id)] || ![winfo exists $tw]} {
269	return [list error cancel not-allowed]
270    }
271
272    set text $txts(text,$xlib,$jid,$id)
273
274    set edit [$tw get 1.0 "end -1 chars"]
275
276    lassign [split [$tw index insert] .] line pos
277
278    # TODO: check temp files
279    set fn "/tmp/mute[rand 1000000]"
280
281    set fd [open $fn.old w]
282    fconfigure $fd -encoding utf-8
283    puts -nonewline $fd $text
284    close $fd
285
286    set fd [open $fn.orig w]
287    fconfigure $fd -encoding utf-8
288    puts -nonewline $fd $text
289    close $fd
290
291    set fd [open $fn.patch w]
292    fconfigure $fd -encoding utf-8
293    puts -nonewline $fd $patch
294    close $fd
295
296    set fd [open $fn.edit w]
297    fconfigure $fd -encoding utf-8
298    puts -nonewline $fd $edit
299    close $fd
300
301    if {[catch { exec patch $fn.orig $fn.patch }]} {
302	puts "something wrong..."
303	return
304    }
305
306    set fd [open $fn.orig r]
307    fconfigure $fd -encoding utf-8
308    set new [read $fd]
309    close $fd
310
311    catch { exec merge $fn.edit $fn.old $fn.orig }
312
313    set fd [open $fn.edit r]
314    fconfigure $fd -encoding utf-8
315    set newedit [read $fd]
316    close $fd
317
318    file delete $fn.old $fn.orig $fn.patch $fn.edit
319
320    set txts(text,$xlib,$jid,$id) $new
321
322    $tw delete 1.0 end
323    $tw insert 0.0 $newedit
324
325    set lineregexp {@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@}
326    set shift 0
327    foreach l [split $patch \n] {
328	if {[regexp $lineregexp $l temp ol os nl ns]} {
329	    if {$ol >= $line} break
330	    set shift [expr {$nl + $ns - $ol - $os}]
331	}
332    }
333
334    set line [expr {$line + $shift}]
335    $tw mark set insert "$line.$pos"
336
337    return [list result ""]
338}
339
340proc mute::editor::recv_set_iq {xlib from xml args} {
341    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
342
343    switch -- $tag {
344	text {
345	    set id [::xmpp::xml::getAttr $attrs id]
346	    open_win $xlib $from $id
347	    set_text $xlib $from $id $cdata
348	}
349	patch {
350	    set id [::xmpp::xml::getAttr $attrs id]
351	    return [patch $xlib $from $id $cdata]
352	}
353	default {
354	    return [list error cancel feature-not-implemented]
355	}
356    }
357}
358
359###############################################################################
360
361namespace eval mute::ancestor {
362    set txts(ids) {id1 id2}
363    set txts(desc,id1) "Useful text"
364    set txts(desc,id2) "Useless text"
365
366    set txts(text,id1) "...
3678. Admin Use Cases
368   8.1. Banning a User
369   8.2. Modifying the Ban List
370   8.3. Granting Membership
371   8.4. Revoking Membership
372   8.5. Modifying the Member List
373   8.6. Granting Moderator Privileges
374   8.7. Revoking Moderator Privileges
375   8.8. Modifying the Moderator List
376...
377"
378
379    set txts(text,id2) ""
380}
381
382proc mute::ancestor::send_text {xlib jid id} {
383    variable txts
384
385    ::xmpp::sendIQ $xlib set \
386	-query [::xmpp::xml::create text \
387			-xmlns $::NS(mute_editor) \
388			-attrs [list id $id] \
389			-cdata $txts(text,$xlib,$id)] \
390	-to $jid
391#	-command [list [namespace current]::subscribe_recv $xlib $jid $id]
392}
393
394proc mute::ancestor::patch {xlib jid id patch} {
395    variable txts
396
397    set text $txts(text,$xlib,$id)
398
399    # TODO: check temp files
400    set fn "/tmp/mute[rand 1000000]"
401
402    set fd [open $fn.orig w]
403    fconfigure $fd -encoding utf-8
404    puts -nonewline $fd $text
405    close $fd
406
407    set fd [open $fn.patch w]
408    fconfigure $fd -encoding utf-8
409    puts -nonewline $fd $patch
410    close $fd
411
412    if {[catch { exec patch $fn.orig $fn.patch }]} {
413	return [list error cancel not-allowed]
414    }
415
416    set fd [open $fn.orig r]
417    fconfigure $fd -encoding utf-8
418    set new [read $fd]
419    close $fd
420
421    file delete $fn.orig $fn.patch
422
423    set txts(text,$xlib,$id) $new
424    after idle [list [namespace current]::distribute_patch $xlib $id $patch]
425
426    return [list result ""]
427}
428
429proc mute::ancestor::distribute_patch {xlib id patch} {
430    variable txts
431
432    foreach subscriber $txts(subscribed,$xlib,$id) {
433	::xmpp::sendIQ $xlib set \
434	    -query [::xmpp::xml::create patch \
435			    -xmlns $::NS(mute_editor) \
436			    -attrs [list id $id] \
437			    -cdata $patch] \
438	    -to $subscriber \
439	    -command [list [namespace current]::unsubscribe_on_error \
440			  $xlib $subscriber $id]
441    }
442}
443
444proc mute::ancestor::unsubscribe_on_error {xlib jid id status xml} {
445    variable txts
446
447    if {$status != "ok"} {
448	set idx [lsearch -exact $txts(subscribed,$xlib,$id) $jid]
449	set txts(subscribed,$xlib,$id) [lreplace $txts(subscribed,$xlib,$id) $idx $idx]
450	puts "REMOVE $xlib $jid"
451    }
452}
453
454proc mute::ancestor::recv_get_iq {xlib from xml args} {
455    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
456
457    switch -- $tag {
458	list {
459	    variable txts
460	    # TODO
461	    if {![info exists txts(ids,$xlib)]} {
462		set txts(ids,$xlib) $txts(ids)
463		foreach id $txts(ids) {
464		    set txts(desc,$xlib,$id) $txts(desc,$id)
465		    set txts(text,$xlib,$id) $txts(text,$id)
466		}
467	    }
468
469	    set items {}
470	    foreach id $txts(ids,$xlib) {
471		lappend items [::xmpp::xml::create item \
472				   -attrs [list id $id \
473						desc $txts(desc,$xlib,$id)]]
474	    }
475	    return [list result [::xmpp::xml::create list \
476				     -xmlns $::NS(mute_ancestor) \
477				     -subelements $items]]
478	}
479	default {
480	    return [list error cancel feature-not-implemented]
481	}
482    }
483    return ""
484}
485
486proc mute::ancestor::recv_set_iq {xlib from xml args} {
487    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
488
489    switch -- $tag {
490	subscribe {
491	    variable txts
492
493	    foreach subel $subels {
494		::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
495
496		set id [::xmpp::xml::getAttr $sattrs id]
497		if {[lcontain $txts(ids,$xlib) $id]} {
498		    lappend txts(subscribed,$xlib,$id) $from
499		    set txts(subscribed,$xlib,$id) [lrmdups $txts(subscribed,$xlib,$id)]
500		    after idle [list [namespace current]::send_text $xlib $from $id]
501		    return [list result ""]
502		} else {
503		    return [list error modify bad-request]
504		}
505	    }
506	    return [list error modify bad-request]
507	}
508	patch {
509	    set id [::xmpp::xml::getAttr $attrs id]
510	    return [patch $xlib $from $id $cdata]
511	}
512	default {
513	    return [list error cancel feature-not-implemented]
514	}
515    }
516    return ""
517}
518
519