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