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