#!/bin/sh # the next line restarts using emcsh \ exec $LINUXCNC_EMCSH "$0" "$@" ############################################################### # Description: halshow.tcl # This file, shows a running hal configuration # and has menu for modifying and tuning # # Author: Raymond E Henry # License: GPL Version 2 # # Copyright (c) 2006-2009 All rights reserved. ############################################################### # FIXME -- empty mod entry widgets after execute # FIXME -- please hal param naming conventions aren't ############################################################### # Load the linuxcnc.tcl file, which defines variables for various useful paths source [file join [file dirname [info script]] .. linuxcnc.tcl] # Load file for canvasbuttons source [file join [file dirname [info script]] cbutton.tcl] package require BWidget # add a few default characteristics to the display foreach class { Button Checkbutton Entry Label Listbox Menu Menubutton \ Message Radiobutton Scale } { option add *$class.borderWidth 1 100 } # get config file path from running linuxcnc process if not invoked by GUI set config_path "" catch {set linuxcnc_process [exec ps -e -o stat,command | grep "^S" | grep -o "linuxcnc \\/.*\\.ini" ] regexp { \/.*\/} $linuxcnc_process config_path set config_path [string trim $config_path] } if {[info exists ::env(CONFIG_DIR)]} { set ::INIDIR "$::env(CONFIG_DIR)" set ::INIFILE "$::env(CONFIG_DIR)/halshow.preferences" } elseif {[file isdirectory $config_path]} { set ::INIDIR "${config_path}" set ::INIFILE "${config_path}halshow.preferences" } else { set ::INIDIR "$::env(HOME)" set ::INIFILE "$::env(HOME)/.halshow_preferences" } # puts stderr "Halshow inifile: $::INIFILE" proc readIni {} { # check that the file is readable if { ![file readable $::INIFILE]} { # puts stderr "\[halshow\] Settings file not found, using defaults" return -1 } elseif { [catch {source $::INIFILE}] } { puts stderr "\[halshow\] Error in settings file $::INIFILE, using defaults.\n" return -1 } else { return 0 } } set ::initPhase true set ::autoSaveWatchlist 1 set ::separateParams 0 set ::use_prefs true proc saveIni {} { # The flag 'initPhase' prevents saving on the first FocusIn event if {!$::initPhase && $::use_prefs} { # open the file for writing (truncates if file exists) if { [catch {set fc [open $::INIFILE w]}] } { puts stder "\[halshow\] Unable to save settings to \"$INIFILE\"." } else { # write file puts $fc "# Halshow settings" puts $fc "# This file is generated automatically." puts $fc "wm geometry . [wm geometry .]" puts $fc "placeFrames $::ratio" puts $fc "set ::ratio $::ratio" puts $fc "set ::old_w_leftf $::old_w_leftf" if {$::autoSaveWatchlist} { puts $fc "set ::watchlist {" foreach elem $::watchlist { puts $fc " $elem" } puts $fc "}" } puts $fc "set ::workmode $::workmode" puts $fc "set ::watchInterval $::watchInterval" puts $fc "set ::col1_width $::col1_width" puts $fc "set ::ffmts $::ffmts" puts $fc "set ::ifmts $::ifmts" puts $fc "set ::alwaysOnTop $::alwaysOnTop" puts $fc "set ::autoSaveWatchlist $::autoSaveWatchlist" puts $fc "set ::separateParams $::separateParams" close $fc } } } # This overwrites the default error message dialog to be able to set it on top proc bgerror {message} { tk_messageBox -title "Application Error" -message [msgcat::mc "Error"] \ -detail $message -icon error -type ok wm attributes . -topmost $::alwaysOnTop } #----------start toplevel---------- # set ::titlename [msgcat::mc "Halshow"] wm title . $::titlename wm protocol . WM_DELETE_WINDOW tk_ image create photo applicationIcon -data { iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAYAAACM/rhtAAAACXBIWXMAAA7EAAAOxAGVKw4bAAAB DklEQVRYhe2X0Q2DIBCGoekUDCATOoUTngOwBn1oLjWNHD8HKG34HgXh4zTAb4komoF53C2Q41n6 gvf+9DkRVcucAQuyWEz8ENa+21uLQp84J3dsS1VYS1YQkWN6SEIVROQ0fRFEQe+9asIY21Vx+G1m CtYyBWsRBYnIWFs+qLXtThSogiWSmgVJZAW5EsjE3KfleQxVEJHsIWdMwW3mIznodYvpJZJi+G1G rOC+71d5JBEFl2W5yiPJ/2WSzTmx/dZMkpI7tt2WSSQ5pockVEFETtMXIZtJNBNuzs1MMgxTsJbf FiQis4ZQPOgawrWZpERSsyAJOJMgE3Of2zKJJNlDzhhFJhn2usXMTPLFCzyRcikArbPDAAAAAElF TkSuQmCC } image create photo preferencesIcon -data { iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gvaeTAAAACXBI WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH4QcJEgQMrJwPLAAAAB10RVh0Q29tbWVudABDcmVhdGVk IHdpdGggVGhlIEdJTVDvZCVuAAAB2UlEQVQ4y8WTTWsTYRSFn2lrgzSdNCOhJkM3gcbdhGRCSIpY dSU1WYkIFQQhZP5BEVx1IYgrETct/QOlLQhDslEMWEGRvPmYooLbJJSJNCVZtIgfcWFnSNt01YV3 dXnP5XDvOeeFc5Z0FvD02ZO+0z9aenzm3JjT3L13J6PrcRNAiEoWIJ8zWF1bOYadJHMJdD1u5nMG lmUBmKGgSstuEAqqoGOmkmk0TQPoD5KMDbJZlsWlaT+3swvuWywRJUbUxU/WqNP4Fb/40/+9GLky S6vRYvvddq9ttz071k5vyjflmfBOUCqVEKKS/fL567djGziChYIqALVarWfb318JUd1UFOWqJI0+ XMjcCjjn6Hrc1WLEYcrnDGKJf6v6fD652WxubqxvmZ1O570sewPOOfmcMdyF1bUVQkGVWCLKwcHh 4dxcegkgHA4b3W63B8jVcp3CbvG0Bm9ev132K34xOeldvHHtJj9//bjQbrcDkcjsA0ni8vz1eXnc M05FVBCikn3x/OX9oTamkmladgN1RkWdUS8eQbIzk0qmAcyN9S3XxpHBdTRNY8/ep2AWqZbrAFTL dQpmkT1738nBcA2OVO27SdQxM9MZCrtFJ5nmx08fTiXx3H/h/9dfs1mvKwIMuy0AAAAASUVORK5C YII= } wm iconphoto . -default applicationIcon set masterwidth 700 set masterheight 475 # set fixed size for configuration display and center set xmax [winfo screenwidth .] set ymax [winfo screenheight .] set x [expr ($xmax - $masterwidth ) / 2 ] set y [expr ($ymax - $masterheight ) / 2] wm geometry . "${masterwidth}x${masterheight}+$x+$y" wm minsize . 230 240 # save settings after switching to another window bind . {saveIni} # trap mouse click on window manager delete and ask to save wm protocol . WM_DELETE_WINDOW askKill proc askKill {} { saveIni killHalConfig } # clean up a possible problems during shutdown proc killHalConfig {} { if {[info exists fid] && $::fid != ""} { catch flush $::fid catch close $::fid } destroy . exit } set ::main [frame .main -padx 6 -pady 3] pack $::main -fill both -expand yes # build frames from left side set ::leftf [frame $::main.left] set ::tf [frame $::leftf.tf] set ::rightf [frame $::main.right] set ::nb [NoteBook $::rightf.note] pack $::nb -side right -fill both -expand yes # Each mode has a unique set of widgets inside tab set showhal [$::nb insert 0 ps -text [msgcat::mc " SHOW "] -raisecmd {showMode showhal} ] set ::watchhal [$::nb insert 1 pw -text [msgcat::mc " WATCH "] -raisecmd {showMode watchhal}] set ::settings [$::nb insert 2 set -text [msgcat::mc " SETTINGS "] -raisecmd {showMode settings}] # use place manager to fix locations of frames within top proc placeFrames {ratio} { place configure $::leftf -in $::main -x 0 -y 0 -relheight 1 -relwidth $ratio place configure $::rightf -in $::main -relx $ratio -y 0 -relheight 1 -relwidth [expr 1-$ratio] set ::ratio $ratio } placeFrames 0.3 set ::geometryOld [wm geometry .] proc checkSizeChanged {w} { if {$w == "." || $w == ".f2.show.grip"} { if {[wm geometry .] == $::geometryOld} { return } } elseif {$w == "force"} { } else { return } if {$::watchlist_len > 20} reloadWatch set ::geometryOld [wm geometry .] } set ::ratioOld $::ratio proc checkRatioChanged {} { if {$::ratio != $::ratioOld} { if {$::watchlist_len > 20} reloadWatch } set ::ratioOld $::ratio } # slider process is used for several widgets proc sSlide {f a b} { $f.sc set $a $b } # Build menu # fixme clean up the underlines so they are unique under each set set menubar [menu $::rightf.menubar -tearoff 0] set filemenu [menu $menubar.file -tearoff 1] $menubar add cascade -label [msgcat::mc "File"] \ -menu $filemenu $filemenu add command -label [msgcat::mc "Load Watch List"] \ -command {getwatchlist} set ::savelabel1 [msgcat::mc "Save Watch List"] ;# identifier for entryconfigure set ::savelabel2 [msgcat::mc "Save Watch List (multiline)"] ;# identifier for entryconfigure $filemenu add command -label [msgcat::mc $::savelabel1] \ -command savewatchlist $filemenu add command -label [msgcat::mc $::savelabel2] \ -command [list savewatchlist multiline] $filemenu add command -label [msgcat::mc "Exit"] \ -command {destroy .; exit} $filemenu configure -postcommand { if {$::watchlist != ""} { $filemenu entryconfigure [msgcat::mc $::savelabel1] -state normal $filemenu entryconfigure [msgcat::mc $::savelabel2] -state normal } else { $filemenu entryconfigure [msgcat::mc $::savelabel1] -state disabled $filemenu entryconfigure [msgcat::mc $::savelabel2] -state disabled } } set viewmenu [menu $menubar.view -tearoff 0] $menubar add cascade -label [msgcat::mc "Tree View"] \ -menu $viewmenu $viewmenu add command -label [msgcat::mc "Expand All"] \ -command {showNode {open}} $viewmenu add command -label [msgcat::mc "Collapse All"] \ -command {showNode {close}} $viewmenu add separator $viewmenu add command -label [msgcat::mc "Expand Pins"] \ -command {showNode {pin}} $viewmenu add command -label [msgcat::mc "Expand Parameters"] \ -command {showNode {param}} $viewmenu add command -label [msgcat::mc "Expand Signals"] \ -command {showNode {sig}} $viewmenu add separator $viewmenu add command -label [msgcat::mc "Reload tree view"] \ -command {refreshHAL} set watchmenu [menu $menubar.watch -tearoff 1] $menubar add cascade -label [msgcat::mc "Watch"] \ -menu $watchmenu $watchmenu add command -label [msgcat::mc "Add pin"] \ -command {addToWatch pin [msgcat::mc "Pin"]} $watchmenu add command -label [msgcat::mc "Add signal"] \ -command {addToWatch sig [msgcat::mc "Signal"]} $watchmenu add command -label [msgcat::mc "Add parameter"] \ -command {addToWatch param [msgcat::mc "Parameter"]} $watchmenu add command -label [msgcat::mc "Add from HAL text"] \ -command addToWatchFromText $watchmenu add separator $watchmenu add command -label [msgcat::mc "Reload Watch"] \ -command {reloadWatch} $watchmenu add command -label [msgcat::mc "Erase Watch"] \ -command { watchReset all setStatusbar [msgcat::mc "Watchlist cleared"] } . configure -menu $menubar # Creates a window with an entry to add items to watchlist proc addToWatch {type name} { set var [entrybox "" [msgcat::mc "Add to watch"] $name] if {$var != "cancel"} { if {[watchHAL $type+$var] == ""} { setStatusbar "'$var' [msgcat::mc "added"]" } } } # frame for scaling ratio set gripf [frame $::leftf.grip -borderwidth 3 -width 8 -cursor sb_h_double_arrow] pack $gripf -side right -fill y pack $::tf -fill both -expand yes # grip symbol for changing the ratio of left and right frame set grip [frame $gripf.grip -relief groove -borderwidth 2 -width 2 -height 20] pack [frame $gripf.topfill] -side top -expand y ; # add frames to center grip pack $grip pack [frame $gripf.bottomfill] -side bottom -expand y set ::grip_clicked false bind $gripf [list scaleFrames] bind $gripf {set ::grip_clicked true} bind $gripf { set ::grip_clicked false checkRatioChanged } bind $grip [list scaleFrames] bind $grip {set ::grip_clicked true} bind $grip { set ::grip_clicked false checkRatioChanged } # frame to hide tree set fh [frame $::tf.fh -borderwidth 0 -relief raised] pack $fh -fill x set fh.top [frame $::tf.fh.top] pack $fh.top -fill x set fh.bot [frame $::tf.fh.bot] set bh [button $fh.top.bh -borderwidth 0 -text » -padx 4 -pady 1] pack $bh -side right bind $bh [list hideListview true] # preferences button set bp [checkbutton $fh.top.bpref -image preferencesIcon -indicatoron false -variable ::bp_state -borderwidth 0 -height 20 -width 20] pack $bp -side right -pady 0 bind $bp { if {$::bp_state} { pack forget $fh.bot } else { pack $fh.bot -fill x } } set cb_fp [checkbutton $fh.bot.fp -variable ::search_full_path -text [msgcat::mc "Full path (regex)"]] pack $cb_fp -side left bind $cb_fp {refreshHAL} # filter entry set ::txt_filt [msgcat::mc "Filter tree"] set ::fe_active false set fe [entry $fh.top.fe -textvariable txt_filt -foreground grey50] pack $fe -fill x -expand y -side left -pady 1 bind $fe { if {!$::fe_active} { set ::txt_filt "" $fe configure -foreground black set ::fe_active true } } bind $fe { if {$::txt_filt == ""} { set ::txt_filt [msgcat::mc "Filter tree"] $fe configure -foreground grey50 set ::fe_active false } } bind $fe {refreshHAL} # frame to show tree set ::fs [frame $::rightf.fs -borderwidth 1 -relief raised -width 24] set bs [button $::fs.bs -borderwidth 0 -text « -padx 5 -pady 0] pack $bs -side top bind $bs [list showListview] # add canvas to create rotated text set clbl [canvas $::fs.clbl -width 20] pack $clbl $clbl create text 10 5 -angle 90 -anchor e -text [msgcat::mc "Tree View"] -font [list "" 10] proc hideListview {resizeWindow} { place $::fs -width 24 -relheight 1.0 pack forget $::nb place $::nb -anchor ne -relx 1.0 -relwidth 1.0 -width -33 -relheight 1.0 placeFrames 0 if {$resizeWindow} { set ::old_w_leftf [winfo width $::leftf] set new_w [expr [winfo width $::nb] + [$::fs cget -width] + 9 + 2* [.main cget -padx]] set new_x [int [expr [winfo x .] + [winfo width .] - $new_w - 3]] # offset added here because [winfo geometry .] differs from [wm geometry .] set y [expr [winfo y .] - 61] wm geometry . "${new_w}x[winfo height .]+$new_x+$y" tkwait visibility $::fs } } set ::old_w_leftf 160 proc showListview {} { place forget $::fs place configure $::nb -relwidth 1.0 -width 0 # recalc ratio set ratio [expr double($::old_w_leftf) / ([winfo width $::nb] + $::old_w_leftf)] placeFrames $ratio set new_w [int [expr $::old_w_leftf + [winfo width $::nb] + 2*[.main cget -padx]]] set new_x [int [expr [winfo x .] + [winfo width .] - $new_w - 3]] # offset added here because [winfo geometry .] differs from [wm geometry .] set y [expr [winfo y .] - 61] wm geometry . "${new_w}x[winfo height .]+$new_x+$y" tkwait visibility $::tf } # scale left and right frame while dragging proc scaleFrames {} { if {$::grip_clicked} { set xpos [expr {[winfo pointerx .] - [winfo x .]}] set padx [$::main cget -padx] if {$xpos >= [expr $padx+4] && $xpos <= [expr [winfo width .]-$padx-4]} { set ratio [expr double ($xpos-$padx+4)/([winfo width .]-2*$padx)] placeFrames $ratio } } } # build the tree widgets left side set ::treew [Tree $::tf.t -width 10 -yscrollcommand "sSlide $::tf" ] set str $::tf.sc scrollbar $str -orient vert -command "$::treew yview" pack $str -side right -fill y pack $::treew -side right -fill both -expand yes $::treew bindText {workMode} $::treew bindText {popupmenu_tree %X %Y} $::treew configure -selectbackground "orange3" proc addSubTree {item} { if {[string first "+" $item] > 0} { set item [regsub "\\+" $item " "] set list [eval hal "show $item"] regexp ".*(?=\\s)" $item type addToWatchFromSel $type $list # merged tree branches hold params too if {!$::separateParams && $type == "pin"} { addToWatchFromSel param [hal show param [lindex $item 1]] } } } #----------tree widget handlers---------- # a global var -- ::treenodes -- holds the names of existing nodes # ::nodenames are the text applied to the toplevel tree nodes set ::nodenames {Components Pins Parameters Signals Functions Threads} # ::searchnames is the real name to be used to reference set ::searchnames {comp pin param sig funct thread} set ::treenodes "" proc refreshHAL {} { set tmpnodes "" # look through tree for nodes that are displayed foreach node $::treenodes { catch { if {[$::treew itemcget $node -open]} { lappend tmpnodes $node } } } # clean out the old tree (param top node absent in merged mode) foreach node $::searchnames { catch {$::treew delete $node} } # reread hal and make new nodes listHAL # read opennodes and set tree state if they still exist # foreach node $tmpnodes { # if {[$::treew exists $node]} { # $::treew opentree $node no # } # } showHAL $::oldvar } # remove items that do not match the filter regex proc filterList {lst} { if {!($::fe_active && $::txt_filt != "")} { return $lst } set out "" foreach path $lst { if {$::search_full_path} { if {[regexp $::txt_filt $path]} { lappend out $path } } else { foreach item [split $path "."] { if {[regexp $::txt_filt $item]} { lappend out $path break } } } } return $out } # listhal gets $searchname stuff # and calls makeNodeX with list of stuff found. # pins and params share one tree unless ::separateParams is set proc listHAL {} { set i -1 foreach node $::searchnames { incr i if {$node == "param" && !$::separateParams} {continue} set name [lindex $::nodenames $i] if {$node == "pin" && !$::separateParams} { set name "Pins & Parameters" } writeNode [list $i root $node $name 1] set items [filterList [hal list $node]] switch -- $node { pin { set pairs {} foreach p $items {lappend pairs [list $p pin]} if {!$::separateParams} { foreach p [filterList [hal list param]] { lappend pairs [list $p param] } set pairs [lsort -index 0 $pairs] } makeNodeP $node $pairs } param - sig { set pairs {} foreach p $items {lappend pairs [list $p $node]} makeNodeP $node $pairs } comp - funct - thread { makeNodeOther $node $items } default {} } } } # pairs is a list of {name leaftype} elements; the leaf node id keeps # the real type ("pin+x.y" / "param+x.y") so type-dependent handlers # (show, watch, popup) keep working in the merged tree proc makeNodeP {which pairs} { # make an array to hold position counts array set pcounts {1 1} # consider each listed element foreach pair $pairs { lassign $pair p leaftype set elementlist [split $p "." ] set lastnode [llength $elementlist] set i 1 set snode {} foreach element $elementlist { if {$snode == {}} { set parent $which; set snode "$which+$element" } else { set parent $snode; set snode "$snode.$element" } set leaf [expr {$i == $lastnode}] if {$leaf} { set snode "$leaftype+$p" } set j $pcounts($i) if {! [$::treew exists "$snode"] } { writeNode [list $j $parent $snode $element $leaf] } incr pcounts($i) incr i set pcounts($i) 1 # end of element foreach } # end of param foreach } # empty the counts array in preparation for next proc call array unset pcounts {} } proc makeNodeOther {which otherstring} { set i 0 foreach element $otherstring { set snode "$which+$element" if {! [$::treew exists "$snode"] } { set leaf 0 writeNode "$i $which $snode $element $leaf" } incr i } } # writeNode handles tree node insertion for makeNodeX # builds a global list -- ::treenodes -- but not leaves proc writeNode {arg} { lassign $arg j base node name leaf if {$leaf > 0 && [string match "param+*" $node]} { # param leaves get the watch-tab param color $::treew insert end $base $node -text $name -fill #6e3400 } else { $::treew insert end $base $node -text $name } if {$::txt_filt != ""} { # strip/extract leading type set plusPos [string first "+" $node] set subnode [string replace $node 0 $plusPos] set type [string range $node 0 $plusPos] if {$::search_full_path && $plusPos > 0} { set match_str "" set return [regexp $::txt_filt $subnode match_str] if {$return} { set match_start [string first $match_str $subnode] set match_end [expr $match_start + [string length $match_str]] set match_end_next_p [string first "." $subnode $match_end] set match_start_prev_p [string last "." $subnode $match_start] if {$match_end_next_p > 0} { set subnode [string replace $subnode $match_end_next_p end] } set match_items [string replace $subnode 0 $match_start_prev_p] set n_items [llength [split $match_items "."]] openTreePath $type$subnode $n_items } } elseif {[regexp $::txt_filt $name]} { openTreePath $node 1 } } if {$leaf > 0} { lappend ::treenodes $node } } proc openTreePath {path_in highlight_n} { if {$path_in=="root"} {return} # this is needed if comp name includes a '+' set plusPos [string first "+" $path_in] set path [string replace $path_in $plusPos $plusPos "."] set items [split $path "."] set items_reduced [lreplace $items end end] set path "" set i 0 set highlight [expr [llength $items] - $highlight_n] foreach item $items_reduced { if {$i==0} { set path $item # merged tree keeps param intermediates under the pin top node if {$path == "param" && ![$::treew exists param]} { set path "pin" } } elseif {$i==1} { set path [string cat $path "+" $item] } else { set path [string cat $path "." $item] } catch { $::treew opentree $path no if {$i >= $highlight} { $::treew selection add $path } } incr i 1 } if {![$::treew exists $path_in]} { regsub {^param\+} $path_in {pin+} path_in } catch {$::treew selection add $path_in} } proc showNode {which} { switch -- $which { open {-} close { foreach type $::searchnames { catch {$::treew ${which}tree $type} } } pin {-} param {-} sig { foreach type $::searchnames { catch {$::treew closetree $type} } if {$which == "param" && ![$::treew exists param]} { set which pin } $::treew opentree $which $::treew see $which } default {} } focus -force $::treew } # #----------end of tree building processes---------- set ::oldvar "zzz" # build show mode right side proc makeShow {} { set f1 [frame $::showhal.f1 -relief ridge -borderwidth 5] pack $f1 -fill both -expand 1 pack [frame $f1.top] -side top -fill both -expand 1 set ::disp [text $f1.top.tx -wrap word -takefocus 0 -state disabled \ -width 0 -height 10\ -relief ridge -borderwidth 0 -yscrollcommand "sSlide $f1.top"] pack $::disp -side left -fill both -expand yes pack [scrollbar $f1.top.sc -orient vert -command "$::disp yview"]\ -side left -fill y set f2 [frame .f2 -borderwidth 0] pack $f2 -fill x -expand 0 pack [frame $f2.b] \ -side top -fill x -anchor w pack [label $f2.b.label -text [msgcat::mc "HAL command :"] ]\ -side left -padx 5 -pady 3 set com [entry $f2.b.entry -textvariable halcommand] pack $com -side left -fill x -expand 1 -pady 3 bind $com {showEx $halcommand} bind $com { if {[%W selection present]} {%W delete sel.first sel.last} } bind $com {moveHist %W -1} bind $com {moveHist %W 1} set ex [button $f2.b.execute -text [msgcat::mc "Execute"] \ -command {showEx $halcommand} ] pack $ex -side left -padx 5 -pady 3 pack [frame $f2.show -height 5] \ -side top -fill both -expand 1 set ::showtext [text $f2.show.txt \ -width 0 -height 1 -bg grey85 \ -borderwidth 2 -relief sunken] pack $::showtext -side left -fill both -anchor w -expand 1 -pady {0 5} -padx 5 pack [ttk::sizegrip $f2.show.grip] -side right -anchor se bind $::disp {popupmenu_text %X %Y} bind . {copySelection 0} bind $f2.show.grip {checkSizeChanged %W} bind . {checkSizeChanged %W} } proc copySelection {clear} { clipboard clear catch {clipboard append [selection get]} if {$clear} { selection clear } } proc makeWatch {} { set ::cisp [canvas $::watchhal.c -yscrollcommand [list $::watchhal.s set]] scrollbar $::watchhal.s -command [list $::cisp yview] -orient v pack $::watchhal.s -side right -fill y -expand no pack $::cisp -side right -fill both -expand yes bind $::cisp { if {$::watchlist_len <= 20} reloadWatch } bind $::cisp {popupmenu_watch_general %W %X %Y} } proc makeSettings {} { proc addTextSetting {frame var descr} { pack [frame $frame.$var] -fill x -anchor w -pady 2 pack [entry $frame.$var.entry -textvariable $var -width 5] -side right pack [label $frame.$var.label -text [msgcat::mc $descr] -justify left]\ -side left -padx 2 } proc addBoolSetting {frame var descr} { pack [frame $frame.$var] -fill x -anchor w -pady 2 pack [checkbutton $frame.$var.checkbox -variable $var] -side right pack [label $frame.$var.label -text [msgcat::mc $descr] -justify left]\ -side left -padx 0 } set f1 [frame $::settings.f1] pack $f1 -expand 0 -side left addTextSetting $f1 ::watchInterval [msgcat::mc "Update interval (in ms)"] addTextSetting $f1 ::col1_width [msgcat::mc "Column width for value in watch tab"] pack [label $f1.label -text [msgcat::mc "Override format string (leave empty for default)"] \ -justify left] -anchor w -pady 2 -padx 2 addTextSetting $f1 ::ffmts " [msgcat::mc "Float"]" addTextSetting $f1 ::ifmts " [msgcat::mc "Integer"]" set ::ffmt_setting $f1.::ffmts set ::ifmt_setting $f1.::ifmts addBoolSetting $f1 ::alwaysOnTop [msgcat::mc "Always on top\n(Note: May not\ working with all desktop environments)"] addBoolSetting $f1 ::autoSaveWatchlist [msgcat::mc "Remember watchlist"] addBoolSetting $f1 ::separateParams [msgcat::mc "Separate parameters from pins in tree"] pack [button $f1.apply -text [msgcat::mc "Apply"] \ -command { wm attributes . -topmost $::alwaysOnTop refreshHAL reloadWatch }] -side right -padx 5 -pady 10 set ::infotext [text $f1.infotext -bd 0 -bg grey85 -wrap word -font [list "" 10]] $::infotext insert end "([msgcat::mc "Settings stored in: "] $::INIFILE)" $::infotext config -state disabled pack $::infotext -pady {20 0} -side left } # showmode handles the tab selection of mode proc showMode {mode} { set ::workmode $mode if {$mode=="watchhal"} { watchLoop } } # all clicks on tree node names go into workMode # keeps the last HAL variable for refresh proc workMode {which} { set ::thisvar $which switch -- $::workmode { showhal { showHAL $which } watchhal { watchHAL $which setStatusbar "" } default { showMode showhal displayThis "Mode went way wrong." } } set ::oldvar $which } # process uses it's own halcmd show so that displayed # info looks like what is in the Hal_Introduction.pdf proc showHAL {which} { if {![info exists ::disp]} {return} if {$which == "zzz"} { displayThis [msgcat::mc "Select a node to show."] return } set thisnode $which set thislist [split $which "+"] set searchbase [lindex $thislist 0] set searchstring [lindex $thislist 1] set thisret [hal show $searchbase $searchstring] # merged tree branches hold params too if {!$::separateParams && $searchbase == "pin" \ && ![catch {$::treew nodes $which} children] && [llength $children]} { append thisret "\n" [hal show param $searchstring] } displayThis $thisret } proc showEx {what} { addToHist $what set str [eval hal $what] $::disp configure -state normal $::disp delete 1.0 end $::disp insert end $str $::disp configure -state disabled } set ::hist "" set ::i_hist 0 proc addToHist {s} { if {$s == ""} return if [string compare $s [lindex $::hist end]] { lappend ::hist $s set ::i_hist [expr [llength $::hist]-1] } } proc moveHist {w where} { incr ::i_hist $where if {[set ::i_hist]<0} {set ::i_hist 0} if {[set ::i_hist]>=[llength $::hist]+1} { set ::i_hist [llength $::hist] } set ::[$w cget -textvariable] [lindex $::hist [set ::i_hist]] $w icursor end } set ::last_watchfile_tail my.halshow set ::last_watchfile_dir [pwd] set ::filetypes { {{HALSHOW} {.halshow}}\ {{TXT} {.txt}}\ {{ANY} {*}}\ } set ::watchlist "" set ::watchlist_len 0 set ::watchstring "" set ::col1_width 100 proc watchHAL {which} { if {$which == "zzz"} { $::cisp create text 40 [expr 1 * 20 + 12] -anchor w -tag firstmessage\ -text [msgcat::mc "<-- Select a Leaf. Click on its name."] set ::watchlist "" set ::watchstring "" return } else { $::cisp delete firstmessage } set tmplist [split $which +] set vartype [lindex $tmplist 0] set varname [lindex $tmplist end] # return if variable is already used. if {[lsearch $::watchlist $which] != -1} { setStatusbar "'$varname' [msgcat::mc "already in list"]" return "Item already in list" } if {$vartype != "pin" && $vartype != "param" && $vartype != "sig"} { # cannot watch components, functions, or threads return } if {$vartype == "sig"} { # stype (and gets) fail when the item clicked is not a leaf # e.g., clicking "Signals / X" if {[catch {hal stype $varname} type]} { setStatusbar $type return $type } } else { # ptype (and getp) fail when the item clicked is not a leaf # e.g., clicking "Pins / axis / 0" if {[catch {hal ptype $varname} type]} { setStatusbar "Watch: $type" return $type } } lappend ::watchlist $which set ::watchlist_len [llength $::watchlist] set i $::watchlist_len set label [lindex [split $which +] end] set labelcolor black # check if pin or param is writable # var writable: 1=yes, 0=no, -1=writable but connected to signal set writable 0 set showret [join [hal show $vartype $label] " "] if {$vartype == "pin"} { # check if pin is input if {[string index [lindex $showret 9] 0] == "I"} { # check if signals are connected to pin if {[string first "==" [lindex $showret 12] 0] < 0} { set writable 1 } else { set writable -1 } } } elseif {$vartype == "param"} { # check if parameter is writable if {[lindex $showret 8] == "RW"} { set writable 1 } set labelcolor #6e3400 } elseif {$vartype == "sig"} { # puts stderr "return $showret, found: [string first "<==" $showret 0]" # check if signal has no writers if {[string first "<==" $showret 0] < 0} { set writable 1 } set labelcolor blue3 } $::cisp create text $::col1_width [expr $i * 20 + 13] -text $label \ -anchor w -tag $label -fill $labelcolor set canvaswidth [winfo width $::cisp] if {$type == "bit"} { $::cisp create oval 10 [expr $i * 20 + 5] 25 [expr $i * 20 + 20] \ -fill lightgray -tag oval$i if {$writable == 1} { if {$vartype == "sig"} { canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 76] \ [expr {$i * 20 + 4}] 24 17 "Tgl" [list hal_tgls $label] 1 canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 48] \ [expr {$i * 20 + 4}] 24 17 "Set" [list hal_sets $label 1] 1 canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 20] \ [expr {$i * 20 + 4}] 24 17 "Clr" [list hal_sets $label 0] 1 } else { canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 76] \ [expr {$i * 20 + 4}] 24 17 "Tgl" [list hal_tglp $label] 1 canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 48] \ [expr {$i * 20 + 4}] 24 17 "Set" [list hal_setp $label 1] 1 canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 20] \ [expr {$i * 20 + 4}] 24 17 "Clr" [list hal_setp $label 0] 1 } } elseif {$writable == -1} { canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 76] \ [expr $i * 20 + 4] 24 17 "Tgl" [] 0 canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 48] \ [expr $i * 20 + 4] 24 17 "Set" [] 0 canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 20] \ [expr $i * 20 + 4] 24 17 "Clr" [] 0 } } else { $::cisp create text 10 [expr $i * 20 + 12] -text "" \ -anchor w -tag text$i if {$writable == 1} { if {$vartype == "sig"} { canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 48] \ [expr $i * 20 + 4] 52 17 "Set val" [list setsValue $label] 1 } else { canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 48] \ [expr $i * 20 + 4] 52 17 "Set val" [list setpValue $label] 1 } } elseif {$writable == -1} { canvasbutton::canvasbutton $::cisp [expr $canvaswidth - 48] \ [expr $i * 20 + 4] 52 17 "Set val" [] 0 } } if {$i > 1} {$::cisp create line 10 [expr $i * 20 + 3] [expr $canvaswidth - 52] \ [expr $i * 20 + 3] -fill grey70} $::cisp bind $label [list popupmenu_watch $vartype $label $i $writable $which %X %Y] $::cisp configure -scrollregion [$::cisp bbox all] $::cisp yview moveto 1.0 set tmplist [split $which +] set vartype [lindex $tmplist 0] set varname [lindex $tmplist end] lappend ::watchstring "$i $vartype $varname " refreshItem $i $vartype $label } # Popup menu for selected items proc popupmenu_watch {vartype label index writable which x y} { # create menu set m [menu .popupMenu$index -tearoff false] # add entries $m add command -label [msgcat::mc "Copy"] -command [list copyName $label] if {$writable} { $m add command -label [msgcat::mc "Set to .."] -command [list setpValue $label] } if {$writable == -1} { $m add command -label [msgcat::mc "Unlink pin"] -command [list unlinkp $label $index] } $m add command -label [msgcat::mc "Show in Tree"] -command "refreshHAL; openTreePath $vartype+$label 1" $m add command -label [msgcat::mc "Remove"] -command [list watchReset $label] # show menu tk_popup $m $x $y bind $m [list destroy $m] } # Popup menu for background (no item selected) proc popupmenu_watch_general {w x y} { # check if no other element is under cursor if {![llength [$w find withtag current]]} { # create menu set m [menu .popupMenuText -tearoff false] # add entries $m add command -label [msgcat::mc "Add from clipboard"] -command { catch {parse_hal_text [clipboard get]} } $m add command -label [msgcat::mc "Add from HAL text"] -command addToWatchFromText $m add command -label [msgcat::mc "Erase Watch"] -command { watchReset all setStatusbar [msgcat::mc "Watchlist cleared"] } # show menu tk_popup $m $x $y bind $m [list destroy $m] } } # Parse as a HAL file to filter out pins, signals and parameters and add # the result to the watchlist proc parse_hal_text {text} { foreach line [split $text "\n"] { set line [string trim $line] # skip empty lines if {$line eq ""} continue # if line begins with 'net', take next as signal and rest as pins if {[regexp {^\s*net\s+(\S+)\s*(.*)$} $line -> sig pin]} { addToWatchFromSel sig $sig if {$pin ne ""} { addToWatchFromSel pin $pin } # first argument after setp is a parameter } elseif {[regexp {^\s*setp\s+(\S+)} $line -> param]} { addToWatchFromSel param $param # try adding everything else as pin } else { addToWatchFromSel pin $line } } } # Creates a window with a text box to add items to the watchlist proc addToWatchFromText {} { # create toplevel dialog set w .clipDialog catch {destroy $w} toplevel $w wm title $w [msgcat::mc "Add to watch"] # text widget text $w.t -width 80 -height 20 pack $w.t -fill both -expand 1 # insert clipboard content catch {$w.t insert 1.0 [clipboard get]} # frame for buttons and buttons frame $w.f pack $w.f -fill x button $w.f.ok -text "Add" -command " set txt \[$w.t get 1.0 end\] destroy $w parse_hal_text \$txt " button $w.f.cancel -text "Cancel" -command "destroy $w" pack $w.f.ok $w.f.cancel -side left -expand 1 -fill x } proc popupmenu_text {x y} { # create menu set m [menu .popupMenuText -tearoff false] # add entries $m add command -label [msgcat::mc "Copy"] -command {copySelection 0} $m add command -label [msgcat::mc "Add as Pin(s)"] -command {addToWatchFromSel "pin" [join [selection get] " "]} $m add command -label [msgcat::mc "Add as Signal(s)"] -command {addToWatchFromSel "sig" [join [selection get] " "]} $m add command -label [msgcat::mc "Add as Param(s)"] -command {addToWatchFromSel "param" [join [selection get] " "]} # show menu tk_popup $m $x $y bind $m [list destroy $m] } proc popupmenu_tree {x y item} { if {[string first "+" $item] > 0} { # create menu set m [menu .popupMenuText -tearoff false] # add entries $m add command -label [msgcat::mc "Add all sub-items to watch"] -command "addSubTree $item" # show menu tk_popup $m $x $y bind $m [list destroy $m] } } # Add pins/signals/parameters from selection to watchlist proc addToWatchFromSel {type selection} { set varcount 0 catch { foreach item $selection { if {![catch {hal [string index $type 0]type $item} return]} { if {[watchHAL "$type+$item"] == ""} { incr varcount } } } } setStatusbar [msgcat::mc "$varcount item(s) added"] } proc hal_setp {label val} { eval hal "setp $label $val" } proc hal_tglp {label} { set val [expr ![eval hal "getp $label"]] eval hal "setp $label $val" } proc hal_sets {label val} { eval hal "sets $label $val" } proc hal_tgls {label} { set val [expr ![eval hal "gets $label"]] eval hal "sets $label $val" } proc copyName {label} { clipboard clear clipboard append $label } proc setpValue {label} { set val [eval hal "getp $label"] set val [entrybox $val [msgcat::mc "Set"] $label] if {$val != "cancel"} { eval hal "setp $label $val" } } proc setsValue {label} { set val [eval hal "gets $label"] set val [entrybox $val [msgcat::mc "Set"] $label] if {$val != "cancel"} { eval hal "sets $label $val" } } proc unlinkp {label i} { # when unlink command successful --> rebuild list if {[eval hal "unlinkp $label"] == "Pin '$label' unlinked"} { reloadWatch } } proc entrybox {defVal buttonText label} { if {[winfo exists .top]} { raise .top focus .top return "cancel" } else { set wn [toplevel .top] wm title $wn [msgcat::mc "Input"] set xpos "[ expr {[winfo rootx [winfo parent $wn]]+ \ ([winfo width [winfo parent $wn]]-[winfo reqwidth $wn])/2}]" set ypos "[ expr {[winfo rooty [winfo parent $wn]]+ \ ([winfo height [winfo parent $wn]]-[winfo reqheight $wn])/2}]" wm geometry $wn "+$xpos+$ypos" wm attributes $wn -topmost $::alwaysOnTop variable entryVal set entryVal $defVal label .top.lbl -text $label entry .top.en -textvariable entryVal # -validate all-validatecommand {expr {[string is double %P] || [string is bool %P]}} .top.en icursor end button .top.but -command {set ret $entryVal} -text $buttonText bind .top.en {set ret $entryVal} bind .top.en {set ret $entryVal} wm protocol .top WM_DELETE_WINDOW {set ret "cancel"}; # on X clicked pack {*}[winfo children .top] focus .top.en vwait ret unset -nocomplain ret unset -nocomplain entryVal destroy .top return $::ret } } # watchHAL prepares a string of {i HALtype name} sets # watchLoop submits these to halcmd and sets canvas # color or value based on reply set ::watching 0 set ::watchInterval 100 proc watchLoop {} { set ::watching 1 set which $::watchstring foreach var $which { scan $var {%i %s %s} cnum vartype varname refreshItem $cnum $vartype $varname } if {$::workmode == "watchhal"} { after $::watchInterval watchLoop } else { set ::watching 0 } } proc setWatchInterval {} { while {true} { set interval [entrybox $::watchInterval [msgcat::mc "Set"] \ [msgcat::mc "Update interval for this session (ms)"]] if {$interval < 1} { tk_messageBox -message [msgcat::mc "Value out of range"] -type ok -icon warning } elseif {$interval == "cancel"} { break; } else { set ::watchInterval $interval break } } } proc refreshItem {cnum vartype varname} { if {$vartype == "sig" } { set getCmd gets set typeCmd stype } else { set getCmd getp set typeCmd ptype } if {[catch { set ret [hal $getCmd $varname] } error]} { setStatusbar $error $::cisp itemconfigure text$cnum -text "----" $::cisp itemconfigure oval$cnum -fill lightgray return } set varnumtype [hal $typeCmd $varname] if {$ret == "TRUE"} { $::cisp itemconfigure oval$cnum -fill yellow } elseif {$ret == "FALSE"} { $::cisp itemconfigure oval$cnum -fill firebrick4 } else { switch $varnumtype { u32 - s32 {set varnumtype int} float {set varnumtype float} } if [catch { set value [expr $ret] } ] { set value $ret ;# allow display of a nan } else { # use format if provided via settings if {$::ffmts != "" && ("$varnumtype" == "float")} { set value [format "$::ffmts" $ret] } if {$::ifmts != "" && ("$varnumtype" == "int")} { set value [format "$::ifmts" $ret] } # use format if provided via command line if {[info exists ::ffmt] && ("$varnumtype" == "float")} { set value [format "$::ffmt" $ret] } if {[info exists ::ifmt] && ("$varnumtype" == "int")} { set value [format "$::ifmt" $ret] } } $::cisp itemconfigure text$cnum -text $value } } proc watchReset {del} { $::cisp delete all switch -- $del { all { watchHAL zzz return } default { set item [string map {+ "\\+"} $del]; # escape '+' for regexp set place [lsearch -regexp $::watchlist $item] if {$place != -1 } { set ::watchlist [lreplace $::watchlist $place $place] set watchlist_copy $::watchlist set ::watchlist "" set scrollbar_pos [lindex [$::cisp yview] 0] foreach var $watchlist_copy { watchHAL $var } $::cisp yview moveto [expr $scrollbar_pos * (1 + 1/double([llength $watchlist_copy]))] setStatusbar "'$del' [msgcat::mc "removed from list"]" } else { watchHAL zzz } } } } proc reloadWatch {} { set watchlist_copy $::watchlist set scrollbar_pos [lindex [$::cisp yview] 0] watchReset all foreach item $watchlist_copy { watchHAL $item } $::cisp yview moveto $scrollbar_pos } # proc switches the insert and removal of upper right text # This also removes any modify array variables proc displayThis {str} { $::disp configure -state normal $::disp delete 1.0 end $::disp insert end $str $::disp configure -state disabled } proc getwatchlist {} { set lfile [tk_getOpenFile \ -filetypes $::filetypes\ -initialdir $::last_watchfile_dir\ -initialfile $::last_watchfile_tail\ -title [msgcat::mc "Load a watch list"]\ ] loadwatchlist $lfile } proc loadwatchlist {filename} { if {"$filename" == ""} return set f [open $filename r] set wl "" while {![eof $f]} { set nextline [string trim [gets $f]] if {[string first "#" $nextline] == 0} continue ;# ignore comment lines set wl "$wl $nextline" } close $f set ::last_watchfile_tail [file tail $filename] set ::last_watchfile_dir [file dirname $filename] wm title . "$::last_watchfile_tail - $::titlename" if {"$wl" == ""} return # Backup auto-saved watchlist set backupFile [string map {"//" "/"} $::INIDIR/.halshow_watchlist_backup] writeWatchlist $backupFile multiline watchReset all $::nb raise pw foreach item $wl { watchHAL $item } setStatusbar "$::last_watchfile_tail [msgcat::mc "loaded"], [msgcat::mc "saved backup for old watchlist in"] $backupFile" } proc savewatchlist { {fmt oneline} } { if {"$::watchlist" == ""} { return -code error "savewatchlist: null ::watchlist" } set sfile [tk_getSaveFile \ -filetypes $::filetypes\ -initialdir $::last_watchfile_dir\ -initialfile $::last_watchfile_tail\ -title [msgcat::mc "Save current watch list"]\ ] writeWatchlist $sfile $fmt set ::last_watchfile_tail [file tail $sfile] set ::last_watchfile_dir [file dirname $sfile] wm title . "$::last_watchfile_tail - $::titlename" } proc writeWatchlist {sfile fmt} { if {"$sfile" == ""} return set f [open $sfile w] switch $fmt { multiline { puts $f "# halshow watchlist created [clock format [clock seconds]]\n" foreach line $::watchlist { puts $f $line } } default {puts $f $::watchlist} } close $f } #----------start up the displays---------- makeShow makeWatch makeSettings refreshHAL $::nb raise ps proc setStatusbar {message} { $::showtext config -state normal $::showtext delete 1.0 end $::showtext insert end $message $::showtext config -state disabled } setStatusbar [msgcat::mc "Commands may be tested here but they will NOT be saved"] proc usage {} { set prog [file tail $::argv0] puts "Usage:" puts " $prog \[Options\] \[watchfile\]" puts " Options:" puts " --help (this help)" puts " --fformat format_string_for_float" puts " --iformat format_string_for_int" puts " --noprefs don't use preference file to save settings" puts "" puts "Notes:" puts " Create watchfile in halshow using: 'File/Save Watch List'." puts " LinuxCNC must be running for standalone usage." exit 0 } if {[llength $::argv] > 0} { set idx 0 while {$idx < [llength $::argv]} { switch [lindex $::argv $idx] { "--help" { incr idx; usage } "--iformat" { incr idx; set ::ifmt [lindex $::argv $idx] incr idx $::ifmt_setting.label configure -text " [msgcat::mc "Integer (disabled by \"--iformat\" argument)"]" $::ifmt_setting.entry configure -state disabled } "--fformat" { incr idx; set ::ffmt [lindex $::argv $idx] incr idx $::ffmt_setting.label configure -text " [msgcat::mc "Float (disabled by \"--fformat\" argument)"]" $::ffmt_setting.entry configure -state disabled } "--noprefs" { set ::use_prefs false $::infotext configure -fg red $::infotext config -state normal $::infotext replace 0.0 end "[msgcat::mc "\"--noprefs\" option set. Settings will not be saved!"]" $::infotext config -state disabled incr idx } default { set watchfile [lindex $::argv $idx] incr idx } } } } # Loading the settings from the file. # This overrides the default settings above. if {$::use_prefs} { readIni if {$::separateParams} { refreshHAL } if {$::ratio == 0} { hideListview false } if {$::workmode == "watchhal"} { $::nb raise pw } } # Load watchlist from file if {[info exists watchfile]} { if [file readable $watchfile] { loadwatchlist $watchfile set ::last_watchfile_tail [file tail $watchfile] set ::last_watchfile_dir [file dirname $watchfile] } else { puts "\nCannot read file <$watchfile>\n" usage } } wm attributes . -topmost $::alwaysOnTop tkwait visibility . set ::initPhase false