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