#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/plugin.tcl,v $
# $Date: 2001/06/13 07:23:04 $
# $Revision: 1.18.1.11 $
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 2000 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
package provide zircon 1.18
#
proc plugin {name syspar params body args} {
    global Plugchannel Pluguser
    set arg net
    set rg net
    set pars {$net}
    foreach x $syspar {
	switch $x {
	channel - user {
	    # FRINK: nocheck
	    set Plug${x}($name) 1
	    append pars " \$$x"
	    lappend arg $x
	    lappend rg $x
	}
	default {error "Unknown plugin parameter - \"$x\""}	
	}
    }
    foreach x $params {
	lappend arg [lindex $x 0]
	lappend parms [list [lindex $x 1] {}]
    }
    switch {} $parms {
	proc [list plugin_$name] $arg $body
    } default {
	proc plugin_$name $rg "
	    mkEntryBox {} [list $name] \"Enter parameters for [list $name]:\" [list $parms] \\
	      \[list ok \[list plugproc_$name $pars\]\] \\
	      \[list cancel {}\]
	"
	proc [list plugproc_$name] $arg $body
    }
}
#
proc addPluginMenu {menu net channel user} {
    switch {} [set pl [info procs plugin_*]] return
    $menu add cascade -label [trans plugin] -menu $menu.plg
    menu $menu.plg -tearoff 0
    addPItems $menu $pl $net $channel $user
}
#
proc addPItems {menu pl net channel user} {
    global Plugchannel Pluguser
    foreach x [lsort $pl] {
	set cmd [list $x $net]
	set name [string range $x 7 end]
	foreach y {channel user} {
	    set val [subst $y]
	    if {[info exists Plug${y}($name)]} {
		if {$val == {}} return
		lappend cmd $val
	    } \
	    elseif {$val != {}} {
	        return
	    }
	}
	$menu.plg add command -label $name -command $cmd
    }
}
