1# $Id$
2
3#############################################################################
4
5namespace eval headlines {
6    variable headid 0
7
8    variable headlines
9    array set headlines {}
10
11    variable selected_id
12    variable options
13    variable trees {}
14
15    custom::defvar send_jids {} \
16	[::msgcat::mc "List of JIDs to whom headlines have been sent."] \
17	-group Hidden
18
19    custom::defvar options(cache) 0 \
20	[::msgcat::mc "Cache headlines on exit and restore on start."] \
21	-group Messages -type boolean
22
23    custom::defvar options(multiple) 0 \
24	[::msgcat::mc "Display headlines in single/multiple windows."] \
25	-group Messages -type options \
26	-values [list 0 [::msgcat::mc "Single window"] \
27		      1 [::msgcat::mc "One window per bare JID"] \
28		      2 [::msgcat::mc "One window per full JID"]]
29
30    custom::defvar options(mark_seen_by) following \
31	[::msgcat::mc "Mark headline read by"] \
32	-group Messages -type options \
33	-values [list following [::msgcat::mc "Following"] \
34		      selection [::msgcat::mc "Selection"] \
35		      timeout [string trim [::msgcat::mc "Timeout "]]]
36
37    custom::defvar options(mark_timeout) 2 \
38	[::msgcat::mc "Headline read timeout value (in seconds)."] \
39	-group Messages -type integer
40
41
42
43    custom::defvar options(display_subject_only) 1 \
44	[::msgcat::mc "Do not display headline descriptions as tree nodes."] \
45	-group Messages -type boolean
46
47    custom::defvar options(timestamp_format) {[%R] } \
48	[::msgcat::mc "Format of timestamp in headline tree view. Set to\
49		       empty string if you don't want to see timestamps."] \
50	-group Messages -type string
51
52    custom::defvar options(show_balloons) 0 \
53	[::msgcat::mc "Show balloons with headline messages over tree nodes."] \
54	-group Messages -type boolean
55}
56
57#############################################################################
58
59package require md5
60
61#############################################################################
62
63proc headlines::process_message {xlib from id type is_subject subject body err thread priority x} {
64    switch -- $type {
65	headline {
66	    show $xlib $from $type $subject $body $thread $priority $x
67	    return stop
68	}
69    }
70    return
71}
72
73hook::add process_message_hook \
74    [namespace current]::headlines::process_message 90
75
76#############################################################################
77
78proc headlines::get_win {xlib from} {
79    variable options
80
81    switch -- $options(multiple) {
82        0 { return .headlines }
83        1 { return .headlines_[jid_to_tag [::xmpp::jid::stripResource $from]] }
84        default { return .headlines_[jid_to_tag $from] }
85    }
86}
87
88#############################################################################
89
90proc headlines::get_tree {xlib from} {
91    set hw [get_win $xlib $from]
92    return $hw.tree
93}
94
95#############################################################################
96
97proc headlines::open_window {xlib from} {
98    global tcl_platform
99    variable options
100    variable trees
101
102    set hw [get_win $xlib $from]
103
104    if {[winfo exists $hw]} return
105
106    switch -- $options(multiple) {
107        0 {
108            set title [::msgcat::mc "Headlines"]
109            set tabtitle [::msgcat::mc "Headlines"]
110        }
111        1 {
112            set user [::xmpp::jid::stripResource $from]
113            set title [::msgcat::mc "%s Headlines" $user]
114            set tabtitle [::xmpp::jid::node $from]
115        }
116        default {
117            set title [::msgcat::mc "%s Headlines" $from]
118            set tabtitle [::xmpp::jid::node $from]/[::xmpp::jid::resource $from]
119        }
120    }
121
122    set tw [get_tree $xlib $from]
123
124    if {[lsearch -exact $trees $tw] < 0} {
125        lappend trees $tw
126    }
127
128    add_win $hw -title $title -tabtitle $tabtitle \
129		-raisecmd [list focus $tw] \
130		-class JDisco
131
132    PanedWin $hw.pw -side right -pad 0 -width 4
133    pack $hw.pw -fill both -expand yes
134
135    set uw [PanedWinAdd $hw.pw -weight 1]
136    set dw [PanedWinAdd $hw.pw -weight 1]
137
138    frame $dw.date
139    label $dw.date.label -anchor w -text [::msgcat::mc "Date:"]
140    entry $dw.date.ts \
141		      -takefocus 0 \
142		      -highlightthickness 0 \
143		      -relief flat
144    pack $dw.date -fill x
145    pack $dw.date.label -side left
146    pack $dw.date.ts -side left -fill x -expand yes
147
148    frame $dw.from
149    label $dw.from.label -anchor w -text [::msgcat::mc "From:"]
150    entry $dw.from.jid \
151		       -takefocus 0 \
152		       -highlightthickness 0 \
153		       -relief flat
154    pack $dw.from -fill x
155    pack $dw.from.label -side left
156    pack $dw.from.jid -side left -fill x -expand yes
157
158    frame $dw.subject
159    label $dw.subject.lsubj -anchor w -text [::msgcat::mc "Subject:"]
160    text $dw.subject.subj \
161			  -height 1 \
162			  -takefocus 0 \
163			  -highlightthickness 0 \
164			  -relief flat \
165			  -state disabled \
166			  -background [lindex [$dw.subject configure -background] 4]
167    pack $dw.subject -fill x
168    pack $dw.subject.lsubj -side left
169    pack $dw.subject.subj -side left -fill x -expand yes
170
171    foreach ent [list $dw.date.ts $dw.from.jid] {
172	if {[catch {$ent configure -state readonly}]} {
173	    $ent configure -state disabled
174	}
175    }
176
177    if {![info exists options(seencolor)]} {
178	if {[string equal $tcl_platform(platform) unix] && \
179		![string equal [option get $hw disabledForeground JDisco] ""]} {
180	    set options(seencolor) [option get $hw disabledForeground JDisco]
181	} else {
182	    set options(seencolor) [option get $hw featurecolor JDisco]
183	}
184    }
185    if {![info exists options(unseencolor)]} {
186	set options(unseencolor) [option get $hw fill JDisco]
187    }
188
189    set sw [ScrolledWindow $uw.sw]
190    Tree $tw \
191	 -selectcommand [list [namespace current]::update_body \
192			      $dw.date.ts $dw.from.jid $dw.subject.subj $hw.body]
193    $sw setwidget $tw
194    pack $sw -side top -expand yes -fill both
195
196    $tw bindText <<ContextMenu>> [list [namespace current]::select_popup $hw]
197    $tw bindText <Double-ButtonPress-1> \
198		 [list [namespace current]::action browse $hw]
199    balloon::setup $tw -command [list [namespace current]::balloon $hw]
200
201    # HACK
202    bind $tw.c <Return> \
203	 [double% "[namespace current]::action browse $hw \[$tw selection get\]"]
204    bind $tw.c <Delete> \
205	 [double% "[namespace current]::action delete $hw \[$tw selection get\]"]
206    bind $tw.c <Insert> \
207	 [double% "[namespace current]::action toggle $hw \[$tw selection get\]"]
208
209    bindscroll $tw.c
210
211    set dsw [ScrolledWindow $dw.sw]
212    text $hw.body -height 12 -state disabled \
213		  -wrap word -takefocus 1
214    ::richtext::config $hw.body -using url
215    $dsw setwidget $hw.body
216    pack $dsw -expand yes -fill both -anchor nw
217
218    bind $hw.body <ButtonPress-1> [list focus %W]
219
220    foreach ww [list $hw.body $dw.date.ts $dw.from.jid $dw.subject.subj] {
221	bind $ww <Key-Up>    [list Tree::_keynav up    [double% $tw]]
222	bind $ww <Key-Down>  [list Tree::_keynav down  [double% $tw]]
223	bind $ww <Key-Left>  [list Tree::_keynav left  [double% $tw]]
224	bind $ww <Key-Right> [list Tree::_keynav right [double% $tw]]
225    }
226
227    hook::run open_headlines_post_hook $hw $tw $uw $dw
228}
229
230#############################################################################
231
232proc headlines::show {xlib from type subject body thread priority x {data {}}} {
233    variable headid
234    variable headlines
235    variable trees
236    variable options
237
238    set subject [string trim $subject]
239    set body [string trim $body]
240
241    set desc ""
242    set url ""
243    set seconds [::xmpp::xml::getAttr [::xmpp::delay::parse $x] seconds]
244    foreach extra $x {
245        ::xmpp::xml::split $extra tag xmlns attrs cdata subels
246	switch -- $xmlns {
247	    jabber:x:oob {
248		foreach item $subels {
249		    ::xmpp::xml::split $item stag sxmlns sattrs scdata ssubels
250
251		    switch -- $stag {
252			desc -
253			url {
254			    set $stag [string trim $scdata]
255			}
256		    }
257		}
258	    }
259	}
260    }
261
262    if {[string equal $subject ""] && [string equal $body ""] && \
263	    [string equal $desc ""] && [string equal $url ""]} {
264	# Ignore an empty message
265	return
266    }
267
268    if {[string equal $subject ""]} {
269	set subject $desc
270    } else {
271	if {$options(display_subject_only)} {
272	    set desc $subject
273	}
274    }
275
276    if {$subject == ""} {
277	set dsubject [::msgcat::mc "<none>"]
278    } else {
279	set dsubject $subject
280    }
281
282    if {$desc == ""} {
283	set ddesc [::msgcat::mc "<none>"]
284    } else {
285	set ddesc $desc
286    }
287
288    set hw [get_win $xlib $from]
289
290    if {![winfo exists $hw]} {
291	open_window $xlib $from
292    }
293
294    set tw [get_tree $xlib $from]
295
296    if {$options(multiple) > 1} {
297	set text $dsubject
298    } else {
299        set text $from
300    }
301    set fnode [str2node $text]
302    if {![$tw exists $fnode]} {
303        $tw insert end root $fnode -text [string map [list "\n" " "] $text] -open 1 \
304            -image browser/headline \
305            -fill $options(seencolor) \
306            -data [list type from text $text unseen 0]
307    }
308
309    if {($options(multiple) > 1) || ([string equal $subject $desc])} {
310        set snode $fnode
311    } else {
312        set snode $fnode-subject-[str2node $dsubject]
313
314        if {![$tw exists $snode]} {
315            $tw insert end $fnode $snode -text [string map [list "\n" " "] $dsubject] -open 1 \
316                -image browser/headline \
317                -fill $options(seencolor) \
318                -data [list type subject text $subject unseen 0]
319        }
320    }
321
322    set anode $fnode-article-[incr headid]
323    if {[$tw exists $anode]} {
324        $tw delete $anode
325    }
326    array set props [list type article unseen 1 seconds $seconds]
327    array set props $data
328    array set props [list text $desc url $url body $body]
329
330    set nodetext \
331	     [clock format $props(seconds) -format $options(timestamp_format)]
332    append nodetext [string map [list "\n" " "] $ddesc]
333
334    $tw insert end $snode $anode -text $nodetext -open 1 \
335        -fill $options(seencolor) \
336        -data [array get props]
337    if {$props(unseen)} {
338        $tw itemconfigure $anode -fill $options(unseencolor)
339    }
340
341    set headlines($anode) [list $xlib $from $type $subject $body $thread $priority $x]
342
343    update $tw $anode
344    tab_set_updated $hw 1 message
345}
346
347#############################################################################
348
349proc headlines::str2node {string} {
350    set utf8str [encoding convertto utf-8 $string]
351    if {[catch { ::md5::md5 -hex $utf8str } ret]} {
352	return [::md5::md5 $utf8str]
353    } else {
354	return $ret
355    }
356}
357
358#############################################################################
359
360proc headlines::update_body {wdate wfrom wsubj wbody tw node} {
361    variable headlines
362    variable options
363    variable selected_id
364
365    if {[catch { array set props [$tw itemcget $node -data] }] ||
366	![info exists props(type)] || \
367	$props(type) != "article"} {
368        set from ""
369	set subj ""
370	set body ""
371	set date ""
372	set url ""
373    } else {
374	set from [lindex $headlines($node) 1]
375	set subj [string map [list "\n" " "] $props(text)]
376	set body $props(body)
377	set date [clock format $props(seconds)]
378	set url $props(url)
379	if {[info exists selected_id]} {
380	    after cancel $selected_id
381	}
382	if {$props(unseen)} {
383	    switch -- $options(mark_seen_by) {
384		selection {
385		    after idle \
386			  [namespace code [list action toggle \
387						[winfo parent $tw] $node]]
388		}
389		timeout {
390		    if {$props(unseen) == 1} {
391			set selected_id [after [expr {$options(mark_timeout)*1000}] \
392					     [namespace code [list action markseen \
393								  [winfo parent $tw] $node]]]
394		    }
395		}
396	    }
397    	}
398    }
399
400    foreach {w s} [list $wdate $date \
401			$wfrom $from] {
402	$w configure -state normal
403	$w delete 0 end
404	$w insert 0 $s
405	if {[catch {$w configure -state readonly}]} {
406	    $w configure -state disabled
407	}
408    }
409
410    $wsubj configure -state normal
411    $wsubj delete 0.0 end
412    $wsubj insert 0.0 $subj
413    $wsubj delete {end - 1 char}
414
415    $wsubj mark set sel_start end
416    $wsubj mark set sel_end 0.0
417
418    $wsubj configure -state disabled
419
420    $wbody configure -state normal
421    $wbody delete 0.0 end
422    ::richtext::render_message $wbody "$body\n\n" ""
423    if {$url != ""} {
424        ::plugins::urls::render_url $wbody url $url {} \
425	    -title [::msgcat::mc "Read on..."] \
426            -add-command [namespace code [list action markseen \
427			       [winfo parent $tw] $node]]
428    }
429
430    $wbody mark set sel_start end
431    $wbody mark set sel_end 0.0
432
433    $wbody configure -state disabled
434}
435
436#############################################################################
437
438proc headlines::update_menu {menu num} {
439    variable send_jids
440
441    set ind 3
442    if {$num} {
443	$menu delete $ind [expr $ind + $num - 1]
444    }
445    foreach jid $send_jids {
446	$menu insert $ind command \
447	    -label [::msgcat::mc "Forward to %s" $jid] \
448	    -command "[namespace current]::forward3 [list $menu] [list $jid] \
449			  \$[namespace current]::headwindow \$[namespace current]::headnode"
450	incr ind
451    }
452}
453
454#############################################################################
455
456namespace eval headlines {
457    if {[winfo exists [set m .h1popmenu]]} {
458	destroy $m
459    }
460    menu $m -tearoff 0
461    $m add command -label [::msgcat::mc "Browse"] \
462	-command "[namespace current]::action browse \
463		    \$[namespace current]::headwindow \$[namespace current]::headnode"
464    $m add separator
465    $m add command -label [::msgcat::mc "Forward..."] \
466	-command "[namespace current]::action forward \
467		    \$[namespace current]::headwindow \$[namespace current]::headnode"
468    $m add separator
469    $m add command -label [::msgcat::mc "Copy headline to clipboard"] \
470	-command "[namespace current]::action copy_headline \
471		    \$[namespace current]::headwindow \$[namespace current]::headnode"
472    $m add command -label [::msgcat::mc "Copy URL to clipboard"] \
473	-command "[namespace current]::action copy_url \
474		    \$[namespace current]::headwindow \$[namespace current]::headnode"
475    $m add command -label [::msgcat::mc "Toggle seen"] \
476	-command "[namespace current]::action toggle \
477		    \$[namespace current]::headwindow \$[namespace current]::headnode" \
478	-accelerator Insert
479    $m add command -label [::msgcat::mc "Delete"] \
480	-command "[namespace current]::action delete \
481		    \$[namespace current]::headwindow \$[namespace current]::headnode"
482    hook::add finload_hook [list [namespace current]::update_menu $m 0]
483
484    if {[winfo exists [set m .h2popmenu]]} {
485	destroy $m
486    }
487    menu $m -tearoff 0
488    $m add command -label [::msgcat::mc "Sort"] \
489	-command "[namespace current]::action sort \
490		    \$[namespace current]::headwindow \$[namespace current]::headnode"
491    $m add command -label [::msgcat::mc "Sort by date"] \
492	-command "[namespace current]::action datesort \
493		    \$[namespace current]::headwindow \$[namespace current]::headnode"
494    $m add command -label [::msgcat::mc "Mark all seen"] \
495	-command "[namespace current]::action markseen \
496		    \$[namespace current]::headwindow \$[namespace current]::headnode"
497    $m add command -label [::msgcat::mc "Mark all unseen"] \
498	-command "[namespace current]::action markunseen \
499		    \$[namespace current]::headwindow \$[namespace current]::headnode"
500    $m add command -label [::msgcat::mc "Delete seen"] \
501	-command "[namespace current]::action deleteseen \
502		    \$[namespace current]::headwindow \$[namespace current]::headnode"
503    $m add command -label [::msgcat::mc "Delete all"] \
504	-command "[namespace current]::action delete \
505		    \$[namespace current]::headwindow \$[namespace current]::headnode"
506}
507
508#############################################################################
509
510proc headlines::select_popup {hw node} {
511    variable headwindow
512    variable headnode
513
514    $hw.tree selection set $node
515
516    if {[catch { array set props [[set tw $hw.tree] itemcget $node -data] }]} {
517        return
518    }
519
520    set headwindow $hw
521    set headnode $node
522
523    switch -- $props(type) {
524        article {
525           set hm .h1popmenu
526        }
527
528        default {
529           set hm .h2popmenu
530        }
531    }
532
533    tk_popup $hm [winfo pointerx .] [winfo pointery .]
534}
535
536#############################################################################
537
538proc headlines::action {action hw node} {
539    variable headlines
540    variable options
541
542    if {[catch { array set props [[set tw $hw.tree] itemcget $node -data] }]} {
543        return
544    }
545
546    switch -glob -- $props(type)/$action {
547        article/browse {
548	    if {$props(url) != ""} {
549		browseurl $props(url)
550	    }
551
552	    if {$props(unseen)} {
553		switch -- $options(mark_seen_by) {
554		    following {
555			set props(unseen) 0
556			$tw itemconfigure $node -fill $options(seencolor) -data [array get props]
557			update $tw $node
558		    }
559		}
560	    }
561	}
562
563	article/forward {
564	    forward .h1popmenu $tw $node
565	}
566
567	article/copy_headline {
568	    clipboard clear -displayof $hw
569	    clipboard append -displayof $hw "$props(text)\n$props(body)\n$props(url)"
570	}
571
572	article/copy_url {
573	    clipboard clear -displayof $hw
574	    clipboard append -displayof $hw $props(url)
575	}
576
577        article/toggle {
578            if {$props(unseen)} {
579                set props(unseen) 0
580                set myfill $options(seencolor)
581            } else {
582                set props(unseen) 1
583                set myfill $options(unseencolor)
584            }
585            $tw itemconfigure $node -fill $myfill -data [array get props]
586            update $tw $node
587        }
588
589        article/markseen {
590            set props(unseen) 0
591            $tw itemconfigure $node -fill $options(seencolor) -data [array get props]
592            update $tw $node
593        }
594
595        article/markunseen {
596            set props(unseen) 1
597            $tw itemconfigure $node -fill $options(unseencolor) -data [array get props]
598            update $tw $node
599        }
600
601        */delete {
602            set props(unseen) 0
603            $tw itemconfigure $node -fill $options(seencolor) -data [array get props]
604            update $tw $node
605
606	    # Deduce the node to select after $node is deleted:
607	    # Next sibling is tried first, then previous, then parent node.
608	    set p [$tw parent $node]
609	    set end [expr {[llength [$tw nodes $p]] - 1}]
610	    set ix [$tw index $node]
611	    if {$ix < $end} {
612		set next [$tw nodes $p [incr ix]]
613	    } elseif {$ix > 0} {
614		set next [$tw nodes $p [incr ix -1]]
615	    } else {
616		set next $p
617	    }
618
619            $tw delete $node
620
621	    if {![string equal $next root]} {
622		$tw selection set $next
623	    }
624        }
625
626        article/deleteseen {
627            if {$props(unseen) == 0} {
628		action delete $hw $node
629	    }
630        }
631
632	from/markseen -
633	subject/markseen {
634            foreach child [$tw nodes $node] {
635		action markseen $hw $child
636            }
637	}
638
639	from/markunseen -
640	subject/markunseen {
641            foreach child [$tw nodes $node] {
642		action markunseen $hw $child
643            }
644	}
645
646	from/deleteseen -
647	subject/deleteseen {
648	    if {$props(unseen) > 0} {
649		foreach child [$tw nodes $node] {
650		    action deleteseen $hw $child
651		}
652	    } else {
653		action delete $hw $node
654	    }
655	}
656
657        from/sort -
658        subject/sort {
659            set children {}
660            foreach child [$tw nodes $node] {
661                catch { unset props }
662                array set props [$tw itemcget $child -data]
663
664                lappend children [list $child $props(text)]
665            }
666            set neworder {}
667            foreach child [lsort -index 1 $children] {
668                lappend neworder [lindex $child 0]
669            }
670            $tw reorder $node $neworder
671
672            foreach child [$tw nodes $node] {
673                action $action $hw $child
674            }
675        }
676
677        from/datesort -
678        subject/datesort {
679            set children {}
680	    set seconds [clock seconds]
681            foreach child [$tw nodes $node] {
682                catch { unset props }
683		set props(seconds) $seconds
684                array set props [$tw itemcget $child -data]
685
686                lappend children [list $child $props(seconds)]
687            }
688            set neworder {}
689            foreach child [lsort -decreasing -index 1 $children] {
690                lappend neworder [lindex $child 0]
691            }
692            $tw reorder $node $neworder
693
694            foreach child [$tw nodes $node] {
695                action $action $hw $child
696            }
697        }
698
699        default {
700        }
701    }
702}
703
704#############################################################################
705
706proc headlines::update {tw node} {
707    variable options
708
709    for {set parent [$tw parent $node]} \
710            {![string equal $parent root]} \
711            {set parent [$tw parent $parent]} {
712        set unseen 0
713
714        foreach child [$tw nodes $parent] {
715            catch { unset props }
716            array set props [$tw itemcget $child -data]
717
718            incr unseen $props(unseen)
719        }
720
721        catch { unset props }
722        array set props [$tw itemcget $parent -data]
723        set props(unseen) $unseen
724
725        set text $props(text)
726	if {$text == ""} {
727	    set text [::msgcat::mc "<none>"]
728	}
729        set myfill $options(seencolor)
730        if {$unseen > 0} {
731            append text " ($unseen)"
732            set myfill $options(unseencolor)
733        }
734        $tw itemconfigure $parent -text $text -fill $myfill \
735                -data [array get props]
736    }
737}
738
739#############################################################################
740
741proc headlines::balloon {hw node} {
742    variable options
743
744    if {!$options(show_balloons)} {
745	return [list $hw:$node ""]
746    }
747
748    if {[catch {array set props [$hw.tree itemcget $node -data]}]} {
749        return [list $hw:$node ""]
750    }
751
752    set width [expr {[winfo width $hw.tree] * 0.8}]
753    if {$width < 400} {
754	set width 400
755    }
756
757    switch -- $props(type) {
758        article {
759            if {![string equal $props(body) ""]} {
760                return [list $hw:$node $props(body) -width $width]
761            }
762        }
763    }
764    return [list $hw:$node ""]
765}
766
767#############################################################################
768
769proc headlines::save {} {
770    variable options
771    variable trees
772
773    if {!$options(cache)} {
774        return
775    }
776
777    if {[catch { open [set file1 [file join $::configdir headlines1.tcl]] \
778                      { WRONLY CREAT TRUNC } } fd]} {
779        debugmsg headlines "unable to open $file: $fd"
780        return
781    }
782    fconfigure $fd -encoding utf-8
783
784    set code [catch {
785        foreach tw $trees {
786            save_aux $tw root $fd
787        }
788    } result]
789
790    catch { close $fd }
791
792    if {$code} {
793        debugmsg headlines $result
794        catch { file delete $file1 }
795
796        return
797    }
798
799    set renameP 0
800    if {![file exists [set file [file join $::configdir headlines.tcl]]]} {
801    } elseif {[file size $file] == 0} {
802        catch { file delete -force $file }
803    } else {
804        set renameP 1
805        catch { file rename -force $file \
806                     [set file0 [file join $::configdir headlines0.tcl]] }
807    }
808
809    if {![catch { file rename $file1 $file } result]} {
810        return
811    }
812
813    debugmsg headlines "unable to rename $file1 to $file: $result"
814    if {($renameP) && ([catch { file rename -force $file0 $file } result])} {
815        debugmsg headlines "unable to rename $file0 back to $file: $result"
816    }
817    catch { file delete $file1 }
818
819    return
820}
821
822#############################################################################
823
824proc headlines::save_aux {tw node fd} {
825    variable headlines
826
827    if {![winfo exists $tw]} {
828        return
829    }
830
831    if {[llength [set children [$tw nodes $node]]] > 0} {
832        foreach child $children {
833            save_aux $tw $child $fd
834        }
835    } elseif {([info exists headlines($node)]) \
836            && (![catch { array set props [$tw itemcget $node -data] }])} {
837        puts $fd [concat [list [namespace current]::show] \
838                         $headlines($node) [list [array get props]]]
839    }
840}
841
842#############################################################################
843
844proc headlines::restore {} {
845    variable options
846
847    if {$options(cache)} {
848	if {[file exists [set file [file join $::configdir headlines.tcl]]]} {
849	    catch {
850		set fd [open $file "r"]
851		fconfigure $fd -encoding utf-8
852		uplevel #0 [read $fd]
853		close $fd
854	    }
855	}
856    }
857
858    return ""
859}
860
861#############################################################################
862
863proc headlines::forward3 {menu to tw node} {
864    variable send_jids
865
866    if {[catch { array set props [$tw.tree itemcget $node -data] } errmsg]} {
867	return
868    }
869
870    if {[llength [connections]] == 0} return
871    set xlib [lindex [connections] 0]
872
873    # TODO: xlib
874    message::send_msg $xlib $to -type headline \
875	-subject $props(text) \
876	-body $props(body) \
877	-xlist [list [::xmpp::xml::create x \
878			    -xmlns jabber:x:oob \
879			    -subelement [::xmpp::xml::create url \
880						-cdata $props(url)] \
881			    -subelement [::xmpp::xml::create desc \
882						-cdata $props(text)]]]
883    set len [llength $send_jids]
884    set send_jids [update_combo_list $send_jids $to 10]
885    update_menu $menu $len
886}
887
888#############################################################################
889
890proc headlines::forward2 {menu tw node} {
891    global forward_hl
892    variable send_jids
893
894    if {[catch { array set props [$tw itemcget $node -data] } errmsg]} {
895	return
896    }
897
898    set len [llength $send_jids]
899    set _send_jids $send_jids
900    foreach choice [array names forward_hl] {
901	if {$forward_hl($choice)} {
902	    lassign $choice xlib to
903	    message::send_msg $xlib $to -type headline \
904		-subject $props(text) \
905		-body $props(body) \
906		-xlist [list [::xmpp::xml::create x \
907				    -xmlns jabber:x:oob \
908				    -subelement [::xmpp::xml::create url \
909							-cdata $props(url)] \
910				    -subelement [::xmpp::xml::create desc \
911							-cdata $props(text)]]]
912	    set _send_jids [update_combo_list $_send_jids $to 10]
913	}
914    }
915    set send_jids $_send_jids
916    update_menu $menu $len
917}
918
919#############################################################################
920
921proc headlines::forward {menu tw node} {
922    global forward_hl
923
924    set gw .forward_headline
925    catch { destroy $gw }
926
927    set choices {}
928    set balloons {}
929    foreach c [connections] {
930	foreach choice [roster::get_jids $c] {
931	    if {![string equal [roster::itemconfig $c $choice -category] conference]} {
932		lappend choices [list $c $choice] [roster::get_label $c $choice]
933		lappend balloons [list $c $choice] $choice
934	    }
935	}
936    }
937    if {[llength $choices] == 0} {
938        MessageDlg ${gw}_err -aspect 50000 -icon info \
939	    -message [::msgcat::mc "No users in roster..."] -type user \
940	    -buttons ok -default 0 -cancel 0
941        return
942    }
943
944    CbDialog $gw [::msgcat::mc "Forward headline"] \
945	[list [::msgcat::mc "Send"] "[namespace current]::forward2 [list $menu] \
946								   [list $tw] \
947								   [list $node]
948				     destroy $gw" \
949	      [::msgcat::mc "Cancel"] [list destroy $gw]] \
950	forward_hl $choices $balloons
951}
952
953#############################################################################
954
955hook::add finload_hook [namespace current]::headlines::restore
956hook::add quit_hook    [namespace current]::headlines::save
957
958#############################################################################
959
960proc headlines::restore_window {from xlib jid} {
961    open_window $xlib $from
962}
963
964#############################################################################
965
966# TODO: Work with changes in options(multiple)
967proc headlines::save_session {vsession} {
968    upvar 2 $vsession session
969    global usetabbar
970
971    # We don't need JID at all, so make it empty (special case)
972    set user     ""
973    set server   ""
974    set resource ""
975
976    # TODO
977    if {!$usetabbar} return
978
979    set prio 0
980    foreach page [.nb pages] {
981	set path [ifacetk::nbpath $page]
982
983	if {[string equal $path .headlines]} {
984	    lappend session [list $prio $user $server $resource \
985		[list [namespace current]::restore_window ""] \
986	    ]
987	}
988	if {[regexp {^.headlines_(.*)} $path -> tag]} {
989	    set jid [tag_to_jid $tag]
990	    lappend session [list $prio $user $server $resource \
991		[list [namespace current]::restore_window $jid] \
992	    ]
993	}
994	incr prio
995    }
996}
997
998hook::add save_session_hook [namespace current]::headlines::save_session
999
1000#############################################################################
1001
1002