# $Id$ 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 [list ButtonBox::invoke [double% $sw.bbox] default] bind $sw [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 [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 [list ButtonBox::invoke [double% $rw.bbox] default] bind $rw [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 +[list [namespace current]::DeleteLastsort %W] bind $sww.listbox <3> \ "[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 [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"]]]