sea/tcl/startup/layout.tcl

#----- 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"
}