#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/List.tcl,v $
# $Date: 2001/07/10 15:36:11 $
# $Revision: 1.18.1.17 $
#
package provide zircon 1.18
#
#
proc showFull {net lst w x y yl} {
    upvar #0 $net ndata
    set chan [lindex $ndata(allChannels) [$w nearest $yl]]
    set w [toplevel .@lt$lst -class Zircon]
    wm overrideredirect $w 1
    wm geometry $w +$x+$y
    grid [label $w.l -text $chan -fg [$net balloonfg] -bg [$net balloonbg]] -ipadx 3 -ipady 3
    clipboard clear
    clipboard append $chan
}
#

proc List {args} {  return [makeObj List $args] }
#
proc list_clear {this} {
    set w [[$this wid] name]
    $w.chn.l delete 0 end
    [$this net] configure -allChannels {}
    catch {destroy .@lt$this}
}
#
proc list_delete {this} {
    $this unshow
    switch {} [$this listfile] {} default { close [$this listfile] }
    catch {filedelete [$this filename] }
}
#
proc list_unshow {this} {
    upvar #0 $this ldata
    switch {} $ldata(wid) return
    $this clear
    $ldata(wid) deregister $this
    set ldata(wid) {}
}
#
proc list_save {this} {
    if {[catch {tk_getSaveFile -defaultextension .txt} sfl]} {
        [$this net] errmsg "File error: $sfl"
	return
    }
    if {$sfl == {}} return
    if {[catch {open $sfl w} fd]} {
        [$this net] errmsg "Cannot open file \"$sfl\": $fd"
	return
    }
    foreach x [[[$this wid] name].chn.l get 0 end] { puts $fd $x }
    if {[catch {close $fd} msg]} {
        [$this net] errmsg "Close error for \"$sfl\": $msg"
	return
    }
}
#
proc list_configure {this args} { confObj $this $args }
#
proc list_show {this} {
    upvar #0 $this ldata
    switch {} $ldata(wid) {
    	set net $ldata(net)
        set ldata(wid) [set wndw [Window :: make .$this]]
	$wndw configure -title "[$net name] Channel List" \
	  -iconname "[$net name] Channel List"
	$wndw register $this "$this unshow" {}
	set w [$wndw name]
	frame $w.filter -relief raised
	checkbutton $w.filter.public -variable ${net}(showPublic) \
	  -text [trans public]
	checkbutton $w.filter.local -variable ${net}(showLocal) \
	  -text [trans local]
	checkbutton $w.filter.private -variable ${net}(showPrivate) \
	  -text [trans private]
	checkbutton $w.filter.topic -variable ${net}(topicOnly) \
	  -text [trans {with topic}]
	checkbutton $w.filter.sorted -variable ${net}(sorted) \
	  -text [trans sorted] -command "allowSBs $net $w"
	checkbutton $w.filter.nocase -variable ${net}(nocase) \
	  -text [trans nocase] -state disabled
	radiobutton $w.filter.names -variable ${net}(sortNames) \
	  -value 1 -text [trans {by name}] -state disabled
	radiobutton $w.filter.users -variable ${net}(sortNames) \
	  -value 0 -text [trans {by users}] -state disabled
	allowSBs $net $w
	scale $w.filter.minm \
	  -from 1 -to 25 -label [trans {minimum number of members}] \
	  -showvalue 1 -orient horizontal \
	  -command "set ${net}(minMembers)"

	$w.filter.minm set [$net minMembers]

	grid $w.filter.minm - - - -sticky ew
	scale $w.filter.maxm \
	  -from 0 -to  50 -label [trans {maximum number of members}] \
	  -showvalue 1 -orient horizontal \
	  -command "set ${net}(maxMembers)"
	$w.filter.maxm set [$net maxMembers]
	evenGrid $w.filter column 0 3
	grid $w.filter.maxm - - - -sticky ew
	grid $w.filter.public $w.filter.local $w.filter.private \
	  $w.filter.topic -sticky w
	grid $w.filter.sorted $w.filter.nocase $w.filter.names $w.filter.users -sticky w
	labelEntry 0 $w.filter2 "-text [list [trans {channel pattern}]]" [$net listPattern] {}
	labelEntry 0 $w.filter3 "-text [list [trans {topic pattern}]]" [$net topicPattern] {}
	$w.filter2.entry configure -textvariable ${net}(listPattern)
	$w.filter3.entry configure -textvariable ${net}(topicPattern)
	makeLB $w.chn -width 20 -height 8 -exportselection 1
	labelEntry 0 $w.which "-text [trans channel]" [$this channel] "$this doit"
	$w.which.entry configure -textvariable ${this}(channel)
	frame $w.btn
	evenGrid $w.btn column 0 2
	button $w.btn.ok -text [trans dismiss] -relief raised \
	  -command "$this unshow"
	button $w.btn.clear -text [trans clear] -relief raised \
	  -command "$this clear"
	button $w.btn.save -text [trans save] -relief raised \
	  -command "$this save"
	switch -glob -- [info tclversion] 7.* {
	    $w.btn.save configure -state disabled
	}
	button $w.btn.list -text [trans list] -relief raised \
	  -command "$this doit"
	grid $w.btn.list $w.btn.clear $w.btn.save $w.btn.ok -sticky ew
	grid columnconfigure $w 0 -weight 1
	grid rowconfigure $w 3 -weight 1
	grid $w.filter -sticky ew
	grid $w.filter2 -sticky ew
	grid $w.filter3 -sticky ew
	grid $w.chn -sticky nsew
	grid $w.which -sticky ew
	grid $w.btn -sticky ew
	bind $w.chn.l <Double-Button-1> "
	    notIdle $w $net
	    channelJoin $net \[lindex \$${net}(allChannels) \[%W nearest %y\]\] {}
	    break
	"
	bind $w.chn.l <ButtonPress-2> "
	    notIdle %W $net
	    showFull $net $this %W %X %Y %y
	    break
	"
	bind $w.chn.l <ButtonRelease-2> "notIdle %W $net ; catch {destroy .@lt$this}; break"
	bind $w.chn.l <Button-1> "
	    notIdle $w $net
	    [$net control] configure -channel \[lindex \$${net}(allChannels) \[%W nearest %y\]\]  
	    break
	"
     } default {
	$ldata(wid) popup
     }
}
#
proc allowSBs {net w} {
   set state normal
   if {![$net sorted]} { set state disabled }
   foreach x {nocase names users} { $w.filter.$x configure -state $state }
}
#
proc list_buildProc {this} {
    set net [$this net]
    upvar #0 $net ndata
    set w [[$this wid] name]
    $this clear
    [$this wid] grab watch
    $w.btn.list configure -state disabled
    foreach x {filter2.entry filter3.entry filter.public filter.local
      filter.topic filter.sorted filter.nocase filter.private
      filter.maxm filter.minm filter.names filter.users} {
	$w.$x configure -state disabled
    }
    $net configure -allChannels {}
    set pbdy "switch {} \$pargs return ; upvar #0 $net ndata\n"
    append pbdy {regsub -all "\t" $pargs "\\\t" pargs
    foreach {chan memb} $pargs break}
    append pbdy "\nset w .$this\n"
    
    switch {} [$this channel] {
# No channel name given
	switch {} ndata(listPattern) {
	    set ndata(listPattern) .*
	} default {
	    if {[catch {regexp -- $ndata(listPattern) test} msg]} {
		set ndata(listPattern) .*
		tellError {} Error "Bad regexp for list pattern:\n$msg"
	    }
	}
	switch {} $ndata(topicPattern) {
	    set ndata(topicPattern) .*
	} default {
	    if {[catch {regexp -- $ndata(topicPattern) test} msg]} {
		set ndata(topicPattern) .*
		tellError {} Error "Bad regexp for topic pattern:\n$msg"
	    }
	}
	append pbdy "if {!\$ndata(showlist)} \{switch -glob -- \$chan {\\*} "
	if {$ndata(showPrivate)} {
    	    append pbdy {{set chan Prv}}
	} {
	    append pbdy return
	}
	if {!$ndata(showLocal)} {append pbdy { &* return}}
	if {!$ndata(showPublic)} {append pbdy { {[#+]*} return}}
	if {$ndata(topicOnly)} {append pbdy { ; switch {} $param return}}
	if {$ndata(minMembers) > 1 || $ndata(maxMembers) > 0} {
	    if {$ndata(minMembers) > 1} {
		append pbdy { ; if {$memb < $ndata(minMembers)} return}
	    }
	    if {$ndata(maxMembers) > 0} {
		append pbdy { ; if {$memb > $ndata(maxMembers)} return}
	    }
	}
	switch .* $ndata(listPattern) {} default {
	    append pbdy " ; if {!\[regexp -nocase -- [list $ndata(listPattern)] \$chan\]} return"
	}
	switch .* $ndata(topicPattern) {} default {
	    append pbdy " ; if {!\[regexp -nocase -- [list $ndata(topicPattern)] \$param\]} return"
	}
	append pbdy " \}"
    }
    append pbdy "\n$net configure +allChannels \$chan"
    if {[set nw $ndata(namewidth)] <= 0} {
    append pbdy {
    if {![catch {format {%s %3d %s} $chan $memb $param} lln]} {
	  $w.chn.l insert end $lln
    }
    }
    } {
    append pbdy "
    if {!\[catch {format {%-${nw}s %3d %s} \[string range \$chan 0 [expr {$nw - 1}]\] \$memb \$param} lln\]} {
	  \$w.chn.l insert end \$lln
    }
    "
    }
    # FRINK : nocheck
    proc doChkList$this {pargs param} $pbdy
}
#
proc list_doit {this} {
    $this clear
    $this buildProc
    set net [$this net]
    set chn [$this channel]
    if {[$net undernet]} { underList $net $chn } {
	switch {} $chn {$net q1Send LIST} default {$net q1Send "LIST :$chn"}
    }
    $this irc321
}
#
proc list_irc321 {this} {
    switch {} [$this wid] return
    upvar #0 ${this}(listfile) lf
    switch {} $lf {
    	set fn [file join [tmpdir] [newName LF].dat]
	$this configure -filename $fn
        if {[catch {open $fn w+} lf]} { set lf {} }
    }
}
#
proc list_irc322 {this unusedprefix param pargs} {
    if {[$this wid] =={}} return
    upvar #0 ${this}(listfile) lf
    switch {} $lf {doChkList$this $pargs $param} default {
	puts $lf [lrange $pargs 1 end]
	puts $lf $param
    }
}
#
proc list_release {this} {
    switch {} [set wn [$this wid]] return
    $wn release arrow
}
#
proc list_process {this} {
    [set net [$this net]] configure -showlist 0
    switch {} [set wid [$this wid]] {
	catch {filedelete [$this filename]}
	catch {close [$this listfile]}
	$this configure -listfile {}
	return
    }
    set w [$wid name]
    catch {grab release $w}
    catch {$w configure -cursor arrow}
    switch {} [set fd [$this listfile]] {} default {
	update
	if {[winfo exists $w]} {
	    seek $fd 0 start
	    set lcount -50
	    if {[$net sorted]} {
		while {![eof $fd]} {
		    lappend lst [list [gets $fd] [gets $fd]]
		    if {![incr lcount]} {
			update
			if {![winfo exists $w]} break
			set lcount -50
		    }
		}
		set lcount -50
		foreach x [if {[$net nocase]} {ncsort $lst} {lsort $lst}] {
		    doChkList$this [lindex $x 0] [lindex $x 1]
		    if {![incr lcount]} {
			update
			if {![winfo exists $w]} break
			set lcount -50
		    }
		}
	    } {
		while {![eof $fd]} {
		    doChkList$this [gets $fd] [gets $fd]
		    if {![incr lcount]} {
			update
			if {![winfo exists $w]} break
			set lcount -50
		    }
		}
	    }
	}
	catch {filedelete [$this filename]}
	close $fd
	$this configure -listfile {}
    }
    foreach x {filter2.entry filter3.entry filter.public filter.local
      filter.topic filter.sorted filter.private
      filter.maxm filter.minm btn.list} {
	catch {$w.$x configure -state normal}
    }
    catch {allowSBs $net $w}
}
