# $Id: search.tcl 2099 2014-01-26 09:48:25Z sergei $

package require xmpp::search

namespace eval search {
    set show_all 0
}

proc search::open {xlib jid args} {
    variable winid

    if {![info exists winid]} {
	set winid 0
    }

    set sw .search[incr winid]

    toplevel $sw -cursor watch
    wm group $sw .
    set title [::msgcat::mc "Search in %s" $jid]
    wm title $sw $title
    wm iconname $sw $title
    wm transient $sw .
    if {$::tcl_platform(platform) == "macintosh"} {
        catch { unsupported1 style $sw floating sideTitlebar }
    } elseif {$::aquaP} {
        ::tk::unsupported::MacWindowStyle style $sw dBoxProc
    }
    wm resizable $sw 0 0

    wm withdraw $sw

    ButtonBox $sw.bbox -spacing 0 -padx 10 -default 0
    $sw.bbox add -text [::msgcat::mc "OK"] \
		 -command [namespace code [list Search $sw $xlib $jid false]] \
		 -state disabled
    $sw.bbox add -text [::msgcat::mc "Cancel"] \
		 -command [list destroy $sw]
    pack $sw.bbox -padx 2m -pady 2m -anchor e -side bottom

    bind $sw <Return> [list ButtonBox::invoke [double% $sw.bbox] default]
    bind $sw <Escape> [list ButtonBox::invoke [double% $sw.bbox] 1]

    Separator::create $sw.sep -orient horizontal
    pack $sw.sep -side bottom -fill x -pady 1m
    
    frame $sw.fields -class Search

    pack $sw.fields -expand yes -fill both -anchor nw -padx 2m -pady 2m
    bind $sw.fields <Destroy> [list data::cleanup %W]

    ::xmpp::search::request $xlib $jid \
		-command [namespace code [list RecvFields $sw $xlib $jid]]
}

proc search::RecvFields {sw xlib jid status fields args} {
    debugmsg search "$status $fields"

    if {![string equal $status ok]} {
        destroy $sw
	MessageDlg ${sw}err -aspect 50000 \
			    -icon error \
			    -message [::msgcat::mc "Search: %s" \
						   [error_to_string $fields]] \
			    -type user \
			    -buttons ok \
			    -default 0 \
			    -cancel 0
	return
    }

    foreach {key val} $args {
	switch -- $key {
	    -old {
		$sw.bbox itemconfigure 0 \
			 -command [namespace code [list Search $sw $xlib $jid $val]]
	    }
	}
    }

    set focus [data::fill_fields_x $sw.fields $fields]

    $sw configure -cursor {}
    $sw.bbox itemconfigure 0 -state normal

    if {$focus != ""} {
	focus $focus
    }
    update idletasks
    wm deiconify $sw
}

proc search::Search {sw xlib jid old} {
    variable data

    $sw configure -cursor watch
    $sw.bbox itemconfigure 0 -state disabled

    set resfields [data::get_fields $sw.fields]

    ::xmpp::search::submit $xlib $jid $resfields \
	    -command [namespace code [list RecvItems $sw $xlib $jid $old]] \
	    -old $old
}

proc search::RecvItems {sw xlib jid old status items} {
    variable lastsort

    debugmsg search "$status $items"

    if {![winfo exists $sw]} {
	return
    }

    if {![string equal $status ok]} {
	$sw configure -cursor {}
	$sw.bbox itemconfigure 0 -text [::msgcat::mc "Try again"] \
	    -command [namespace code [list SearchAgain "" $sw $jid $xlib $old errormsg]] \
	    -state normal
	$sw.bbox itemconfigure 1 -text [::msgcat::mc "Close"]

	if {[winfo exists $sw.errormsg]} {
	    destroy $sw.errormsg
	}

	message $sw.errormsg -aspect 50000 \
	    -text [::msgcat::mc "An error occurred when searching in %s\n\n%s" \
				$jid [error_to_string $items]]

	pack $sw.errormsg -expand yes -fill both -after $sw.fields \
			  -anchor nw -padx 1c -pady 1c
	pack forget $sw.fields

	return
    }

    wm withdraw $sw

    set rw [toplevel ${sw}results]
    wm group $rw .
    set title [::msgcat::mc "Search in %s" $jid]
    wm title $rw $title
    wm iconname $rw $title
    wm withdraw $rw

    ButtonBox $rw.bbox -spacing 0 -padx 10 -default 0
    $rw.bbox add -text [::msgcat::mc "Search again"] \
		 -command [namespace code [list SearchAgain $rw $sw $jid $xlib $old]]
    $rw.bbox add -text [::msgcat::mc "Close"] \
		 -command "destroy [list $rw]
			   destroy [list $sw]"
    pack $rw.bbox -padx 2m -pady 2m -anchor e -side bottom

    bind $rw <Return> [list ButtonBox::invoke [double% $rw.bbox] default]
    bind $rw <Escape> [list ButtonBox::invoke [double% $rw.bbox] 1]

    Separator::create $rw.sep -orient horizontal
    pack $rw.sep -side bottom -fill x -pady 1m

    set sww [ScrolledWindow $rw.items]

    ::mclistbox::mclistbox $sww.listbox \
	-resizeonecolumn 1 \
	-labelanchor w \
	-width 90 \
	-height 16

    pack $sww -expand yes -fill both -anchor nw -padx 2m -pady 2m
    $sww setwidget $sww.listbox

    set lastsort($sww.listbox) ""
    bind $sww.listbox <Destroy> +[list [namespace current]::DeleteLastsort %W]
    
    bind $sww.listbox <<ContextMenu>> \
	"[namespace current]::SelectAndPopupMenu [list [double% $sww.listbox]] \
	     \[[double% $sww.listbox] nearest \[::mclistbox::convert %W -y %y\]\] \
	     [double% $xlib]"

    bindscroll $sww $sww.listbox

    set rows [FillMclistbox $rw $jid $sww.listbox $items]

    if {$rows <= 0} {
	pack forget $sww
	message $rw.errormsg -aspect 50000 \
	    -text [::msgcat::mc "Search in %s: No matching items found" $jid]
	pack $rw.errormsg -expand yes -fill both -anchor nw -padx 1c -pady 1c
    } elseif {$rows <= 12} {
	$sww.listbox configure -height [expr {$rows - ($rows % 4) + 4}]
    }

    BWidget::place $rw 0 0 center
    wm deiconify $rw
}

proc search::DeleteLastsort {id} {
    variable lastsort

    if {[info exists lastsort($id)]} {
	unset lastsort($id)
    }
}

proc search::FillMclistbox {sw jid w items} {
    variable show_all

    set width(0) 3
    set name(0) N
    $w column add N -label " [::msgcat::mc #] "

    set row 0
    set col 1

    foreach {tag item} $items {
	switch -- $tag {
	    title {
		if {$item != ""} {
		    wm title $sw $item
		    wm iconname $sw $item
		}
	    }
	    reported {
		set reported {}
		foreach {var label} $item {
		    lappend reported $var
		    set label_name($var) $label
		}
	    }
	}
    }

    foreach {tag item} $items {
	switch -- $tag {
	    item {
		foreach {var values} $item {
		    foreach value $values {
			if {![string equal $value ""]} {
			    if {$show_all || ![info exists reported] || \
				    [lsearch -exact $reported $var] >= 0} {
				if {![info exists fieldcol($var)]} {
				    set fieldcol($var) $col
				    if {[info exists label_name($var)]} {
					set l $label_name($var)
				    } else {
					set l $var
				    }
				    set width($col) [string length " $l "]
				    set name($col) $var
				    $w column add $var -label " $l "
				    $w label bind $var <ButtonPress-1> [namespace code [list Sort %W [double% $var]]]
				    set lasttag $var

				    incr col
				}
				set data($fieldcol($var),$row) $value

				debugmsg search "$var $value"
			    }
			}
		    }
		}

		set data(0,$row) [expr {$row + 1}]
		incr row
	    }
	}	
    }

    FinalizeMclistbox $w $row $col name data width
}

proc search::FinalizeMclistbox {w row col n d wi} {
    upvar $n name
    upvar $d data
    upvar $wi width

    $w column add lastcol -label "" -width 0
    $w configure -fillcolumn lastcol
    
    for {set j 0} {$j < $row} {incr j} {
	set datalist {}
	for {set i 0} {$i < $col} {incr i} {
	    if {[info exists data($i,$j)]} {
		set wd [string length " $data($i,$j) "]
		if {$wd > $width($i)} {
		    set width($i) $wd
		}
		lappend datalist " $data($i,$j) "
	    } else {
		lappend datalist ""
	    }
	}
	lappend datalist ""
	$w insert end $datalist
    }
    for {set i 0} {$i < $col} {incr i} {
	$w column configure $name($i) -width $width($i)
    }

    return $row
}

proc search::Sort {w tag} {
    variable lastsort

    set data [$w get 0 end]
    set index [lsearch -exact [$w column names] $tag]
    if {$lastsort($w) != $tag} {
	set result [lsort -dictionary -index $index $data]
	set lastsort($w) $tag
    } else {
	set result [lsort -decreasing -dictionary -index $index $data]
	set lastsort($w) ""
    }
    set result1 {}
    set i 0
    foreach row $result {
	lappend result1 [lreplace $row 0 0 " [incr i] "]
    }
    $w delete 0 end
    eval $w insert end $result1
}

proc search::SearchAgain {rw sw jid xlib old {delwidget ""}} {
    catch {destroy $rw}

    $sw configure -cursor {}
    if {![string equal $delwidget ""]} {
	pack $sw.fields -expand yes -fill both -after $sw.$delwidget -anchor nw -padx 2m -pady 2m
	pack forget $sw.$delwidget

	$sw.bbox itemconfigure 0 -text [::msgcat::mc "OK"] \
	    -command [namespace code [list Search $sw $xlib $jid $old]] \
	    -state normal
	$sw.bbox itemconfigure 1 -text [::msgcat::mc "Cancel"]
    } else {
	$sw.bbox itemconfigure 0 -state normal
	wm deiconify $sw
    }
}

proc search::SelectAndPopupMenu {w index xlib} {

    $w selection clear 0 end
    $w selection set $index
    set jid [string trim [lindex [$w get $index] 1]]

    if {[winfo exists [set m .searchpopupmenu]]} {
	destroy $m
    }
    menu $m -tearoff 0

    hook::run search_popup_menu_hook $m $xlib $jid

    tk_popup $m [winfo pointerx .] [winfo pointery .]
}

proc search::AddSeparator {m xlib jid} {
    $m add separator
}

hook::add search_popup_menu_hook \
    [namespace current]::search::AddSeparator 40
hook::add search_popup_menu_hook \
    [namespace current]::search::AddSeparator 50

hook::add postload_hook \
    [list disco::browser::register_feature_handler jabber:iq:search \
	[namespace current]::search::open \
	-desc [list * [::msgcat::mc "Search"]]]

