set hl_showhidden 0 set hl_showprop 0 proc hl {{path "/"} {prefix ""}} { global hl_showhidden hl_showprop switch -- $path { -p { set hl_showprop 1 clientput "show properties" return } -h { set hl_showhidden 1 clientput "show hidden nodes" return } -s { set hl_showhidden 0 set hl_showprop 0 clientput "short listing" return } } if {"[string index $path end]" != "/"} { append path / set nest 0 } else { set nest 1 } set node [lindex [split $path /] end-1] if {[string equal "" $node]} { set node "/" } set prop [split [hlistprop $path] "\n"] if {! $hl_showhidden && $nest} { foreach p $prop { if {[string equal visible=false $p]} { return } } } scan [hinfo $path] {%[a-z],%d,%d} type children length switch $type { text - float - int - none { clientput "$prefix$node ($type) [silent -9e-9 hvali $path]" } default { clientput "$prefix$node ($type)" } } if {$hl_showprop || ! $nest} { foreach p $prop { clientput "$prefix $p" } } if {$children > 0 && $nest} { set nodes [split [hlist $path]] foreach n $nodes { if {! [string equal "" $n]} { hl $path$n/ "$prefix " } } } } publishLazy hl spy proc hdbItem {path title} { set cmd [silent 0 hgetpropval $path sicscommand] scan [hinfo $path] {%[a-z],%d,%d} type children length if {![string equal 0 $cmd]} { switch $type { text - float - int - func { set label [silent 0 hgetpropval $path label] if {$label ne 0} { set title $label } set help [silent 0 hgetpropval $path help] if {! [string equal 0 $help]} { foreach line [split $help "\n"] { clientput "-H$line" } } if {[silent 0 hgetpropval $path newline]} { clientput "-P" } if {[silent 0 hgetpropval $path nonewline]} { clientput "--" } set priv [silent internal hgetpropval $path priv] set buttons [silent "" hgetpropval $path buttons] set val "" if {[string match "run *" $cmd]} { set val [silent "" hgetpropval $path target] set cmd2 [string range $cmd 4 end] set val [silent $val result $cmd2 target] clientput "-P" } elseif {$type eq "func"} { clientput "-T$title" clientput "-B $cmd" clientput "--" return } else { set cmd2 "" if {[catch {set val [result $cmd]} msg]} { if {$msg eq "ERROR: not read yet"} { set val "" } else { clientput "-SW" clientput "-L${title}:[string map {"ERROR:" ""} $msg]" return 1 } } } set graph 1 if {$buttons ne ""} { set priv internal clientput "-P" } switch $priv { user - spy { set val [silent $val hgetpropval $path requested] set val [silent $val hgetpropval $path secoprequested] set enum [silent "" hgetpropval $path enum] if {$enum eq ""} { # experimental set vlist [silent 0 hgetpropval $path vlist] if {$vlist ne "0"} { set title "$title ([lindex [split $vlist ,] $val])" } clientput "-T$title" clientput "-V$val" set wid [silent 0 hgetpropval $path width] if {$wid != 0} { clientput "-W$wid" } clientput "-I$cmd" } elseif {$enum eq "1"} { clientput "-T$title" clientput "-V$val" clientput "-C$cmd" } elseif {$enum eq "push"} { clientput "-T[silent $title hgetpropval $path buttontitle]" # space after B because BC,BD,BS have special meaning clientput "-B $cmd 1" } else { if {[silent 1 hgetpropval $path newline]} { clientput "-P" } if {$label ne 0} { clientput "-L$label" clientput "--" } clientput "-V[lindex $val end]" clientput "-R$cmd" set enumsplit [silent "" hgetpropval $path enumsplit] if {$enumsplit ne ""} { foreach split_val [split $enumsplit ,] { set enumsplit_at($split_val) 1 } } set idx 0 foreach item [split $enum ,] { lassign [split $item =] nam num if {$num eq ""} { set num $idx } else { set idx $num } incr idx if {[info exists enumsplit_at($num)]} { clientput "-P" } else { clientput "--" } clientput "-T$nam" if {[llength $val] <= 1} { clientput "-r$num" } else { clientput "-r$nam" } } GraphIcon $path set graph 0 if {[silent 1 hgetpropval $path lineend]} { clientput "-P" } } } default { set enum [split [silent 0 hgetpropval $path enum] ","] set name $val set wid 0 if {[llength $enum] > 1} { set idx 0 foreach item $enum { lassign [split $item =] itm_name itm_value if {$itm_value eq ""} { set itm_value $idx } elseif {[string is integer $itm_value]} { set idx $itm_value } if {$itm_value == $val} { set name $itm_name } incr idx set wid [expr max($wid, [string length $itm_name])] } } set wid [silent $wid hgetpropval $path width] if {$wid != 0} { set wid [expr $wid - [string length $name]] if {$wid < 0} { set wid 0 } set name "$name[string repeat { } $wid]" } if {$buttons ne ""} { clientput "--" } clientput "-T$title" clientput "-V$name" clientput "-i$cmd" } } if {$cmd2 ne ""} { set title [silent "" hgetpropval $path runlabel] if {[catch {set val [result $cmd2]} msg]} { clientput "-SW" clientput "-L${title}:[string map {"ERROR:" ""} $msg]" return 1 } clientput "-T$title" clientput "-V$val" clientput "-i$cmd2" clientput "-P" } if {$buttons ne ""} { # buttons syntax: # buttons are separated with ':' # on buttons is: // # hidden values are separated with ',' or '-' (for ranges) foreach button [split $buttons :] { lassign [split $button /] name bval values set showbutton 1 foreach v [split $values ,] { lassign [split $v -] from to if {$to eq ""} { set to $from } if {$val >= $from && $val <= $to} { set showbutton 0 break } } if {$showbutton} { clientput "--" clientput "-T$name" # space after B because BC,BD,BS have special meaning clientput "-B $cmd $bval" } } clientput "-P" } if {$graph} { GraphIcon $path } set warning [silent "" hgetpropval $path warning] if {[string index $warning 0] eq "/"} { set warning [silent "" hgetpropval $warning geterror] } if {$warning ne ""} { clientput "-SW" clientput "-L[string map {"ERROR:" ""} $warning]" } return 1 } func { set label [silent 0 hgetpropval $path label] if {$label ne 0} { set title $label } } } } return 0 } proc nodeVisible {path {key visible}} { global shown_groups set vis [silent true hgetpropval $path $key] if {$vis eq "expert"} { return [info exists shown_groups(expertMode)] } return $vis } proc hdbLayout {path} { global shown_groups # for the parent layouts set group [silent 0 hgetpropval $path group] # clientput "L $path G $group [nodeVisible $path groupMode]" if {! [string equal 0 $group] && [nodeVisible $path groupMode]} { lassign [split $path /] _ obj if {![string match *$obj* $group]} { set group "$group \[$obj\]" } clientput "-T$group" clientput "-G$path" if {[info exists shown_groups($path)]} { lassign [split $path /] nul obj sub if {$sub eq ""} { # bare object showStatus $obj } if {[nodeVisible $path]} { # show node inside of kids group hdbItem /$path $path } hdbLay $path/ clientput "-E1" } else { clientput "-E0" } } } proc hdbLay {path} { global shown_groups # for the kids layouts set nodes [split [hlist $path]] foreach n $nodes { if {![string equal "" $n]} { if {[nodeVisible $path$n]} { # show node outside of kids group hdbItem $path$n $n } set group [silent 0 hgetpropval $path$n group] if {! [string equal 0 $group] && [nodeVisible $path$n groupMode]} { clientput "-T$group" clientput "-G$path$n" if {[info exists shown_groups($path$n)]} { hdbLay $path$n/ clientput "-E1" } else { clientput "-E0" } } if {[silent 0 hgetpropval $path$n show_more]} { if {![hval $path$n]} { return } } } } } proc hdbGrp {path} { set group [silent 0 hgetpropval $path group] if {! [string equal 0 $group] && [nodeVisible $path groupMode]} { clientput "-T$group" clientput "-G$path" lassign [split $path /] nul obj sub if {$sub eq ""} { # bare object showStatus $obj } if {[nodeVisible $path]} { # show node inside of kids group hdbItem /$path $path } hdbLay $path/ clientput "-E1" } } proc hdbScan {path action args} { # scan the children of (path must end with "/") # for each node # # is executed. # an action must return a integer. # if this value is negative, hdbScan immediately returns this value # else the return value is the sum of the action return values set nodes [split [hlist $path]] set retsum 0 foreach n $nodes { if {![string equal "" $n]} { if {[llength $args] > 0} { set ret [$action $path$n $args] } else { set ret [$action $path$n] } if {$ret < 0} { return $ret } incr retsum $ret } } return $retsum }