#!/bin/sh
# The next line restarts using tclsh since sh ignores the backslash \
exec oagwish "$0" "$@"

set auto_path [linsert $auto_path 0 /usr/local/oag/apps/lib/$env(HOST_ARCH)]
set auto_path [linsert $auto_path 0 /usr/local/oag/lib_patch/$env(HOST_ARCH)]
APSDebugPath

#printsource
#showwidgetnameswithmouse

# $Log: not supported by cvs2svn $
# Revision 1.3  1996/09/30 16:38:03  evans
# Removed Xorbit:S1A:Q1:CurrentAO as default PV name.
#
# Revision 1.2  1996/03/27  20:29:37  evans
# First time.
#
# Revision 1.1.1.1  1996/03/25  18:53:09  evans
# Imported files.
#

# **************************** errmsg **********************************
proc errmsg {string} {

    APSErrorDialog .tkprobeerror -errorMessage $string -unique 1
#    APSAlertBox1 .errmsg -errorMessage $string -modeless 1 -unique 1 -name Error
#    puts [format "Tk Probe: %s" $string]
}
# **************************** overviewtext ****************************
proc overviewtext {} {
    return "\
Tk Probe\
\n\n\
Usage: tkprobe \[<pvname>\]\
\n\n\
Tk Probe allows you to search for a process variable, get its value,\
set a new value, echo the value to the terminal, start or stop\
monitoring the value, get the status, and get more extended\
information about the process variable.\
\n\n\
Set sets the process variable to the number in the New Value box.  Get\
gets the current value and displays it in the Value box.  The Value box\
is only changed after Search or Get, or while monitoring.\
\n\n\
Start and Stop start and stop monitoring of the process variable.\
While monitoring, the number in the Value box changes whenever the\
process variable changes outside of its deadband.\
\n\ "
}
# **************************** pvcmon **********************************
proc pvcmon {} {
    global pvname pvout pvset
    global errorCode

    if {![string compare $pvout ""]} {
	errmsg "Must do Search first!"
	return
    }
    if {[pv cmon pvout] != 0} {
	errmsg "Clearing a monitor for $pvname failed:\n[join $errorCode]"
	return
    }
}
# **************************** pvget ***********************************
proc pvget {} {
    global pvname pvout pvset
    global errorCode

    if {![string compare $pvout ""]} {
	errmsg "Must do Search first!"
	return
    }
    if {[pv getw pvout] != 0} {
	errmsg "Get for $pvname failed:\n[join $errorCode]"
	return
    }
    set pvout $pvout
}
# **************************** pvinfo **********************************
proc pvinfo {} {
    global pvname pvout pvset
    global errorCode

    if {![string compare $pvout ""]} {
	errmsg "Must do Search first!"
	return
    }
    set pvinfo0 {state severity status time units name choices \
		    hopr lopr hihi hi lolo lo precision ioc access size}
    set pvinfo [pv info pvout $pvinfo0]
    set pvinfo [lindex $pvinfo 0]      ;# First element of list of lists
    set pvinfo [lrange $pvinfo 1 end]  ;# First element is variable name

    set len [llength $pvinfo]
    set string ""
    for {set i 0} {$i < $len} {incr i} {
	append string [format "%s: %s\n" \
			  [string toupper [lindex $pvinfo0 $i]] \
			 [lindex $pvinfo $i]]
    }
    set string [string trim $string]

    if {[winfo exists .pvinfo]} {destroy .pvinfo}
    APSInfoWindow .pvinfo -name "PV Information" -infoMessage $string
    .pvinfo.msg configure -justify left
}
# **************************** pvsnoop **********************************
set snooping 0
proc pvsnoop {} {
    global pvname pvout pvset
    global errorCode snoopSDIS snoopCAHost snooping snoopingID

    if {![string compare $pvout ""]} {
	errmsg "Must do Search first!"
	return
    }
    if {$snooping} {
        pvsnoopstop 
    }
    set ioc [lindex [split [lindex [lindex [pv info pvout ioc] 0] 1] "."] 0]
    set caHostID ${ioc}:caHostId1
    set pvroot [lindex [split $pvname "."] 0]
    APScavput "-list=${caHostID}.DESC="
    APScavput "-list=${pvroot}.SDIS=$caHostID PP NMS"
    lappend snoopSDIS ${pvroot}.SDIS
    lappend snoopCAHost ${caHostID}.DESC
    set snooping 1
    set snoopingID [APSExecLog .execlog -name "tkprobe snooper" -unixCommand "camonitor ${caHostID}.DESC" -width 100]

    dp_atexit append pvsnoopstop


#    if {[winfo exists .pvinfo]} {destroy .pvinfo}
#    APSInfoWindow .pvinfo -name "PV Information" -infoMessage $string
#    .pvinfo.msg configure -justify left
}
# **************************** pvsnoopstop **********************************
proc pvsnoopstop {} {
    global snoopSDIS snoopCAHost snoopingID snooping
    foreach sdis $snoopSDIS {
        exec cavput "-list=${sdis}="
    }
    foreach cahost $snoopCAHost {
        exec cavput "-list=${cahost}="
    }
    set snoopSDIS ""
    set snoopCAHost ""
    APSExecLogAbort -id $snoopingID -destroy 1
    set snooping 0
}
# **************************** pvlink **********************************
proc pvlink {} {
    global pvname pvout pvset
    global errorCode

    if {[pv linkw pvout $pvname] != 0} {
	errmsg "Read link to $pvname failed:\n[join $errorCode]"
	set pvout ""
	return
    }
    if {[pv linkw pvset $pvname] != 0} {
	errmsg "Write link to $pvname failed:\n[join $errorCode]"
	return
    }
    set pvout $pvout
}
# **************************** pvmon ***********************************
proc pvmon {} {
    global pvname pvout pvset
    global errorCode

    if {![string compare $pvout ""]} {
	errmsg "Must do Search first!"
	return
    }
    pvget
    if {[pv mon pvout {set pvout $pvout}] != 0} {
	errmsg "Setting a monitor for $pvname failed:\n[join $errorCode]"
	return
    }
}
# **************************** pvput ***********************************
proc pvput {} {
    global pvname pvout pvset
    global errorCode

    if {![string compare $pvout ""]} {
	errmsg "Must do Search first!"
	return
    }
    if {[pv putw pvset] != 0} {
	errmsg "Set for $pvname failed:\n[join $errorCode]"
	return
    }
}
# **************************** pvstat **********************************
proc pvstat {} {
    global pvname pvout pvset pvstat
    global errorCode

    if {![string compare $pvout ""]} {
	errmsg "Must do Search first!"
	return
    }
    if {[pv stat pvout pvstat] != 0} {
	errmsg "Get stat for $pvname failed:\n[join $errorCode]"
	return
    }
    set string [format "STATE: %s\nSTATUS: %s\nSEVERITY: %s\nTIME: %s"  \
		  $pvstat(state) $pvstat(status) \
		  $pvstat(severity) $pvstat(time)]
    if {[winfo exists .pvstat]} {destroy .pvstat}
    APSInfoWindow .pvstat -name "PV Status" -infoMessage $string
    .pvstat.msg configure -justify left
#    puts $string
}

# **********************************************************************
# **************************** main ************************************
# **********************************************************************

set tcl_precision 17
set tk_strictMotif 1

set name "Tk Probe"
set version "\$Revision: 1.4 $ \$Author: evans $"
set overview [overviewtext]
if {$argc} {
    set pvname [lindex $argv 0]
} else {
    set pvname ""
    #set pvname "Xorbit:S1A:Q1:CurrentAO"
    #set pvname "TestI:IK"
}
set pvout ""
set pvset ""
set framepad 2

APSApplication . -name $name -version $version -overview $overview \
  -contextHelp "Sorry, there is no context help available for this widget."

APSLabeledEntry .pvnameframe -parent .userFrame -label "  PV Name:" \
  -textVariable pvname -width 40 -contextHelp \
  "The name of a process variable." -packOption "-side top -fill x -expand true"
#bind $w.pvnameframe.entry <Return> pvlink
APSLabeledOutput .pvvalueframe -parent .userFrame -label "    Value:" \
  -textVariable pvout -width 40 -contextHelp \
  "The last obtained value of the process variable."
pack configure .userFrame.pvvalueframe.entry -expand true
APSLabeledEntry .pvsetvalueframe -parent .userFrame -label "Set Value:" \
  -textVariable pvset -width 40 -contextHelp \
  "The value to to which the process variable will be set when the Set\
    button is pressed." -packOption "-side top -fill x -expand true"
#bind $w.pvsetvalueframe.entry <Return> pvput

#frame2
frame .frame2
set w .frame2
pack $w -in .userFrame -side top -fill x -fill y -padx $framepad -pady $framepad

APSButton .searchbutton -parent $w -text Search -command pvlink \
 -contextHelp \
   "Causes the process variable to be searched for."
APSButton .getbutton -parent $w -text Get -command pvget \
 -contextHelp \
   "Causes the current value of the process variable to be obtained."
APSButton .setbutton -parent $w -text Set -command pvput \
 -contextHelp \
   "Causes the current value of the process variable to be set to the\
    value in the \"Set Value:\" entry box."

#frame 3
frame .frame3
set w .frame3
pack $w -in .userFrame -side top -fill x -fill y -padx $framepad -pady $framepad

APSButton .startbutton -parent $w -text Start -command pvmon \
 -contextHelp \
   "Causes the process variable to be monitored.  If this process\
     variable has been set up for monitoring, the Value will be\
     updated when the value of the process variable changes outside\
     of its deadband."
APSButton .stopbutton -parent $w -text Stop -command pvcmon \
 -contextHelp \
   "Causes the process variable to stop being monitored."
APSButton .statbutton -parent $w -text Status -command pvstat \
 -contextHelp \
   "Gives status information about the process variable."
APSButton .infobutton -parent $w -text Info -command pvinfo \
 -contextHelp \
   "Gives extended information about the process variable."

APSButton .snoopbutton -parent $w -text Snoop -command pvsnoop \
 -contextHelp \
   "Gives information about who is changing the process variable."

# **************************** Emacs Editing Sequences *****************
# Local Variables:
# mode: tcl
# End:
