| 1 |
|
|---|
| 2 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 3 | proc ::TolInspector::ClearConsoleObj { } {
|
|---|
| 4 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 5 | variable ht_tree
|
|---|
| 6 | variable data
|
|---|
| 7 |
|
|---|
| 8 | set idx_con [$ht_tree index root-console]
|
|---|
| 9 | $ht_tree entry delete $idx_con 0 end
|
|---|
| 10 |
|
|---|
| 11 | #Quitamos del spool todos los objetos que provengan de la consola
|
|---|
| 12 | foreach _obj $data(pool,objects) {
|
|---|
| 13 | array set obj $_obj
|
|---|
| 14 | if {[string equal $obj(origin) "root-console"]} {
|
|---|
| 15 | set idx [lsearch $data(pool,objects) $_obj]
|
|---|
| 16 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
|
|---|
| 17 | }
|
|---|
| 18 | }
|
|---|
| 19 | UpdatePoolObj
|
|---|
| 20 | #Finalmente limpiamos el stack de la consola de tol
|
|---|
| 21 | ::tol::console stack release
|
|---|
| 22 | }
|
|---|
| 23 |
|
|---|
| 24 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 25 | proc ::TolInspector::ClearConsoleObjSel {ht} {
|
|---|
| 26 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 27 | variable vars_selected
|
|---|
| 28 | variable data
|
|---|
| 29 |
|
|---|
| 30 | foreach var $vars_selected {
|
|---|
| 31 | set name [$ht entry cget $var -label]
|
|---|
| 32 | #puts "name=$name"
|
|---|
| 33 | #Quitamos del spool todos los objetos que provengan de la consola
|
|---|
| 34 | foreach _obj $data(pool,objects) {
|
|---|
| 35 | array set obj $_obj
|
|---|
| 36 | #puts "_obj=$_obj"
|
|---|
| 37 | if {[string equal $obj(origin) "root-console"] && [string equal $obj(objName) $name]} {
|
|---|
| 38 | set idx [lsearch $data(pool,objects) $_obj]
|
|---|
| 39 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
|
|---|
| 40 | }
|
|---|
| 41 | }
|
|---|
| 42 | UpdatePoolObj
|
|---|
| 43 | #Finalmente quitamos el objeto de la consola de tol
|
|---|
| 44 | ::tol::console stack release $name
|
|---|
| 45 | }
|
|---|
| 46 | UpdateConsoleObj
|
|---|
| 47 | }
|
|---|
| 48 |
|
|---|
| 49 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 50 | proc ::TolInspector::UpdateFileRoot { } {
|
|---|
| 51 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 52 | variable ht_tree
|
|---|
| 53 | set open 0
|
|---|
| 54 | set idx_file [$ht_tree index root-files]
|
|---|
| 55 | if { [$ht_tree entry isopen $idx_file] } {
|
|---|
| 56 | $ht_tree close $idx_file
|
|---|
| 57 | set open 1
|
|---|
| 58 | }
|
|---|
| 59 | if { [$ht_tree index focus] == $idx_file } {
|
|---|
| 60 | SelectObject
|
|---|
| 61 | }
|
|---|
| 62 | if $open {
|
|---|
| 63 | $ht_tree open $idx_file
|
|---|
| 64 | }
|
|---|
| 65 | }
|
|---|
| 66 |
|
|---|
| 67 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 68 | proc ::TolInspector::UpdateConsoleObj { } {
|
|---|
| 69 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 70 | variable ht_tree
|
|---|
| 71 |
|
|---|
| 72 | set idx_con [$ht_tree index root-console]
|
|---|
| 73 | if { [$ht_tree entry isopen $idx_con] } {
|
|---|
| 74 | $ht_tree close $idx_con
|
|---|
| 75 | }
|
|---|
| 76 | $ht_tree selection anchor root-console
|
|---|
| 77 | $ht_tree selection mark root-console
|
|---|
| 78 | #Tolcon_Trace "Abierto el nodo root-console"
|
|---|
| 79 | if { [$ht_tree index focus] == $idx_con } {
|
|---|
| 80 | SelectObject
|
|---|
| 81 | }
|
|---|
| 82 | }
|
|---|
| 83 |
|
|---|
| 84 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 85 | proc ::TolInspector::UpdatePoolObj { } {
|
|---|
| 86 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 87 | variable ht_tree
|
|---|
| 88 |
|
|---|
| 89 | set idx_pool [$ht_tree index root-pool]
|
|---|
| 90 | if { [$ht_tree entry isopen $idx_pool] } {
|
|---|
| 91 | $ht_tree close $idx_pool
|
|---|
| 92 | }
|
|---|
| 93 | if { [$ht_tree index focus] == $idx_pool } {
|
|---|
| 94 | SelectObject
|
|---|
| 95 | }
|
|---|
| 96 | }
|
|---|
| 97 |
|
|---|
| 98 |
|
|---|
| 99 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 100 | proc ::TolInspector::PostVariable { x y } {
|
|---|
| 101 | #
|
|---|
| 102 | # PURPOSE: Composes a popup menu for variables and displays it. Its composed
|
|---|
| 103 | # depending on the node/s clicked by user.
|
|---|
| 104 | #
|
|---|
| 105 | # PARAMETERS:
|
|---|
| 106 | # x -> x-coordinate where popup menu is drawn
|
|---|
| 107 | # y -> y-coordinate where popup menu is drawn
|
|---|
| 108 | #
|
|---|
| 109 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 110 | variable data_menu
|
|---|
| 111 | variable vars_selected
|
|---|
| 112 | variable options_selected
|
|---|
| 113 | variable ht_vars
|
|---|
| 114 | variable ht_tree
|
|---|
| 115 | variable item_data
|
|---|
| 116 | variable data
|
|---|
| 117 |
|
|---|
| 118 | variable tolset
|
|---|
| 119 | variable tolindex
|
|---|
| 120 |
|
|---|
| 121 | #User functions to contextual menu
|
|---|
| 122 | ::TolInspector::ReadUserFunctions
|
|---|
| 123 |
|
|---|
| 124 | array unset options_selected
|
|---|
| 125 | set all_objects {}
|
|---|
| 126 |
|
|---|
| 127 | foreach it [array names data_menu] {
|
|---|
| 128 | $data_menu($it) delete 0 end
|
|---|
| 129 | }
|
|---|
| 130 | set InRootConsole [string equal [lindex [$ht_tree get -full anchor] end] "root-console"]
|
|---|
| 131 | set InRootPool [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
|
|---|
| 132 | set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end] "root-files"]
|
|---|
| 133 | #puts "PostVariable: InRootConsole,InRootPool,InRootFiles = $InRootConsole,$InRootPool,$InRootFiles"
|
|---|
| 134 | set node_act [$ht_vars index current]
|
|---|
| 135 | if { [string length $node_act] } {
|
|---|
| 136 | set vars_selected [$ht_vars curselection]
|
|---|
| 137 | if { [lsearch $vars_selected $node_act] >= 0 } {
|
|---|
| 138 | foreach var $vars_selected {
|
|---|
| 139 | array set aryData [$ht_vars entry cget $var -data]
|
|---|
| 140 | #puts "PostVariable: aryData = [array get aryData]"
|
|---|
| 141 | set itemid $aryData(Index)
|
|---|
| 142 | set path $aryData(Path)
|
|---|
| 143 | set grammar [lindex $item_data($itemid) 2]
|
|---|
| 144 | set objName [$ht_vars entry cget $var -label]
|
|---|
| 145 | #puts "OBJECT=$objName, PATH=$path"
|
|---|
| 146 | if { $InRootPool } {
|
|---|
| 147 | set object $data(pool,variables,$itemid)
|
|---|
| 148 | } else {
|
|---|
| 149 | if {[llength $aryData(Reference)]} {
|
|---|
| 150 | #set object [lindex $aryData(Reference) 0]
|
|---|
| 151 | set object [lrange $aryData(Reference) 0 end]
|
|---|
| 152 | } else {
|
|---|
| 153 | if { [string length $tolset] } {
|
|---|
| 154 | #set object [concat [list File $tolset] $tolindex $itemid]
|
|---|
| 155 | set object [concat $tolset $tolindex $itemid]
|
|---|
| 156 | #puts "tolset = $tolset"
|
|---|
| 157 | } else {
|
|---|
| 158 | if [llength $objName] {
|
|---|
| 159 | set object [list $grammar $objName]
|
|---|
| 160 | } else {
|
|---|
| 161 | set object $objName
|
|---|
| 162 | }
|
|---|
| 163 | }
|
|---|
| 164 | }
|
|---|
| 165 | }
|
|---|
| 166 | lappend all_objects $object
|
|---|
| 167 | #puts "PostVariable: OBJECT=$object OBJNAME=$objName TOLSET=$tolset PATH=$path GRAMMAR=$grammar"
|
|---|
| 168 | switch -- $grammar {
|
|---|
| 169 | Code -
|
|---|
| 170 | Complex -
|
|---|
| 171 | Date -
|
|---|
| 172 | Matrix -
|
|---|
| 173 | VMatrix -
|
|---|
| 174 | Polyn -
|
|---|
| 175 | Ratio -
|
|---|
| 176 | Real -
|
|---|
| 177 | Serie -
|
|---|
| 178 | Anything -
|
|---|
| 179 | Text -
|
|---|
| 180 | NameBlock -
|
|---|
| 181 | TimeSet {
|
|---|
| 182 | lappend options_selected($grammar) [list $object $objName $path]
|
|---|
| 183 | }
|
|---|
| 184 | Set {
|
|---|
| 185 | # Si el objeto se da como referencia
|
|---|
| 186 | if { [llength $object] > 1 } {
|
|---|
| 187 | #puts "PostVariable: Set: object = $object"
|
|---|
| 188 | if {$InRootFiles} {
|
|---|
| 189 | set isFile 1
|
|---|
| 190 | } else {
|
|---|
| 191 | set info [::tol::info var $object]
|
|---|
| 192 | set isFile [expr [lindex $info 7] == 4]
|
|---|
| 193 | }
|
|---|
| 194 | #set desc [lindex $info 4]
|
|---|
| 195 | } else {
|
|---|
| 196 | if {[catch "::tol::info included $object" info]} {
|
|---|
| 197 | set info [::tol::info var [list Set $objName]]
|
|---|
| 198 | #set isFile [expr [lindex $info 5] == 4]
|
|---|
| 199 | set isFile [expr [lindex $info 7] == 4]
|
|---|
| 200 | #set desc [lindex $info 4]
|
|---|
| 201 | } else {
|
|---|
| 202 | #set info [::tol::info included $objName]
|
|---|
| 203 | #set isFile [expr [lindex $info 4] == 4]
|
|---|
| 204 | set isFile 1
|
|---|
| 205 | #set desc ""
|
|---|
| 206 | }
|
|---|
| 207 | }
|
|---|
| 208 | if $isFile {
|
|---|
| 209 | lappend options_selected(File) [list $object $objName $path]
|
|---|
| 210 | } else {
|
|---|
| 211 | lappend options_selected($grammar) [list $object $objName $path]
|
|---|
| 212 | }
|
|---|
| 213 | }
|
|---|
| 214 | }
|
|---|
| 215 | }
|
|---|
| 216 | set grammar_selected [array names options_selected]
|
|---|
| 217 | if { [llength $grammar_selected] } {
|
|---|
| 218 | foreach grammar $grammar_selected {
|
|---|
| 219 | switch -- $grammar {
|
|---|
| 220 | VMatrix -
|
|---|
| 221 | Matrix {
|
|---|
| 222 | $data_menu(main) add cascade -label [mc "Export matrix"]\
|
|---|
| 223 | -menu $data_menu(Matrix,Export)
|
|---|
| 224 | if {[llength $options_selected($grammar)] == 1} {
|
|---|
| 225 | set object [lindex [lindex $options_selected($grammar) 0] 0]
|
|---|
| 226 | $data_menu(main) add command -label [mc "Table matrix"] \
|
|---|
| 227 | -command [list ::TolInspector::TableMatrix $object]
|
|---|
| 228 | $data_menu(Matrix,Export) add command -label "BDT" \
|
|---|
| 229 | -command [list ::TolInspector::ExportBDTMatrix $object]
|
|---|
| 230 | $data_menu(main) add command -label [mc "Draw matrix"]... \
|
|---|
| 231 | -command [list ::TolInspector::DrawMatrix $object]
|
|---|
| 232 | } else {
|
|---|
| 233 | $data_menu(main) add cascade -label [mc "Table matrix"] \
|
|---|
| 234 | -menu $data_menu(Matrix,Table)
|
|---|
| 235 | $data_menu(Matrix,Export) add cascade -label "BDT" \
|
|---|
| 236 | -menu $data_menu(Matrix,Export,BDT)
|
|---|
| 237 | $data_menu(main) add cascade -label [mc "Draw matrix"]... \
|
|---|
| 238 | -menu $data_menu(Matrix,Draw)
|
|---|
| 239 | foreach objInfo $options_selected(Matrix) {
|
|---|
| 240 | $data_menu(Matrix,Table) add command -label [lindex $objInfo 1]\
|
|---|
| 241 | -command [list ::TolInspector::TableMatrix [lindex $objInfo 0]]
|
|---|
| 242 | $data_menu(Matrix,Export,BDT) add command -label [lindex $objInfo 1]\
|
|---|
| 243 | -command [list ::TolInspector::ExportBDTMatrix [lindex $objInfo 0]]
|
|---|
| 244 | $data_menu(Matrix,Draw) add command -label [lindex $objInfo 1] \
|
|---|
| 245 | -command [list ::TolInspector::DrawMatrix [lindex $objInfo 0]]
|
|---|
| 246 | }
|
|---|
| 247 | }
|
|---|
| 248 | if { $grammar eq "Matrix" } {
|
|---|
| 249 | set all_matrix {}
|
|---|
| 250 | foreach m $options_selected(Matrix) {
|
|---|
| 251 | lappend all_matrix [ lindex $m 0 ]
|
|---|
| 252 | }
|
|---|
| 253 | TolGui_InsertEntriesMatrixChart $data_menu(main) $all_matrix
|
|---|
| 254 | }
|
|---|
| 255 | }
|
|---|
| 256 | Serie {
|
|---|
| 257 | if {[llength $options_selected(Serie)] == 1} {
|
|---|
| 258 | set lblSerie "serie"
|
|---|
| 259 | } else {
|
|---|
| 260 | set lblSerie "series"
|
|---|
| 261 | }
|
|---|
| 262 | $data_menu(main) add command -label [mc "Draw $lblSerie"]\
|
|---|
| 263 | -command ::TolInspector::DrawSerie
|
|---|
| 264 | $data_menu(main) add command -label [mc "Table $lblSerie"]\
|
|---|
| 265 | -command ::TolInspector::TableSerie
|
|---|
| 266 | if {[llength $options_selected(Serie)] == 1} {
|
|---|
| 267 | set object [lindex [lindex $options_selected(Serie) 0] 0]
|
|---|
| 268 | $data_menu(main) add command -label [mc "Draw autocorrelation"] \
|
|---|
| 269 | -command [list ::TolInspector::DrawAutocorSerie $object]
|
|---|
| 270 | $data_menu(main) add command -label [mc "Table autocorrelation"] \
|
|---|
| 271 | -command [list ::TolInspector::TableAutocorSerie $object]
|
|---|
| 272 | } else {
|
|---|
| 273 | $data_menu(main) add cascade -label [mc "Draw autocorrelation"] \
|
|---|
| 274 | -menu $data_menu(Serie,DrawAutocor)
|
|---|
| 275 | $data_menu(main) add cascade -label [mc "Table autocorrelation"] \
|
|---|
| 276 | -menu $data_menu(Serie,TableAutocor)
|
|---|
| 277 | foreach objInfo $options_selected(Serie) {
|
|---|
| 278 | $data_menu(Serie,DrawAutocor) add command -label [lindex $objInfo 1]\
|
|---|
| 279 | -command [list ::TolInspector::DrawAutocorSerie [lindex $objInfo 0]]
|
|---|
| 280 | $data_menu(Serie,TableAutocor) add command -label [lindex $objInfo 1]\
|
|---|
| 281 | -command [list ::TolInspector::TableAutocorSerie [lindex $objInfo 0]]
|
|---|
| 282 | }
|
|---|
| 283 | }
|
|---|
| 284 | $data_menu(main) add command -label [mc "Table statistics"]\
|
|---|
| 285 | -command ::TolInspector::TableStatisticsSerie
|
|---|
| 286 | }
|
|---|
| 287 | TimeSet {
|
|---|
| 288 | if {[llength $options_selected(TimeSet)] == 1} {
|
|---|
| 289 | set object [lindex [lindex $options_selected(TimeSet) 0] 0]
|
|---|
| 290 | $data_menu(main) add command -label [mc "View timeset"] \
|
|---|
| 291 | -command [list ::TolInspector::ViewTimeSet $object]
|
|---|
| 292 | } else {
|
|---|
| 293 | $data_menu(main) add cascade -label [mc "View timeset"] \
|
|---|
| 294 | -menu $data_menu(TimeSet,View)
|
|---|
| 295 | foreach objInfo $options_selected(TimeSet) {
|
|---|
| 296 | $data_menu(TimeSet,View) add command -label [lindex $objInfo 1] \
|
|---|
| 297 | -command [list ::TolInspector::ViewTimeSet [lindex $objInfo 0]]
|
|---|
| 298 | }
|
|---|
| 299 | }
|
|---|
| 300 | }
|
|---|
| 301 | NameBlock {
|
|---|
| 302 | # entradas desde MenuManager
|
|---|
| 303 | if 0 {
|
|---|
| 304 | TolGui_InsertEntriesFromMenuManager \
|
|---|
| 305 | $data_menu(main) \
|
|---|
| 306 | $options_selected(NameBlock)
|
|---|
| 307 | }
|
|---|
| 308 | # entradas desde @MenuDesc
|
|---|
| 309 | # @MenuDesc sera reemplazado, ver https://www.tol-project.org/ticket/1372
|
|---|
| 310 | set sel_length [ llength $options_selected(NameBlock) ]
|
|---|
| 311 | if { $sel_length } {
|
|---|
| 312 | set idx_current [ lsearch $vars_selected $node_act ]
|
|---|
| 313 | set all_nb_options \
|
|---|
| 314 | [ TolGui_GetMenuEntries \
|
|---|
| 315 | $options_selected(NameBlock) $idx_current ]
|
|---|
| 316 | set num_options [ llength $all_nb_options ]
|
|---|
| 317 | #puts "num_options = $num_options"
|
|---|
| 318 | foreach mi $all_nb_options {
|
|---|
| 319 | set _cname [ lindex $mi 0 ]
|
|---|
| 320 | set cname [ string map [ list @ "" . _ ] $_cname ]
|
|---|
| 321 | #puts "cname = $cname"
|
|---|
| 322 | foreach { ninst obj_addr entries } [ lindex $mi 1 ] break
|
|---|
| 323 | set instances [ lindex $mi 2 ]
|
|---|
| 324 | if { $num_options > 1 } {
|
|---|
| 325 | # creo el menu de la clase si no existe
|
|---|
| 326 | set mclass $data_menu(main).cls$cname
|
|---|
| 327 | if { ![ winfo exists $mclass ] } {
|
|---|
| 328 | menu $mclass -tearoff 0
|
|---|
| 329 | } else {
|
|---|
| 330 | $mclass delete 0 end
|
|---|
| 331 | }
|
|---|
| 332 | $data_menu(main) add cascade -label $cname -menu $mclass
|
|---|
| 333 | set target_menu $mclass
|
|---|
| 334 | } else {
|
|---|
| 335 | set target_menu $data_menu(main)
|
|---|
| 336 | }
|
|---|
| 337 | foreach inst_entry $entries {
|
|---|
| 338 | foreach { label single group } $inst_entry break
|
|---|
| 339 | set opt_label \
|
|---|
| 340 | "$label [ expr { $sel_length>1 ? $ninst : {} } ]"
|
|---|
| 341 | $target_menu add command -label $opt_label \
|
|---|
| 342 | -command [ list TolGui_InvokeMethod \
|
|---|
| 343 | $single $obj_addr ]
|
|---|
| 344 | if { $group ne "" && [ llength $instances ] > 1 } {
|
|---|
| 345 | # hay una funcion que se aplica a toda la seleccion
|
|---|
| 346 | $target_menu add command -label "$label All" \
|
|---|
| 347 | -command [ list TolGui_InvokeGroup \
|
|---|
| 348 | $_cname $group $instances ]
|
|---|
| 349 | }
|
|---|
| 350 | }
|
|---|
| 351 | }
|
|---|
| 352 | }
|
|---|
| 353 | }
|
|---|
| 354 | Set {
|
|---|
| 355 | if {[llength $options_selected(Set)] == 1} {
|
|---|
| 356 | set object [lindex [lindex $options_selected(Set) 0] 0]
|
|---|
| 357 | $data_menu(main) add command -label [mc "Table set"] \
|
|---|
| 358 | -command [list ::TolInspector::TableSet $object]
|
|---|
| 359 | $data_menu(main) add command -label [mc "Draw set"] \
|
|---|
| 360 | -command [list ::TolInspector::DrawSet $object]
|
|---|
| 361 | # menu special
|
|---|
| 362 | $data_menu(main) add cascade -label [mc "Draw set special"] \
|
|---|
| 363 | -menu $data_menu(Set,Draw,Special)
|
|---|
| 364 | $data_menu(Set,Draw,Special) add command \
|
|---|
| 365 | -label [mc SetGraphAllFirst] \
|
|---|
| 366 | -command [list ::TolInspector::DrawSet $object 1]
|
|---|
| 367 | $data_menu(Set,Draw,Special) add command \
|
|---|
| 368 | -label [mc SetGraphAllGeneric] \
|
|---|
| 369 | -command [list ::TolInspector::DrawSet $object 2]
|
|---|
| 370 | $data_menu(Set,Draw,Special) add command \
|
|---|
| 371 | -label [mc SetGraphEvenUneven] \
|
|---|
| 372 | -command [list ::TolInspector::DrawSet $object 3]
|
|---|
| 373 | } else {
|
|---|
| 374 | $data_menu(main) add cascade -label [mc "Table set"] \
|
|---|
| 375 | -menu $data_menu(Set,Table)
|
|---|
| 376 | $data_menu(main) add cascade -label [mc "Draw set"] \
|
|---|
| 377 | -menu $data_menu(Set,Draw)
|
|---|
| 378 | foreach objInfo $options_selected(Set) {
|
|---|
| 379 | $data_menu(Set,Table) add command -label [lindex $objInfo 1] \
|
|---|
| 380 | -command [list ::TolInspector::TableSet [lindex $objInfo 0]]
|
|---|
| 381 | $data_menu(Set,Draw) add command -label [lindex $objInfo 1] \
|
|---|
| 382 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0]]
|
|---|
| 383 | }
|
|---|
| 384 | # menu special
|
|---|
| 385 | set i 0
|
|---|
| 386 | $data_menu(main) add cascade -label [mc "Draw set special"] \
|
|---|
| 387 | -menu $data_menu(Set,Draw,Special,M)
|
|---|
| 388 | foreach objInfo $options_selected(Set) {
|
|---|
| 389 | # exists menu previus ?
|
|---|
| 390 | if {[winfo exists $data_menu(Set,Draw,Special,M).setdrawspecialm$i]} {
|
|---|
| 391 | destroy $data_menu(Set,Draw,Special,M).setdrawspecialm$i
|
|---|
| 392 | }
|
|---|
| 393 | set mn \
|
|---|
| 394 | [menu $data_menu(Set,Draw,Special,M).setdrawspecialm$i \
|
|---|
| 395 | -tearoff 0]
|
|---|
| 396 | $data_menu(Set,Draw,Special,M) add cascade \
|
|---|
| 397 | -label [lindex $objInfo 1] -menu $mn
|
|---|
| 398 | $mn add command -label [mc SetGraphAllFirst] \
|
|---|
| 399 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 1]
|
|---|
| 400 | $mn add command -label [mc SetGraphAllGeneric] \
|
|---|
| 401 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 2]
|
|---|
| 402 | $mn add command -label [mc SetGraphEvenUneven] \
|
|---|
| 403 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 3]
|
|---|
| 404 | incr i
|
|---|
| 405 | }
|
|---|
| 406 | }
|
|---|
| 407 | }
|
|---|
| 408 | File {
|
|---|
| 409 | if {[llength $options_selected(File)] == 1} {
|
|---|
| 410 | set objName [lindex [lindex $options_selected(File) 0] 1]
|
|---|
| 411 | $data_menu(main) add command -label [mc "View file"] \
|
|---|
| 412 | -command [list ::TolInspector::ViewFile $objName]
|
|---|
| 413 | if $InRootFiles {
|
|---|
| 414 | $data_menu(main) add command -label [mc "Decompile file"] \
|
|---|
| 415 | -command [list ::TolInspector::DecompileFile $objName]
|
|---|
| 416 | }
|
|---|
| 417 | } else {
|
|---|
| 418 | $data_menu(main) add cascade -label [mc "View file"] \
|
|---|
| 419 | -menu $data_menu(File,View)
|
|---|
| 420 | foreach objInfo $options_selected(File) {
|
|---|
| 421 | $data_menu(File,View) add command -label [lindex $objInfo 1] \
|
|---|
| 422 | -command [list ::TolInspector::ViewFile [lindex $objInfo 1]]
|
|---|
| 423 | }
|
|---|
| 424 | if $InRootFiles {
|
|---|
| 425 | $data_menu(main) add cascade -label [mc "Decompile file"] \
|
|---|
| 426 | -menu $data_menu(File,Decompile)
|
|---|
| 427 | foreach objInfo $options_selected(File) {
|
|---|
| 428 | $data_menu(File,Decompile) add command -label [lindex $objInfo 1] \
|
|---|
| 429 | -command [list ::TolInspector::DecompileFile [lindex $objInfo 1]]
|
|---|
| 430 | }
|
|---|
| 431 | }
|
|---|
| 432 | }
|
|---|
| 433 | }
|
|---|
| 434 | } ;# end del switch
|
|---|
| 435 | # inserto las opciones definidas en MenuManager
|
|---|
| 436 | if { $grammar ne "Anything" } {
|
|---|
| 437 | TolGui_InsertEntriesFromMenuManager \
|
|---|
| 438 | $data_menu(main) \
|
|---|
| 439 | $options_selected($grammar)
|
|---|
| 440 | }
|
|---|
| 441 |
|
|---|
| 442 | $data_menu(main) add separator
|
|---|
| 443 | $data_menu(main) add cascade -label [mc "Functions"] \
|
|---|
| 444 | -menu $data_menu($grammar,Functions)
|
|---|
| 445 | ShowMenuUserFunc $grammar
|
|---|
| 446 | if {[llength $options_selected($grammar)] == 1} {
|
|---|
| 447 | set objName [lindex [lindex $options_selected($grammar) 0] 1]
|
|---|
| 448 | set path [lindex [lindex $options_selected($grammar) 0] 2]
|
|---|
| 449 | $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 450 | -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
|
|---|
| 451 | } else {
|
|---|
| 452 | $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 453 | -menu $data_menu($grammar,File)
|
|---|
| 454 | foreach objInfo $options_selected($grammar) {
|
|---|
| 455 | $data_menu($grammar,File) add command -label [lindex $objInfo 1] \
|
|---|
| 456 | -command [list ::TolInspector::ViewDefinition\
|
|---|
| 457 | [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
|
|---|
| 458 | }
|
|---|
| 459 | }
|
|---|
| 460 | $data_menu(main) add separator
|
|---|
| 461 | } ;#end del foreach
|
|---|
| 462 |
|
|---|
| 463 | # Store selection in oza
|
|---|
| 464 | if { [ llength $all_objects ] > 1 || [ lindex $grammar_selected 0 ] ne "Set" } {
|
|---|
| 465 | $data_menu(main) add command -label [mc "Store selection in OZA"]... \
|
|---|
| 466 | -command [ list TolGui_StoreSelectionInOZA $all_objects ]
|
|---|
| 467 | } else {
|
|---|
| 468 | $data_menu(main) add command -label [mc "Store Set in OZA"]... \
|
|---|
| 469 | -command [ list TolGui_StoreSelectionInOZA $all_objects ]
|
|---|
| 470 | $data_menu(main) add command -label [mc "Store elements in OZA"]... \
|
|---|
| 471 | -command [ list TolGui_StoreSetElementsInOZA [ lindex $all_objects 0 ] ]
|
|---|
| 472 | }
|
|---|
| 473 | $data_menu(main) add separator
|
|---|
| 474 | # Store selection in oza
|
|---|
| 475 |
|
|---|
| 476 | if { $InRootPool } {
|
|---|
| 477 | $data_menu(main) add command -label [mc "Remove from spool"] \
|
|---|
| 478 | -command [list ::TolInspector::RemoveFromSpool $ht_vars]
|
|---|
| 479 | } else {
|
|---|
| 480 | $data_menu(main) add command -label [mc "Add to spool"] \
|
|---|
| 481 | -command [list ::TolInspector::AddToSpool $ht_vars [lindex [$ht_tree get -full anchor] 1]]
|
|---|
| 482 | }
|
|---|
| 483 | $data_menu(main) add command -label [mc "To Eval window"] \
|
|---|
| 484 | -command [list ::TolInspector::AddToEvalWindow $ht_vars]
|
|---|
| 485 | $data_menu(main) add separator
|
|---|
| 486 | if { $InRootConsole} {
|
|---|
| 487 | $data_menu(main) add command -label [mc "Decompile"] \
|
|---|
| 488 | -command [list ::TolInspector::ClearConsoleObjSel $ht_vars]
|
|---|
| 489 | $data_menu(main) add separator
|
|---|
| 490 | }
|
|---|
| 491 | $data_menu(main) add command -label [mc "Select all"] \
|
|---|
| 492 | -command [list ::TolInspector::SelectAll $ht_vars]
|
|---|
| 493 | $data_menu(main) add command -label [mc "Toggle selection"] \
|
|---|
| 494 | -command [list ::TolInspector::ToggleSelection $ht_vars]
|
|---|
| 495 | tk_popup $data_menu(main) $x $y
|
|---|
| 496 | } ;#end del if
|
|---|
| 497 | }
|
|---|
| 498 | }
|
|---|
| 499 | }
|
|---|
| 500 |
|
|---|
| 501 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 502 | proc ::TolInspector::PostFunction { x y } {
|
|---|
| 503 | #
|
|---|
| 504 | # PURPOSE: Composes a popup menu for functions and displays it. Its composed
|
|---|
| 505 | # depending on the node/s clicked by user.
|
|---|
| 506 | #
|
|---|
| 507 | # PARAMETERS:
|
|---|
| 508 | # x -> x-coordinate where popup menu is drawn
|
|---|
| 509 | # y -> y-coordinate where popup menu is drawn
|
|---|
| 510 | #
|
|---|
| 511 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 512 | variable data_menu
|
|---|
| 513 | variable vars_selected
|
|---|
| 514 | variable ht_funcs
|
|---|
| 515 | variable ht_tree
|
|---|
| 516 | variable item_data
|
|---|
| 517 | variable data
|
|---|
| 518 |
|
|---|
| 519 | variable tolset
|
|---|
| 520 | variable tolindex
|
|---|
| 521 |
|
|---|
| 522 | array unset options_selected
|
|---|
| 523 | foreach it [array names data_menu] {
|
|---|
| 524 | $data_menu($it) delete 0 end
|
|---|
| 525 | }
|
|---|
| 526 |
|
|---|
| 527 | set InRootPool [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
|
|---|
| 528 | set node_act [$ht_funcs index current]
|
|---|
| 529 | if { [string length $node_act] } {
|
|---|
| 530 | set vars_selected [$ht_funcs curselection]
|
|---|
| 531 | if { [lsearch $vars_selected $node_act] >= 0 } {
|
|---|
| 532 | foreach var $vars_selected {
|
|---|
| 533 | array set aryData [$ht_funcs entry cget $var -data]
|
|---|
| 534 | set itemid $aryData(Index)
|
|---|
| 535 | set path $aryData(Path)
|
|---|
| 536 | set grammar [lindex $item_data($itemid) 2]
|
|---|
| 537 | set objName [$ht_funcs entry cget $var -label]
|
|---|
| 538 |
|
|---|
| 539 | if { $InRootPool } {
|
|---|
| 540 | set object $data(pool,variables,$itemid)
|
|---|
| 541 | } else {
|
|---|
| 542 | if { [string length $tolset] } {
|
|---|
| 543 | set object [concat [list $tolset] $tolindex $itemid]
|
|---|
| 544 | } else {
|
|---|
| 545 | set object $objName
|
|---|
| 546 | }
|
|---|
| 547 | }
|
|---|
| 548 | # La única gramática seleccionable en ht_funcs es Code
|
|---|
| 549 | lappend code_selected [list $object $objName $path]
|
|---|
| 550 | }
|
|---|
| 551 |
|
|---|
| 552 | if {[llength $code_selected] == 1} {
|
|---|
| 553 | set objName [lindex [lindex $code_selected 0] 1]
|
|---|
| 554 | set path [lindex [lindex $code_selected 0] 2]
|
|---|
| 555 | $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 556 | -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
|
|---|
| 557 | } else {
|
|---|
| 558 | $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
|
|---|
| 559 | -menu $data_menu($grammar,File)
|
|---|
| 560 | foreach objInfo $code_selected {
|
|---|
| 561 | $data_menu($grammar,File) add command -label [lindex $objInfo 1]\
|
|---|
| 562 | -command [list ::TolInspector::ViewDefinition\
|
|---|
| 563 | [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
|
|---|
| 564 | }
|
|---|
| 565 | }
|
|---|
| 566 |
|
|---|
| 567 | if { $InRootPool } {
|
|---|
| 568 | $data_menu(main) add command -label [mc "Remove from spool"] \
|
|---|
| 569 | -command [list ::TolInspector::RemoveFromSpool $ht_funcs]
|
|---|
| 570 | } else {
|
|---|
| 571 | $data_menu(main) add command -label [mc "Add to spool"] \
|
|---|
| 572 | -command [list ::TolInspector::AddToSpool $ht_funcs [lindex [$ht_tree get -full anchor] 1]]
|
|---|
| 573 | }
|
|---|
| 574 | $data_menu(main) add command -label [mc "To Eval window"] \
|
|---|
| 575 | -command [list ::TolInspector::AddToEvalWindow $ht_funcs]
|
|---|
| 576 | $data_menu(main) add separator
|
|---|
| 577 | $data_menu(main) add command -label [mc "Select all"] \
|
|---|
| 578 | -command [list ::TolInspector::SelectAll $ht_funcs]
|
|---|
| 579 | $data_menu(main) add command -label [mc "Toggle selection"] \
|
|---|
| 580 | -command [list ::TolInspector::ToggleSelection $ht_funcs]
|
|---|
| 581 | tk_popup $data_menu(main) $x $y
|
|---|
| 582 | }
|
|---|
| 583 | }
|
|---|
| 584 | }
|
|---|
| 585 |
|
|---|
| 586 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 587 | proc ::TolInspector::PostTree { x y } {
|
|---|
| 588 | #
|
|---|
| 589 | # PURPOSE: Composes a popup menu for left treeview and displays it. Its
|
|---|
| 590 | # composed depending on the node clicked by user.
|
|---|
| 591 | #
|
|---|
| 592 | # PARAMETERS:
|
|---|
| 593 | # x -> x-coordinate where popup menu is drawn
|
|---|
| 594 | # y -> y-coordinate where popup menu is drawn
|
|---|
| 595 | #
|
|---|
| 596 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 597 | variable data_menu
|
|---|
| 598 | variable vars_selected
|
|---|
| 599 | variable ht_tree
|
|---|
| 600 | variable item_data
|
|---|
| 601 | variable data
|
|---|
| 602 | variable tolset
|
|---|
| 603 | variable tolindex
|
|---|
| 604 | variable item_id
|
|---|
| 605 | #puts "ht_tree: $ht_tree"
|
|---|
| 606 | #No terminado todavía
|
|---|
| 607 | #return
|
|---|
| 608 | array unset options_selected
|
|---|
| 609 |
|
|---|
| 610 | #puts "::TolInspector::PostTree $x $y"
|
|---|
| 611 | foreach it [array names data_menu] {
|
|---|
| 612 | $data_menu($it) delete 0 end
|
|---|
| 613 | }
|
|---|
| 614 | set InRootPool [string equal [lindex [$ht_tree get -full anchor] end-1] "root-pool"]
|
|---|
| 615 | #puts "InRootPool: $InRootPool"
|
|---|
| 616 | # InRootFiles has a value 1 if node is a File
|
|---|
| 617 | set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end-1] "root-files"]
|
|---|
| 618 | #puts "InRootFiles: $InRootFiles"
|
|---|
| 619 | # index of the selected node
|
|---|
| 620 | set node_act [$ht_tree index current]
|
|---|
| 621 | #puts "node_act: $node_act"
|
|---|
| 622 | if { [string length $node_act] } {
|
|---|
| 623 | set vars_selected [$ht_tree curselection]
|
|---|
| 624 | #puts "vars_selected: $vars_selected"
|
|---|
| 625 | if { [lsearch $vars_selected $node_act] >= 0 } { ;# Not root node
|
|---|
| 626 | set index [$ht_tree index anchor]
|
|---|
| 627 | #puts "index: $index"
|
|---|
| 628 | if { $index } {
|
|---|
| 629 | set info_node [split [lindex [$ht_tree get -full $index] end] "-"]
|
|---|
| 630 | #puts "info_node: $info_node"
|
|---|
| 631 | set node_type [lindex $info_node 0]
|
|---|
| 632 | #puts "node_type: $node_type"
|
|---|
| 633 | set node_name [lindex $info_node 1]
|
|---|
| 634 | #puts "node_name: $node_name"
|
|---|
| 635 | } else { ;# root node
|
|---|
| 636 | set node_type root
|
|---|
| 637 | set node_name root
|
|---|
| 638 | }
|
|---|
| 639 | # if user selects a root or a grammar doesn't nothing
|
|---|
| 640 | switch -regexp $node_type {
|
|---|
| 641 | root -
|
|---|
| 642 | grammar { return }
|
|---|
| 643 | }
|
|---|
| 644 | # label of object showed in the tree
|
|---|
| 645 | set objName [$ht_tree entry cget $index -label]
|
|---|
| 646 | #puts "objName: $objName"
|
|---|
| 647 | set object $objName
|
|---|
| 648 |
|
|---|
| 649 | if {$InRootFiles} {
|
|---|
| 650 | array set aryData [$ht_tree entry cget $index -data]
|
|---|
| 651 | if [info exist aryData(FileName)] {
|
|---|
| 652 | set objName $aryData(FileName)
|
|---|
| 653 | }
|
|---|
| 654 | }
|
|---|
| 655 | #puts "2objName: $objName"
|
|---|
| 656 | if { $InRootPool } {
|
|---|
| 657 | #puts "es InRootPool $item_id"
|
|---|
| 658 | set itemid $item_id
|
|---|
| 659 | #set object $data(pool,variables,$itemid)
|
|---|
| 660 | set object $data(pool,reference,$node_type)
|
|---|
| 661 | } else {
|
|---|
| 662 | #puts "NO InRootPool"
|
|---|
| 663 | if { [string length $tolset] } {
|
|---|
| 664 | set object [concat [list $tolset] $tolindex]
|
|---|
| 665 | } else {
|
|---|
| 666 | set object $objName
|
|---|
| 667 | }
|
|---|
| 668 | }
|
|---|
| 669 | #puts "object = $objName '[$ht_tree entry cget $index -data]'"
|
|---|
| 670 | #Tolcon_Trace "***********************************" {red}
|
|---|
| 671 | #Tolcon_Trace "index=$index, node_type=$node_type, node_name=$node_name" {red}
|
|---|
| 672 | #Tolcon_Trace "tolset=$tolset, tolindex=$tolindex, aryData= [$ht_tree entry cget $index -data]" {red}
|
|---|
| 673 | #Tolcon_Trace "object=$object, label=$objName" {red}
|
|---|
| 674 | #Tolcon_Trace "***********************************" {red}
|
|---|
| 675 |
|
|---|
| 676 | #
|
|---|
| 677 | # TICKET: #1438
|
|---|
| 678 | # Por que se pregunta aqui por los objetos de consola?
|
|---|
| 679 | #
|
|---|
| 680 | set stackList [::tol::console stack list]
|
|---|
| 681 | #puts "stackList: $stackList"
|
|---|
| 682 | set stackValue {}
|
|---|
| 683 | foreach stackItem $stackList {
|
|---|
| 684 | #puts "stackItem: $stackItem"
|
|---|
| 685 | #puts "lindex $stackValue 1: [lindex $stackValue 1]"
|
|---|
| 686 | #puts "objName: $objName"
|
|---|
| 687 | if {[lindex $stackItem 1] eq $objName} {
|
|---|
| 688 | set stackValue $stackItem
|
|---|
| 689 | }
|
|---|
| 690 | break
|
|---|
| 691 | }
|
|---|
| 692 | #puts "stackValue: $stackValue"
|
|---|
| 693 | set grammar [lindex $stackValue 0]
|
|---|
| 694 | #puts "grammar: $grammar"
|
|---|
| 695 | #set full_data $item_data($index) ;# {value} {desc} {grammar}
|
|---|
| 696 | #set grammar [lindex $full_data 2]
|
|---|
| 697 |
|
|---|
| 698 | #foreach fun [::tol::info functions $grammar] {
|
|---|
| 699 | # set finfo [::tol::info functions $grammar $fun]
|
|---|
| 700 | # InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0
|
|---|
| 701 | #}
|
|---|
| 702 | if {[catch {set info [::tol::info included $objName]}]} {
|
|---|
| 703 | if { !($grammar eq "")} {
|
|---|
| 704 | if {[catch {set info [::tol::info var [list $grammar $object]}]} {
|
|---|
| 705 | #set info [concat [list "$grammar" $objName ] [::tol::info var $grammar $objName]]
|
|---|
| 706 | set info [::tol::info var [list $grammar $objName]]
|
|---|
| 707 | #Tolcon_Trace "INFO de ::tol::info var Set objName"
|
|---|
| 708 | } else {
|
|---|
| 709 | set info [::tol::info var [list $grammar $object]]
|
|---|
| 710 | #Tolcon_Trace "INFO de ::tol::info var $grammar object"
|
|---|
| 711 | }
|
|---|
| 712 | set isFile [expr [lindex $info 5] == 4]
|
|---|
| 713 | } else {
|
|---|
| 714 | set isFile 0
|
|---|
| 715 | }
|
|---|
| 716 |
|
|---|
| 717 | } else {
|
|---|
| 718 | set info [::tol::info included $objName]
|
|---|
| 719 | #Tolcon_Trace "INFO de ::tol::info included objName"
|
|---|
| 720 | set isFile 1
|
|---|
| 721 | }
|
|---|
| 722 | #puts "paso"
|
|---|
| 723 |
|
|---|
| 724 | if $isFile {
|
|---|
| 725 | #puts "entro como fichero"
|
|---|
| 726 | $data_menu(main) add command -label [mc "View file"] \
|
|---|
| 727 | -command [list ::TolInspector::ViewFile $objName]
|
|---|
| 728 | if $InRootFiles {
|
|---|
| 729 | $data_menu(main) add command -label [mc "Decompile file"] \
|
|---|
| 730 | -command [list ::TolInspector::DecompileFile $objName]
|
|---|
| 731 | }
|
|---|
| 732 | } else {
|
|---|
| 733 | #puts "no entro como fichero"
|
|---|
| 734 | if { $grammar eq "Set" } {
|
|---|
| 735 | $data_menu(main) add command -label [mc "Table set"] \
|
|---|
| 736 | -command [list ::TolInspector::TableSet $object]
|
|---|
| 737 | $data_menu(main) add command -label [mc "Draw set"] \
|
|---|
| 738 | -command [list ::TolInspector::DrawSet $object]
|
|---|
| 739 | }
|
|---|
| 740 | }
|
|---|
| 741 | tk_popup $data_menu(main) $x $y
|
|---|
| 742 | }
|
|---|
| 743 | }
|
|---|
| 744 | }
|
|---|
| 745 |
|
|---|
| 746 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 747 | # Procedures asociated with tol inspector popup menu
|
|---|
| 748 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 749 |
|
|---|
| 750 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 751 | proc ::TolInspector::RemoveFromSpool {ht} {
|
|---|
| 752 | #
|
|---|
| 753 | # PURPOSE: Removes from spool all selected objects
|
|---|
| 754 | #
|
|---|
| 755 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 756 | variable vars_selected
|
|---|
| 757 | variable item_data
|
|---|
| 758 | variable tolset
|
|---|
| 759 | variable tolindex
|
|---|
| 760 | variable data
|
|---|
| 761 |
|
|---|
| 762 | foreach var $vars_selected {
|
|---|
| 763 | array set aryData [$ht entry cget $var -data]
|
|---|
| 764 | set itemid $aryData(Index)
|
|---|
| 765 | set path $aryData(Path)
|
|---|
| 766 | set reference $aryData(Reference)
|
|---|
| 767 | set grammar [lindex $item_data($itemid) 2]
|
|---|
| 768 |
|
|---|
| 769 | set objName [$ht entry cget $var -label]
|
|---|
| 770 |
|
|---|
| 771 | set _objpool [list "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
|
|---|
| 772 | if {$grammar eq "Code"} {
|
|---|
| 773 | set graApply [lindex $aryData(Content) 0]
|
|---|
| 774 | lappend _objpool "graApply" $graApply
|
|---|
| 775 | }
|
|---|
| 776 | #Tolcon_Trace "OBJPOOL on REMOVE: $_objpool"
|
|---|
| 777 |
|
|---|
| 778 | # Buscamos el objeto (identificador: referencia)
|
|---|
| 779 | array set objpool $_objpool
|
|---|
| 780 | foreach _obj $data(pool,objects) {
|
|---|
| 781 | array set obj $_obj
|
|---|
| 782 | #Tolcon_Trace "obj(reference)=$obj(reference), objpool(reference)=$objpool(reference)"
|
|---|
| 783 | if {[string equal $obj(reference) $objpool(reference)]} {
|
|---|
| 784 | if {$obj(grammar) eq "Code"} {
|
|---|
| 785 | if {[string equal $obj(graApply) $objpool(graApply)]} {
|
|---|
| 786 | set idx [lsearch $data(pool,objects) $_obj]
|
|---|
| 787 | #Tolcon_Trace "El obj a quitar tiene idx=$idx"
|
|---|
| 788 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
|
|---|
| 789 | }
|
|---|
| 790 | } else {
|
|---|
| 791 | set idx [lsearch $data(pool,objects) $_obj]
|
|---|
| 792 | #Tolcon_Trace "El obj a quitar tiene idx=$idx"
|
|---|
| 793 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
|
|---|
| 794 | }
|
|---|
| 795 | }
|
|---|
| 796 | }
|
|---|
| 797 | }
|
|---|
| 798 | #Tolcon_Trace "P.O. after REMOVE: $data(pool,objects)"
|
|---|
| 799 | UpdatePoolObj
|
|---|
| 800 | }
|
|---|
| 801 |
|
|---|
| 802 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 803 | proc ::TolInspector::AddToSpool {ht origin} {
|
|---|
| 804 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 805 | variable vars_selected
|
|---|
| 806 | variable item_data
|
|---|
| 807 | variable tolset
|
|---|
| 808 | variable tolindex
|
|---|
| 809 | variable data
|
|---|
| 810 |
|
|---|
| 811 | foreach var $vars_selected {
|
|---|
| 812 | array set aryData [$ht entry cget $var -data]
|
|---|
| 813 | set itemid $aryData(Index)
|
|---|
| 814 | set path $aryData(Path)
|
|---|
| 815 | set grammar [lindex $item_data($itemid) 2]
|
|---|
| 816 | set objName [$ht entry cget $var -label]
|
|---|
| 817 | #puts "AddToSpool: Reference=$aryData(Reference) tolset=$tolset grammar=$grammar"
|
|---|
| 818 | if {[llength $aryData(Reference)]} {
|
|---|
| 819 | set reference $aryData(Reference)
|
|---|
| 820 | } else {
|
|---|
| 821 | if { [string length $tolset] } {
|
|---|
| 822 | #set object [concat [list $tolset] $tolindex $itemid]
|
|---|
| 823 | #set object [concat [list File $tolset] $tolindex $itemid]
|
|---|
| 824 | set object [concat $tolset $tolindex $itemid]
|
|---|
| 825 | #puts "AddToSpool: object=$object"
|
|---|
| 826 | set reference [::tol::info reference $object]
|
|---|
| 827 | } else {
|
|---|
| 828 | if {$grammar eq "Set"} {
|
|---|
| 829 | #puts "AddToSpool: origin=$origin"
|
|---|
| 830 | set reference [::tol::info reference [list Set $objName]]
|
|---|
| 831 | #Tolcon_Trace "reference de ::tol::info reference [list $objName]"
|
|---|
| 832 | } else {
|
|---|
| 833 | if [catch {set reference [::tol::info reference [list $grammar $objName]]}] {
|
|---|
| 834 | set reference $objName
|
|---|
| 835 | #Tolcon_Trace "reference NO SE QUE PONER"
|
|---|
| 836 | }
|
|---|
| 837 | #Tolcon_Trace "reference de ::tol::info reference $grammar $objName"
|
|---|
| 838 | }
|
|---|
| 839 | }
|
|---|
| 840 | }
|
|---|
| 841 | set _objpool [list "origin" $origin "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
|
|---|
| 842 | if {$grammar eq "Code"} {
|
|---|
| 843 | set graApply [lindex $aryData(Content) 0]
|
|---|
| 844 | lappend _objpool "graApply" $graApply
|
|---|
| 845 | }
|
|---|
| 846 | #Tolcon_Trace "***************"
|
|---|
| 847 | #Tolcon_Trace "OBJPOOL on ADD:"
|
|---|
| 848 | #Tolcon_Trace "***************"
|
|---|
| 849 | #foreach {key value} $_objpool {
|
|---|
| 850 | # Tolcon_Trace " $key=$value"
|
|---|
| 851 | #}
|
|---|
| 852 | set inserted 0
|
|---|
| 853 | # Si la referencia es igual, el objeto es el mismo (salvo para obj de tipo Code)
|
|---|
| 854 | array set objpool $_objpool
|
|---|
| 855 | foreach _obj $data(pool,objects) {
|
|---|
| 856 | array set obj $_obj
|
|---|
| 857 | if {[string equal $obj(reference) $objpool(reference)]} {
|
|---|
| 858 | #Si es de la gramatica Code miro a ver la gramatica sobre la que se aplica
|
|---|
| 859 | if {$objpool(grammar) eq "Code"} {
|
|---|
| 860 | if {[string equal $obj(graApply) $objpool(graApply)]} {
|
|---|
| 861 | set inserted 1
|
|---|
| 862 | }
|
|---|
| 863 | } else {
|
|---|
| 864 | set inserted 1
|
|---|
| 865 | }
|
|---|
| 866 | }
|
|---|
| 867 | }
|
|---|
| 868 | if {!$inserted} {
|
|---|
| 869 | lappend data(pool,objects) $_objpool
|
|---|
| 870 | #puts "AddToSpool: P.O. after ADD: $data(pool,objects)"
|
|---|
| 871 | } else {
|
|---|
| 872 | #puts "$_objpool ALREADY IN SPOOL"
|
|---|
| 873 | }
|
|---|
| 874 | }
|
|---|
| 875 |
|
|---|
| 876 | }
|
|---|
| 877 |
|
|---|
| 878 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 879 | proc ::TolInspector::AddToEvalWindow {ht} {
|
|---|
| 880 | #
|
|---|
| 881 | # PURPOSE: Adds names of selected objects (vars or functions) in treeview ht
|
|---|
| 882 | # to eval window
|
|---|
| 883 | #
|
|---|
| 884 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 885 | variable ht_vars
|
|---|
| 886 | variable vars_selected
|
|---|
| 887 |
|
|---|
| 888 | set names ""
|
|---|
| 889 | foreach var $vars_selected {
|
|---|
| 890 | lappend names [$ht entry cget $var -label]
|
|---|
| 891 | }
|
|---|
| 892 | ::TolConsole::ToEvalWindow [ListToStr $names]
|
|---|
| 893 | }
|
|---|
| 894 |
|
|---|
| 895 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 896 | proc ::TolInspector::SelectAll {ht} {
|
|---|
| 897 | #
|
|---|
| 898 | # PURPOSE: Selects all nodes of a given treeview
|
|---|
| 899 | #
|
|---|
| 900 | # PARAMETERS:
|
|---|
| 901 | # ht -> treeview's path
|
|---|
| 902 | #
|
|---|
| 903 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 904 | set found [$ht find]
|
|---|
| 905 | if {[llength $found] > 1} {
|
|---|
| 906 | $ht selection set [lindex $found 1] [lindex $found end]
|
|---|
| 907 | }
|
|---|
| 908 | }
|
|---|
| 909 |
|
|---|
| 910 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 911 | proc ::TolInspector::ToggleSelection {ht} {
|
|---|
| 912 | #
|
|---|
| 913 | # PURPOSE: Toggles selection of nodes of a given treeview
|
|---|
| 914 | #
|
|---|
| 915 | # PARAMETERS:
|
|---|
| 916 | # ht -> treeview's path
|
|---|
| 917 | #
|
|---|
| 918 | #/////////////////////////////////////////////////////////////////////////////
|
|---|
| 919 | set found [$ht find]
|
|---|
| 920 | if {[llength $found] > 1} {
|
|---|
| 921 | $ht selection toggle [lindex $found 1] [lindex $found end]
|
|---|
| 922 | }
|
|---|
| 923 | }
|
|---|
