initial commit
This commit is contained in:
l_samenv
313
tcl/startup/layout.tcl
Normal file
313
tcl/startup/layout.tcl
Normal file
@ -0,0 +1,313 @@
|
||||
#----- layout elements ----
|
||||
|
||||
if {[clientput "ERROR old SeaServer version" value] eq ""} {
|
||||
proc client_log {message} {
|
||||
set message [regsub ERROR $message Error]
|
||||
set message [regsub WARNING $message Warning]
|
||||
clientput $message
|
||||
}
|
||||
} else {
|
||||
proc client_log {message} {
|
||||
clientput $message log
|
||||
}
|
||||
}
|
||||
|
||||
proc layout {lay args} {
|
||||
global shown_groups inside_samenv
|
||||
|
||||
if {$inside_samenv} {
|
||||
client_log "ERROR: in layout $lay $args"
|
||||
client_log "ERROR: Layout function must start with capital in config files"
|
||||
}
|
||||
EndTable
|
||||
if {[array exists shown_groups]} {
|
||||
array unset shown_groups
|
||||
}
|
||||
foreach a $args {
|
||||
set shown_groups($a) 1
|
||||
}
|
||||
set title Main
|
||||
if {[catch ${lay}Group msg] != 0} {
|
||||
Style warning
|
||||
Label "$msg"
|
||||
}
|
||||
}
|
||||
|
||||
# for seaweb
|
||||
proc getgroup {p} {
|
||||
global shown_groups grp_title
|
||||
if {[array exists shown_groups]} {
|
||||
array unset shown_groups
|
||||
}
|
||||
set shown_groups($p) 1
|
||||
if {[string index $p 0] eq "/"} {
|
||||
hdbLayout $p
|
||||
} elseif {$p eq "main"} {
|
||||
client_log "-Tmain"
|
||||
client_log "-G$p"
|
||||
mainGroup forweb
|
||||
client_log "-E1"
|
||||
} elseif {$p eq "webSelect"} {
|
||||
if {[info exists grp_title($p)]} {
|
||||
client_log "-T$grp_title($p)"
|
||||
}
|
||||
client_log "-G$p"
|
||||
layout $p
|
||||
client_log "-E1"
|
||||
} elseif {[string match "_*" $p]} {
|
||||
getgroup$p
|
||||
} else {
|
||||
if {[catch {eval ${p}Layout} msg]} {
|
||||
if {[info exists grp_title($p)]} {
|
||||
client_log "-T$grp_title($p)"
|
||||
}
|
||||
client_log "-G$p"
|
||||
if {[catch {eval ${p}Group} msg]} {
|
||||
Style Warning
|
||||
Label $msg
|
||||
}
|
||||
client_log "-E1"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc StartTable {} {
|
||||
global inside_table
|
||||
set inside_table 1
|
||||
}
|
||||
|
||||
proc EndTable {} {
|
||||
global inside_table
|
||||
if {[info exists inside_table]} {
|
||||
unset inside_table
|
||||
}
|
||||
}
|
||||
|
||||
proc plval {varval} {
|
||||
set vl [split $varval /]
|
||||
set var [lindex $vl 0]
|
||||
if {[llength $vl] == 1} {
|
||||
set op [split $var]
|
||||
# if {[llength $op] > 1} {
|
||||
# upvar #0 [lindex $op 0] a
|
||||
# set par [join [lrange $op 1 end] _]
|
||||
# } else {
|
||||
# upvar #0 $var a
|
||||
# set par _
|
||||
# }
|
||||
# if {[info exists a($par)]} {
|
||||
# set val $a($par)
|
||||
# } else {
|
||||
set val [eval result $var]
|
||||
# }
|
||||
} else {
|
||||
set val [lindex $vl 1]
|
||||
}
|
||||
return $val
|
||||
}
|
||||
|
||||
proc plvar {varval} {
|
||||
return [lindex [split $varval /] 0]
|
||||
}
|
||||
|
||||
proc Tip args {
|
||||
client_log "-H[join $args]"
|
||||
}
|
||||
|
||||
proc Value {label var} {
|
||||
client_log "-T$label"
|
||||
client_log "-V[plval $var]"
|
||||
client_log "-i[plvar $var]"
|
||||
}
|
||||
|
||||
proc Input {label var {lenfix 0} {lentab 0} {showgraph 1}} {
|
||||
global inside_table
|
||||
if {! [info exists inside_table]} {
|
||||
if {$lenfix > 0} {
|
||||
client_log "-W$lenfix"
|
||||
}
|
||||
client_log "-T$label"
|
||||
client_log "-V[plval $var]"
|
||||
client_log "-I[plvar $var]"
|
||||
if {$showgraph} {
|
||||
GraphIcon [plvar $var]
|
||||
}
|
||||
} else {
|
||||
Newline
|
||||
set fixed [result eval ctrlTable fixed $var]
|
||||
if {$fixed} {
|
||||
if {$lenfix > 0} {
|
||||
client_log "-W$lenfix"
|
||||
}
|
||||
client_log "-T$label"
|
||||
client_log "-V[plval $var]"
|
||||
client_log "-I[plvar $var]"
|
||||
NoNewline
|
||||
client_log "-Tfixed"
|
||||
client_log "-V$fixed"
|
||||
client_log "-CctrlTable fixed $var"
|
||||
} else {
|
||||
Tip "(actual value [plval $var])"
|
||||
if {$lentab == 0} {set lentab 32}
|
||||
client_log "-W$lentab"
|
||||
client_log "-T$label"
|
||||
client_log "-V[result eval ctrlTable $var]"
|
||||
client_log "-IctrlTable $var"
|
||||
NoNewline
|
||||
client_log "-Tfixed"
|
||||
client_log "-V$fixed"
|
||||
client_log "-CctrlTable fixed $var"
|
||||
}
|
||||
if {$showgraph} {
|
||||
GraphIcon [plvar $var]
|
||||
}
|
||||
Newline
|
||||
}
|
||||
}
|
||||
|
||||
proc CheckBox {label var} {
|
||||
client_log "-T$label"
|
||||
client_log "-V[plval $var]"
|
||||
client_log "-C[plvar $var]"
|
||||
}
|
||||
|
||||
proc SwitchButton {tag args} {
|
||||
client_log "-T[join $args]"
|
||||
client_log "-BC$tag"
|
||||
}
|
||||
|
||||
proc OkButton {tag args} {
|
||||
client_log "-T[join $args]"
|
||||
client_log "-BD$tag"
|
||||
}
|
||||
|
||||
proc SelectButton {grp args} {
|
||||
client_log "-T[join $args]"
|
||||
client_log "-BS$grp"
|
||||
}
|
||||
|
||||
proc Group {lay title args} {
|
||||
global shown_groups grp_title
|
||||
if {[string compare $title ""]!= 0} {
|
||||
client_log "-T$title"
|
||||
set grp_title($lay) $title
|
||||
}
|
||||
set layout "$lay[join $args _]"
|
||||
client_log "-G$layout"
|
||||
if {[info exists shown_groups($layout)]} {
|
||||
set cmd "${lay}Group [join $args]"
|
||||
if {[catch {eval $cmd} msg] != 0} {
|
||||
Style warning
|
||||
Label "$msg"
|
||||
}
|
||||
client_log "-E1"
|
||||
} else {
|
||||
client_log "-E0"
|
||||
}
|
||||
}
|
||||
|
||||
proc Style {type} {
|
||||
switch [string tolower $type] {
|
||||
warning {
|
||||
client_log "-SW"
|
||||
}
|
||||
hotwarning {
|
||||
client_log "-SA"
|
||||
}
|
||||
header {
|
||||
client_log "-SH"
|
||||
}
|
||||
graphsettings {
|
||||
client_log "-SG"
|
||||
}
|
||||
default {
|
||||
error "ERROR: Unknown style"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc Label args {
|
||||
client_log "-L[join $args]"
|
||||
}
|
||||
|
||||
proc RadioGroup {name {value none}} {
|
||||
if {[string compare $value none] == 0} {
|
||||
set value [eval result $name]
|
||||
}
|
||||
client_log "-V$value"
|
||||
client_log "-R$name"
|
||||
}
|
||||
|
||||
proc RadioButton {value {title none}} {
|
||||
if {[string compare $title none] == 0} {
|
||||
set title $value
|
||||
}
|
||||
client_log "-T$title"
|
||||
client_log "-r$value"
|
||||
}
|
||||
|
||||
proc Newline {} {
|
||||
client_log "-P"
|
||||
}
|
||||
|
||||
proc NoNewline {} {
|
||||
client_log "--"
|
||||
}
|
||||
|
||||
proc NarrowColumn {{div 2}} {
|
||||
client_log "-D$div"
|
||||
}
|
||||
|
||||
proc GraphicsId {arg} {
|
||||
client_log "-g$arg"
|
||||
}
|
||||
|
||||
publishLazy layout Spy
|
||||
publishLazy getgroup Spy
|
||||
|
||||
proc getgroup_overview {} {
|
||||
set units [list]
|
||||
foreach item [result vars] {
|
||||
set unit 0
|
||||
set label ""
|
||||
scan $item {%[^|]|%[^|]|%[^|]|} var unit label
|
||||
if {$label eq ""} {
|
||||
set label $var
|
||||
}
|
||||
set fullunit $unit
|
||||
scan $unit {%[^_]} unit
|
||||
set path [join [split $var .] /]
|
||||
if {[catch "hgetpropval $path logger_name"] == 0} {
|
||||
# hipadaba
|
||||
set val [hvali $path]
|
||||
catch {set val [format %.7g $val]}
|
||||
set valunit "-V$val $unit"
|
||||
catch {
|
||||
append valunit " !!! [hgetpropval $path geterror]"
|
||||
}
|
||||
} else {
|
||||
set sub ""
|
||||
scan $path {%[^/]/%s} obj sub
|
||||
set com "result $obj $sub"
|
||||
if [catch $com val] {
|
||||
|
||||
} else {
|
||||
catch {set val [format "%.6g" $val]}
|
||||
}
|
||||
set valunit "-V$val $unit"
|
||||
}
|
||||
if {! [info exists output_$fullunit]} {
|
||||
lappend units $fullunit
|
||||
}
|
||||
append output_$fullunit "-T$label\n$valunit\n-i_$path\n"
|
||||
}
|
||||
set output ""
|
||||
foreach fullunit $units {
|
||||
append output [set output_$fullunit]
|
||||
}
|
||||
|
||||
if {$output eq ""} {
|
||||
set output "-Tdevice\n-Vnone\n-i_none\n"
|
||||
}
|
||||
client_log "-Toverview\n-G_overview\n$output\n-E1"
|
||||
}
|
||||
Reference in New Issue
Block a user