| 1 |
|
|---|
| 2 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 3 | proc ::TolInspector::ClearConsoleObj { } {
|
|---|
| 4 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 5 | variable wt_tree
|
|---|
| 6 |
|
|---|
| 7 | foreach it [$wt_tree item children "root-console"] {
|
|---|
| 8 | $wt_tree item delete $it
|
|---|
| 9 | }
|
|---|
| 10 | #Limpiamos el stack de la consola de tol
|
|---|
| 11 | ::tol::console stack release
|
|---|
| 12 | }
|
|---|
| 13 |
|
|---|
| 14 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 15 | proc ::TolInspector::ClearConsoleObjSel {wt} {
|
|---|
| 16 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 17 | variable vars_selected
|
|---|
| 18 |
|
|---|
| 19 | foreach var $vars_selected {
|
|---|
| 20 | set name [$wt item text $var Name]
|
|---|
| 21 | #puts "name=$name"
|
|---|
| 22 | #Quitamos el objeto de la consola de tol
|
|---|
| 23 | ::tol::console stack release $name
|
|---|
| 24 | }
|
|---|
| 25 | UpdateConsoleObj
|
|---|
| 26 | }
|
|---|
| 27 |
|
|---|
| 28 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 29 | proc ::TolInspector::UpdateFileRoot { } {
|
|---|
| 30 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 31 | variable wt_tree
|
|---|
| 32 | set idx_file [$wt_tree item id "root-files"]
|
|---|
| 33 | if { [$wt_tree item isopen $idx_file] } {
|
|---|
| 34 | #@ si está abierto el nodo de archivos, se cierra y se abre
|
|---|
| 35 | $wt_tree collapse $idx_file
|
|---|
| 36 | $wt_tree expand $idx_file
|
|---|
| 37 | #@ si la selección estaba en el nodo de archivos se pierde
|
|---|
| 38 | #@ de modo que seleccionamos el nodo raíz
|
|---|
| 39 | if { [$wt_tree selection get] eq "" } {
|
|---|
| 40 | $wt_tree selection modify $idx_file all
|
|---|
| 41 | }
|
|---|
| 42 | }
|
|---|
| 43 | #@ si la selección es el nodo raíz, actualizamos la vista
|
|---|
| 44 | if { [$wt_tree item state get $idx_file selected] } {
|
|---|
| 45 | SelectObject
|
|---|
| 46 | }
|
|---|
| 47 | }
|
|---|
| 48 |
|
|---|
| 49 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 50 | proc ::TolInspector::UpdatePackageRoot { } {
|
|---|
| 51 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 52 | variable wt_tree
|
|---|
| 53 |
|
|---|
| 54 | set open 0
|
|---|
| 55 | set idx [$wt_tree item id "root-packages"]
|
|---|
| 56 | if { [$wt_tree item isopen $idx] } {
|
|---|
| 57 | $wt_tree collapse $idx
|
|---|
| 58 | set open 1
|
|---|
| 59 | }
|
|---|
| 60 | if { [$wt_tree item state get $idx selected] } {
|
|---|
| 61 | SelectObject
|
|---|
| 62 | }
|
|---|
| 63 | if $open {
|
|---|
| 64 | $wt_tree expand $idx
|
|---|
| 65 | }
|
|---|
| 66 | }
|
|---|
| 67 |
|
|---|
| 68 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 69 | proc ::TolInspector::UpdateConsoleObj { } {
|
|---|
| 70 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 71 | variable wt_tree
|
|---|
| 72 |
|
|---|
| 73 | set idx_con [$wt_tree item id "root-console"]
|
|---|
| 74 | if { [$wt_tree item isopen $idx_con] } {
|
|---|
| 75 | $wt_tree collapse $idx_con
|
|---|
| 76 | }
|
|---|
| 77 | $wt_tree selection clear
|
|---|
| 78 | $wt_tree selection add $idx_con
|
|---|
| 79 |
|
|---|
| 80 | #Tolcon_Trace "Abierto el nodo root-console"
|
|---|
| 81 | if { [$wt_tree item state get $idx_con selected] } {
|
|---|
| 82 | SelectObject
|
|---|
| 83 | }
|
|---|
| 84 | }
|
|---|
| 85 |
|
|---|
| 86 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 87 | proc ::TolInspector::PostVariable { x y X Y } {
|
|---|
| 88 | #
|
|---|
| 89 | # PURPOSE: Composes a popup menu for variables and displays it. Its composed
|
|---|
| 90 | # depending on the node/s clicked by user.
|
|---|
| 91 | #
|
|---|
| 92 | # PARAMETERS:
|
|---|
| 93 | # x -> x-coordinate where popup menu is drawn
|
|---|
| 94 | # y -> y-coordinate where popup menu is drawn
|
|---|
| 95 | #
|
|---|
| 96 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 97 | variable data_menu
|
|---|
| 98 | variable vars_selected
|
|---|
| 99 | variable options_selected
|
|---|
| 100 | variable wt_vars
|
|---|
| 101 | variable wt_tree
|
|---|
| 102 |
|
|---|
| 103 | #User functions to contextual menu
|
|---|
| 104 | ::TolInspector::ReadUserFunctions
|
|---|
| 105 |
|
|---|
| 106 | array unset options_selected
|
|---|
| 107 | set all_objects {}
|
|---|
| 108 |
|
|---|
| 109 | foreach it [array names data_menu] {
|
|---|
| 110 | $data_menu($it) delete 0 end
|
|---|
| 111 | }
|
|---|
| 112 |
|
|---|
| 113 | set parent [$wt_tree selection get 0]
|
|---|
| 114 | set parent_tolReference [$wt_tree item text $parent Reference]
|
|---|
| 115 |
|
|---|
| 116 | set InRootConsole [string equal $parent_tolReference "Console"]
|
|---|
| 117 | set InRootFiles [string equal $parent_tolReference "File"]
|
|---|
| 118 | set InRootGrammars [string equal $parent_tolReference "Grammar"]
|
|---|
| 119 |
|
|---|
| 120 | #@ node_act es el nodo bajo el puntero
|
|---|
| 121 | array set obj_act [$wt_vars identify $x $y]
|
|---|
| 122 | if { ![array size obj_act] } { return }
|
|---|
| 123 | if { [lsearch [array names obj_act] item] eq -1 } { return }
|
|---|
| 124 | set node_act $obj_act(item)
|
|---|
| 125 |
|
|---|
| 126 | if { [string length $node_act] } {
|
|---|
| 127 | set vars_selected [$wt_vars selection get 0 end] ;# curselection
|
|---|
| 128 | if { [lsearch $vars_selected $node_act] >= 0 } {
|
|---|
| 129 | foreach var $vars_selected {
|
|---|
| 130 | set itemid [$wt_vars item text $var Index]
|
|---|
| 131 | set path [$wt_vars item text $var Path]
|
|---|
| 132 | set grammar [$wt_vars item text $var Grammar]
|
|---|
| 133 | set objName [$wt_vars item text $var Name]
|
|---|
| 134 | set object [$wt_vars item text $var Reference]
|
|---|
| 135 |
|
|---|
| 136 | #puts "OBJECT=$objName, PATH=$path"
|
|---|
| 137 |
|
|---|
| 138 | lappend all_objects $object
|
|---|
| 139 | switch -- $grammar {
|
|---|
| 140 | Code -
|
|---|
| 141 | Complex -
|
|---|
| 142 | Date -
|
|---|
| 143 | Matrix -
|
|---|
| 144 | VMatrix -
|
|---|
| 145 | Polyn -
|
|---|
| 146 | Ratio -
|
|---|
| 147 | Real -
|
|---|
| 148 | Serie -
|
|---|
| 149 | Anything -
|
|---|
| 150 | Text -
|
|---|
| 151 | NameBlock -
|
|---|
| 152 | TimeSet {
|
|---|
| 153 | lappend options_selected($grammar) [list $object $objName $path]
|
|---|
| 154 | }
|
|---|
| 155 | Set {
|
|---|
| 156 | # Si el objeto se da como referencia
|
|---|
| 157 | if { [llength $object] > 1 } {
|
|---|
| 158 | #puts "PostVariable: Set: object = $object"
|
|---|
| 159 | if {$InRootFiles} {
|
|---|
| 160 | set isFile 1
|
|---|
| 161 | } else {
|
|---|
| 162 | set info [::tol::info var $object]
|
|---|
| 163 | set isFile [expr [lindex $info 7] == 4]
|
|---|
| 164 | }
|
|---|
| 165 | #set desc [lindex $info 4]
|
|---|
| 166 | } else {
|
|---|
| 167 | if {[catch "::tol::info included $object" info]} {
|
|---|
| 168 | set info [::tol::info var [list Set $objName]]
|
|---|
| 169 | #set isFile [expr [lindex $info 5] == 4]
|
|---|
| 170 | set isFile [expr [lindex $info 7] == 4]
|
|---|
| 171 | #set desc [lindex $info 4]
|
|---|
| 172 | } else {
|
|---|
| 173 | #set info [::tol::info included $objName]
|
|---|
| 174 | #set isFile [expr [lindex $info 4] == 4]
|
|---|
| 175 | set isFile 1
|
|---|
| 176 | #set desc ""
|
|---|
| 177 | }
|
|---|
| 178 | }
|
|---|
| 179 | if $isFile {
|
|---|
| 180 | lappend options_selected(File) [list $object $objName $path]
|
|---|
| 181 | } else {
|
|---|
| 182 | lappend options_selected($grammar) [list $object $objName $path]
|
|---|
| 183 | }
|
|---|
| 184 | }
|
|---|
| 185 | }
|
|---|
| 186 | }
|
|---|
| 187 | set grammar_selected [array names options_selected]
|
|---|
| 188 | if { [llength $grammar_selected] } {
|
|---|
| 189 | foreach grammar $grammar_selected {
|
|---|
| 190 | switch -- $grammar {
|
|---|
| 191 | VMatrix -
|
|---|
| 192 | Matrix {
|
|---|
| 193 | $data_menu(main) add cascade -label [mc "Export matrix"] \
|
|---|
| 194 | -menu $data_menu(Matrix,Export)
|
|---|
| 195 | if {[llength $options_selected($grammar)] == 1} {
|
|---|
| 196 | set object [lindex [lindex $options_selected($grammar) 0] 0]
|
|---|
| 197 | $data_menu(main) add command -label [mc "Table matrix"] \
|
|---|
| 198 | -command [list ::TolInspector::TableMatrix $object]
|
|---|
| 199 | $data_menu(Matrix,Export) add command -label "BDT" \
|
|---|
| 200 | -command [list ::TolInspector::ExportBDTMatrix $object]
|
|---|
| 201 | $data_menu(main) add command -label [mc "Draw matrix"]... \
|
|---|
| 202 | -command [list ::TolInspector::DrawMatrix $object]
|
|---|
| 203 | } else {
|
|---|
| 204 | $data_menu(main) add cascade -label [mc "Table matrix"] \
|
|---|
| 205 | -menu $data_menu(Matrix,Table)
|
|---|
| 206 | $data_menu(Matrix,Export) add cascade -label "BDT" \
|
|---|
| 207 | -menu $data_menu(Matrix,Export,BDT)
|
|---|
| 208 | $data_menu(main) add cascade -label [mc "Draw matrix"]... \
|
|---|
| 209 | -menu $data_menu(Matrix,Draw)
|
|---|
| 210 | foreach objInfo $options_selected(Matrix) {
|
|---|
| 211 | $data_menu(Matrix,Table) add command -label [lindex $objInfo 1] \
|
|---|
| 212 | -command [list ::TolInspector::TableMatrix [lindex $objInfo 0]]
|
|---|
| 213 | $data_menu(Matrix,Export,BDT) add command -label [lindex $objInfo 1] \
|
|---|
| 214 | -command [list ::TolInspector::ExportBDTMatrix [lindex $objInfo 0]]
|
|---|
| 215 | $data_menu(Matrix,Draw) add command -label [lindex $objInfo 1] \
|
|---|
| 216 | -command [list ::TolInspector::DrawMatrix [lindex $objInfo 0]]
|
|---|
| 217 | }
|
|---|
| 218 | }
|
|---|
| 219 | if { $grammar eq "Matrix" } {
|
|---|
| 220 | set all_matrix {}
|
|---|
| 221 | foreach m $options_selected(Matrix) {
|
|---|
| 222 | lappend all_matrix [ lindex $m 0 ]
|
|---|
| 223 | }
|
|---|
| 224 | TolGui_InsertEntriesMatrixChart $data_menu(main) $all_matrix
|
|---|
| 225 | }
|
|---|
| 226 | }
|
|---|
| 227 | Serie {
|
|---|
| 228 | if {[llength $options_selected(Serie)] == 1} {
|
|---|
| 229 | set lblSerie "serie"
|
|---|
| 230 | } else {
|
|---|
| 231 | set lblSerie "series"
|
|---|
| 232 | }
|
|---|
| 233 | $data_menu(main) add command -label [mc "Draw $lblSerie"] \
|
|---|
| 234 | -command ::TolInspector::DrawSerie
|
|---|
| 235 | $data_menu(main) add command -label [mc "Table $lblSerie"] \
|
|---|
| 236 | -command ::TolInspector::TableSerie
|
|---|
| 237 | if {[llength $options_selected(Serie)] == 1} {
|
|---|
| 238 | set object [lindex [lindex $options_selected(Serie) 0] 0]
|
|---|
| 239 | $data_menu(main) add command -label [mc "Draw autocorrelation"] \
|
|---|
| 240 | -command [list ::TolInspector::DrawAutocorSerie $object]
|
|---|
| 241 | $data_menu(main) add command -label [mc "Table autocorrelation"] \
|
|---|
| 242 | -command [list ::TolInspector::TableAutocorSerie $object]
|
|---|
| 243 | } else {
|
|---|
| 244 | $data_menu(main) add cascade -label [mc "Draw autocorrelation"] \
|
|---|
| 245 | -menu $data_menu(Serie,DrawAutocor)
|
|---|
| 246 | $data_menu(main) add cascade -label [mc "Table autocorrelation"] \
|
|---|
| 247 | -menu $data_menu(Serie,TableAutocor)
|
|---|
| 248 | foreach objInfo $options_selected(Serie) {
|
|---|
| 249 | $data_menu(Serie,DrawAutocor) add command -label [lindex $objInfo 1] \
|
|---|
| 250 | -command [list ::TolInspector::DrawAutocorSerie [lindex $objInfo 0]]
|
|---|
| 251 | $data_menu(Serie,TableAutocor) add command -label [lindex $objInfo 1] \
|
|---|
| 252 | -command [list ::TolInspector::TableAutocorSerie [lindex $objInfo 0]]
|
|---|
| 253 | }
|
|---|
| 254 | }
|
|---|
| 255 | $data_menu(main) add command -label [mc "Table statistics"] \
|
|---|
| 256 | -command ::TolInspector::TableStatisticsSerie
|
|---|
| 257 | }
|
|---|
| 258 | TimeSet {
|
|---|
| 259 | if {[llength $options_selected(TimeSet)] == 1} {
|
|---|
| 260 | set object [lindex [lindex $options_selected(TimeSet) 0] 0]
|
|---|
| 261 | $data_menu(main) add command -label [mc "View timeset"] \
|
|---|
| 262 | -command [list ::TolInspector::ViewTimeSet $object]
|
|---|
| 263 | } else {
|
|---|
| 264 | $data_menu(main) add cascade -label [mc "View timeset"] \
|
|---|
| 265 | -menu $data_menu(TimeSet,View)
|
|---|
| 266 | foreach objInfo $options_selected(TimeSet) {
|
|---|
| 267 | $data_menu(TimeSet,View) add command -label [lindex $objInfo 1] \
|
|---|
| 268 | -command [list ::TolInspector::ViewTimeSet [lindex $objInfo 0]]
|
|---|
| 269 | }
|
|---|
| 270 | }
|
|---|
| 271 | }
|
|---|
| 272 | NameBlock {
|
|---|
| 273 | # entradas desde MenuManager
|
|---|
| 274 | if 0 {
|
|---|
| 275 | TolGui_InsertEntriesFromMenuManager \
|
|---|
| 276 | $data_menu(main) \
|
|---|
| 277 | $options_selected(NameBlock)
|
|---|
| 278 | }
|
|---|
| 279 | # entradas desde @MenuDesc
|
|---|
| 280 | # @MenuDesc sera reemplazado, ver https://www.tol-project.org/ticket/1372
|
|---|
| 281 | set sel_length [ llength $options_selected(NameBlock) ]
|
|---|
| 282 | if { $sel_length } {
|
|---|
| 283 | set idx_current [ lsearch $vars_selected $node_act ]
|
|---|
| 284 | set all_nb_options \
|
|---|
| 285 | [ TolGui_GetMenuEntries \
|
|---|
| 286 | $options_selected(NameBlock) $idx_current ]
|
|---|
| 287 | set num_options [ llength $all_nb_options ]
|
|---|
| 288 | #puts "num_options = $num_options"
|
|---|
| 289 | foreach mi $all_nb_options {
|
|---|
| 290 | set _cname [ lindex $mi 0 ]
|
|---|
| 291 | set cname [ string map [ list @ "" . _ ] $_cname ]
|
|---|
| 292 | #puts "cname = $cname"
|
|---|
| 293 | foreach { ninst obj_addr entries } [ lindex $mi 1 ] break
|
|---|
| 294 | set instances [ lindex $mi 2 ]
|
|---|
| 295 | if { $num_options > 1 } {
|
|---|
| 296 | # creo el menu de la clase si no existe
|
|---|
| 297 | set mclass $data_menu(main).cls$cname
|
|---|
| 298 | if { ![ winfo exists $mclass ] } {
|
|---|
| 299 | menu $mclass -tearoff 0
|
|---|
| 300 | } else {
|
|---|
| 301 | $mclass delete 0 end
|
|---|
| 302 | }
|
|---|
| 303 | $data_menu(main) add cascade -label $cname -menu $mclass
|
|---|
| 304 | set target_menu $mclass
|
|---|
| 305 | } else {
|
|---|
| 306 | set target_menu $data_menu(main)
|
|---|
| 307 | }
|
|---|
| 308 | foreach inst_entry $entries {
|
|---|
| 309 | foreach { label single group } $inst_entry break
|
|---|
| 310 | set opt_label \
|
|---|
| 311 | "$label [ expr { $sel_length>1 ? $ninst : {} } ]"
|
|---|
| 312 | $target_menu add command -label $opt_label \
|
|---|
| 313 | -command [ list TolGui_InvokeMethod \
|
|---|
| 314 | $single $obj_addr ]
|
|---|
| 315 | if { $group ne "" && [ llength $instances ] > 1 } {
|
|---|
| 316 | # hay una funcion que se aplica a toda la seleccion
|
|---|
| 317 | $target_menu add command -label "$label All" \
|
|---|
| 318 | -command [ list TolGui_InvokeGroup \
|
|---|
| 319 | $_cname $group $instances ]
|
|---|
| 320 | }
|
|---|
| 321 | }
|
|---|
| 322 | }
|
|---|
| 323 | }
|
|---|
| 324 | }
|
|---|
| 325 | Set {
|
|---|
| 326 | if {[llength $options_selected(Set)] == 1} {
|
|---|
| 327 | set object [lindex [lindex $options_selected(Set) 0] 0]
|
|---|
| 328 | $data_menu(main) add command -label [mc "Table set"] \
|
|---|
| 329 | -command [list ::TolInspector::TableSet $object]
|
|---|
| 330 | $data_menu(main) add command -label [mc "Draw set"] \
|
|---|
| 331 | -command [list ::TolInspector::DrawSet $object]
|
|---|
| 332 | # menu special
|
|---|
| 333 | $data_menu(main) add cascade -label [mc "Draw set special"] \
|
|---|
| 334 | -menu $data_menu(Set,Draw,Special)
|
|---|
| 335 | $data_menu(Set,Draw,Special) add command \
|
|---|
| 336 | -label [mc SetGraphAllFirst] \
|
|---|
| 337 | -command [list ::TolInspector::DrawSet $object 1]
|
|---|
| 338 | $data_menu(Set,Draw,Special) add command \
|
|---|
| 339 | -label [mc SetGraphAllGeneric] \
|
|---|
| 340 | -command [list ::TolInspector::DrawSet $object 2]
|
|---|
| 341 | $data_menu(Set,Draw,Special) add command \
|
|---|
| 342 | -label [mc SetGraphEvenUneven] \
|
|---|
| 343 | -command [list ::TolInspector::DrawSet $object 3]
|
|---|
| 344 | } else {
|
|---|
| 345 | $data_menu(main) add cascade -label [mc "Table set"] \
|
|---|
| 346 | -menu $data_menu(Set,Table)
|
|---|
| 347 | $data_menu(main) add cascade -label [mc "Draw set"] \
|
|---|
| 348 | -menu $data_menu(Set,Draw)
|
|---|
| 349 | foreach objInfo $options_selected(Set) {
|
|---|
| 350 | $data_menu(Set,Table) add command -label [lindex $objInfo 1] \
|
|---|
| 351 | -command [list ::TolInspector::TableSet [lindex $objInfo 0]]
|
|---|
| 352 | $data_menu(Set,Draw) add command -label [lindex $objInfo 1] \
|
|---|
| 353 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0]]
|
|---|
| 354 | }
|
|---|
| 355 | # menu special
|
|---|
| 356 | set i 0
|
|---|
| 357 | $data_menu(main) add cascade -label [mc "Draw set special"] \
|
|---|
| 358 | -menu $data_menu(Set,Draw,Special,M)
|
|---|
| 359 | foreach objInfo $options_selected(Set) {
|
|---|
| 360 | # exists menu previus ?
|
|---|
| 361 | if {[winfo exists $data_menu(Set,Draw,Special,M).setdrawspecialm$i]} {
|
|---|
| 362 | destroy $data_menu(Set,Draw,Special,M).setdrawspecialm$i
|
|---|
| 363 | }
|
|---|
| 364 | set mn \
|
|---|
| 365 | [menu $data_menu(Set,Draw,Special,M).setdrawspecialm$i \
|
|---|
| 366 | -tearoff 0]
|
|---|
| 367 | $data_menu(Set,Draw,Special,M) add cascade \
|
|---|
| 368 | -label [lindex $objInfo 1] -menu $mn
|
|---|
| 369 | $mn add command -label [mc SetGraphAllFirst] \
|
|---|
| 370 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 1]
|
|---|
| 371 | $mn add command -label [mc SetGraphAllGeneric] \
|
|---|
| 372 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 2]
|
|---|
| 373 | $mn add command -label [mc SetGraphEvenUneven] \
|
|---|
| 374 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 3]
|
|---|
| 375 | incr i
|
|---|
| 376 | }
|
|---|
| 377 | }
|
|---|
| 378 | }
|
|---|
| 379 | File {
|
|---|
| 380 | if {[llength $options_selected(File)] == 1} {
|
|---|
| 381 | set objName [lindex [lindex $options_selected(File) 0] 2]
|
|---|
| 382 | $data_menu(main) add command -label [mc "View file"] \
|
|---|
| 383 | -command [list ::TolInspector::ViewFile $objName]
|
|---|
| 384 | if $InRootFiles {
|
|---|
| 385 | $data_menu(main) add command -label [mc "Decompile file"] \
|
|---|
| 386 | -command [list ::TolInspector::DecompileFile $objName]
|
|---|
| 387 | }
|
|---|
| 388 | } else {
|
|---|
| 389 | $data_menu(main) add cascade -label [mc "View file"] \
|
|---|
| 390 | -menu $data_menu(File,View)
|
|---|
| 391 | foreach objInfo $options_selected(File) {
|
|---|
| 392 | $data_menu(File,View) add command -label [lindex $objInfo 1] \
|
|---|
| 393 | -command [list ::TolInspector::ViewFile [lindex $objInfo 2]]
|
|---|
| 394 | }
|
|---|
| 395 | if $InRootFiles {
|
|---|
| 396 | $data_menu(main) add cascade -label [mc "Decompile file"] \
|
|---|
| 397 | -menu $data_menu(File,Decompile)
|
|---|
| 398 | foreach objInfo $options_selected(File) {
|
|---|
| 399 | $data_menu(File,Decompile) add command -label [lindex $objInfo 1] \
|
|---|
| 400 | -command [list ::TolInspector::DecompileFile [lindex $objInfo 2]]
|
|---|
| 401 | }
|
|---|
| 402 | }
|
|---|
| 403 | }
|
|---|
| 404 | }
|
|---|
| 405 | } ;# end del switch
|
|---|
| 406 | # inserto las opciones definidas en MenuManager
|
|---|
| 407 | if { $grammar ne "Anything" } {
|
|---|
| 408 | TolGui_InsertEntriesFromMenuManager \
|
|---|
| 409 | $data_menu(main) \
|
|---|
| 410 | $options_selected($grammar)
|
|---|
| 411 | }
|
|---|
| 412 |
|
|---|
| 413 | $data_menu(main) add separator
|
|---|
| 414 | $data_menu(main) add cascade -label [mc "Functions"] \
|
|---|
| 415 | -menu $data_menu($grammar,Functions)
|
|---|
| 416 | ShowMenuUserFunc $grammar
|
|---|
| 417 | if {[llength $options_selected($grammar)] == 1} {
|
|---|
| 418 | set objName [lindex [lindex $options_selected($grammar) 0] 1]
|
|---|
| 419 | set path [lindex [lindex $options_selected($grammar) 0] 2]
|
|---|
| 420 | $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 421 | -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
|
|---|
| 422 | } else {
|
|---|
| 423 | $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 424 | -menu $data_menu($grammar,File)
|
|---|
| 425 | foreach objInfo $options_selected($grammar) {
|
|---|
| 426 | $data_menu($grammar,File) add command -label [lindex $objInfo 1] \
|
|---|
| 427 | -command [list ::TolInspector::ViewDefinition\
|
|---|
| 428 | [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
|
|---|
| 429 | }
|
|---|
| 430 | }
|
|---|
| 431 | $data_menu(main) add separator
|
|---|
| 432 | } ;#end del foreach
|
|---|
| 433 |
|
|---|
| 434 | # Store selection in oza
|
|---|
| 435 | if { [ llength $all_objects ] > 1 || [ lindex $grammar_selected 0 ] ne "Set" } {
|
|---|
| 436 | $data_menu(main) add command -label [mc "Store selection in OZA"]... \
|
|---|
| 437 | -command [ list TolGui_StoreSelectionInOZA $all_objects ]
|
|---|
| 438 | } else {
|
|---|
| 439 | $data_menu(main) add command -label [mc "Store Set in OZA"]... \
|
|---|
| 440 | -command [ list TolGui_StoreSelectionInOZA $all_objects ]
|
|---|
| 441 | $data_menu(main) add command -label [mc "Store elements in OZA"]... \
|
|---|
| 442 | -command [ list TolGui_StoreSetElementsInOZA [ lindex $all_objects 0 ] ]
|
|---|
| 443 | }
|
|---|
| 444 | $data_menu(main) add separator
|
|---|
| 445 | # Store selection in oza
|
|---|
| 446 |
|
|---|
| 447 | $data_menu(main) add command -label [mc "Add to Console"] \
|
|---|
| 448 | -command [list ::TolInspector::AddToConsole $wt_vars]
|
|---|
| 449 | $data_menu(main) add command -label [mc "Write into Eval"] \
|
|---|
| 450 | -command [list ::TolInspector::AddToEvalWindow $wt_vars]
|
|---|
| 451 | $data_menu(main) add separator
|
|---|
| 452 | if { $InRootConsole} {
|
|---|
| 453 | $data_menu(main) add command -label [mc "Decompile"] \
|
|---|
| 454 | -command [list ::TolInspector::ClearConsoleObjSel $wt_vars]
|
|---|
| 455 | $data_menu(main) add separator
|
|---|
| 456 | }
|
|---|
| 457 | $data_menu(main) add command -label [mc "Select all"] \
|
|---|
| 458 | -command [list ::TolInspector::SelectAll $wt_vars]
|
|---|
| 459 | $data_menu(main) add command -label [mc "Toggle selection"] \
|
|---|
| 460 | -command [list ::TolInspector::ToggleSelection $wt_vars]
|
|---|
| 461 | tk_popup $data_menu(main) $X $Y
|
|---|
| 462 | } ;#end del if
|
|---|
| 463 | }
|
|---|
| 464 | }
|
|---|
| 465 | }
|
|---|
| 466 |
|
|---|
| 467 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 468 | proc ::TolInspector::PostFunction { x y X Y } {
|
|---|
| 469 | #
|
|---|
| 470 | # PURPOSE: Composes a popup menu for functions and displays it. Its composed
|
|---|
| 471 | # depending on the node/s clicked by user.
|
|---|
| 472 | #
|
|---|
| 473 | # PARAMETERS:
|
|---|
| 474 | # x -> x-coordinate where popup menu is drawn
|
|---|
| 475 | # y -> y-coordinate where popup menu is drawn
|
|---|
| 476 | #
|
|---|
| 477 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 478 | variable data_menu
|
|---|
| 479 | variable vars_selected
|
|---|
| 480 | variable wt_funcs
|
|---|
| 481 | variable wt_tree
|
|---|
| 482 |
|
|---|
| 483 | array unset options_selected
|
|---|
| 484 | foreach it [array names data_menu] {
|
|---|
| 485 | $data_menu($it) delete 0 end
|
|---|
| 486 | }
|
|---|
| 487 |
|
|---|
| 488 | #@ node_act es el nodo bajo el puntero
|
|---|
| 489 | array set obj_act [$wt_funcs identify $x $y]
|
|---|
| 490 | if { ![array size obj_act] } { return }
|
|---|
| 491 | if { [lsearch [array names obj_act] item] eq -1 } { return }
|
|---|
| 492 | set node_act $obj_act(item)
|
|---|
| 493 |
|
|---|
| 494 | if { [string length $node_act] } {
|
|---|
| 495 | set vars_selected [$wt_funcs selection get 0 end] ;# curselection
|
|---|
| 496 | if { [lsearch $vars_selected $node_act] >= 0 } {
|
|---|
| 497 | foreach var $vars_selected {
|
|---|
| 498 | set itemid [$wt_funcs item text $var Index]
|
|---|
| 499 | set path [$wt_funcs item text $var Path]
|
|---|
| 500 | set grammar [$wt_funcs item text $var Grammar]
|
|---|
| 501 | set objName [$wt_funcs item text $var Name]
|
|---|
| 502 | set object [$wt_funcs item text $var Reference]
|
|---|
| 503 | # La única gramática seleccionable en wt_funcs es Code
|
|---|
| 504 | lappend code_selected [list $object $objName $path]
|
|---|
| 505 | }
|
|---|
| 506 |
|
|---|
| 507 | if {[llength $code_selected] == 1} {
|
|---|
| 508 | set objName [lindex [lindex $code_selected 0] 1]
|
|---|
| 509 | set path [lindex [lindex $code_selected 0] 2]
|
|---|
| 510 | $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 511 | -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
|
|---|
| 512 | } else {
|
|---|
| 513 | $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 514 | -menu $data_menu($grammar,File)
|
|---|
| 515 | foreach objInfo $code_selected {
|
|---|
| 516 | $data_menu($grammar,File) add command -label [lindex $objInfo 1]\
|
|---|
| 517 | -command [list ::TolInspector::ViewDefinition\
|
|---|
| 518 | [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
|
|---|
| 519 | }
|
|---|
| 520 | }
|
|---|
| 521 | $data_menu(main) add command -label [mc "Write into Eval"] \
|
|---|
| 522 | -command [list ::TolInspector::AddToEvalWindow $wt_funcs]
|
|---|
| 523 | $data_menu(main) add separator
|
|---|
| 524 | $data_menu(main) add command -label [mc "Select all"] \
|
|---|
| 525 | -command [list ::TolInspector::SelectAll $wt_funcs]
|
|---|
| 526 | $data_menu(main) add command -label [mc "Toggle selection"] \
|
|---|
| 527 | -command [list ::TolInspector::ToggleSelection $wt_funcs]
|
|---|
| 528 | tk_popup $data_menu(main) $X $Y
|
|---|
| 529 | }
|
|---|
| 530 | }
|
|---|
| 531 | }
|
|---|
| 532 |
|
|---|
| 533 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 534 | proc ::TolInspector::PostTree { x y X Y } {
|
|---|
| 535 | #
|
|---|
| 536 | # PURPOSE: Composes a popup menu for left treeview and displays it. Its
|
|---|
| 537 | # composed depending on the node clicked by user.
|
|---|
| 538 | #
|
|---|
| 539 | # PARAMETERS:
|
|---|
| 540 | # x -> x-coordinate where popup menu is drawn
|
|---|
| 541 | # y -> y-coordinate where popup menu is drawn
|
|---|
| 542 | #
|
|---|
| 543 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 544 | variable data_menu
|
|---|
| 545 | variable vars_selected
|
|---|
| 546 | variable wt_tree
|
|---|
| 547 | variable arguments
|
|---|
| 548 |
|
|---|
| 549 | #puts "ht_tree: $ht_tree"
|
|---|
| 550 | #No terminado todavía
|
|---|
| 551 | #return
|
|---|
| 552 | array unset options_selected
|
|---|
| 553 |
|
|---|
| 554 | #puts "::TolInspector::PostTree $x $y"
|
|---|
| 555 | foreach it [array names data_menu] {
|
|---|
| 556 | $data_menu($it) delete 0 end
|
|---|
| 557 | }
|
|---|
| 558 |
|
|---|
| 559 | set selection [$wt_tree selection get 0]
|
|---|
| 560 | if { ![string length $selection] } { return }
|
|---|
| 561 |
|
|---|
| 562 | set tolReference [$wt_tree item text $selection Reference]
|
|---|
| 563 | if { [llength $tolReference] == 2 } {
|
|---|
| 564 | set InRootFiles [string equal [lindex $tolReference 0] "File"]
|
|---|
| 565 | } else {
|
|---|
| 566 | set InRootFiles 0
|
|---|
| 567 | }
|
|---|
| 568 |
|
|---|
| 569 | #@ node_act es el nodo bajo el puntero
|
|---|
| 570 | array set obj_act [$wt_tree identify $x $y]
|
|---|
| 571 | if { ![array size obj_act] } { return }
|
|---|
| 572 | if { [lsearch [array names obj_act] item] eq -1 } { return }
|
|---|
| 573 | set node_act $obj_act(item)
|
|---|
| 574 |
|
|---|
| 575 | if { [string length $node_act] } {
|
|---|
| 576 | set vars_selected [$wt_tree selection get 0 end] ;# curselection
|
|---|
| 577 | #puts "vars_selected: $vars_selected"
|
|---|
| 578 | if { [lsearch $vars_selected $node_act] >= 0 } { ;# Not root node
|
|---|
| 579 | set index [$wt_tree selection get 0] ;# anchor
|
|---|
| 580 |
|
|---|
| 581 | if { $index == 0 } return
|
|---|
| 582 | # if user selects a root or a grammar doesn't nothing
|
|---|
| 583 | set tolReference [$wt_tree item text $index Reference]
|
|---|
| 584 | if { [llength $tolReference] == 1 } return
|
|---|
| 585 |
|
|---|
| 586 | # label of object showed in the tree
|
|---|
| 587 | set objName [$wt_tree item text $index Name]
|
|---|
| 588 | set object [$wt_tree item text $index Reference]
|
|---|
| 589 |
|
|---|
| 590 | if {$InRootFiles} {
|
|---|
| 591 | set objName [lindex $tolReference 1]
|
|---|
| 592 | }
|
|---|
| 593 | # TICKET: #1438
|
|---|
| 594 | # Por que se pregunta aqui por los objetos de consola?
|
|---|
| 595 | set stackList [::tol::console stack list]
|
|---|
| 596 | #puts "stackList: $stackList"
|
|---|
| 597 | set stackValue {}
|
|---|
| 598 | foreach stackItem $stackList {
|
|---|
| 599 | if {[lindex $stackItem 1] eq $objName} {
|
|---|
| 600 | set stackValue $stackItem
|
|---|
| 601 | }
|
|---|
| 602 | break
|
|---|
| 603 | }
|
|---|
| 604 | #puts "stackValue: $stackValue"
|
|---|
| 605 | set grammar [lindex $stackValue 0]
|
|---|
| 606 | #puts "grammar: $grammar"
|
|---|
| 607 |
|
|---|
| 608 | #foreach fun [::tol::info functions $grammar] {
|
|---|
| 609 | # set finfo [::tol::info functions $grammar $fun]
|
|---|
| 610 | # InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0
|
|---|
| 611 | #}
|
|---|
| 612 | if {[catch {set info [::tol::info included $objName]}]} {
|
|---|
| 613 | if { !($grammar eq "")} {
|
|---|
| 614 | if {[catch {set info [::tol::info var [list $grammar $object]}]} {
|
|---|
| 615 | #set info [concat [list "$grammar" $objName ] [::tol::info var $grammar $objName]]
|
|---|
| 616 | set info [::tol::info var [list $grammar $objName]]
|
|---|
| 617 | #Tolcon_Trace "INFO de ::tol::info var Set objName"
|
|---|
| 618 | } else {
|
|---|
| 619 | set info [::tol::info var [list $grammar $object]]
|
|---|
| 620 | #Tolcon_Trace "INFO de ::tol::info var $grammar object"
|
|---|
| 621 | }
|
|---|
| 622 | set isFile [expr [lindex $info 5] == 4]
|
|---|
| 623 | } else {
|
|---|
| 624 | set isFile 0
|
|---|
| 625 | }
|
|---|
| 626 |
|
|---|
| 627 | } else {
|
|---|
| 628 | set info [::tol::info included $objName]
|
|---|
| 629 | #Tolcon_Trace "INFO de ::tol::info included objName"
|
|---|
| 630 | set isFile 1
|
|---|
| 631 | }
|
|---|
| 632 | #puts "paso"
|
|---|
| 633 |
|
|---|
| 634 | if $isFile {
|
|---|
| 635 | #puts "entro como fichero"
|
|---|
| 636 | $data_menu(main) add command -label [mc "View file"] \
|
|---|
| 637 | -command [list ::TolInspector::ViewFile $objName]
|
|---|
| 638 | if $InRootFiles {
|
|---|
| 639 | $data_menu(main) add command -label [mc "Decompile file"] \
|
|---|
| 640 | -command [list ::TolInspector::DecompileFile $objName]
|
|---|
| 641 | }
|
|---|
| 642 | } else {
|
|---|
| 643 | #puts "no entro como fichero"
|
|---|
| 644 | if { $grammar eq "Set" } {
|
|---|
| 645 | $data_menu(main) add command -label [mc "Table set"] \
|
|---|
| 646 | -command [list ::TolInspector::TableSet $object]
|
|---|
| 647 | $data_menu(main) add command -label [mc "Draw set"] \
|
|---|
| 648 | -command [list ::TolInspector::DrawSet $object]
|
|---|
| 649 | }
|
|---|
| 650 | }
|
|---|
| 651 | tk_popup $data_menu(main) $X $Y
|
|---|
| 652 | }
|
|---|
| 653 | }
|
|---|
| 654 | }
|
|---|
| 655 |
|
|---|
| 656 |
|
|---|
| 657 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 658 | proc ::TolInspector::AddToConsole {wt} {
|
|---|
| 659 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 660 | variable vars_selected
|
|---|
| 661 |
|
|---|
| 662 | foreach var $vars_selected {
|
|---|
| 663 | set reference [$wt item text $var Reference]
|
|---|
| 664 | #Tolcon_Trace "GetObjectFromAddress(\"[::tol::info address $reference]\")"
|
|---|
| 665 | ::tol::console eval "GetObjectFromAddress(\"[::tol::info address $reference]\")"
|
|---|
| 666 | }
|
|---|
| 667 | UpdateConsoleObj
|
|---|
| 668 | }
|
|---|
| 669 |
|
|---|
| 670 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 671 | proc ::TolInspector::AddToEvalWindow {wt} {
|
|---|
| 672 | #
|
|---|
| 673 | # PURPOSE: Adds names of selected objects (vars or functions) in wtree wt to eval window
|
|---|
| 674 | #
|
|---|
| 675 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 676 | variable vars_selected
|
|---|
| 677 |
|
|---|
| 678 | set names ""
|
|---|
| 679 | foreach var $vars_selected {
|
|---|
| 680 | lappend names [$wt item text $var Name]
|
|---|
| 681 | }
|
|---|
| 682 | ::TolConsole::ToEvalWindow [ListToStr $names]
|
|---|
| 683 | }
|
|---|
| 684 |
|
|---|
| 685 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 686 | proc ::TolInspector::SelectAll {wt} {
|
|---|
| 687 | #
|
|---|
| 688 | # PURPOSE: Selects all nodes of a given wtree
|
|---|
| 689 | #
|
|---|
| 690 | # PARAMETERS:
|
|---|
| 691 | # wt -> wtree's object
|
|---|
| 692 | #
|
|---|
| 693 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 694 | $wt selection add 0 end
|
|---|
| 695 | }
|
|---|
| 696 |
|
|---|
| 697 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 698 | proc ::TolInspector::ToggleSelection {wt} {
|
|---|
| 699 | #
|
|---|
| 700 | # PURPOSE: Toggles selection of nodes of a given wtree
|
|---|
| 701 | #
|
|---|
| 702 | # PARAMETERS:
|
|---|
| 703 | # wt -> wtree's object
|
|---|
| 704 | #
|
|---|
| 705 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 706 | set sel [$wt selection get 0 end]
|
|---|
| 707 | $wt selection add 0 end
|
|---|
| 708 | $wt selection modify {} $sel
|
|---|
| 709 | }
|
|---|
| 710 |
|
|---|
| 711 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 712 | proc ::TolInspector::SelectionExpand { } {
|
|---|
| 713 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 714 | variable wt_vars
|
|---|
| 715 | set node [$wt_vars selection get 0]
|
|---|
| 716 | if {$node == ""} {
|
|---|
| 717 | ::TolInspector::SelectionCollapse
|
|---|
| 718 | } else {
|
|---|
| 719 | $wt_vars expand $node
|
|---|
| 720 | }
|
|---|
| 721 | }
|
|---|
| 722 |
|
|---|
| 723 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 724 | proc ::TolInspector::SelectionCollapse { } {
|
|---|
| 725 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 726 | variable wt_tree
|
|---|
| 727 | set node [$wt_tree selection get 0]
|
|---|
| 728 | if {$node eq 0} {} else {
|
|---|
| 729 | set parent [$wt_tree item parent $node]
|
|---|
| 730 | $wt_tree collapse $node
|
|---|
| 731 | $wt_tree selection clear
|
|---|
| 732 | $wt_tree selection add $parent
|
|---|
| 733 | }
|
|---|
| 734 | }
|
|---|
| 735 |
|
|---|
| 736 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 737 | proc ::TolInspector::ToggleItem { x y } {
|
|---|
| 738 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 739 | variable wt_tree
|
|---|
| 740 |
|
|---|
| 741 | set lstxy [$wt_tree identify $x $y]
|
|---|
| 742 | if { [llength $lstxy] } {
|
|---|
| 743 | if { [lindex $lstxy 0] == "item" } {
|
|---|
| 744 | $wt_tree item toggle [lindex $lstxy 1]
|
|---|
| 745 | }
|
|---|
| 746 | }
|
|---|
| 747 | }
|
|---|
