| 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : tolinspe.tcl |
|---|
| 3 | # PURPOSE : This file contains a namespace called TolInspector with its |
|---|
| 4 | # functions. Its for creating a the TOL object inspector and |
|---|
| 5 | # managing its events. |
|---|
| 6 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 7 | |
|---|
| 8 | package require bguifunction |
|---|
| 9 | package require snit |
|---|
| 10 | package require btable |
|---|
| 11 | |
|---|
| 12 | if { 0 && ![info exists toltk_script_path] } { |
|---|
| 13 | set toltk_script_path [file dirname [info script]] |
|---|
| 14 | source [file join $toltk_script_path init_toltk.tcl] |
|---|
| 15 | } |
|---|
| 16 | |
|---|
| 17 | if {"unix" eq $::tcl_platform(platform)} { |
|---|
| 18 | foreach "but units" [list 4 -5 5 5] { |
|---|
| 19 | set comm [string map "%d $units" { |
|---|
| 20 | %W yview scroll %d units |
|---|
| 21 | }] |
|---|
| 22 | bind TreeView <$but> $comm |
|---|
| 23 | } |
|---|
| 24 | } else { |
|---|
| 25 | bind TreeView <MouseWheel> { |
|---|
| 26 | %W yview scroll [expr int(-1*%D/36)] units |
|---|
| 27 | } |
|---|
| 28 | } |
|---|
| 29 | # |
|---|
| 30 | ##///////////////////////////////////////////////////////////////////////////// |
|---|
| 31 | #proc dump { args } { |
|---|
| 32 | ## |
|---|
| 33 | ## PURPOSE: Auxiliary procedure to show a string |
|---|
| 34 | ## |
|---|
| 35 | ##///////////////////////////////////////////////////////////////////////////// |
|---|
| 36 | #puts $args |
|---|
| 37 | #} |
|---|
| 38 | |
|---|
| 39 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 40 | proc startupResources { } { |
|---|
| 41 | # |
|---|
| 42 | # PURPOSE: Establishes the preferences of the inspector |
|---|
| 43 | # |
|---|
| 44 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 45 | global tcl_platform |
|---|
| 46 | global toltk_options |
|---|
| 47 | DynamicHelp::configure -background #FFFFC0 |
|---|
| 48 | if {[string equal $tcl_platform(platform) "windows"]} { |
|---|
| 49 | set toltk_options(colors,SystemButtonFace) SystemButtonFace |
|---|
| 50 | set toltk_options(fonts,MenuNor) {Tahoma 8} |
|---|
| 51 | set toltk_options(fonts,Fixed) {{Courier New} 9} |
|---|
| 52 | set toltk_options(fonts,FixSmall) {{Courier New} 8} |
|---|
| 53 | set toltk_options(fonts,Title1) {Arial 9 bold} |
|---|
| 54 | set toltk_options(fonts,Label) {Arial 9} |
|---|
| 55 | set toltk_options(fonts,TxtSmall) {Arial 8} |
|---|
| 56 | set toltk_options(relief,ridge) ridge |
|---|
| 57 | } else { |
|---|
| 58 | set toltk_options(colors,SystemButtonFace) #d4d4d4 |
|---|
| 59 | set toltk_options(fonts,MenuNor) {-*-helvetica-medium-r} |
|---|
| 60 | set toltk_options(fonts,Fixed) {Courier 9} |
|---|
| 61 | set toltk_options(fonts,FixSmall) {-*-courier-small-r} |
|---|
| 62 | set toltk_options(fonts,Title1) {-*-helvetica-bold-r} |
|---|
| 63 | set toltk_options(fonts,Label) {-*-helvetica-medium-r} |
|---|
| 64 | set toltk_options(fonts,TxtSmall) {-*-helvetica-small-r} |
|---|
| 65 | set toltk_options(relief,ridge) raised |
|---|
| 66 | } |
|---|
| 67 | option add *background $toltk_options(colors,SystemButtonFace) user |
|---|
| 68 | option add *Label.font $toltk_options(fonts,Label) user |
|---|
| 69 | option add *Radiobutton.font $toltk_options(fonts,Label) user |
|---|
| 70 | option add *Checkbutton.font $toltk_options(fonts,Label) user |
|---|
| 71 | option add *Button.font $toltk_options(fonts,Label) user |
|---|
| 72 | option add *Menu.font $toltk_options(fonts,MenuNor) user |
|---|
| 73 | option add *TitleFrame.l.font $toltk_options(fonts,Title1) user |
|---|
| 74 | option add *Tabset.selectForeground black user |
|---|
| 75 | |
|---|
| 76 | option readfile [file join $::toltk_script_path toltk.rc] user |
|---|
| 77 | } |
|---|
| 78 | |
|---|
| 79 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 80 | namespace eval ::TolInspector { |
|---|
| 81 | # |
|---|
| 82 | # PURPOSE: The purpose of this namespace is creating a the TOL object |
|---|
| 83 | # inspector and managing its events. |
|---|
| 84 | # VARIABLES: |
|---|
| 85 | # data: |
|---|
| 86 | # regFunLst: List array with functions defined by user |
|---|
| 87 | # tolset: Name of the current TOL set variable |
|---|
| 88 | # tolindex: |
|---|
| 89 | # at_set: |
|---|
| 90 | # node_prefix: |
|---|
| 91 | # ht_tree: Tree widget containing the TOL objects (:blt::treeview) |
|---|
| 92 | # blt_tree: Tree widget containing the TOL objects (:blt::tree) |
|---|
| 93 | # w_tabset: Tabset widget containing trees of variables and functions |
|---|
| 94 | # ht_vars: Tree widget containing the tree of Variables |
|---|
| 95 | # (:blt::treeview) |
|---|
| 96 | # blt_vartree: Tree widget containing the tree of Variables (:blt::tree) |
|---|
| 97 | # data_menu: Array with data of menus |
|---|
| 98 | # group_id: |
|---|
| 99 | # ht_funcs: Tree widget containing the tree of Functions |
|---|
| 100 | # (:blt::treeview) |
|---|
| 101 | # blt_functree: Tree widget containing the tree of Functions (:blt::tree) |
|---|
| 102 | # item_data: Array to hold the full content & description of items |
|---|
| 103 | # item_id: Current index of item to insert in ht_* starting from 1 |
|---|
| 104 | # OnSelectItem: Command to invoke on SelectItem in ht_* |
|---|
| 105 | # OnBusyCmd: Command to invoke when busy |
|---|
| 106 | # SubTypeImgs: Images associated to types of set |
|---|
| 107 | # |
|---|
| 108 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 109 | variable data |
|---|
| 110 | |
|---|
| 111 | # List array with functions defined by user |
|---|
| 112 | variable regFunLst |
|---|
| 113 | |
|---|
| 114 | # name of the current TOL set variable. |
|---|
| 115 | variable tolset "" |
|---|
| 116 | variable tolindex "" |
|---|
| 117 | # estas variables desapareceran cuando ::tol::forallchild admita scripts |
|---|
| 118 | # completos y no solo nombres de proc |
|---|
| 119 | variable at_set |
|---|
| 120 | variable node_prefix |
|---|
| 121 | |
|---|
| 122 | variable iterSet "" |
|---|
| 123 | variable knownReference "" |
|---|
| 124 | |
|---|
| 125 | variable gra_parent "" |
|---|
| 126 | # tree widget containing the TOL objects. |
|---|
| 127 | variable ht_tree ;# is a ::blt::treeview |
|---|
| 128 | variable blt_tree ;# is a ::blt::tree |
|---|
| 129 | |
|---|
| 130 | # tabset widget containing trees of variables and functions |
|---|
| 131 | variable w_tabset |
|---|
| 132 | |
|---|
| 133 | # list widget containing the variables. It's the window of |
|---|
| 134 | # the tab Variable |
|---|
| 135 | variable ht_vars ;# is a ::blt::treeview |
|---|
| 136 | variable blt_vartree ;# is a ::blt::tree |
|---|
| 137 | |
|---|
| 138 | variable data_menu |
|---|
| 139 | variable group_id -1 |
|---|
| 140 | |
|---|
| 141 | # list widget containing the functions. It's the window of |
|---|
| 142 | # the tab Functions |
|---|
| 143 | variable ht_funcs ;# is a ::blt::treeview |
|---|
| 144 | variable blt_functree ;# is a ::blt::tree |
|---|
| 145 | |
|---|
| 146 | # array to hold the full content & description of items |
|---|
| 147 | variable item_data |
|---|
| 148 | |
|---|
| 149 | # current index of item to insert in ht_* starting from 1 |
|---|
| 150 | variable item_id |
|---|
| 151 | |
|---|
| 152 | # tell if we are processing a SelectSet event |
|---|
| 153 | |
|---|
| 154 | #variable selecting_set |
|---|
| 155 | #variable closing |
|---|
| 156 | |
|---|
| 157 | # command to invoke on SelectItem in ht_* |
|---|
| 158 | variable OnSelectItem |
|---|
| 159 | |
|---|
| 160 | # command to invoke when busy |
|---|
| 161 | variable OnBusyCmd "" |
|---|
| 162 | |
|---|
| 163 | # images associated to types of set. |
|---|
| 164 | variable SubTypeImgs { |
|---|
| 165 | GenericSet MODFile PRJFile DIRFile TOLFile |
|---|
| 166 | BDCFile BDTFile BSTFile BMTFile BSIFile TSIFile BMIFile |
|---|
| 167 | StructuredSet TableSet} |
|---|
| 168 | |
|---|
| 169 | } |
|---|
| 170 | |
|---|
| 171 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 172 | proc ::TolInspector::SubTypeImage { idx } { |
|---|
| 173 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 174 | variable SubTypeImgs |
|---|
| 175 | |
|---|
| 176 | #Tolcon_Trace "SubTypeImage $idx = [lindex $SubTypeImgs $idx]" |
|---|
| 177 | ::Bitmap::get [lindex $SubTypeImgs $idx] |
|---|
| 178 | } |
|---|
| 179 | |
|---|
| 180 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 181 | proc ::TolInspector::CreateColumns { ht } { |
|---|
| 182 | # |
|---|
| 183 | # PURPOSE: Creates the columns (index, name, content, path, description ) |
|---|
| 184 | # of the tree of variables or functions |
|---|
| 185 | # |
|---|
| 186 | # PARAMETERS: |
|---|
| 187 | # ht: path of ::blt::treeview of variables or ::blt::treeview of functions |
|---|
| 188 | # |
|---|
| 189 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 190 | # main column ==> Name |
|---|
| 191 | $ht column configure treeView -text [mc "Name"] -justify left \ |
|---|
| 192 | -bg white -activetitlebackground gray90 -pad 3 |
|---|
| 193 | # index column |
|---|
| 194 | $ht column insert 0 Index \ |
|---|
| 195 | -bg white -justify left -activetitlebackground gray90 |
|---|
| 196 | # columns Content Path & Description |
|---|
| 197 | #(pgea) se oculta la columna correspondiente a la referencia |
|---|
| 198 | $ht column insert end Content Description Path\ |
|---|
| 199 | -bg white -justify left -activetitlebackground gray90 -pad 3 |
|---|
| 200 | $ht column insert end Reference -hide yes |
|---|
| 201 | foreach c {Index Content Description Path} { |
|---|
| 202 | $ht column configure $c -text [mc "$c"] |
|---|
| 203 | } |
|---|
| 204 | # associates the command of order to each one of the titles of the |
|---|
| 205 | # columns of the trees |
|---|
| 206 | foreach column [$ht column names] { |
|---|
| 207 | $ht column configure $column \ |
|---|
| 208 | -command [list ::TolInspector::SortColumn $ht $column] |
|---|
| 209 | } |
|---|
| 210 | } |
|---|
| 211 | |
|---|
| 212 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 213 | proc ::TolInspector::SortColumn {ht column} { |
|---|
| 214 | # |
|---|
| 215 | # PURPOSE: Associates the command of order to the title of a column of the |
|---|
| 216 | # tree of variables or the tree of functions |
|---|
| 217 | # |
|---|
| 218 | # PARAMETERS: |
|---|
| 219 | # ht: path of ::blt::treeview of variables or ::blt::treeview of |
|---|
| 220 | # functions |
|---|
| 221 | # column: name of the column of this tree |
|---|
| 222 | # |
|---|
| 223 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 224 | set old [$ht sort cget -column] |
|---|
| 225 | set decreasing 0 |
|---|
| 226 | if { "$old" == "$column" } { |
|---|
| 227 | set decreasing [$ht sort cget -decreasing] |
|---|
| 228 | set decreasing [expr !$decreasing] |
|---|
| 229 | } |
|---|
| 230 | $ht sort configure -decreasing $decreasing -column $column -mode integer |
|---|
| 231 | $ht configure -flat no |
|---|
| 232 | $ht sort auto yes |
|---|
| 233 | |
|---|
| 234 | blt::busy hold $ht |
|---|
| 235 | update |
|---|
| 236 | blt::busy release $ht |
|---|
| 237 | } |
|---|
| 238 | |
|---|
| 239 | |
|---|
| 240 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 241 | proc ::TolInspector::Create { w args } { |
|---|
| 242 | # |
|---|
| 243 | # PURPOSE: Creates the object inspector, that contains two panels with three |
|---|
| 244 | # treeviews and three trees. |
|---|
| 245 | # - One for the left side of the inspector (with grammars, |
|---|
| 246 | # included files, console objects and object's spool) |
|---|
| 247 | # - And two for the right one (one for variables tab and one for |
|---|
| 248 | # functions tab) |
|---|
| 249 | # |
|---|
| 250 | # PARAMETERS: |
|---|
| 251 | # w: path where tol inspector must be created |
|---|
| 252 | # args: list of pairs {-option value} with options for the inspector. |
|---|
| 253 | # -onselcmd Comand to execute when a node is selected |
|---|
| 254 | # -wleft relative weight of left pane |
|---|
| 255 | # -wrigth relative weight of rigth pane |
|---|
| 256 | # |
|---|
| 257 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 258 | global toltk_options |
|---|
| 259 | variable ht_tree |
|---|
| 260 | variable blt_tree |
|---|
| 261 | variable ht_vars |
|---|
| 262 | variable blt_vartree |
|---|
| 263 | variable data_menu |
|---|
| 264 | variable ht_funcs |
|---|
| 265 | variable blt_functree |
|---|
| 266 | variable w_tabset |
|---|
| 267 | variable OnSelectItem |
|---|
| 268 | variable OnBusyCmd "" |
|---|
| 269 | |
|---|
| 270 | # this should be used insted of a lot of scalar variables. |
|---|
| 271 | # but, what can we do now? |
|---|
| 272 | |
|---|
| 273 | variable widgets |
|---|
| 274 | variable data |
|---|
| 275 | |
|---|
| 276 | array set data { |
|---|
| 277 | pool,objects "" |
|---|
| 278 | } |
|---|
| 279 | |
|---|
| 280 | array set options { |
|---|
| 281 | -onselcmd "" |
|---|
| 282 | -wleft 3 |
|---|
| 283 | -wright 7 |
|---|
| 284 | } |
|---|
| 285 | array set options $args |
|---|
| 286 | |
|---|
| 287 | # initializes the command OnSelectItem to "" |
|---|
| 288 | set OnSelectItem $options(-onselcmd) |
|---|
| 289 | |
|---|
| 290 | #variable selecting_set 0 |
|---|
| 291 | #variable closing 0 |
|---|
| 292 | |
|---|
| 293 | #upvar \#0 ::TolTk::Images Images |
|---|
| 294 | |
|---|
| 295 | # creation of PANED WINDOW MAIN |
|---|
| 296 | set pwMain [PanedWindow $w -side bottom -pad 0 -width 4] |
|---|
| 297 | # creation of pane left and pane right |
|---|
| 298 | set paneLeft [$pwMain add -weight $options(-wleft)] |
|---|
| 299 | set paneRight [$pwMain add -weight $options(-wright)] |
|---|
| 300 | set widgets(panes,left) $paneLeft |
|---|
| 301 | set widgets(panes,right) $paneRight |
|---|
| 302 | |
|---|
| 303 | # when a panel is destroyed, the item 'geometry,side' of the array variable |
|---|
| 304 | # data gives the value of the width of panel 'side' (left or right) |
|---|
| 305 | bind $paneLeft <Destroy> { |
|---|
| 306 | namespace eval ::TolInspector { |
|---|
| 307 | variable data |
|---|
| 308 | variable widgets |
|---|
| 309 | set data(geometry,left) [winfo width $widgets(panes,left)] |
|---|
| 310 | } |
|---|
| 311 | } |
|---|
| 312 | bind $paneRight <Destroy> { |
|---|
| 313 | namespace eval ::TolInspector { |
|---|
| 314 | variable data |
|---|
| 315 | variable widgets |
|---|
| 316 | set data(geometry,right) [winfo width $widgets(panes,right)] |
|---|
| 317 | } |
|---|
| 318 | } |
|---|
| 319 | # bind for destruction of paned window main |
|---|
| 320 | bind $pwMain <Destroy> ::TolInspector::Destroy |
|---|
| 321 | |
|---|
| 322 | # creation of pane left with tree with the TOL OBJECTS |
|---|
| 323 | CreatePaneLeft $paneLeft |
|---|
| 324 | # creation of the right panel with TABSET of VARIABLES and FUNCTIONS |
|---|
| 325 | CreatePaneRight $paneRight |
|---|
| 326 | # creation of the menus |
|---|
| 327 | CreateMenus |
|---|
| 328 | # packing the panedwindowmain |
|---|
| 329 | pack $pwMain -fill both -expand yes |
|---|
| 330 | |
|---|
| 331 | # esto es para evitar que aparezca el icono open cuando |
|---|
| 332 | # relleno estando el mouse sobre ht_* |
|---|
| 333 | $ht_vars bind Entry <Enter> "" |
|---|
| 334 | $ht_vars bind Entry <Leave> "" |
|---|
| 335 | $ht_funcs bind Entry <Enter> "" |
|---|
| 336 | $ht_funcs bind Entry <Leave> "" |
|---|
| 337 | } |
|---|
| 338 | |
|---|
| 339 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 340 | proc ::TolInspector::CreatePaneLeft { paneLeft } { |
|---|
| 341 | # |
|---|
| 342 | # PURPOSE: Creation of TREE LEFT with the TOL OBJECTS |
|---|
| 343 | # |
|---|
| 344 | # PARAMETERS: |
|---|
| 345 | # paneLeft: path of the pane of the left in TolInspector |
|---|
| 346 | # |
|---|
| 347 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 348 | global toltk_options |
|---|
| 349 | variable blt_tree |
|---|
| 350 | variable ht_tree |
|---|
| 351 | |
|---|
| 352 | # creation of the ScrolledWindow of the left side |
|---|
| 353 | set sw1 [ScrolledWindow $paneLeft.sw -ipad 0 -borderwidth 0 -scrollbar both ] |
|---|
| 354 | # creation of the left tree |
|---|
| 355 | set blt_tree [::blt::tree create tree$sw1.ht] |
|---|
| 356 | set ht_tree [::blt::treeview $sw1.ht -tree $blt_tree -bg white \ |
|---|
| 357 | -hideroot no -activeicons "" \ |
|---|
| 358 | -selectbackground gray75 -selectforeground black \ |
|---|
| 359 | -selectcommand ::TolInspector::SelectObject \ |
|---|
| 360 | -highlightthickness 0 -font $toltk_options(fonts,Label)] |
|---|
| 361 | # configuration of the left tree |
|---|
| 362 | $ht_tree configure \ |
|---|
| 363 | -closecommand "::TolInspector::CloseObject %#" \ |
|---|
| 364 | -opencommand "::TolInspector::OpenObject %#" |
|---|
| 365 | $ht_tree style configure text -bg white |
|---|
| 366 | $ht_tree column configure treeView -bg white |
|---|
| 367 | $ht_tree column insert end FileName -hide true |
|---|
| 368 | # creation of the root node "Tol Objects" |
|---|
| 369 | set img [::Bitmap::get Objects] |
|---|
| 370 | $ht_tree entry configure root -label [mc "Tol Objects"]\ |
|---|
| 371 | -icons [list $img $img] |
|---|
| 372 | |
|---|
| 373 | # creation of the node father "Grammars" |
|---|
| 374 | set img [::Bitmap::get Grammars] |
|---|
| 375 | set blt_idx [$blt_tree insert root -label "root-grammars"\ |
|---|
| 376 | -tags "root-grammars"] |
|---|
| 377 | $ht_tree entry configure $blt_idx -label [mc "Grammars"]\ |
|---|
| 378 | -icons [list $img $img] |
|---|
| 379 | # Inserts in the node of grammars a node by each grammar that exists in Tol |
|---|
| 380 | InsertGrammars |
|---|
| 381 | |
|---|
| 382 | # creation of the node father "Packages" |
|---|
| 383 | set img [::Bitmap::get "package"] |
|---|
| 384 | set blt_idx [$blt_tree insert root -label "root-packages"\ |
|---|
| 385 | -tags "root-packages"] |
|---|
| 386 | $ht_tree entry configure $blt_idx -label [mc "Packages"]\ |
|---|
| 387 | -icons [list $img $img] -button yes |
|---|
| 388 | |
|---|
| 389 | # creation of the node father "Included Files" |
|---|
| 390 | set img [::Bitmap::get "Files"] |
|---|
| 391 | set blt_idx [$blt_tree insert root -label "root-files" -tags "root-files"] |
|---|
| 392 | $ht_tree entry configure $blt_idx -label [mc "Included Files"] \ |
|---|
| 393 | -icons [list $img $img] -button yes |
|---|
| 394 | # creation of the node father "Console Objects" |
|---|
| 395 | set img [::Bitmap::get "Console"] |
|---|
| 396 | set blt_idx [$blt_tree insert root -label "root-console"\ |
|---|
| 397 | -tags "root-console"] |
|---|
| 398 | $ht_tree entry configure $blt_idx -label [mc "Console Objects"] \ |
|---|
| 399 | -icons [list $img $img] -button yes |
|---|
| 400 | # creation of the node father "Objects' Spool" |
|---|
| 401 | set img [::Bitmap::get "pool"] |
|---|
| 402 | set blt_idx [$blt_tree insert root -label "root-pool" -tags "root-pool"] |
|---|
| 403 | $ht_tree entry configure $blt_idx -label [mc "Objects' Spool"] \ |
|---|
| 404 | -icons [list $img $img] -button yes |
|---|
| 405 | # associates the tree to scrolled window |
|---|
| 406 | $sw1 setwidget $ht_tree |
|---|
| 407 | # packing |
|---|
| 408 | pack $sw1 -fill both -expand yes |
|---|
| 409 | # bind the focus on tree |
|---|
| 410 | bind $ht_tree <Button-1> "::focus $ht_tree" |
|---|
| 411 | } |
|---|
| 412 | |
|---|
| 413 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 414 | proc ::TolInspector::CreatePaneRight { paneRight } { |
|---|
| 415 | # |
|---|
| 416 | # PURPOSE: Creation of the right pane with TABSET with VARIABLES and FUNCTIONS |
|---|
| 417 | # |
|---|
| 418 | # PARAMETERS: |
|---|
| 419 | # paneLeft: path of the pane of the right in TolInspector |
|---|
| 420 | # |
|---|
| 421 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 422 | global toltk_options |
|---|
| 423 | variable w_tabset |
|---|
| 424 | variable blt_vartree |
|---|
| 425 | variable ht_vars |
|---|
| 426 | variable blt_functree |
|---|
| 427 | variable ht_funcs |
|---|
| 428 | |
|---|
| 429 | # creates the tabset to display the variables & functions |
|---|
| 430 | #set w_tabset [::blt::tabset $paneRight.ts -relief flat\ |
|---|
| 431 | -bd 0 -outerpad 0 -tier 2 -slant none -textside top \ |
|---|
| 432 | -highlightthickness 0 -side left -rotate 90] |
|---|
| 433 | set w_tabset [::blt::tabset $paneRight.ts -relief flat\ |
|---|
| 434 | -bd 0 -outerpad 0 -tier 2 -slant right -textside right \ |
|---|
| 435 | -highlightthickness 0] |
|---|
| 436 | # creates the scrolled windows for each one of the tabs |
|---|
| 437 | set sw21 [ScrolledWindow $w_tabset.sw1] |
|---|
| 438 | set sw22 [ScrolledWindow $w_tabset.sw2] |
|---|
| 439 | # inserts in the tabset the tabs of functions and variables |
|---|
| 440 | $w_tabset insert end \ |
|---|
| 441 | Variables -text [mc Variables] -selectbackground \#d9d9d9 -bg gray75 \ |
|---|
| 442 | -image [::Bitmap::get Variables] -pady 0\ |
|---|
| 443 | Functions -text [mc Functions] -selectbackground \#d9d9d9 -bg gray75 \ |
|---|
| 444 | -image [::Bitmap::get Functions] -pady 0 |
|---|
| 445 | |
|---|
| 446 | # Creation of the right TREE RIGHT with VARIABLES |
|---|
| 447 | set blt_vartree [::blt::tree create tree$sw21.vars] |
|---|
| 448 | set ht_vars [::blt::treeview $sw21.vars -tree $blt_vartree -flat no\ |
|---|
| 449 | -bg white -hideroot yes -linewidth 0 -activeicons {}\ |
|---|
| 450 | -selectmode multiple\ |
|---|
| 451 | -selectbackground gray75 -selectforeground black \ |
|---|
| 452 | -highlightthickness 0 -font $toltk_options(fonts,Label)] |
|---|
| 453 | #tv_ordered_selection tvsel -tv $ht_vars |
|---|
| 454 | # configuration of the tree of variables |
|---|
| 455 | $ht_vars configure \ |
|---|
| 456 | -opencommand "::TolInspector::OpenVariable %#" \ |
|---|
| 457 | -selectcommand "::TolInspector::SelectItem $ht_vars" |
|---|
| 458 | $ht_vars style configure text -bg white |
|---|
| 459 | bind $ht_vars <Button-1> "::focus $ht_vars" |
|---|
| 460 | |
|---|
| 461 | # Creation of the right TREE RIGHT with FUNCTIONS |
|---|
| 462 | set blt_functree [::blt::tree create tree$sw22.funcs] |
|---|
| 463 | set ht_funcs [::blt::treeview $sw22.funcs -tree $blt_functree -flat no\ |
|---|
| 464 | -bg white -hideroot yes -linewidth 0 -activeicons {} \ |
|---|
| 465 | -selectmode multiple\ |
|---|
| 466 | -selectbackground gray75 -selectforeground black \ |
|---|
| 467 | -highlightthickness 0 -font $toltk_options(fonts,Label)] |
|---|
| 468 | # configuration of the tree of functions |
|---|
| 469 | $ht_funcs configure -selectcommand "::TolInspector::SelectItem $ht_funcs" |
|---|
| 470 | $ht_funcs style configure text -bg white |
|---|
| 471 | bind $ht_funcs <Button-1> "::focus $ht_funcs" |
|---|
| 472 | |
|---|
| 473 | # associates the trees to scrolled windows |
|---|
| 474 | $sw21 setwidget $ht_vars |
|---|
| 475 | $sw22 setwidget $ht_funcs |
|---|
| 476 | # configure the tabs |
|---|
| 477 | $w_tabset tab configure Variables -window $sw21 -fill both -padx 0 |
|---|
| 478 | $w_tabset tab configure Functions -window $sw22 -fill both -padx 0 |
|---|
| 479 | # create the columns of the trees of variables and functions |
|---|
| 480 | CreateColumns $ht_vars |
|---|
| 481 | CreateColumns $ht_funcs |
|---|
| 482 | # packing the tabset |
|---|
| 483 | pack $w_tabset -fill both -expand yes |
|---|
| 484 | $w_tabset tab configure Variables\ |
|---|
| 485 | -command "::TolInspector::SelectItem $ht_vars" |
|---|
| 486 | $w_tabset tab configure Functions\ |
|---|
| 487 | -command "::TolInspector::SelectItem $ht_funcs" |
|---|
| 488 | } |
|---|
| 489 | |
|---|
| 490 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 491 | proc ::TolInspector::CreateMenus {} { |
|---|
| 492 | # |
|---|
| 493 | # PURPOSE: Create the menus of the trees |
|---|
| 494 | # |
|---|
| 495 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 496 | variable data_menu |
|---|
| 497 | variable ht_vars |
|---|
| 498 | variable ht_funcs |
|---|
| 499 | variable ht_tree |
|---|
| 500 | |
|---|
| 501 | set data_menu(main) [menu $ht_vars.m -tearoff 0] |
|---|
| 502 | set data_menu(Code,File) [menu $data_menu(main).mcof -tearoff 0] |
|---|
| 503 | set data_menu(Complex,File) [menu $data_menu(main).mcxf -tearoff 0] |
|---|
| 504 | set data_menu(Date,File) [menu $data_menu(main).mdaf -tearoff 0] |
|---|
| 505 | set data_menu(Matrix,File) [menu $data_menu(main).mmaf -tearoff 0] |
|---|
| 506 | set data_menu(VMatrix,File) [menu $data_menu(main).mvmf -tearoff 0] |
|---|
| 507 | set data_menu(Polyn,File) [menu $data_menu(main).mpof -tearoff 0] |
|---|
| 508 | set data_menu(Ratio,File) [menu $data_menu(main).mraf -tearoff 0] |
|---|
| 509 | set data_menu(Real,File) [menu $data_menu(main).mref -tearoff 0] |
|---|
| 510 | set data_menu(Serie,File) [menu $data_menu(main).msef -tearoff 0] |
|---|
| 511 | set data_menu(Set,File) [menu $data_menu(main).mstf -tearoff 0] |
|---|
| 512 | set data_menu(File,File) [menu $data_menu(main).mfif -tearoff 0] |
|---|
| 513 | set data_menu(Anything,File) [menu $data_menu(main).mspf -tearoff 0] |
|---|
| 514 | set data_menu(Text,File) [menu $data_menu(main).mtef -tearoff 0] |
|---|
| 515 | set data_menu(TimeSet,File) [menu $data_menu(main).mtif -tearoff 0] |
|---|
| 516 | set data_menu(NameBlock,File) [menu $data_menu(main).mnbf -tearoff 0] |
|---|
| 517 | |
|---|
| 518 | set data_menu(Code,Functions) [menu $data_menu(main).mcofu -tearoff 0] |
|---|
| 519 | set data_menu(Complex,Functions) [menu $data_menu(main).mcxfu -tearoff 0] |
|---|
| 520 | set data_menu(Date,Functions) [menu $data_menu(main).mdafu -tearoff 0] |
|---|
| 521 | set data_menu(Matrix,Functions) [menu $data_menu(main).mmafu -tearoff 0] |
|---|
| 522 | set data_menu(VMatrix,Functions) [menu $data_menu(main).mvmfu -tearoff 0] |
|---|
| 523 | set data_menu(Polyn,Functions) [menu $data_menu(main).mpofu -tearoff 0] |
|---|
| 524 | set data_menu(Ratio,Functions) [menu $data_menu(main).mrafu -tearoff 0] |
|---|
| 525 | set data_menu(Real,Functions) [menu $data_menu(main).mrefu -tearoff 0] |
|---|
| 526 | set data_menu(Serie,Functions) [menu $data_menu(main).msefu -tearoff 0] |
|---|
| 527 | set data_menu(Set,Functions) [menu $data_menu(main).mstfu -tearoff 0] |
|---|
| 528 | set data_menu(File,Functions) [menu $data_menu(main).mfifu -tearoff 0] |
|---|
| 529 | set data_menu(Anything,Functions) [menu $data_menu(main).mspfu -tearoff 0] |
|---|
| 530 | set data_menu(Text,Functions) [menu $data_menu(main).mtefu -tearoff 0] |
|---|
| 531 | set data_menu(TimeSet,Functions) [menu $data_menu(main).mtifu -tearoff 0] |
|---|
| 532 | set data_menu(NameBlock,Functions) [menu $data_menu(main).mnbfu -tearoff 0] |
|---|
| 533 | |
|---|
| 534 | set data_menu(Matrix,Table) [menu $data_menu(main).mmat -tearoff 0] |
|---|
| 535 | set data_menu(Matrix,Export) [menu $data_menu(main).mmae -tearoff 0] |
|---|
| 536 | set data_menu(Matrix,Draw) [menu $data_menu(main).mmac -tearoff 0] |
|---|
| 537 | set data_menu(Matrix,Export,BDT) [menu $data_menu(main).mmaebdt -tearoff 0] |
|---|
| 538 | set data_menu(Serie,DrawAutocor) [menu $data_menu(main).mseda -tearoff 0] |
|---|
| 539 | set data_menu(Serie,TableAutocor) [menu $data_menu(main).mseta -tearoff 0] |
|---|
| 540 | set data_menu(Set,Table) [menu $data_menu(main).mstt -tearoff 0] |
|---|
| 541 | set data_menu(Set,Table2) [menu $data_menu(main).mstt2 -tearoff 0] |
|---|
| 542 | set data_menu(Set,Draw) [menu $data_menu(main).mstd -tearoff 0] |
|---|
| 543 | set data_menu(Set,Draw,Special) [menu $data_menu(main).mstds -tearoff 0] |
|---|
| 544 | set data_menu(Set,Draw,Special,M) [menu $data_menu(main).mstdsm -tearoff 0] |
|---|
| 545 | set data_menu(File,View) [menu $data_menu(main).mfiv -tearoff 0] |
|---|
| 546 | set data_menu(File,Decompile) [menu $data_menu(main).mfid -tearoff 0] |
|---|
| 547 | set data_menu(TimeSet,View) [menu $data_menu(main).mtiv -tearoff 0] |
|---|
| 548 | #$ht_vars bind Entry <Button-3> +[$ht_vars bind Entry <Button-1>] |
|---|
| 549 | |
|---|
| 550 | # composes the menus for each one of the trees, depending the node |
|---|
| 551 | # that is selected |
|---|
| 552 | $ht_vars bind all <Button-3> +[list ::TolInspector::PostVariable %X %Y] |
|---|
| 553 | $ht_funcs bind all <Button-3> +[list ::TolInspector::PostFunction %X %Y] |
|---|
| 554 | $ht_tree bind all <Button-3> +[list ::TolInspector::PostTree %X %Y] |
|---|
| 555 | } |
|---|
| 556 | |
|---|
| 557 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 558 | proc ::TolInspector::GetWeight { pane } { |
|---|
| 559 | # |
|---|
| 560 | # PURPOSE: Set data(geometry,$pane) to the value of the current geometry |
|---|
| 561 | # of the pane |
|---|
| 562 | # |
|---|
| 563 | # PARAMETERS: |
|---|
| 564 | # pane -> string with a value "left" or "right" for each one of panels |
|---|
| 565 | # |
|---|
| 566 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 567 | variable widgets |
|---|
| 568 | variable data |
|---|
| 569 | |
|---|
| 570 | if {[winfo exists $widgets(panes,$pane)]} { |
|---|
| 571 | set data(geometry,$pane) [winfo width $widgets(panes,$pane)] |
|---|
| 572 | } |
|---|
| 573 | set data(geometry,$pane) |
|---|
| 574 | } |
|---|
| 575 | |
|---|
| 576 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 577 | proc ::TolInspector::Destroy { } { |
|---|
| 578 | # |
|---|
| 579 | # PURPOSE: Destroys the three trees of TolInspector and array with full |
|---|
| 580 | # content & description of items |
|---|
| 581 | # |
|---|
| 582 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 583 | variable blt_tree |
|---|
| 584 | variable blt_vartree |
|---|
| 585 | variable blt_functree |
|---|
| 586 | variable item_data |
|---|
| 587 | |
|---|
| 588 | ::blt::tree destroy $blt_tree |
|---|
| 589 | ::blt::tree destroy $blt_vartree |
|---|
| 590 | ::blt::tree destroy $blt_functree |
|---|
| 591 | unset item_data |
|---|
| 592 | } |
|---|
| 593 | |
|---|
| 594 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 595 | proc ::TolInspector::OneLine { str } { |
|---|
| 596 | # |
|---|
| 597 | # PURPOSE: Gives a string with carriage returns \n and return this string |
|---|
| 598 | # until the first carriage return that appears after a word, |
|---|
| 599 | # replacing the rest by ... if some word existed after that carriage |
|---|
| 600 | # return |
|---|
| 601 | # Examples: the str "a\n b c" returns "a..." |
|---|
| 602 | # "\n \n a\n b" returns "a..." |
|---|
| 603 | # "\n \n a\n" returns "a" |
|---|
| 604 | # PARAMETERS: |
|---|
| 605 | # str -> string with \n |
|---|
| 606 | # |
|---|
| 607 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 608 | set str [string trim $str] |
|---|
| 609 | set lnidx [string first "\n" $str] |
|---|
| 610 | if { $lnidx != -1 } { |
|---|
| 611 | if { [incr lnidx -1] > 0 } { |
|---|
| 612 | return "[string range $str 0 $lnidx]..." |
|---|
| 613 | } else { |
|---|
| 614 | return "..." |
|---|
| 615 | } |
|---|
| 616 | } |
|---|
| 617 | set str |
|---|
| 618 | } |
|---|
| 619 | |
|---|
| 620 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 621 | proc ::TolInspector::TrimContent { grammar content } { |
|---|
| 622 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 623 | if { [string equal "Real" $grammar] } { |
|---|
| 624 | return [::TolConsole::Format $content] |
|---|
| 625 | } else { |
|---|
| 626 | if { [string equal \"\n\" $content] } { |
|---|
| 627 | set content {"\n"} |
|---|
| 628 | } |
|---|
| 629 | return [OneLine $content] |
|---|
| 630 | set content [string trim $content] |
|---|
| 631 | set lnidx [string first "\n" $content] |
|---|
| 632 | if { $lnidx != -1 } { |
|---|
| 633 | if { [incr lnidx -1] > 0 } { |
|---|
| 634 | return "[string range $content 0 $lnidx]..." |
|---|
| 635 | } else { |
|---|
| 636 | return "..." |
|---|
| 637 | } |
|---|
| 638 | } |
|---|
| 639 | set content |
|---|
| 640 | } |
|---|
| 641 | } |
|---|
| 642 | |
|---|
| 643 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 644 | proc ::TolInspector::_InsertChild { args } { |
|---|
| 645 | # |
|---|
| 646 | # PURPOSE: este proc es para ancapsular desc en una lista |
|---|
| 647 | # |
|---|
| 648 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 649 | eval InsertChild [lrange $args 0 3] [list [list [lindex $args 4]]] [lrange $args 5 end] |
|---|
| 650 | } |
|---|
| 651 | |
|---|
| 652 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 653 | proc ::TolInspector::InsertChild { args } { |
|---|
| 654 | # |
|---|
| 655 | # PURPOSE: Inserts a node in the corresponding treeview of the right panel. |
|---|
| 656 | # |
|---|
| 657 | # PARAMETERS: |
|---|
| 658 | # args[0] -> grammar |
|---|
| 659 | # args[1] -> name |
|---|
| 660 | # args[2] -> content |
|---|
| 661 | # args[3] -> path |
|---|
| 662 | # args[4] -> desc |
|---|
| 663 | # Si grammar == "Code" |
|---|
| 664 | # args[5] -> ¿es una variable? |
|---|
| 665 | # Si grammar == "Set" || "NameBlock" |
|---|
| 666 | # args[5] -> indexes of the set |
|---|
| 667 | # args[6] -> is file? |
|---|
| 668 | # args[7] -> has subset? |
|---|
| 669 | # args[8] -> subtype |
|---|
| 670 | # args[end] -> "Reference {reference}" end > 4 |
|---|
| 671 | # |
|---|
| 672 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 673 | variable ht_vars |
|---|
| 674 | variable blt_vartree |
|---|
| 675 | variable ht_funcs |
|---|
| 676 | variable blt_functree |
|---|
| 677 | variable gra_parent |
|---|
| 678 | |
|---|
| 679 | #puts "InsertChild: args=$args [info level 1]" |
|---|
| 680 | set grammar [lindex $args 0] |
|---|
| 681 | set name [ lindex $args 1 ] |
|---|
| 682 | set content [lindex $args 2] |
|---|
| 683 | set path [lindex $args 3] |
|---|
| 684 | set desc [lindex [lindex $args 4] 0] |
|---|
| 685 | |
|---|
| 686 | |
|---|
| 687 | if {[llength [lindex $args end]] >= 2} { |
|---|
| 688 | #set ref [list [lindex [lindex $args end] 0] [lrange [lindex $args end] 1 end]] |
|---|
| 689 | set ref [concat [lindex [lindex $args end] 0] [lrange [lindex $args end] 1 end]] |
|---|
| 690 | } else { |
|---|
| 691 | set ref "" |
|---|
| 692 | } |
|---|
| 693 | #puts "InsertChild: ref=$ref" |
|---|
| 694 | switch $grammar { |
|---|
| 695 | Code { |
|---|
| 696 | set isvar [lindex $args 5] |
|---|
| 697 | if { [string equal $isvar "1"] } { |
|---|
| 698 | Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc $ref |
|---|
| 699 | } else { |
|---|
| 700 | Insert_HTItem $ht_funcs $blt_functree $grammar $name $content $path $desc $ref |
|---|
| 701 | } |
|---|
| 702 | } |
|---|
| 703 | NameBlock - |
|---|
| 704 | Set { |
|---|
| 705 | #puts "HTItem, ref = '$ref' '$args'" |
|---|
| 706 | # args[5] is the index of the set object |
|---|
| 707 | # args[6] is the flag file |
|---|
| 708 | # args[8] is the subtype |
|---|
| 709 | Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc \ |
|---|
| 710 | [lindex $args 5] [lindex $args 6] [lindex $args 8] $ref |
|---|
| 711 | } |
|---|
| 712 | default { |
|---|
| 713 | Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc $ref |
|---|
| 714 | } |
|---|
| 715 | } |
|---|
| 716 | } |
|---|
| 717 | |
|---|
| 718 | # si grammar == "Set" |
|---|
| 719 | # args[0] -> indexes |
|---|
| 720 | # args[1] -> ¿is a file? |
|---|
| 721 | # args[2] -> subtype |
|---|
| 722 | |
|---|
| 723 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 724 | proc ::TolInspector::Insert_HTItem {ht tree grammar name content path desc args} { |
|---|
| 725 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 726 | variable ht_tree |
|---|
| 727 | variable tolset |
|---|
| 728 | variable tolindex |
|---|
| 729 | variable iterSet |
|---|
| 730 | variable knownReference |
|---|
| 731 | variable node_prefix |
|---|
| 732 | variable item_data |
|---|
| 733 | variable item_id |
|---|
| 734 | variable gra_parent |
|---|
| 735 | |
|---|
| 736 | #upvar \#0 ::TolTk::Images Images |
|---|
| 737 | |
|---|
| 738 | #puts "ENTER: ::TolInspector::Insert_HTItem" |
|---|
| 739 | if { $knownReference eq "" } { |
|---|
| 740 | set objRef $iterSet |
|---|
| 741 | lappend objRef $item_id |
|---|
| 742 | } else { |
|---|
| 743 | #puts "knownReference = $knownReference" |
|---|
| 744 | set objRef $knownReference |
|---|
| 745 | } |
|---|
| 746 | |
|---|
| 747 | #puts "\tobjRef = $objRef" |
|---|
| 748 | if { $gra_parent eq "NameBlock" } { |
|---|
| 749 | array set info_member [ FilterNameBlockMember $name ] |
|---|
| 750 | if { !$info_member(-show) } { |
|---|
| 751 | incr item_id |
|---|
| 752 | return |
|---|
| 753 | } |
|---|
| 754 | set fcolor $info_member(-fcolor) |
|---|
| 755 | } else { |
|---|
| 756 | set fcolor "black" |
|---|
| 757 | } |
|---|
| 758 | |
|---|
| 759 | set brief_cont [TrimContent $grammar $content] |
|---|
| 760 | set brief_desc [TrimContent DONTCARE $desc] |
|---|
| 761 | #puts "Insert_HTItem: args=$args" |
|---|
| 762 | if {[llength [lindex $args end]] >= 2} { |
|---|
| 763 | set ref_value [lindex [lindex $args end] 1] |
|---|
| 764 | } elseif {[regexp -- "console" $node_prefix]} { |
|---|
| 765 | set ref_value [list Console] |
|---|
| 766 | eval lappend ref_value $tolindex $item_id |
|---|
| 767 | } else { |
|---|
| 768 | set ref_value "" |
|---|
| 769 | } |
|---|
| 770 | |
|---|
| 771 | #puts "Insert_HTItem: ref_value=$ref_value tolindex=$tolindex item_id=$item_id node_prefix=$node_prefix" |
|---|
| 772 | #puts "\ttolset=$tolset" |
|---|
| 773 | set data [list Index $item_id \ |
|---|
| 774 | Content $brief_cont \ |
|---|
| 775 | Path $path \ |
|---|
| 776 | Description $brief_desc \ |
|---|
| 777 | Reference $ref_value] |
|---|
| 778 | |
|---|
| 779 | if {$grammar eq "Set" || $grammar eq "NameBlock"} { |
|---|
| 780 | if {[string length $tolset] || [regexp "console" $node_prefix]} { |
|---|
| 781 | # OJO: si tolset == "" no implica que no estemos en un Set |
|---|
| 782 | # por ejemplo un Set de la consola. |
|---|
| 783 | set item [GetItemName $node_prefix [lindex $args 0]] |
|---|
| 784 | #Tolcon_Trace "InsertHTItem. item(if): $item" |
|---|
| 785 | } else { |
|---|
| 786 | switch [lindex [$ht_tree get -full anchor] end] { |
|---|
| 787 | root-files { |
|---|
| 788 | set item file$item_id |
|---|
| 789 | } |
|---|
| 790 | root-console { |
|---|
| 791 | set item console$item_id |
|---|
| 792 | } |
|---|
| 793 | root-pool { |
|---|
| 794 | set item pool$item_id |
|---|
| 795 | } |
|---|
| 796 | default { |
|---|
| 797 | set item item$item_id |
|---|
| 798 | } |
|---|
| 799 | } |
|---|
| 800 | } |
|---|
| 801 | # aqui hay que pedir el bitmap en funcion del subtype: args[2] |
|---|
| 802 | if {$grammar eq "Set"} { |
|---|
| 803 | #puts "*******Set $objRef *******" |
|---|
| 804 | set icon_grammar [SubTypeImage [lindex $args 2]] |
|---|
| 805 | set data [lreplace $data 9 9 $objRef] |
|---|
| 806 | } else { |
|---|
| 807 | #(pgea) se reemplaza el valor de la referencia en data |
|---|
| 808 | set data [lreplace $data 9 9 $objRef] |
|---|
| 809 | #(pgea) se utiliza la informacon de instancia |
|---|
| 810 | #puts "Tol_ClassOfFromReference $objRef" |
|---|
| 811 | set classOf [Tol_ClassOfFromReference $objRef] |
|---|
| 812 | #puts "Tol_InstanceContentFromReference $objRef" |
|---|
| 813 | set insCont [Tol_InstanceContentFromReference $objRef] |
|---|
| 814 | if {$insCont ne ""} { |
|---|
| 815 | set data [lreplace $data 3 3 [TrimContent $grammar $insCont]] |
|---|
| 816 | } elseif {$classOf ne ""} { |
|---|
| 817 | set data [lreplace $data 3 3 $classOf] |
|---|
| 818 | } |
|---|
| 819 | set objAddress [ tol::info address $objRef ] |
|---|
| 820 | set icon_grammar [ ::ImageManager::getIconForInstance $objAddress ] |
|---|
| 821 | } |
|---|
| 822 | } elseif { $grammar eq "Anything" } { |
|---|
| 823 | set item "item$item_id" |
|---|
| 824 | set anyType [ tol::info anything $objRef ] |
|---|
| 825 | set icon_grammar [ ::Bitmap::get $anyType ] |
|---|
| 826 | } else { |
|---|
| 827 | set item "item$item_id" |
|---|
| 828 | set icon_grammar [ ::Bitmap::get $grammar ] |
|---|
| 829 | } |
|---|
| 830 | set idnew [$tree insert 0 -label $item] |
|---|
| 831 | set label [OneLine $name] |
|---|
| 832 | if {$label eq ""} { |
|---|
| 833 | if {[set label $brief_desc] eq ""} { |
|---|
| 834 | set label " " |
|---|
| 835 | } |
|---|
| 836 | } |
|---|
| 837 | $ht entry configure $idnew -label $label \ |
|---|
| 838 | -icons [list $icon_grammar $icon_grammar] -data $data \ |
|---|
| 839 | -foreground $fcolor |
|---|
| 840 | set item_data($item_id) [list $content $desc $grammar] |
|---|
| 841 | incr item_id |
|---|
| 842 | } |
|---|
| 843 | |
|---|
| 844 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 845 | proc ::TolInspector::ClearHiertables { } { |
|---|
| 846 | # |
|---|
| 847 | # PURPOSE: |
|---|
| 848 | # |
|---|
| 849 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 850 | variable w_tabset |
|---|
| 851 | variable ht_vars |
|---|
| 852 | variable ht_funcs |
|---|
| 853 | variable item_data |
|---|
| 854 | variable OnSelectItem |
|---|
| 855 | |
|---|
| 856 | $ht_vars entry delete root 0 end |
|---|
| 857 | $ht_funcs entry delete root 0 end |
|---|
| 858 | $ht_vars column configure Index -hide no |
|---|
| 859 | $ht_funcs column configure Index -hide no |
|---|
| 860 | catch { |
|---|
| 861 | unset item_data |
|---|
| 862 | } |
|---|
| 863 | $w_tabset tab configure Variables -text [mc Variables] -state normal |
|---|
| 864 | $w_tabset tab configure Functions -state normal |
|---|
| 865 | |
|---|
| 866 | if { [string length $OnSelectItem] } { |
|---|
| 867 | $OnSelectItem |
|---|
| 868 | } |
|---|
| 869 | } |
|---|
| 870 | |
|---|
| 871 | # este proc debe pasar a ser un getContainerReference |
|---|
| 872 | # |
|---|
| 873 | proc ::TolInspector::getPackageReference { treePath } { |
|---|
| 874 | variable ht_tree |
|---|
| 875 | |
|---|
| 876 | #puts "::TolInspector::getPackageReference $treePath" |
|---|
| 877 | catch { |
|---|
| 878 | set typeContainer "NameBlock" |
|---|
| 879 | set order [ lindex [ split [ lindex $treePath 2 ] "-" ] end ] |
|---|
| 880 | incr order -1 |
|---|
| 881 | #puts "path,2 = [ lindex $treePath 2 ]" |
|---|
| 882 | #puts "order = $order" |
|---|
| 883 | set idx [lindex [ $ht_tree entry children "root-packages"] $order] |
|---|
| 884 | set nameContainer [ $ht_tree entry cget $idx -label ] |
|---|
| 885 | #puts "en root-package:" |
|---|
| 886 | #puts "\torder=$order" |
|---|
| 887 | #puts "\tidx=$idx" |
|---|
| 888 | #puts "\tnameContainer=$nameContainer" |
|---|
| 889 | set container [ list $typeContainer $nameContainer ] |
|---|
| 890 | if { [ llength $treePath ] > 3 } { |
|---|
| 891 | foreach c [ lrange $treePath 3 end-1 ] { |
|---|
| 892 | set orderItem [ lindex [ split $c "-" ] end ] |
|---|
| 893 | lappend container $orderItem |
|---|
| 894 | } |
|---|
| 895 | set tolindex [ lindex [ split [ lindex $treePath end ] "-" ] end ] |
|---|
| 896 | } else { |
|---|
| 897 | set tolindex [ list ] |
|---|
| 898 | } |
|---|
| 899 | } msg |
|---|
| 900 | #puts "::TolInspector::getPackageReference: $msg" |
|---|
| 901 | #puts "::TolInspector::getPackageReference: [ list $container $tolindex ]" |
|---|
| 902 | return [ list $container $tolindex ] |
|---|
| 903 | } |
|---|
| 904 | |
|---|
| 905 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 906 | proc ::TolInspector::OpenObject { index } { |
|---|
| 907 | # |
|---|
| 908 | # PURPOSE: Script called each time a node in ht_tree (left treeview) is |
|---|
| 909 | # opened. |
|---|
| 910 | # |
|---|
| 911 | # PARAMETERS: |
|---|
| 912 | # index : The id of the node opened |
|---|
| 913 | # |
|---|
| 914 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 915 | variable tolset |
|---|
| 916 | variable tolindex |
|---|
| 917 | variable iterSet |
|---|
| 918 | variable at_set |
|---|
| 919 | variable node_prefix |
|---|
| 920 | variable ht_tree |
|---|
| 921 | variable data |
|---|
| 922 | |
|---|
| 923 | #puts "OpenObject: index=$index" |
|---|
| 924 | set path [$ht_tree get -full $index] |
|---|
| 925 | #puts "path = $path" |
|---|
| 926 | if { $index } { |
|---|
| 927 | set parent1 [lindex $path 1] |
|---|
| 928 | if { [set ispackage [string equal $parent1 "root-packages"]] || |
|---|
| 929 | [set isfile [string equal $parent1 "root-files"]] || |
|---|
| 930 | [set isconsole [string equal $parent1 "root-console"]] || |
|---|
| 931 | [string equal $parent1 "root-pool"] } { |
|---|
| 932 | set lpath [llength $path] |
|---|
| 933 | #puts "lpath = $lpath" |
|---|
| 934 | if { $lpath == 2 } { |
|---|
| 935 | if { $ispackage } { |
|---|
| 936 | InsertPackages |
|---|
| 937 | } elseif { $isfile } { |
|---|
| 938 | InsertFiles |
|---|
| 939 | } elseif { $isconsole } { |
|---|
| 940 | InsertConsoleObj |
|---|
| 941 | } else { |
|---|
| 942 | InsertPoolObj |
|---|
| 943 | } |
|---|
| 944 | } else { |
|---|
| 945 | #puts "OpenObject: path = $path" |
|---|
| 946 | set leaf [lindex $path end] |
|---|
| 947 | set leaf_info [split $leaf "-"] |
|---|
| 948 | set node_prefix [lindex $leaf_info 0] |
|---|
| 949 | set _tolset $tolset |
|---|
| 950 | if { $parent1 eq "root-packages" } { |
|---|
| 951 | foreach {tolset tolindex} [ getPackageReference $path ] break |
|---|
| 952 | } elseif { [string equal $parent1 "root-pool"] } { |
|---|
| 953 | #Tolcon_Trace "OpenObject. tolset=$tolset" |
|---|
| 954 | set tolset $data(pool,reference,[lindex $leaf_info 0]) |
|---|
| 955 | #puts "OpenObject: Spool: tolset=$tolset, leaf_info=$leaf_info" |
|---|
| 956 | if { $lpath == 3 } { |
|---|
| 957 | set tolindex [lrange $tolset 1 end] |
|---|
| 958 | set tolset [lindex $tolset 0] |
|---|
| 959 | } else { |
|---|
| 960 | set tolindex [lrange $leaf_info 1 end] |
|---|
| 961 | if {[lindex $tolset 0] eq "Console"} { |
|---|
| 962 | set tolset [lindex $tolset 0] |
|---|
| 963 | } else { |
|---|
| 964 | set tolset [lrange $tolset 0 1] |
|---|
| 965 | } |
|---|
| 966 | #set tolindex [lrange $tolset 1 end] |
|---|
| 967 | #set tolset [lindex $tolset 0] |
|---|
| 968 | #lappend tolindex [lindex $leaf_info end] |
|---|
| 969 | } |
|---|
| 970 | #Tolcon_Trace "OpenObject. tolset=$tolset" |
|---|
| 971 | } elseif {[regexp -- "console(.+)" $node_prefix --> idx_con]} { |
|---|
| 972 | set tolset "Console" |
|---|
| 973 | #puts "OpenObject: Console: leaf_info = $leaf_info" |
|---|
| 974 | if {[llength $leaf_info] == 1} { |
|---|
| 975 | set tolindex $idx_con |
|---|
| 976 | } else { |
|---|
| 977 | #set tolindex [list $idx_con [lrange $leaf_info 1 end]] |
|---|
| 978 | set tolindex [lrange $leaf_info 1 end] |
|---|
| 979 | } |
|---|
| 980 | } else { |
|---|
| 981 | set idx [$ht_tree find -name $node_prefix] |
|---|
| 982 | array set aryData [$ht_tree entry cget $idx -data] |
|---|
| 983 | set tolset [list File $aryData(FileName)] |
|---|
| 984 | #set tolset [$ht_tree entry cget [$ht_tree find -name $node_prefix] -label] |
|---|
| 985 | if { $lpath == 3 } { |
|---|
| 986 | set tolindex "" |
|---|
| 987 | } else { |
|---|
| 988 | set tolindex [lrange $leaf_info 1 end] |
|---|
| 989 | } |
|---|
| 990 | } |
|---|
| 991 | Busy |
|---|
| 992 | set at_set $index |
|---|
| 993 | set iterSet [eval list $tolset $tolindex] |
|---|
| 994 | variable gra_parent [ GetParentGrammar $iterSet ] |
|---|
| 995 | ::tol::forallchild $iterSet ::TolInspector::InsertSubset |
|---|
| 996 | set tolset $_tolset |
|---|
| 997 | NotBusy |
|---|
| 998 | } |
|---|
| 999 | } |
|---|
| 1000 | } |
|---|
| 1001 | } |
|---|
| 1002 | |
|---|
| 1003 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1004 | proc ::TolInspector::InsertPackages {} { |
|---|
| 1005 | # |
|---|
| 1006 | # PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL |
|---|
| 1007 | # packages |
|---|
| 1008 | # |
|---|
| 1009 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1010 | variable ht_tree |
|---|
| 1011 | #upvar \#0 ::TolTk::Images Images |
|---|
| 1012 | |
|---|
| 1013 | set order 1 |
|---|
| 1014 | foreach pkg [::tol::info packages] { |
|---|
| 1015 | # takes an icon with the same name that the grammar |
|---|
| 1016 | set img [ ::Bitmap::get NameBlock ] |
|---|
| 1017 | $ht_tree insert -at "root-packages" end package-$order -label $pkg\ |
|---|
| 1018 | -icons [list $img $img] -button yes |
|---|
| 1019 | incr order |
|---|
| 1020 | } |
|---|
| 1021 | } |
|---|
| 1022 | |
|---|
| 1023 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1024 | proc ::TolInspector::InsertGrammars {} { |
|---|
| 1025 | # |
|---|
| 1026 | # PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL |
|---|
| 1027 | # grammar |
|---|
| 1028 | # |
|---|
| 1029 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1030 | variable ht_tree |
|---|
| 1031 | #upvar \#0 ::TolTk::Images Images |
|---|
| 1032 | |
|---|
| 1033 | set id 1 |
|---|
| 1034 | foreach g [::tol::info grammars] { |
|---|
| 1035 | # takes an icon with the same name that the grammar |
|---|
| 1036 | set img [::Bitmap::get $g] |
|---|
| 1037 | $ht_tree insert -at "root-grammars" end grammar-$id -label $g\ |
|---|
| 1038 | -icons [list $img $img] |
|---|
| 1039 | incr id |
|---|
| 1040 | } |
|---|
| 1041 | } |
|---|
| 1042 | |
|---|
| 1043 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1044 | proc ::TolInspector::InsertFiles { } { |
|---|
| 1045 | # |
|---|
| 1046 | # PURPOSE: Inserts a node in ht_tree (left treeview) for each Included file |
|---|
| 1047 | # |
|---|
| 1048 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1049 | variable ht_tree |
|---|
| 1050 | variable blt_tree |
|---|
| 1051 | |
|---|
| 1052 | set index 1 |
|---|
| 1053 | #set img [::Bitmap::get "File"] |
|---|
| 1054 | foreach f [lreverse [::tol::info included]] { |
|---|
| 1055 | set finfo [::tol::info included $f] |
|---|
| 1056 | set button [lindex $finfo 3] |
|---|
| 1057 | set subtype [lindex $finfo 4] |
|---|
| 1058 | # tomar la imagen en funcion del subtype |
|---|
| 1059 | set img [SubTypeImage $subtype] |
|---|
| 1060 | set tag_file "file$index" |
|---|
| 1061 | set blt_idx [$blt_tree insert "root-files" \ |
|---|
| 1062 | -label $tag_file -tags $tag_file] |
|---|
| 1063 | # Tail del fichero. PodrÃa hacerse configurable por el usuario |
|---|
| 1064 | set label [file tail $f] |
|---|
| 1065 | $ht_tree entry configure $blt_idx -label $label\ |
|---|
| 1066 | -icons [list $img $img] -button $button -data [list "FileName" $f] |
|---|
| 1067 | incr index |
|---|
| 1068 | } |
|---|
| 1069 | } |
|---|
| 1070 | |
|---|
| 1071 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1072 | proc ::TolInspector::InsertConsoleObj { } { |
|---|
| 1073 | # |
|---|
| 1074 | # PURPOSE: Inserts a node in ht_tree (left treeview) for each Console object |
|---|
| 1075 | # |
|---|
| 1076 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1077 | variable ht_tree |
|---|
| 1078 | variable has_button 0 |
|---|
| 1079 | |
|---|
| 1080 | set index 1 |
|---|
| 1081 | foreach co [::tol::console stack list] { |
|---|
| 1082 | set grammar [lindex $co 0] |
|---|
| 1083 | if {$grammar eq "Set" || $grammar eq "NameBlock"} { |
|---|
| 1084 | # SUBTYPE: icono en funcion de [lindex $co 7] |
|---|
| 1085 | if {$grammar eq "Set"} { |
|---|
| 1086 | set icon [SubTypeImage [lindex $co 7]] |
|---|
| 1087 | } else { |
|---|
| 1088 | set objRef [ list "Console" $index ] |
|---|
| 1089 | set objAddress [ tol::info address $objRef ] |
|---|
| 1090 | set icon [ ::ImageManager::getIconForInstance $objAddress ] |
|---|
| 1091 | } |
|---|
| 1092 | set name [lindex $co 1] |
|---|
| 1093 | #tol::forallchild $name HasSubset |
|---|
| 1094 | set has_button [lindex $co 6] |
|---|
| 1095 | if {$name eq ""} { |
|---|
| 1096 | if {[set name [TrimContent DONTCARE [lindex $co 4]]] eq ""} { |
|---|
| 1097 | set name " " |
|---|
| 1098 | } |
|---|
| 1099 | } |
|---|
| 1100 | $ht_tree insert -at root-console end "console$index" -label $name \ |
|---|
| 1101 | -icons [list $icon $icon] -button $has_button -data [list "FileName" $index] |
|---|
| 1102 | } |
|---|
| 1103 | incr index |
|---|
| 1104 | } |
|---|
| 1105 | } |
|---|
| 1106 | |
|---|
| 1107 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1108 | proc ::TolInspector::InsertPoolObj { } { |
|---|
| 1109 | # |
|---|
| 1110 | # PURPOSE: Inserts a node in ht_tree (left treeview) for each object in Spool |
|---|
| 1111 | # |
|---|
| 1112 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1113 | variable data |
|---|
| 1114 | variable ht_tree |
|---|
| 1115 | array unset data pool,reference,* |
|---|
| 1116 | set index 1 |
|---|
| 1117 | |
|---|
| 1118 | foreach _obj $data(pool,objects) { |
|---|
| 1119 | #Tolcon_Trace "InsertPoolObj. _obj=$_obj" |
|---|
| 1120 | array set obj $_obj |
|---|
| 1121 | if { [string equal $obj(grammar) "Set"] || [string equal $obj(grammar) "NameBlock"] } { |
|---|
| 1122 | #Si la referencia del objeto tiene espacios en la ruta, el |
|---|
| 1123 | # llength me darÃa > 1, por eso añado la 2ª parte de la condicion |
|---|
| 1124 | if { ([llength $obj(reference)] > 1) && \ |
|---|
| 1125 | ![string equal $obj(reference) $obj(objName)]} { |
|---|
| 1126 | set infoObj [::tol::info variable $obj(reference)] |
|---|
| 1127 | } else { |
|---|
| 1128 | if {[catch { set infoObj [concat [list "Set" $obj(reference)] \ |
|---|
| 1129 | [::tol::info included $obj(reference)]] }]} { |
|---|
| 1130 | set infoObj [concat [list "Set" $obj(reference)] \ |
|---|
| 1131 | [::tol::info variable "Set" $obj(reference)]] |
|---|
| 1132 | } else { |
|---|
| 1133 | # Insertamos el 1 de isFile |
|---|
| 1134 | set infoObj [linsert $infoObj 5 1] |
|---|
| 1135 | } |
|---|
| 1136 | } |
|---|
| 1137 | #Tolcon_Trace "infoObj=$infoObj" |
|---|
| 1138 | if {[set name [file tail [lindex $infoObj 1]]] eq ""} { |
|---|
| 1139 | if {[set name [TrimContent DONTCARE [lindex $infoObj 4]]] eq ""} { |
|---|
| 1140 | set name " " |
|---|
| 1141 | } |
|---|
| 1142 | } |
|---|
| 1143 | set has_button [lindex $infoObj 6] |
|---|
| 1144 | #set icon [SubTypeImage [lindex $infoObj 7]] |
|---|
| 1145 | if {$obj(grammar) eq "Set"} { |
|---|
| 1146 | set icon [SubTypeImage [lindex $infoObj 7]] |
|---|
| 1147 | } else { |
|---|
| 1148 | #puts "en pool = $obj(reference)" |
|---|
| 1149 | set objAddress [ tol::info address $objRef ] |
|---|
| 1150 | set icon [ ::ImageManager::getIconForInstance $objAddress ] |
|---|
| 1151 | } |
|---|
| 1152 | |
|---|
| 1153 | $ht_tree insert -at root-pool end "pool$index" -label $name \ |
|---|
| 1154 | -icon [list $icon $icon] -button $has_button |
|---|
| 1155 | #Tolcon_Trace "InsertPoolObj. name=$name" |
|---|
| 1156 | if { ([llength $obj(reference)] > 1) && \ |
|---|
| 1157 | [string equal $obj(reference) $obj(objName)]} { |
|---|
| 1158 | set obj(reference) [list $obj(reference)] |
|---|
| 1159 | } |
|---|
| 1160 | set data(pool,reference,pool$index) $obj(reference) |
|---|
| 1161 | } |
|---|
| 1162 | incr index |
|---|
| 1163 | } |
|---|
| 1164 | } |
|---|
| 1165 | |
|---|
| 1166 | proc ::TolInspector::FilterNameBlockMember { name } { |
|---|
| 1167 | set st_reg [ regexp {(.+::)?(_)?(\.)?(.*)} $name => p1 p2 p3 p4] |
|---|
| 1168 | if { !$st_reg } { |
|---|
| 1169 | list -show 1 -fcolor "black" -name $name |
|---|
| 1170 | } elseif { $p2 eq "_" } { |
|---|
| 1171 | if { $p3 eq "." } { |
|---|
| 1172 | if { [string match {autodoc.member.*} $p4] } { |
|---|
| 1173 | # es un elemento de autodocumentacion y no se muestra |
|---|
| 1174 | list -show 0 |
|---|
| 1175 | } { |
|---|
| 1176 | # es un miembro de solo lectura |
|---|
| 1177 | list -show 1 -fcolor "gray50" -name "_.$p4" |
|---|
| 1178 | } |
|---|
| 1179 | } else { |
|---|
| 1180 | # es un miembro oculto, |
|---|
| 1181 | set showPrivate [ Tol_GetViewPrivateMembers ] |
|---|
| 1182 | list -show $showPrivate -fcolor "gray75" -name "_$p4" |
|---|
| 1183 | } |
|---|
| 1184 | } else { |
|---|
| 1185 | list -show 1 -fcolor "black" -name $p4 |
|---|
| 1186 | } |
|---|
| 1187 | } |
|---|
| 1188 | |
|---|
| 1189 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1190 | proc ::TolInspector::InsertSubset { args } { |
|---|
| 1191 | # |
|---|
| 1192 | # PURPOSE: Inserts a node in ht_tree (left treeview) for each child of a Set |
|---|
| 1193 | # |
|---|
| 1194 | # PARAMETERS: |
|---|
| 1195 | # args[0] -> grammar |
|---|
| 1196 | # args[1] -> name |
|---|
| 1197 | # args[2] -> content |
|---|
| 1198 | # args[3] -> path |
|---|
| 1199 | # args[4] -> desc |
|---|
| 1200 | # Si grammar == "Set" |
|---|
| 1201 | # args[5] -> indexes of the set |
|---|
| 1202 | # args[6] -> is file? |
|---|
| 1203 | # args[7] -> has subset? |
|---|
| 1204 | # args[8] -> subtype |
|---|
| 1205 | # |
|---|
| 1206 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1207 | variable ht_tree |
|---|
| 1208 | variable at_set |
|---|
| 1209 | variable tolset |
|---|
| 1210 | variable iterSet |
|---|
| 1211 | variable node_prefix |
|---|
| 1212 | variable has_button 0 |
|---|
| 1213 | variable blt_tree |
|---|
| 1214 | variable gra_parent |
|---|
| 1215 | catch { |
|---|
| 1216 | #puts "InsertSubset, args=$args" |
|---|
| 1217 | set grammar [lindex $args 0] |
|---|
| 1218 | if {$grammar eq "Set" || $grammar eq "NameBlock"} { |
|---|
| 1219 | #puts "InsertSubset, args=$args" |
|---|
| 1220 | if { $gra_parent eq "NameBlock" } { |
|---|
| 1221 | array set info_member [ FilterNameBlockMember [ lindex $args 1 ] ] |
|---|
| 1222 | if { !$info_member(-show) } { |
|---|
| 1223 | return |
|---|
| 1224 | } |
|---|
| 1225 | set name $info_member(-name) |
|---|
| 1226 | set fcolor $info_member(-fcolor) |
|---|
| 1227 | } else { |
|---|
| 1228 | set name [ lindex $args 1 ] |
|---|
| 1229 | set fcolor "black" |
|---|
| 1230 | } |
|---|
| 1231 | set content [lindex $args 2] |
|---|
| 1232 | # idx es el indice completo desde el Set root |
|---|
| 1233 | set idx [lindex $args 5] |
|---|
| 1234 | set isfile [lindex $args 6] |
|---|
| 1235 | set has_button [lindex $args 7] |
|---|
| 1236 | set subtype [lindex $args 8] |
|---|
| 1237 | #tol::forallchild $tolset $idx HasSubset |
|---|
| 1238 | if {$grammar eq "Set"} { |
|---|
| 1239 | set icon [SubTypeImage $subtype] |
|---|
| 1240 | } else { |
|---|
| 1241 | set objRef $iterSet |
|---|
| 1242 | lappend objRef [ lindex $idx end ] |
|---|
| 1243 | set objAddress [ tol::info address $objRef ] |
|---|
| 1244 | set icon [ ::ImageManager::getIconForInstance $objAddress ] |
|---|
| 1245 | } |
|---|
| 1246 | # Tail por si es un fichero. PodrÃa hacerse configurable por el usuario |
|---|
| 1247 | set label [file tail $name] |
|---|
| 1248 | #puts [list InsertSubset, idx {lindex $args 5} = $idx] |
|---|
| 1249 | set idnew [ $blt_tree insert $at_set \ |
|---|
| 1250 | -label [ GetItemName $node_prefix $idx ] ] |
|---|
| 1251 | |
|---|
| 1252 | #puts "InsertSubset, node_prefix = $node_prefix" |
|---|
| 1253 | #puts "InsertSubset, idnew = $idnew" |
|---|
| 1254 | #puts "InsertSubset, -label = [GetItemName $node_prefix $idx]" |
|---|
| 1255 | |
|---|
| 1256 | if {$label eq ""} { |
|---|
| 1257 | if {[set label [TrimContent DONTCARE [lindex $args 4]]] eq ""} { |
|---|
| 1258 | set label " " |
|---|
| 1259 | } |
|---|
| 1260 | } |
|---|
| 1261 | $ht_tree entry configure $idnew -label $label -button $has_button \ |
|---|
| 1262 | -icons [list $icon $icon] -foreground $fcolor |
|---|
| 1263 | } |
|---|
| 1264 | } msg |
|---|
| 1265 | #puts "InsertSubSet: $msg" |
|---|
| 1266 | } |
|---|
| 1267 | |
|---|
| 1268 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1269 | proc ::TolInspector::ClearConsoleObj { } { |
|---|
| 1270 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1271 | variable ht_tree |
|---|
| 1272 | variable data |
|---|
| 1273 | |
|---|
| 1274 | set idx_con [$ht_tree index root-console] |
|---|
| 1275 | $ht_tree entry delete $idx_con 0 end |
|---|
| 1276 | |
|---|
| 1277 | #Quitamos del spool todos los objetos que provengan de la consola |
|---|
| 1278 | foreach _obj $data(pool,objects) { |
|---|
| 1279 | array set obj $_obj |
|---|
| 1280 | if {[string equal $obj(origin) "root-console"]} { |
|---|
| 1281 | set idx [lsearch $data(pool,objects) $_obj] |
|---|
| 1282 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx] |
|---|
| 1283 | } |
|---|
| 1284 | } |
|---|
| 1285 | UpdatePoolObj |
|---|
| 1286 | #Finalmente limpiamos el stack de la consola de tol |
|---|
| 1287 | ::tol::console stack release |
|---|
| 1288 | } |
|---|
| 1289 | |
|---|
| 1290 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1291 | proc ::TolInspector::ClearConsoleObjSel {ht} { |
|---|
| 1292 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1293 | variable vars_selected |
|---|
| 1294 | variable data |
|---|
| 1295 | |
|---|
| 1296 | foreach var $vars_selected { |
|---|
| 1297 | set name [$ht entry cget $var -label] |
|---|
| 1298 | #puts "name=$name" |
|---|
| 1299 | #Quitamos del spool todos los objetos que provengan de la consola |
|---|
| 1300 | foreach _obj $data(pool,objects) { |
|---|
| 1301 | array set obj $_obj |
|---|
| 1302 | #puts "_obj=$_obj" |
|---|
| 1303 | if {[string equal $obj(origin) "root-console"] && [string equal $obj(objName) $name]} { |
|---|
| 1304 | set idx [lsearch $data(pool,objects) $_obj] |
|---|
| 1305 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx] |
|---|
| 1306 | } |
|---|
| 1307 | } |
|---|
| 1308 | UpdatePoolObj |
|---|
| 1309 | #Finalmente quitamos el objeto de la consola de tol |
|---|
| 1310 | ::tol::console stack release $name |
|---|
| 1311 | } |
|---|
| 1312 | UpdateConsoleObj |
|---|
| 1313 | } |
|---|
| 1314 | |
|---|
| 1315 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1316 | proc ::TolInspector::UpdateFileRoot { } { |
|---|
| 1317 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1318 | variable ht_tree |
|---|
| 1319 | set open 0 |
|---|
| 1320 | set idx_file [$ht_tree index root-files] |
|---|
| 1321 | if { [$ht_tree entry isopen $idx_file] } { |
|---|
| 1322 | $ht_tree close $idx_file |
|---|
| 1323 | set open 1 |
|---|
| 1324 | } |
|---|
| 1325 | if { [$ht_tree index focus] == $idx_file } { |
|---|
| 1326 | SelectObject |
|---|
| 1327 | } |
|---|
| 1328 | if $open { |
|---|
| 1329 | $ht_tree open $idx_file |
|---|
| 1330 | } |
|---|
| 1331 | } |
|---|
| 1332 | |
|---|
| 1333 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1334 | proc ::TolInspector::UpdateConsoleObj { } { |
|---|
| 1335 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1336 | variable ht_tree |
|---|
| 1337 | |
|---|
| 1338 | set idx_con [$ht_tree index root-console] |
|---|
| 1339 | if { [$ht_tree entry isopen $idx_con] } { |
|---|
| 1340 | $ht_tree close $idx_con |
|---|
| 1341 | } |
|---|
| 1342 | $ht_tree selection anchor root-console |
|---|
| 1343 | $ht_tree selection mark root-console |
|---|
| 1344 | #Tolcon_Trace "Abierto el nodo root-console" |
|---|
| 1345 | if { [$ht_tree index focus] == $idx_con } { |
|---|
| 1346 | SelectObject |
|---|
| 1347 | } |
|---|
| 1348 | } |
|---|
| 1349 | |
|---|
| 1350 | |
|---|
| 1351 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1352 | proc ::TolInspector::UpdatePoolObj { } { |
|---|
| 1353 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1354 | variable ht_tree |
|---|
| 1355 | |
|---|
| 1356 | set idx_pool [$ht_tree index root-pool] |
|---|
| 1357 | if { [$ht_tree entry isopen $idx_pool] } { |
|---|
| 1358 | $ht_tree close $idx_pool |
|---|
| 1359 | } |
|---|
| 1360 | if { [$ht_tree index focus] == $idx_pool } { |
|---|
| 1361 | SelectObject |
|---|
| 1362 | } |
|---|
| 1363 | } |
|---|
| 1364 | |
|---|
| 1365 | |
|---|
| 1366 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1367 | proc ::TolInspector::SelectObject { } { |
|---|
| 1368 | # |
|---|
| 1369 | # PURPOSE: Script called each time a node in ht_tree (left treeview) is |
|---|
| 1370 | # selected. |
|---|
| 1371 | # |
|---|
| 1372 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1373 | |
|---|
| 1374 | #Tolcon_Trace "LLAMADA A SELECTOBJECT" |
|---|
| 1375 | variable w_tabset |
|---|
| 1376 | variable ht_tree |
|---|
| 1377 | #variable set_type "" |
|---|
| 1378 | variable tolset |
|---|
| 1379 | variable tolindex |
|---|
| 1380 | #variable closing |
|---|
| 1381 | variable node_prefix "" |
|---|
| 1382 | variable data |
|---|
| 1383 | variable knownReference "" |
|---|
| 1384 | |
|---|
| 1385 | set index [$ht_tree index anchor] |
|---|
| 1386 | |
|---|
| 1387 | if { ![string length $index] } { |
|---|
| 1388 | ClearHiertables |
|---|
| 1389 | return |
|---|
| 1390 | } |
|---|
| 1391 | ClearHiertables |
|---|
| 1392 | |
|---|
| 1393 | set path [ $ht_tree get -full $index ] |
|---|
| 1394 | set tolset "" |
|---|
| 1395 | if { $index } { |
|---|
| 1396 | #puts "SelectObject index = $index" |
|---|
| 1397 | #puts "SelectObject: full = $path" |
|---|
| 1398 | set info_node [split [lindex $path end] "-"] ;# ojo si el path tiene - |
|---|
| 1399 | set node_type [lindex $info_node 0] |
|---|
| 1400 | set node_name [lindex $info_node 1] |
|---|
| 1401 | #puts "SelectObject: info_node = $info_node" |
|---|
| 1402 | } else { |
|---|
| 1403 | set node_type root |
|---|
| 1404 | set node_name root |
|---|
| 1405 | } |
|---|
| 1406 | |
|---|
| 1407 | Busy |
|---|
| 1408 | #puts "SelectObject: node_type = $node_type, node_name = $node_name" |
|---|
| 1409 | switch -regexp $node_type { |
|---|
| 1410 | root { |
|---|
| 1411 | switch $node_name { |
|---|
| 1412 | root - |
|---|
| 1413 | grammars { |
|---|
| 1414 | ClearHiertables |
|---|
| 1415 | #$w_tabset tab configure Variables -state disabled |
|---|
| 1416 | #$w_tabset tab configure Functions -state disabled |
|---|
| 1417 | } |
|---|
| 1418 | package { |
|---|
| 1419 | puts "implementa el llenado del panel derecho" |
|---|
| 1420 | } |
|---|
| 1421 | files { |
|---|
| 1422 | SelectFileRoot |
|---|
| 1423 | } |
|---|
| 1424 | console { |
|---|
| 1425 | SelectConsoleRoot |
|---|
| 1426 | } |
|---|
| 1427 | pool { |
|---|
| 1428 | SelectPoolRoot |
|---|
| 1429 | } |
|---|
| 1430 | } |
|---|
| 1431 | } |
|---|
| 1432 | grammar { |
|---|
| 1433 | SelectGrammar |
|---|
| 1434 | } |
|---|
| 1435 | default { |
|---|
| 1436 | set node_prefix $node_type |
|---|
| 1437 | #puts "SelectObject: node_prefix = $node_prefix" |
|---|
| 1438 | if { $node_type eq "package" } { |
|---|
| 1439 | foreach {tolset tolindex} [ getPackageReference $path ] break |
|---|
| 1440 | } elseif {[regexp -- "pool" $node_type]} { |
|---|
| 1441 | set tolset $data(pool,reference,[lindex $node_type 0]) |
|---|
| 1442 | #puts "SelectObject: Spool: tolset=$tolset, info_node=$info_node" |
|---|
| 1443 | if { [llength $info_node] == 1 } { |
|---|
| 1444 | set tolindex [lrange $tolset 1 end] |
|---|
| 1445 | set tolset [lindex $tolset 0] |
|---|
| 1446 | } else { |
|---|
| 1447 | #set tolindex [lrange $tolset 1 end] |
|---|
| 1448 | #set tolset [lindex $tolset 0] |
|---|
| 1449 | #lappend tolindex [lindex $info_node end] |
|---|
| 1450 | set tolindex [lrange $info_node 1 end] |
|---|
| 1451 | if {[lindex $tolset 0] eq "Console"} { |
|---|
| 1452 | set tolset [lindex $tolset 0] |
|---|
| 1453 | } else { |
|---|
| 1454 | set tolset [lrange $tolset 0 1] |
|---|
| 1455 | } |
|---|
| 1456 | } |
|---|
| 1457 | } elseif {[regexp -- "console(.+)" $node_type --> idx_con]} { |
|---|
| 1458 | #puts "SelectObject: Console: tolset=$tolset info_node=$info_node idx_con=$idx_con" |
|---|
| 1459 | set tolset "Console" |
|---|
| 1460 | #set idx [$ht_tree find -name $node_type] |
|---|
| 1461 | #array set aryData [$ht_tree entry cget $idx -data] |
|---|
| 1462 | #set tolindex [eval list $aryData(FileName) [lrange $info_node 1 end]] |
|---|
| 1463 | if {[llength $info_node] == 1} { |
|---|
| 1464 | set tolindex $idx_con |
|---|
| 1465 | } else { |
|---|
| 1466 | set tolindex [lrange $info_node 1 end] |
|---|
| 1467 | #set tolindex [concat [list $idx_con] $tolindex] |
|---|
| 1468 | } |
|---|
| 1469 | } else { |
|---|
| 1470 | set idx [$ht_tree find -name $node_type] |
|---|
| 1471 | array set aryData [$ht_tree entry cget $idx -data] |
|---|
| 1472 | #puts "SelectObject: FileName=$aryData(FileName) info_node=$info_node" |
|---|
| 1473 | set tolset [list File $aryData(FileName)] |
|---|
| 1474 | set tolindex [lrange $info_node 1 end] |
|---|
| 1475 | #set tolindex [lrange $info_node 2 end] |
|---|
| 1476 | } |
|---|
| 1477 | #puts "SelectObject end: tolset=$tolset, tolindex=$tolindex" |
|---|
| 1478 | SelectSet |
|---|
| 1479 | } |
|---|
| 1480 | } |
|---|
| 1481 | NotBusy |
|---|
| 1482 | } |
|---|
| 1483 | |
|---|
| 1484 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1485 | proc ::TolInspector::SelectFileRoot { } { |
|---|
| 1486 | # |
|---|
| 1487 | # PURPOSE: Script called each time 'Included Files' node in ht_tree is |
|---|
| 1488 | # selected. Gets information about each node that must be in |
|---|
| 1489 | # included files, and inserts it in the right treeview. |
|---|
| 1490 | # |
|---|
| 1491 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1492 | variable item_id 1 |
|---|
| 1493 | variable w_tabset |
|---|
| 1494 | variable knownReference "" |
|---|
| 1495 | |
|---|
| 1496 | ClearHiertables |
|---|
| 1497 | $w_tabset tab configure Variables -text [mc Files] |
|---|
| 1498 | # $w_tabset tab configure Functions -state disabled |
|---|
| 1499 | $w_tabset select 0 |
|---|
| 1500 | foreach f [lreverse [::tol::info included]] { |
|---|
| 1501 | # this catch is needed because info include could return files not |
|---|
| 1502 | # realy included. |
|---|
| 1503 | if { [ catch { ::tol::info included $f } fi ] } continue |
|---|
| 1504 | # tener en cuenta el subtype cuando lo retorne |
|---|
| 1505 | set knownReference [ list "File" $f ] |
|---|
| 1506 | InsertChild Set $f \ |
|---|
| 1507 | [lindex $fi 0] [lindex $fi 1] [list [lindex $fi 2]] $item_id 1 [lindex $fi 3] [lindex $fi 4] |
|---|
| 1508 | } |
|---|
| 1509 | } |
|---|
| 1510 | |
|---|
| 1511 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1512 | proc ::TolInspector::SelectConsoleRoot { } { |
|---|
| 1513 | # |
|---|
| 1514 | # PURPOSE: Script called each time 'Console Objects' node in ht_tree is |
|---|
| 1515 | # selected. Gets information about each node that must be in console, |
|---|
| 1516 | # and inserts it in the right treeview. |
|---|
| 1517 | # |
|---|
| 1518 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1519 | variable w_tabset |
|---|
| 1520 | variable ht_vars |
|---|
| 1521 | variable ht_funcs |
|---|
| 1522 | variable item_id 1 |
|---|
| 1523 | variable iterSet "Console" |
|---|
| 1524 | variable knownReference "" |
|---|
| 1525 | |
|---|
| 1526 | ClearHiertables |
|---|
| 1527 | #(pgea) se quita la linea que oculta la columna del indice y que |
|---|
| 1528 | #(pgea) el procedimimento anterior ClearHiertables muestra |
|---|
| 1529 | # $ht_vars column configure Index -hide yes |
|---|
| 1530 | # $w_tabset tab configure Functions -state disabled |
|---|
| 1531 | |
|---|
| 1532 | foreach co [::tol::console stack list] { |
|---|
| 1533 | #puts "SelectConsoleRoot: co = $co" |
|---|
| 1534 | set gra [lindex $co 0] |
|---|
| 1535 | set name [lindex $co 1] |
|---|
| 1536 | set cont [lindex $co 2] |
|---|
| 1537 | set path [lindex $co 3] |
|---|
| 1538 | set desc [lindex $co 4] |
|---|
| 1539 | set knownReference [ list Console $item_id ] |
|---|
| 1540 | switch [lindex $co 0 ] { |
|---|
| 1541 | Code { |
|---|
| 1542 | InsertChild $gra $name $cont $path [list $desc] 0 |
|---|
| 1543 | } |
|---|
| 1544 | NameBlock - |
|---|
| 1545 | Set { |
|---|
| 1546 | #puts "switch: SelectConsoleRoot $gra" |
|---|
| 1547 | InsertChild $gra $name $cont $path [list $desc] \ |
|---|
| 1548 | $item_id [lindex $co 5] [lindex $co 6] [lindex $co 7] \ |
|---|
| 1549 | [list Reference [list "Console" $item_id]] |
|---|
| 1550 | } |
|---|
| 1551 | default { |
|---|
| 1552 | InsertChild $gra $name $cont $path [list $desc] \ |
|---|
| 1553 | [list Reference [list "Console" $item_id]] |
|---|
| 1554 | } |
|---|
| 1555 | } |
|---|
| 1556 | } |
|---|
| 1557 | set knownReference "" |
|---|
| 1558 | } |
|---|
| 1559 | |
|---|
| 1560 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1561 | proc ::TolInspector::SelectPoolRoot { } { |
|---|
| 1562 | # |
|---|
| 1563 | # PURPOSE: Script called each time 'Spool Objects' node in ht_tree is |
|---|
| 1564 | # selected. Gets information about each node that must be in pool, |
|---|
| 1565 | # and inserts it in the right treeview. |
|---|
| 1566 | # |
|---|
| 1567 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1568 | variable w_tabset |
|---|
| 1569 | variable ht_vars |
|---|
| 1570 | variable data |
|---|
| 1571 | variable item_id 1 |
|---|
| 1572 | variable knownReference "" |
|---|
| 1573 | |
|---|
| 1574 | ClearHiertables |
|---|
| 1575 | $ht_vars column configure Index -hide yes |
|---|
| 1576 | |
|---|
| 1577 | array unset data pool,variables,* |
|---|
| 1578 | # Para cada uno de los objetos que debe haber en el spool |
|---|
| 1579 | # busco la información del nodo y lo inserto en el treeview de la derecha |
|---|
| 1580 | foreach _obj $data(pool,objects) { |
|---|
| 1581 | array set obj $_obj |
|---|
| 1582 | #Si la referencia del objeto tiene espacios en la ruta, el |
|---|
| 1583 | # llength me darÃa > 1, por eso añado la 2ª parte de la condicion |
|---|
| 1584 | #puts "SelectPoolRoot: obj(grammar)=$obj(grammar) obj(objName)=$obj(objName) obj(reference)=$obj(reference)" |
|---|
| 1585 | if { ([llength $obj(reference)] > 1) && ![string equal $obj(reference) $obj(objName)]} { |
|---|
| 1586 | if {$obj(grammar) eq "Code"} { |
|---|
| 1587 | set infoObj [concat [list $obj(grammar) $obj(objName)] \ |
|---|
| 1588 | [::tol::info function $obj(reference)]] |
|---|
| 1589 | } else { |
|---|
| 1590 | set infoObj [::tol::info variable $obj(reference)] |
|---|
| 1591 | } |
|---|
| 1592 | #Tolcon_Trace "tol info (var|function) reference" |
|---|
| 1593 | } else { |
|---|
| 1594 | if {[catch { set infoObj [concat [list "Set" $obj(reference)] \ |
|---|
| 1595 | [::tol::info included $obj(reference)]] }]} { |
|---|
| 1596 | if {$obj(grammar) eq "Code"} { |
|---|
| 1597 | set infoObj [concat [list $obj(grammar) $obj(reference)] \ |
|---|
| 1598 | [::tol::info function $obj(graApply) $obj(reference)]] |
|---|
| 1599 | } else { |
|---|
| 1600 | #set infoObj [concat [list $obj(grammar) $obj(reference)] \ |
|---|
| 1601 | # [::tol::info variable $obj(grammar) $obj(reference)]] |
|---|
| 1602 | set infoObj [::tol::info variable [list $obj(grammar) $obj(reference)]] |
|---|
| 1603 | } |
|---|
| 1604 | #Tolcon_Trace "tol info (var|function) Grammar nameGlobal" |
|---|
| 1605 | } else { |
|---|
| 1606 | # Insertamos el 1 de isFile |
|---|
| 1607 | set infoObj [linsert $infoObj 5 1] |
|---|
| 1608 | #Tolcon_Trace "tol info included" |
|---|
| 1609 | } |
|---|
| 1610 | } |
|---|
| 1611 | #Tolcon_Trace "INFOOBJ: $infoObj" |
|---|
| 1612 | set gra [lindex $infoObj 0] |
|---|
| 1613 | set name [lindex $infoObj 1] |
|---|
| 1614 | set cont [lindex $infoObj 2] |
|---|
| 1615 | set path [lindex $infoObj 3] |
|---|
| 1616 | set desc [lindex $infoObj 4] |
|---|
| 1617 | set data(pool,variables,$item_id) $obj(reference) |
|---|
| 1618 | |
|---|
| 1619 | switch $gra { |
|---|
| 1620 | Code { |
|---|
| 1621 | InsertChild $gra $name $cont $path [list $desc] 0 "Reference $obj(reference)" |
|---|
| 1622 | } |
|---|
| 1623 | Set - |
|---|
| 1624 | NameBlock { |
|---|
| 1625 | set knownReference $obj(reference) |
|---|
| 1626 | InsertChild $gra $name $cont $path [list $desc] \ |
|---|
| 1627 | $item_id [lindex $infoObj 5] [lindex $infoObj 6] [lindex $infoObj 7] "Reference $obj(reference)" |
|---|
| 1628 | set knownReference "" |
|---|
| 1629 | } |
|---|
| 1630 | default { |
|---|
| 1631 | InsertChild $gra $name $cont $path [list $desc] "Reference $obj(reference)" |
|---|
| 1632 | } |
|---|
| 1633 | } |
|---|
| 1634 | } |
|---|
| 1635 | } |
|---|
| 1636 | |
|---|
| 1637 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1638 | proc ::TolInspector::SelectGrammar { } { |
|---|
| 1639 | # |
|---|
| 1640 | # PURPOSE: Script called each time a Grammar node in ht_tree is selected. Gets |
|---|
| 1641 | # information about each var and function of this grammar, and |
|---|
| 1642 | # inserts them in the right treeview. |
|---|
| 1643 | # |
|---|
| 1644 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1645 | variable w_tabset |
|---|
| 1646 | variable ht_tree |
|---|
| 1647 | variable ht_vars |
|---|
| 1648 | variable ht_funcs |
|---|
| 1649 | variable item_id 1 |
|---|
| 1650 | variable OnSelectItem |
|---|
| 1651 | variable knownReference |
|---|
| 1652 | |
|---|
| 1653 | set knownReference "" |
|---|
| 1654 | ClearHiertables |
|---|
| 1655 | $ht_vars column configure Index -hide yes |
|---|
| 1656 | $ht_funcs column configure Index -hide yes |
|---|
| 1657 | set grammar [$ht_tree entry cget anchor -label] |
|---|
| 1658 | if { [string compare $grammar "Anything"] } { |
|---|
| 1659 | if { [string length $OnSelectItem] } { |
|---|
| 1660 | $OnSelectItem [::tol::info grammars $grammar] |
|---|
| 1661 | } |
|---|
| 1662 | foreach var [::tol::info variables $grammar] { |
|---|
| 1663 | if {[catch { |
|---|
| 1664 | set vinfo [::tol::info variables [list $grammar $var]] |
|---|
| 1665 | } msg]} { |
|---|
| 1666 | Tol_HciWriter "<E>in ::TolInspector::SelectGrammar : $msg\n</E>" |
|---|
| 1667 | continue |
|---|
| 1668 | } |
|---|
| 1669 | if { [string equal $grammar "Code"] } { |
|---|
| 1670 | #Tolcon_Trace "Code : -- $vinfo --" |
|---|
| 1671 | InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] 1 |
|---|
| 1672 | } elseif { $grammar eq "Set" || $grammar eq "NameBlock" } { |
|---|
| 1673 | #Tolcon_Trace "Set : -- $vinfo --" |
|---|
| 1674 | set knownReference [ list $grammar $var ] |
|---|
| 1675 | InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] \ |
|---|
| 1676 | $item_id [lindex $vinfo 5] [lindex $vinfo 6] [lindex $vinfo 7] |
|---|
| 1677 | } else { |
|---|
| 1678 | InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] $item_id 0 |
|---|
| 1679 | } |
|---|
| 1680 | } |
|---|
| 1681 | } else { |
|---|
| 1682 | # $w_tabset tab configure Variables -state disabled |
|---|
| 1683 | # $w_tabset select 1 |
|---|
| 1684 | } |
|---|
| 1685 | foreach fun [::tol::info functions $grammar] { |
|---|
| 1686 | set finfo [::tol::info functions $grammar $fun] |
|---|
| 1687 | InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0 |
|---|
| 1688 | } |
|---|
| 1689 | } |
|---|
| 1690 | |
|---|
| 1691 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1692 | proc ::TolInspector::SelectSet { } { |
|---|
| 1693 | # |
|---|
| 1694 | # PURPOSE: Script called each time a Set node in ht_tree is selected. Gets |
|---|
| 1695 | # information about each child of this set, and inserts it in the |
|---|
| 1696 | # right treeview. |
|---|
| 1697 | # |
|---|
| 1698 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1699 | variable ht_tree |
|---|
| 1700 | variable ht_vars |
|---|
| 1701 | variable ht_funcs |
|---|
| 1702 | |
|---|
| 1703 | variable tolset |
|---|
| 1704 | variable tolindex |
|---|
| 1705 | variable iterSet |
|---|
| 1706 | variable var_id 1 |
|---|
| 1707 | variable fun_id 1 |
|---|
| 1708 | variable item_id |
|---|
| 1709 | #variable selecting_set |
|---|
| 1710 | |
|---|
| 1711 | # if { $selecting_set } { |
|---|
| 1712 | #puts "eoooo ..." |
|---|
| 1713 | # return |
|---|
| 1714 | # } |
|---|
| 1715 | ClearHiertables |
|---|
| 1716 | # set selecting_set 1 |
|---|
| 1717 | set item_id 1 |
|---|
| 1718 | |
|---|
| 1719 | #puts "SelectSet: tolset=$tolset tolindex=$tolindex" |
|---|
| 1720 | set iterSet [eval list $tolset $tolindex] |
|---|
| 1721 | variable gra_parent [ GetParentGrammar $iterSet ] |
|---|
| 1722 | ::tol::forallchild $iterSet ::TolInspector::_InsertChild |
|---|
| 1723 | # set selecting_set 0 |
|---|
| 1724 | } |
|---|
| 1725 | |
|---|
| 1726 | proc ::TolInspector::GetParentGrammar { set_ref } { |
|---|
| 1727 | set root [ lindex $set_ref 0 ] |
|---|
| 1728 | set L [ llength $set_ref ] |
|---|
| 1729 | if { ( $root eq "File" && $L <= 2 ) } { |
|---|
| 1730 | set root |
|---|
| 1731 | } else { |
|---|
| 1732 | lindex [ tol::info var $set_ref ] 0 |
|---|
| 1733 | } |
|---|
| 1734 | } |
|---|
| 1735 | |
|---|
| 1736 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1737 | proc ::TolInspector::CloseObject { index } { |
|---|
| 1738 | # |
|---|
| 1739 | # PURPOSE: Script called each time a node in ht_tree (left treeview) is |
|---|
| 1740 | # closed. |
|---|
| 1741 | # |
|---|
| 1742 | # PARAMETERS: |
|---|
| 1743 | # index : The id of the node closed |
|---|
| 1744 | # |
|---|
| 1745 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1746 | variable ht_tree |
|---|
| 1747 | #variable closing 1 |
|---|
| 1748 | set path [$ht_tree get -full $index] |
|---|
| 1749 | if { $index } { |
|---|
| 1750 | set parent1 [lindex $path 1] |
|---|
| 1751 | if { [string equal $parent1 "root-packages"] || |
|---|
| 1752 | [string equal $parent1 "root-files"] || |
|---|
| 1753 | [string equal $parent1 "root-console"] || |
|---|
| 1754 | [string equal $parent1 "root-pool"] } { |
|---|
| 1755 | $ht_tree entry delete $index 0 end |
|---|
| 1756 | } |
|---|
| 1757 | } |
|---|
| 1758 | } |
|---|
| 1759 | |
|---|
| 1760 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1761 | proc ::TolInspector::HasSubset { args } { |
|---|
| 1762 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1763 | if { [string equal [lindex $args 0] "Set"] } { |
|---|
| 1764 | variable has_button 1 |
|---|
| 1765 | return 0 |
|---|
| 1766 | } |
|---|
| 1767 | return 1 |
|---|
| 1768 | } |
|---|
| 1769 | |
|---|
| 1770 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1771 | proc ::TolInspector::OpenVariable { index } { |
|---|
| 1772 | # |
|---|
| 1773 | # PURPOSE: ???? |
|---|
| 1774 | # |
|---|
| 1775 | # PARAMETERS: |
|---|
| 1776 | # index -> |
|---|
| 1777 | # |
|---|
| 1778 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1779 | variable tolset ;# Name of the current TOL set variable |
|---|
| 1780 | variable ht_vars ;# ::blt::treeview of variables |
|---|
| 1781 | variable ht_tree ;# ::blt::treeview left |
|---|
| 1782 | variable blt_tree ;# ::blt::tree left |
|---|
| 1783 | variable item_data ;# Array to hold the full content & description of items |
|---|
| 1784 | |
|---|
| 1785 | if { ![string length $index] } { |
|---|
| 1786 | return |
|---|
| 1787 | } |
|---|
| 1788 | set node_anchor [lindex [$ht_tree get -full anchor] end] |
|---|
| 1789 | |
|---|
| 1790 | set tree_index -1 |
|---|
| 1791 | #puts "OpenVariable = $item_data([lindex [$ht_vars entry cget $index -data] end])" |
|---|
| 1792 | if { ![regexp -- "grammar-" $node_anchor] } { |
|---|
| 1793 | set grammar [lindex $item_data([lindex [$ht_vars entry cget $index -data] end]) 2] |
|---|
| 1794 | if {$grammar eq "Set" || $grammar eq "NameBlock"} { |
|---|
| 1795 | $ht_tree open anchor |
|---|
| 1796 | #puts "full = [$ht_vars get -full $index]" |
|---|
| 1797 | set local_name [lindex [$ht_vars get -full $index] end] |
|---|
| 1798 | set idx_anchor [$ht_tree index anchor] |
|---|
| 1799 | #puts "a buscar $local_name dentro de $idx_anchor" |
|---|
| 1800 | if {[set tree_index [$blt_tree findchild $idx_anchor $local_name]] == -1} { |
|---|
| 1801 | foreach idx [$ht_tree entry children anchor] { |
|---|
| 1802 | if { [string equal $local_name [lindex [$ht_tree get -full $idx] end]] } { |
|---|
| 1803 | set tree_index $idx |
|---|
| 1804 | break |
|---|
| 1805 | } |
|---|
| 1806 | } |
|---|
| 1807 | } |
|---|
| 1808 | } |
|---|
| 1809 | } |
|---|
| 1810 | if { $tree_index != -1 } { |
|---|
| 1811 | update |
|---|
| 1812 | blt::tv::SetSelectionAnchor $ht_tree $tree_index |
|---|
| 1813 | set blt::tv::scroll 1 |
|---|
| 1814 | #$ht_tree selection clearall |
|---|
| 1815 | #$ht_tree see $tree_index |
|---|
| 1816 | #$ht_tree focus $tree_index |
|---|
| 1817 | #$ht_tree selection set $tree_index |
|---|
| 1818 | #$ht_tree selection anchor $tree_index |
|---|
| 1819 | #set blt::Hiertable::scroll 1 |
|---|
| 1820 | } |
|---|
| 1821 | } |
|---|
| 1822 | |
|---|
| 1823 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1824 | proc ::TolInspector::SelectItem { ht } { |
|---|
| 1825 | # |
|---|
| 1826 | # PURPOSE: Procedure that is executed when the user selects an element of |
|---|
| 1827 | # the trees of variables orfunctions. |
|---|
| 1828 | # First it take all the arguments necessary of the node of tree to |
|---|
| 1829 | # execute the procedure stored in the variable OnSelectItem, and |
|---|
| 1830 | # later executes it passing those arguments. |
|---|
| 1831 | # |
|---|
| 1832 | # PARAMETERS: path of ht_* (::blt::treeview of variables or of functions) |
|---|
| 1833 | # |
|---|
| 1834 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1835 | # variable w_text ;# TODO: ???? |
|---|
| 1836 | variable OnSelectItem ;#Command to invoke on SelectItem in ht_* |
|---|
| 1837 | variable item_data ;# Array to hold the full content & description of items |
|---|
| 1838 | |
|---|
| 1839 | set entry [$ht index anchor] ;# id of entry selected |
|---|
| 1840 | if { [string length $OnSelectItem] } { |
|---|
| 1841 | # there are associated command |
|---|
| 1842 | if { [string length $entry] } { |
|---|
| 1843 | # almost one entry of ht_* selected |
|---|
| 1844 | array set aryData [$ht entry cget $entry -data] |
|---|
| 1845 | set name [$ht entry cget $entry -label] ;# name of item |
|---|
| 1846 | set itemid $aryData(Index) ;# id of item |
|---|
| 1847 | set path $aryData(Path) ;# path of file of item |
|---|
| 1848 | #(pgea) se anyade la propiedad Reference |
|---|
| 1849 | set objRef $aryData(Reference) ;# info of item |
|---|
| 1850 | set full_data $item_data($itemid) ;# {value} {desc} {grammar} |
|---|
| 1851 | set value [lindex $full_data 0] ;# value of item PE: |
|---|
| 1852 | # Anything Field(Set s, Text nombre) |
|---|
| 1853 | |
|---|
| 1854 | if { [string equal \"\n\" $value] } { |
|---|
| 1855 | # hasn't value |
|---|
| 1856 | set value {"\n"} |
|---|
| 1857 | } else { |
|---|
| 1858 | set value [string trim $value] |
|---|
| 1859 | } |
|---|
| 1860 | set desc [string trim [lindex $full_data 1]] |
|---|
| 1861 | set grammar [lindex $full_data 2] |
|---|
| 1862 | set icon [lindex [$ht entry cget $entry -icons] 0] |
|---|
| 1863 | #(pgea) lista de argumentos que recibe ::TolConsole::OnInfo |
|---|
| 1864 | set args [list $icon $grammar $name $value $path $desc $objRef] |
|---|
| 1865 | } else { |
|---|
| 1866 | set args "" |
|---|
| 1867 | } |
|---|
| 1868 | eval "$OnSelectItem $args" |
|---|
| 1869 | } |
|---|
| 1870 | return |
|---|
| 1871 | #;# TODO: ???? |
|---|
| 1872 | # if { [string length $entry] } { |
|---|
| 1873 | # FillText $ht $entry |
|---|
| 1874 | # } else { |
|---|
| 1875 | # $w_text delete 1.0 end |
|---|
| 1876 | # } |
|---|
| 1877 | } |
|---|
| 1878 | |
|---|
| 1879 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1880 | #(pgea) se usa? |
|---|
| 1881 | proc ::TolInspector::FillText { ht entry } { |
|---|
| 1882 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1883 | variable w_text |
|---|
| 1884 | variable item_data |
|---|
| 1885 | #upvar #0 ::TolTk::Images Images |
|---|
| 1886 | |
|---|
| 1887 | $w_text delete 1.0 end |
|---|
| 1888 | array set aryData [$ht entry cget $entry -data] |
|---|
| 1889 | set name [$ht entry cget $entry -label] |
|---|
| 1890 | set itemid $aryData(Index) |
|---|
| 1891 | set full_data $item_data($itemid) |
|---|
| 1892 | |
|---|
| 1893 | set value [lindex $full_data 0] |
|---|
| 1894 | if { [string equal \"\n\" $value] } { |
|---|
| 1895 | set value {"\n"} |
|---|
| 1896 | } |
|---|
| 1897 | set desc [string trim [lindex $full_data 1]] |
|---|
| 1898 | set grammar [lindex $full_data 2] |
|---|
| 1899 | set icon [lindex [$ht entry cget $entry -icons] 0] |
|---|
| 1900 | foreach {prop val} [list "Grammar: " $grammar "Name: " $name "Value: " [string trim $value]] { |
|---|
| 1901 | set idx_start [$w_text index "end -1 chars"] |
|---|
| 1902 | $w_text insert end $prop |
|---|
| 1903 | set idx_end [$w_text index "end -1 chars"] |
|---|
| 1904 | $w_text tag add tagLabel $idx_start $idx_end |
|---|
| 1905 | if {[string equal $prop "Grammar: "]} { |
|---|
| 1906 | $w_text image create end -image $icon |
|---|
| 1907 | $w_text insert end " " |
|---|
| 1908 | } |
|---|
| 1909 | $w_text insert end "$val\n" |
|---|
| 1910 | $w_text tag add tagValue $idx_end [$w_text index "end -1 chars"] |
|---|
| 1911 | } |
|---|
| 1912 | $w_text tag configure tagLabel -font fnBold |
|---|
| 1913 | $w_text tag configure tagValue -wrap none |
|---|
| 1914 | if { [string length $desc] } { |
|---|
| 1915 | set idx_start [$w_text index "end -1 chars"] |
|---|
| 1916 | $w_text insert end "Description\n" |
|---|
| 1917 | set idx_end [$w_text index "end -1 chars"] |
|---|
| 1918 | $w_text tag add tagPropLabel $idx_start $idx_end |
|---|
| 1919 | $w_text insert end $desc |
|---|
| 1920 | $w_text tag add tagPropValue $idx_end [$w_text index "end -1 chars"] |
|---|
| 1921 | $w_text tag configure tagPropLabel -font fnBold -underline 1 |
|---|
| 1922 | $w_text tag configure tagPropValue -wrap word |
|---|
| 1923 | } |
|---|
| 1924 | } |
|---|
| 1925 | |
|---|
| 1926 | #proc ::TolInspector::GetIndexes { nodeid } { |
|---|
| 1927 | # variable ht_tree |
|---|
| 1928 | # # No se utiliza |
|---|
| 1929 | # # name is prefix-i1-i2-i3-...-in |
|---|
| 1930 | # |
|---|
| 1931 | # if { $nodeid } { |
|---|
| 1932 | # lrange [split [$ht_tree get $nodeid] "-"] 1 end |
|---|
| 1933 | # } else list |
|---|
| 1934 | #} |
|---|
| 1935 | |
|---|
| 1936 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1937 | proc ::TolInspector::GetItemName { prefix idx_list } { |
|---|
| 1938 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1939 | set node_id $prefix |
|---|
| 1940 | foreach id $idx_list { |
|---|
| 1941 | append node_id "-$id" |
|---|
| 1942 | } |
|---|
| 1943 | set node_id |
|---|
| 1944 | } |
|---|
| 1945 | |
|---|
| 1946 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1947 | proc ::TolInspector::OnBusy { cmd } { |
|---|
| 1948 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1949 | variable OnBusyCmd $cmd |
|---|
| 1950 | } |
|---|
| 1951 | |
|---|
| 1952 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1953 | proc ::TolInspector::Busy { } { |
|---|
| 1954 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1955 | variable OnBusyCmd |
|---|
| 1956 | variable ht_tree |
|---|
| 1957 | variable ht_vars |
|---|
| 1958 | |
|---|
| 1959 | $ht_tree configure -cursor watch |
|---|
| 1960 | $ht_vars configure -cursor watch |
|---|
| 1961 | if { [string length $OnBusyCmd] } { |
|---|
| 1962 | eval $OnBusyCmd 1 |
|---|
| 1963 | } |
|---|
| 1964 | } |
|---|
| 1965 | |
|---|
| 1966 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1967 | proc ::TolInspector::NotBusy { } { |
|---|
| 1968 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 1969 | variable OnBusyCmd |
|---|
| 1970 | variable ht_tree |
|---|
| 1971 | variable ht_vars |
|---|
| 1972 | |
|---|
| 1973 | $ht_tree configure -cursor "" |
|---|
| 1974 | $ht_vars configure -cursor "" |
|---|
| 1975 | |
|---|
| 1976 | if { [string length $OnBusyCmd] } { |
|---|
| 1977 | eval $OnBusyCmd 0 |
|---|
| 1978 | } |
|---|
| 1979 | } |
|---|
| 1980 | |
|---|
| 1981 | proc Tol_GetViewPrivateMembers { } { |
|---|
| 1982 | set viewOpt 0 |
|---|
| 1983 | catch { |
|---|
| 1984 | # no funciona |
|---|
| 1985 | tol::console eval { |
|---|
| 1986 | Real __getViewPrivateMembers_tmp__ = |
|---|
| 1987 | TolConfigManager::Config::Various::View::PrivateMembers; |
|---|
| 1988 | } |
|---|
| 1989 | set x [ lindex [ tol::info variable { Real __getViewPrivateMembers_tmp__ } ] 2 ] |
|---|
| 1990 | tol::console stack release __getViewPrivateMembers_tmp__ |
|---|
| 1991 | set viewOpt [ expr { int( $x ) } ] |
|---|
| 1992 | |
|---|
| 1993 | } msg |
|---|
| 1994 | #puts "Tol_GetViewPrivateMembers: $msg" |
|---|
| 1995 | return $viewOpt |
|---|
| 1996 | } |
|---|
| 1997 | |
|---|
| 1998 | proc Tol_ObjIsClassOf { obj_addr cls_name } { |
|---|
| 1999 | tol::console eval [ string map [ list %A $obj_addr %C $cls_name ] { |
|---|
| 2000 | Real __gui_check__ = IsInstanceOf( GetObjectFromAddress( "%A" ),"%C" ) |
|---|
| 2001 | } ] |
|---|
| 2002 | set info [ tol::info variable {Real __gui_check__} ] |
|---|
| 2003 | set x [ lindex $info 2 ] |
|---|
| 2004 | tol::console stack release __gui_check__ |
|---|
| 2005 | expr { round($x) } |
|---|
| 2006 | } |
|---|
| 2007 | |
|---|
| 2008 | proc Tol_ClassOf { obj_addr } { |
|---|
| 2009 | tol::console eval [ string map [ list %A $obj_addr ] { |
|---|
| 2010 | Text __gui_classof__ = { |
|---|
| 2011 | Anything obj = GetObjectFromAddress( "%A" ); |
|---|
| 2012 | // WriteLn( "Tol_ClassOf " << Grammar( obj ) ); |
|---|
| 2013 | Text If( Grammar( obj ) == "NameBlock", ClassOf( obj ), "" ) |
|---|
| 2014 | } |
|---|
| 2015 | } ] |
|---|
| 2016 | set info [ tol::info variable {Text __gui_classof__} ] |
|---|
| 2017 | set x [ string trim [ lindex $info 2 ] \" ] |
|---|
| 2018 | tol::console stack release __gui_classof__ |
|---|
| 2019 | set x |
|---|
| 2020 | } |
|---|
| 2021 | |
|---|
| 2022 | proc Tol_ClassOfFromReference { objReference } { |
|---|
| 2023 | set addr [ ::tol::info address $objReference ] |
|---|
| 2024 | return [ Tol_ClassOf $addr ] |
|---|
| 2025 | } |
|---|
| 2026 | |
|---|
| 2027 | proc Tol_StructOf { obj_addr } { |
|---|
| 2028 | set tolcode [ string map [ list %A $obj_addr ] { |
|---|
| 2029 | Text { |
|---|
| 2030 | Anything obj = GetObjectFromAddress( "%A" ); |
|---|
| 2031 | // WriteLn( "Tol_StructOf " << Grammar( obj ) ); |
|---|
| 2032 | Text If( Grammar( obj ) == "Set", StructName( obj ), "" ) |
|---|
| 2033 | } |
|---|
| 2034 | } ] |
|---|
| 2035 | return [ lindex [ toltcl::eval $tolcode ] 0 ] |
|---|
| 2036 | } |
|---|
| 2037 | |
|---|
| 2038 | proc Tol_StructOfFromReference { objReference } { |
|---|
| 2039 | # WATCH!!!! |
|---|
| 2040 | # when Tol_StructOfFromReference is invoken on {File xxx} xxx is |
|---|
| 2041 | # decompiled!!!! |
|---|
| 2042 | if { [ llength $objReference ] == 2 && |
|---|
| 2043 | [ lindex $objReference 0 ] eq "File" } { |
|---|
| 2044 | return "" |
|---|
| 2045 | } |
|---|
| 2046 | set addr [ ::tol::info address $objReference ] |
|---|
| 2047 | return [ Tol_StructOf $addr ] |
|---|
| 2048 | } |
|---|
| 2049 | |
|---|
| 2050 | #(pgea) nueva funcion para obtener la informacion de instancia |
|---|
| 2051 | proc Tol_InstanceInfo { obj_addr } { |
|---|
| 2052 | tol::console eval [ string map [ list %A $obj_addr ] { |
|---|
| 2053 | Text __gui_instanceinfo__ = { |
|---|
| 2054 | Anything __intance__ = GetObjectFromAddress("%A"); |
|---|
| 2055 | Text If(ObjectExist("Code", "__intance__::_.get.autodoc.info"), |
|---|
| 2056 | __intance__::_.get.autodoc.info(?), "") |
|---|
| 2057 | } |
|---|
| 2058 | } ] |
|---|
| 2059 | set info [ tol::info variable {Text __gui_instanceinfo__} ] |
|---|
| 2060 | set x [ string trim [ lindex $info 2 ] \" ] |
|---|
| 2061 | tol::console stack release __gui_instanceinfo__ |
|---|
| 2062 | set x |
|---|
| 2063 | } |
|---|
| 2064 | |
|---|
| 2065 | #(pgea) nueva funcion para obtener la informacion de instancia |
|---|
| 2066 | proc Tol_InstanceInfoFromReference { objReference } { |
|---|
| 2067 | set addr [ ::tol::info address $objReference ] |
|---|
| 2068 | return [ Tol_InstanceInfo $addr ] |
|---|
| 2069 | } |
|---|
| 2070 | |
|---|
| 2071 | #(pgea) nueva funcion para obtener el contenido de la instancia |
|---|
| 2072 | proc Tol_InstanceContent { obj_addr } { |
|---|
| 2073 | tol::console eval [ string map [ list %A $obj_addr ] { |
|---|
| 2074 | Text __gui_instancecontent__ = { |
|---|
| 2075 | Anything __intance__ = GetObjectFromAddress("%A"); |
|---|
| 2076 | Text If(ObjectExist("Code", "__intance__::_.get.autodoc.content"), |
|---|
| 2077 | __intance__::_.get.autodoc.content(?), "") |
|---|
| 2078 | } |
|---|
| 2079 | } ] |
|---|
| 2080 | set info [ tol::info variable {Text __gui_instancecontent__} ] |
|---|
| 2081 | set x [ string trim [ lindex $info 2 ] \" ] |
|---|
| 2082 | tol::console stack release __gui_instancecontent__ |
|---|
| 2083 | set x |
|---|
| 2084 | } |
|---|
| 2085 | |
|---|
| 2086 | #(pgea) nueva funcion para obtener el contenido de la instancia |
|---|
| 2087 | proc Tol_InstanceContentFromReference { objReference } { |
|---|
| 2088 | set addr [ ::tol::info address $objReference ] |
|---|
| 2089 | return [ Tol_InstanceContent $addr ] |
|---|
| 2090 | } |
|---|
| 2091 | |
|---|
| 2092 | proc TolGui_GetMenuEntries { selection idx } { |
|---|
| 2093 | #puts "TolGui_GetMenuEntries $selection $idx" |
|---|
| 2094 | array set instances {} |
|---|
| 2095 | array set menu_class {} |
|---|
| 2096 | set i 0 |
|---|
| 2097 | foreach obj_info $selection { |
|---|
| 2098 | set tcl_ref [ lindex $obj_info 0 ] |
|---|
| 2099 | set obj_addr [ ::tol::info address $tcl_ref ] |
|---|
| 2100 | if { [ Tol_ObjIsClassOf $obj_addr "GuiTools::@MenuDesc" ] } { |
|---|
| 2101 | set class [ Tol_ClassOf $obj_addr ] |
|---|
| 2102 | lappend instances($class) $obj_addr |
|---|
| 2103 | set name_inst [ lindex $obj_info 1 ] |
|---|
| 2104 | set menu_items [ TolGui_GetObjMenu $obj_addr ] |
|---|
| 2105 | # esto hace que estemos guardando la ultima instancia, asumimos |
|---|
| 2106 | # tambien que todas las instancia tienen la misma espcificacion |
|---|
| 2107 | # de menu |
|---|
| 2108 | if { ![ llength [ array names menu_class $class ] ] || $i == $idx } { |
|---|
| 2109 | set menu_class($class) \ |
|---|
| 2110 | [ list $name_inst $obj_addr $menu_items ] |
|---|
| 2111 | } |
|---|
| 2112 | } |
|---|
| 2113 | incr i |
|---|
| 2114 | } |
|---|
| 2115 | set menu_info [ list ] |
|---|
| 2116 | foreach c [ array names instances ] { |
|---|
| 2117 | lappend menu_info [ list $c $menu_class($c) $instances($c) ] |
|---|
| 2118 | } |
|---|
| 2119 | #puts "$menu_info" |
|---|
| 2120 | set menu_info |
|---|
| 2121 | } |
|---|
| 2122 | |
|---|
| 2123 | proc TolGui_InsertEntriesFromMenuManager { targetMenu selection } { |
|---|
| 2124 | set addrList [ list ] |
|---|
| 2125 | foreach obj_info $selection { |
|---|
| 2126 | set tcl_ref [ lindex $obj_info 0 ] |
|---|
| 2127 | lappend addrList [ ::tol::info address $tcl_ref ] |
|---|
| 2128 | } |
|---|
| 2129 | ::MenuManager::insertEntriesForSelection $targetMenu $addrList |
|---|
| 2130 | } |
|---|
| 2131 | |
|---|
| 2132 | proc TolGui_GetObjMenu { obj_addr } { |
|---|
| 2133 | set try [ catch { |
|---|
| 2134 | tol::console eval [ string map [ list %A $obj_addr ] { |
|---|
| 2135 | GuiTools::@MenuDesc __aux_menu__ = GetObjectFromAddress("%A"); |
|---|
| 2136 | Set __gui_menu_entries__ = __aux_menu__::getMenuEntries(?) |
|---|
| 2137 | } ] } msg ] |
|---|
| 2138 | if { $try } { |
|---|
| 2139 | puts "ERROR TolGui_GetObjMenu : $msg" |
|---|
| 2140 | set result "" |
|---|
| 2141 | } else { |
|---|
| 2142 | set result [ TolObj2TclObj {Set __gui_menu_entries__} ] |
|---|
| 2143 | } |
|---|
| 2144 | tol::console stack release __aux_menu__ |
|---|
| 2145 | tol::console stack release __gui_menu_entries__ |
|---|
| 2146 | set result |
|---|
| 2147 | } |
|---|
| 2148 | |
|---|
| 2149 | proc TolGui_InvokeMethod { method obj_addr } { |
|---|
| 2150 | #puts "TolGui_InvokeMethod $method $obj_addr" |
|---|
| 2151 | set try [ catch { |
|---|
| 2152 | tol::console eval [ string map [ list %A $obj_addr %M $method ] { |
|---|
| 2153 | NameBlock __aux_instance__ = GetObjectFromAddress("%A"); |
|---|
| 2154 | Real __aux_result__ = __aux_instance__::%M(?) |
|---|
| 2155 | } ] } msg ] |
|---|
| 2156 | if { $try } { |
|---|
| 2157 | puts "ERROR TolGui_InvokeMethod : $msg" |
|---|
| 2158 | } |
|---|
| 2159 | tol::console stack release __aux_instance__ |
|---|
| 2160 | tol::console stack release __aux_result__ |
|---|
| 2161 | } |
|---|
| 2162 | |
|---|
| 2163 | proc TclList2SetOfText { lst } { |
|---|
| 2164 | set result [ list ] |
|---|
| 2165 | foreach i $lst { |
|---|
| 2166 | lappend result \"[string map {\" \\\"} $i]\" |
|---|
| 2167 | } |
|---|
| 2168 | return "SetOfText([join $result ,])" |
|---|
| 2169 | } |
|---|
| 2170 | |
|---|
| 2171 | proc TolGui_InvokeGroup { cname function group } { |
|---|
| 2172 | set SOA [ TclList2SetOfText $group ] |
|---|
| 2173 | set try [ catch { |
|---|
| 2174 | tol::console eval \ |
|---|
| 2175 | [ string map [ list %C $cname %F $function %S $SOA ] { |
|---|
| 2176 | Real __aux_result__ = { |
|---|
| 2177 | Set aux = EvalSet( %S, NameBlock( Text addr ) { |
|---|
| 2178 | NameBlock GetObjectFromAddress( addr ) |
|---|
| 2179 | } ); |
|---|
| 2180 | Real %C::%F( aux ) |
|---|
| 2181 | } |
|---|
| 2182 | } ] } msg ] |
|---|
| 2183 | if { $try } { |
|---|
| 2184 | puts "ERROR TolGui_InvokeGroup : $msg" |
|---|
| 2185 | } |
|---|
| 2186 | tol::console stack release __aux_result__ |
|---|
| 2187 | } |
|---|
| 2188 | |
|---|
| 2189 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2190 | proc ::TolInspector::PostVariable { x y } { |
|---|
| 2191 | # |
|---|
| 2192 | # PURPOSE: Composes a popup menu for variables and displays it. Its composed |
|---|
| 2193 | # depending on the node/s clicked by user. |
|---|
| 2194 | # |
|---|
| 2195 | # PARAMETERS: |
|---|
| 2196 | # x -> x-coordinate where popup menu is drawn |
|---|
| 2197 | # y -> y-coordinate where popup menu is drawn |
|---|
| 2198 | # |
|---|
| 2199 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2200 | variable data_menu |
|---|
| 2201 | variable vars_selected |
|---|
| 2202 | variable options_selected |
|---|
| 2203 | variable ht_vars |
|---|
| 2204 | variable ht_tree |
|---|
| 2205 | variable item_data |
|---|
| 2206 | variable data |
|---|
| 2207 | |
|---|
| 2208 | variable tolset |
|---|
| 2209 | variable tolindex |
|---|
| 2210 | |
|---|
| 2211 | #User functions to contextual menu |
|---|
| 2212 | ::TolInspector::ReadUserFunctions |
|---|
| 2213 | |
|---|
| 2214 | array unset options_selected |
|---|
| 2215 | |
|---|
| 2216 | foreach it [array names data_menu] { |
|---|
| 2217 | $data_menu($it) delete 0 end |
|---|
| 2218 | } |
|---|
| 2219 | set InRootConsole [string equal [lindex [$ht_tree get -full anchor] end] "root-console"] |
|---|
| 2220 | set InRootPool [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"] |
|---|
| 2221 | set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end] "root-files"] |
|---|
| 2222 | #puts "PostVariable: InRootConsole,InRootPool,InRootFiles = $InRootConsole,$InRootPool,$InRootFiles" |
|---|
| 2223 | set node_act [$ht_vars index current] |
|---|
| 2224 | if { [string length $node_act] } { |
|---|
| 2225 | set vars_selected [$ht_vars curselection] |
|---|
| 2226 | if { [lsearch $vars_selected $node_act] >= 0 } { |
|---|
| 2227 | foreach var $vars_selected { |
|---|
| 2228 | array set aryData [$ht_vars entry cget $var -data] |
|---|
| 2229 | #puts "PostVariable: aryData = [array get aryData]" |
|---|
| 2230 | set itemid $aryData(Index) |
|---|
| 2231 | set path $aryData(Path) |
|---|
| 2232 | set grammar [lindex $item_data($itemid) 2] |
|---|
| 2233 | set objName [$ht_vars entry cget $var -label] |
|---|
| 2234 | #puts "OBJECT=$objName, PATH=$path" |
|---|
| 2235 | if { $InRootPool } { |
|---|
| 2236 | set object $data(pool,variables,$itemid) |
|---|
| 2237 | } else { |
|---|
| 2238 | if {[llength $aryData(Reference)]} { |
|---|
| 2239 | #set object [lindex $aryData(Reference) 0] |
|---|
| 2240 | set object [lrange $aryData(Reference) 0 end] |
|---|
| 2241 | } else { |
|---|
| 2242 | if { [string length $tolset] } { |
|---|
| 2243 | #set object [concat [list File $tolset] $tolindex $itemid] |
|---|
| 2244 | set object [concat $tolset $tolindex $itemid] |
|---|
| 2245 | #puts "tolset = $tolset" |
|---|
| 2246 | } else { |
|---|
| 2247 | if [llength $objName] { |
|---|
| 2248 | set object [list $grammar $objName] |
|---|
| 2249 | } else { |
|---|
| 2250 | set object $objName |
|---|
| 2251 | } |
|---|
| 2252 | } |
|---|
| 2253 | } |
|---|
| 2254 | } |
|---|
| 2255 | #puts "PostVariable: OBJECT=$object OBJNAME=$objName TOLSET=$tolset PATH=$path GRAMMAR=$grammar" |
|---|
| 2256 | switch -- $grammar { |
|---|
| 2257 | Code - |
|---|
| 2258 | Complex - |
|---|
| 2259 | Date - |
|---|
| 2260 | Matrix - |
|---|
| 2261 | VMatrix - |
|---|
| 2262 | Polyn - |
|---|
| 2263 | Ratio - |
|---|
| 2264 | Real - |
|---|
| 2265 | Serie - |
|---|
| 2266 | Anything - |
|---|
| 2267 | Text - |
|---|
| 2268 | NameBlock - |
|---|
| 2269 | TimeSet { |
|---|
| 2270 | lappend options_selected($grammar) [list $object $objName $path] |
|---|
| 2271 | } |
|---|
| 2272 | Set { |
|---|
| 2273 | # Si el objeto se da como referencia |
|---|
| 2274 | if { [llength $object] > 1 } { |
|---|
| 2275 | #puts "PostVariable: Set: object = $object" |
|---|
| 2276 | if {$InRootFiles} { |
|---|
| 2277 | set isFile 1 |
|---|
| 2278 | } else { |
|---|
| 2279 | set info [::tol::info var $object] |
|---|
| 2280 | set isFile [expr [lindex $info 7] == 4] |
|---|
| 2281 | } |
|---|
| 2282 | #set desc [lindex $info 4] |
|---|
| 2283 | } else { |
|---|
| 2284 | if {[catch "::tol::info included $object" info]} { |
|---|
| 2285 | set info [::tol::info var [list Set $objName]] |
|---|
| 2286 | #set isFile [expr [lindex $info 5] == 4] |
|---|
| 2287 | set isFile [expr [lindex $info 7] == 4] |
|---|
| 2288 | #set desc [lindex $info 4] |
|---|
| 2289 | } else { |
|---|
| 2290 | #set info [::tol::info included $objName] |
|---|
| 2291 | #set isFile [expr [lindex $info 4] == 4] |
|---|
| 2292 | set isFile 1 |
|---|
| 2293 | #set desc "" |
|---|
| 2294 | } |
|---|
| 2295 | } |
|---|
| 2296 | if $isFile { |
|---|
| 2297 | lappend options_selected(File) [list $object $objName $path] |
|---|
| 2298 | } else { |
|---|
| 2299 | lappend options_selected($grammar) [list $object $objName $path] |
|---|
| 2300 | } |
|---|
| 2301 | } |
|---|
| 2302 | } |
|---|
| 2303 | } |
|---|
| 2304 | set grammar_selected [array names options_selected] |
|---|
| 2305 | if { [llength $grammar_selected] } { |
|---|
| 2306 | foreach grammar $grammar_selected { |
|---|
| 2307 | switch -- $grammar { |
|---|
| 2308 | VMatrix - |
|---|
| 2309 | Matrix { |
|---|
| 2310 | $data_menu(main) add cascade -label [mc "Export matrix"]\ |
|---|
| 2311 | -menu $data_menu(Matrix,Export) |
|---|
| 2312 | if {[llength $options_selected($grammar)] == 1} { |
|---|
| 2313 | set object [lindex [lindex $options_selected($grammar) 0] 0] |
|---|
| 2314 | $data_menu(main) add command -label [mc "Table matrix"] \ |
|---|
| 2315 | -command [list ::TolInspector::TableMatrix $object] |
|---|
| 2316 | $data_menu(Matrix,Export) add command -label "BDT" \ |
|---|
| 2317 | -command [list ::TolInspector::ExportBDTMatrix $object] |
|---|
| 2318 | $data_menu(main) add command -label [mc "Draw matrix"] \ |
|---|
| 2319 | -command [list ::TolInspector::DrawMatrix $object] |
|---|
| 2320 | } else { |
|---|
| 2321 | $data_menu(main) add cascade -label [mc "Table matrix"] \ |
|---|
| 2322 | -menu $data_menu(Matrix,Table) |
|---|
| 2323 | $data_menu(Matrix,Export) add cascade -label "BDT" \ |
|---|
| 2324 | -menu $data_menu(Matrix,Export,BDT) |
|---|
| 2325 | $data_menu(main) add cascade -label [mc "Draw matrix"] \ |
|---|
| 2326 | -menu $data_menu(Matrix,Draw) |
|---|
| 2327 | foreach objInfo $options_selected(Matrix) { |
|---|
| 2328 | $data_menu(Matrix,Table) add command -label [lindex $objInfo 1]\ |
|---|
| 2329 | -command [list ::TolInspector::TableMatrix [lindex $objInfo 0]] |
|---|
| 2330 | $data_menu(Matrix,Export,BDT) add command -label [lindex $objInfo 1]\ |
|---|
| 2331 | -command [list ::TolInspector::ExportBDTMatrix [lindex $objInfo 0]] |
|---|
| 2332 | $data_menu(Matrix,Draw) add command -label [lindex $objInfo 1] \ |
|---|
| 2333 | -command [list ::TolInspector::DrawMatrix [lindex $objInfo 0]] |
|---|
| 2334 | } |
|---|
| 2335 | } |
|---|
| 2336 | } |
|---|
| 2337 | Serie { |
|---|
| 2338 | if {[llength $options_selected(Serie)] == 1} { |
|---|
| 2339 | set lblSerie "serie" |
|---|
| 2340 | } else { |
|---|
| 2341 | set lblSerie "series" |
|---|
| 2342 | } |
|---|
| 2343 | $data_menu(main) add command -label [mc "Draw $lblSerie"]\ |
|---|
| 2344 | -command ::TolInspector::DrawSerie |
|---|
| 2345 | $data_menu(main) add command -label [mc "Table $lblSerie"]\ |
|---|
| 2346 | -command ::TolInspector::TableSerie |
|---|
| 2347 | if {[llength $options_selected(Serie)] == 1} { |
|---|
| 2348 | set object [lindex [lindex $options_selected(Serie) 0] 0] |
|---|
| 2349 | $data_menu(main) add command -label [mc "Draw autocorrelation"] \ |
|---|
| 2350 | -command [list ::TolInspector::DrawAutocorSerie $object] |
|---|
| 2351 | $data_menu(main) add command -label [mc "Table autocorrelation"] \ |
|---|
| 2352 | -command [list ::TolInspector::TableAutocorSerie $object] |
|---|
| 2353 | } else { |
|---|
| 2354 | $data_menu(main) add cascade -label [mc "Draw autocorrelation"] \ |
|---|
| 2355 | -menu $data_menu(Serie,DrawAutocor) |
|---|
| 2356 | $data_menu(main) add cascade -label [mc "Table autocorrelation"] \ |
|---|
| 2357 | -menu $data_menu(Serie,TableAutocor) |
|---|
| 2358 | foreach objInfo $options_selected(Serie) { |
|---|
| 2359 | $data_menu(Serie,DrawAutocor) add command -label [lindex $objInfo 1]\ |
|---|
| 2360 | -command [list ::TolInspector::DrawAutocorSerie [lindex $objInfo 0]] |
|---|
| 2361 | $data_menu(Serie,TableAutocor) add command -label [lindex $objInfo 1]\ |
|---|
| 2362 | -command [list ::TolInspector::TableAutocorSerie [lindex $objInfo 0]] |
|---|
| 2363 | } |
|---|
| 2364 | } |
|---|
| 2365 | $data_menu(main) add command -label [mc "Table statistics"]\ |
|---|
| 2366 | -command ::TolInspector::TableStatisticsSerie |
|---|
| 2367 | } |
|---|
| 2368 | TimeSet { |
|---|
| 2369 | if {[llength $options_selected(TimeSet)] == 1} { |
|---|
| 2370 | set object [lindex [lindex $options_selected(TimeSet) 0] 0] |
|---|
| 2371 | $data_menu(main) add command -label [mc "View timeset"] \ |
|---|
| 2372 | -command [list ::TolInspector::ViewTimeSet $object] |
|---|
| 2373 | } else { |
|---|
| 2374 | $data_menu(main) add cascade -label [mc "View timeset"] \ |
|---|
| 2375 | -menu $data_menu(TimeSet,View) |
|---|
| 2376 | foreach objInfo $options_selected(TimeSet) { |
|---|
| 2377 | $data_menu(TimeSet,View) add command -label [lindex $objInfo 1] \ |
|---|
| 2378 | -command [list ::TolInspector::ViewTimeSet [lindex $objInfo 0]] |
|---|
| 2379 | } |
|---|
| 2380 | } |
|---|
| 2381 | } |
|---|
| 2382 | NameBlock { |
|---|
| 2383 | # entradas desde MenuManager |
|---|
| 2384 | if 0 { |
|---|
| 2385 | TolGui_InsertEntriesFromMenuManager \ |
|---|
| 2386 | $data_menu(main) \ |
|---|
| 2387 | $options_selected(NameBlock) |
|---|
| 2388 | } |
|---|
| 2389 | # entradas desde @MenuDesc |
|---|
| 2390 | # @MenuDesc sera reemplazado, ver https://www.tol-project.org/ticket/1372 |
|---|
| 2391 | set sel_length [ llength $options_selected(NameBlock) ] |
|---|
| 2392 | if { $sel_length } { |
|---|
| 2393 | set idx_current [ lsearch $vars_selected $node_act ] |
|---|
| 2394 | set all_nb_options \ |
|---|
| 2395 | [ TolGui_GetMenuEntries \ |
|---|
| 2396 | $options_selected(NameBlock) $idx_current ] |
|---|
| 2397 | set num_options [ llength $all_nb_options ] |
|---|
| 2398 | #puts "num_options = $num_options" |
|---|
| 2399 | foreach mi $all_nb_options { |
|---|
| 2400 | set _cname [ lindex $mi 0 ] |
|---|
| 2401 | set cname [ string map [ list @ "" . _ ] $_cname ] |
|---|
| 2402 | #puts "cname = $cname" |
|---|
| 2403 | foreach { ninst obj_addr entries } [ lindex $mi 1 ] break |
|---|
| 2404 | set instances [ lindex $mi 2 ] |
|---|
| 2405 | if { $num_options > 1 } { |
|---|
| 2406 | # creo el menu de la clase si no existe |
|---|
| 2407 | set mclass $data_menu(main).cls$cname |
|---|
| 2408 | if { ![ winfo exists $mclass ] } { |
|---|
| 2409 | menu $mclass -tearoff 0 |
|---|
| 2410 | } else { |
|---|
| 2411 | $mclass delete 0 end |
|---|
| 2412 | } |
|---|
| 2413 | $data_menu(main) add cascade -label $cname -menu $mclass |
|---|
| 2414 | set target_menu $mclass |
|---|
| 2415 | } else { |
|---|
| 2416 | set target_menu $data_menu(main) |
|---|
| 2417 | } |
|---|
| 2418 | foreach inst_entry $entries { |
|---|
| 2419 | foreach { label single group } $inst_entry break |
|---|
| 2420 | set opt_label \ |
|---|
| 2421 | "$label [ expr { $sel_length>1 ? $ninst : {} } ]" |
|---|
| 2422 | $target_menu add command -label $opt_label \ |
|---|
| 2423 | -command [ list TolGui_InvokeMethod \ |
|---|
| 2424 | $single $obj_addr ] |
|---|
| 2425 | if { $group ne "" && [ llength $instances ] > 1 } { |
|---|
| 2426 | # hay una funcion que se aplica a toda la seleccion |
|---|
| 2427 | $target_menu add command -label "$label All" \ |
|---|
| 2428 | -command [ list TolGui_InvokeGroup \ |
|---|
| 2429 | $_cname $group $instances ] |
|---|
| 2430 | } |
|---|
| 2431 | } |
|---|
| 2432 | } |
|---|
| 2433 | } |
|---|
| 2434 | } |
|---|
| 2435 | Set { |
|---|
| 2436 | if {[llength $options_selected(Set)] == 1} { |
|---|
| 2437 | set object [lindex [lindex $options_selected(Set) 0] 0] |
|---|
| 2438 | $data_menu(main) add command -label [mc "Table set"] \ |
|---|
| 2439 | -command [list ::TolInspector::TableSet $object] |
|---|
| 2440 | $data_menu(main) add command -label [mc "Draw set"] \ |
|---|
| 2441 | -command [list ::TolInspector::DrawSet $object] |
|---|
| 2442 | # menu special |
|---|
| 2443 | $data_menu(main) add cascade -label [mc "Draw set special"] \ |
|---|
| 2444 | -menu $data_menu(Set,Draw,Special) |
|---|
| 2445 | $data_menu(Set,Draw,Special) add command \ |
|---|
| 2446 | -label [mc SetGraphAllFirst] \ |
|---|
| 2447 | -command [list ::TolInspector::DrawSet $object 1] |
|---|
| 2448 | $data_menu(Set,Draw,Special) add command \ |
|---|
| 2449 | -label [mc SetGraphAllGeneric] \ |
|---|
| 2450 | -command [list ::TolInspector::DrawSet $object 2] |
|---|
| 2451 | $data_menu(Set,Draw,Special) add command \ |
|---|
| 2452 | -label [mc SetGraphEvenUneven] \ |
|---|
| 2453 | -command [list ::TolInspector::DrawSet $object 3] |
|---|
| 2454 | } else { |
|---|
| 2455 | $data_menu(main) add cascade -label [mc "Table set"] \ |
|---|
| 2456 | -menu $data_menu(Set,Table) |
|---|
| 2457 | $data_menu(main) add cascade -label [mc "Draw set"] \ |
|---|
| 2458 | -menu $data_menu(Set,Draw) |
|---|
| 2459 | foreach objInfo $options_selected(Set) { |
|---|
| 2460 | $data_menu(Set,Table) add command -label [lindex $objInfo 1] \ |
|---|
| 2461 | -command [list ::TolInspector::TableSet [lindex $objInfo 0]] |
|---|
| 2462 | $data_menu(Set,Draw) add command -label [lindex $objInfo 1] \ |
|---|
| 2463 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0]] |
|---|
| 2464 | } |
|---|
| 2465 | # menu special |
|---|
| 2466 | set i 0 |
|---|
| 2467 | $data_menu(main) add cascade -label [mc "Draw set special"] \ |
|---|
| 2468 | -menu $data_menu(Set,Draw,Special,M) |
|---|
| 2469 | foreach objInfo $options_selected(Set) { |
|---|
| 2470 | # exists menu previus ? |
|---|
| 2471 | if {[winfo exists $data_menu(Set,Draw,Special,M).setdrawspecialm$i]} { |
|---|
| 2472 | destroy $data_menu(Set,Draw,Special,M).setdrawspecialm$i |
|---|
| 2473 | } |
|---|
| 2474 | set mn \ |
|---|
| 2475 | [menu $data_menu(Set,Draw,Special,M).setdrawspecialm$i \ |
|---|
| 2476 | -tearoff 0] |
|---|
| 2477 | $data_menu(Set,Draw,Special,M) add cascade \ |
|---|
| 2478 | -label [lindex $objInfo 1] -menu $mn |
|---|
| 2479 | $mn add command -label [mc SetGraphAllFirst] \ |
|---|
| 2480 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 1] |
|---|
| 2481 | $mn add command -label [mc SetGraphAllGeneric] \ |
|---|
| 2482 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 2] |
|---|
| 2483 | $mn add command -label [mc SetGraphEvenUneven] \ |
|---|
| 2484 | -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 3] |
|---|
| 2485 | incr i |
|---|
| 2486 | } |
|---|
| 2487 | } |
|---|
| 2488 | } |
|---|
| 2489 | File { |
|---|
| 2490 | if {[llength $options_selected(File)] == 1} { |
|---|
| 2491 | set objName [lindex [lindex $options_selected(File) 0] 1] |
|---|
| 2492 | $data_menu(main) add command -label [mc "View file"] \ |
|---|
| 2493 | -command [list ::TolInspector::ViewFile $objName] |
|---|
| 2494 | if $InRootFiles { |
|---|
| 2495 | $data_menu(main) add command -label [mc "Decompile file"] \ |
|---|
| 2496 | -command [list ::TolInspector::DecompileFile $objName] |
|---|
| 2497 | } |
|---|
| 2498 | } else { |
|---|
| 2499 | $data_menu(main) add cascade -label [mc "View file"] \ |
|---|
| 2500 | -menu $data_menu(File,View) |
|---|
| 2501 | foreach objInfo $options_selected(File) { |
|---|
| 2502 | $data_menu(File,View) add command -label [lindex $objInfo 1] \ |
|---|
| 2503 | -command [list ::TolInspector::ViewFile [lindex $objInfo 1]] |
|---|
| 2504 | } |
|---|
| 2505 | if $InRootFiles { |
|---|
| 2506 | $data_menu(main) add cascade -label [mc "Decompile file"] \ |
|---|
| 2507 | -menu $data_menu(File,Decompile) |
|---|
| 2508 | foreach objInfo $options_selected(File) { |
|---|
| 2509 | $data_menu(File,Decompile) add command -label [lindex $objInfo 1] \ |
|---|
| 2510 | -command [list ::TolInspector::DecompileFile [lindex $objInfo 1]] |
|---|
| 2511 | } |
|---|
| 2512 | } |
|---|
| 2513 | } |
|---|
| 2514 | } |
|---|
| 2515 | } ;# end del switch |
|---|
| 2516 | # inserto las opciones definidas en MenuManager |
|---|
| 2517 | if { $grammar ne "Anything" } { |
|---|
| 2518 | TolGui_InsertEntriesFromMenuManager \ |
|---|
| 2519 | $data_menu(main) \ |
|---|
| 2520 | $options_selected($grammar) |
|---|
| 2521 | } |
|---|
| 2522 | |
|---|
| 2523 | $data_menu(main) add separator |
|---|
| 2524 | $data_menu(main) add cascade -label [mc "Functions"] \ |
|---|
| 2525 | -menu $data_menu($grammar,Functions) |
|---|
| 2526 | ShowMenuUserFunc $grammar |
|---|
| 2527 | if {[llength $options_selected($grammar)] == 1} { |
|---|
| 2528 | set objName [lindex [lindex $options_selected($grammar) 0] 1] |
|---|
| 2529 | set path [lindex [lindex $options_selected($grammar) 0] 2] |
|---|
| 2530 | $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \ |
|---|
| 2531 | -command [list ::TolInspector::ViewDefinition $objName $path $grammar] |
|---|
| 2532 | } else { |
|---|
| 2533 | $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \ |
|---|
| 2534 | -menu $data_menu($grammar,File) |
|---|
| 2535 | foreach objInfo $options_selected($grammar) { |
|---|
| 2536 | $data_menu($grammar,File) add command -label [lindex $objInfo 1]\ |
|---|
| 2537 | -command [list ::TolInspector::ViewDefinition\ |
|---|
| 2538 | [lindex $objInfo 1] [lindex $objInfo 2] $grammar] |
|---|
| 2539 | } |
|---|
| 2540 | } |
|---|
| 2541 | $data_menu(main) add separator |
|---|
| 2542 | } ;#end del foreach |
|---|
| 2543 | if { $InRootPool } { |
|---|
| 2544 | $data_menu(main) add command -label [mc "Remove from spool"] \ |
|---|
| 2545 | -command [list ::TolInspector::RemoveFromSpool $ht_vars] |
|---|
| 2546 | } else { |
|---|
| 2547 | $data_menu(main) add command -label [mc "Add to spool"] \ |
|---|
| 2548 | -command [list ::TolInspector::AddToSpool $ht_vars [lindex [$ht_tree get -full anchor] 1]] |
|---|
| 2549 | } |
|---|
| 2550 | $data_menu(main) add command -label [mc "To Eval window"] \ |
|---|
| 2551 | -command [list ::TolInspector::AddToEvalWindow $ht_vars] |
|---|
| 2552 | $data_menu(main) add separator |
|---|
| 2553 | if { $InRootConsole} { |
|---|
| 2554 | $data_menu(main) add command -label [mc "Decompile"] \ |
|---|
| 2555 | -command [list ::TolInspector::ClearConsoleObjSel $ht_vars] |
|---|
| 2556 | $data_menu(main) add separator |
|---|
| 2557 | } |
|---|
| 2558 | $data_menu(main) add command -label [mc "Select all"] \ |
|---|
| 2559 | -command [list ::TolInspector::SelectAll $ht_vars] |
|---|
| 2560 | $data_menu(main) add command -label [mc "Toggle selection"] \ |
|---|
| 2561 | -command [list ::TolInspector::ToggleSelection $ht_vars] |
|---|
| 2562 | tk_popup $data_menu(main) $x $y |
|---|
| 2563 | } ;#end del if |
|---|
| 2564 | } |
|---|
| 2565 | } |
|---|
| 2566 | } |
|---|
| 2567 | |
|---|
| 2568 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2569 | proc ::TolInspector::PostFunction { x y } { |
|---|
| 2570 | # |
|---|
| 2571 | # PURPOSE: Composes a popup menu for functions and displays it. Its composed |
|---|
| 2572 | # depending on the node/s clicked by user. |
|---|
| 2573 | # |
|---|
| 2574 | # PARAMETERS: |
|---|
| 2575 | # x -> x-coordinate where popup menu is drawn |
|---|
| 2576 | # y -> y-coordinate where popup menu is drawn |
|---|
| 2577 | # |
|---|
| 2578 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2579 | variable data_menu |
|---|
| 2580 | variable vars_selected |
|---|
| 2581 | variable ht_funcs |
|---|
| 2582 | variable ht_tree |
|---|
| 2583 | variable item_data |
|---|
| 2584 | variable data |
|---|
| 2585 | |
|---|
| 2586 | variable tolset |
|---|
| 2587 | variable tolindex |
|---|
| 2588 | |
|---|
| 2589 | array unset options_selected |
|---|
| 2590 | foreach it [array names data_menu] { |
|---|
| 2591 | $data_menu($it) delete 0 end |
|---|
| 2592 | } |
|---|
| 2593 | |
|---|
| 2594 | set InRootPool [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"] |
|---|
| 2595 | set node_act [$ht_funcs index current] |
|---|
| 2596 | if { [string length $node_act] } { |
|---|
| 2597 | set vars_selected [$ht_funcs curselection] |
|---|
| 2598 | if { [lsearch $vars_selected $node_act] >= 0 } { |
|---|
| 2599 | foreach var $vars_selected { |
|---|
| 2600 | array set aryData [$ht_funcs entry cget $var -data] |
|---|
| 2601 | set itemid $aryData(Index) |
|---|
| 2602 | set path $aryData(Path) |
|---|
| 2603 | set grammar [lindex $item_data($itemid) 2] |
|---|
| 2604 | set objName [$ht_funcs entry cget $var -label] |
|---|
| 2605 | |
|---|
| 2606 | if { $InRootPool } { |
|---|
| 2607 | set object $data(pool,variables,$itemid) |
|---|
| 2608 | } else { |
|---|
| 2609 | if { [string length $tolset] } { |
|---|
| 2610 | set object [concat [list $tolset] $tolindex $itemid] |
|---|
| 2611 | } else { |
|---|
| 2612 | set object $objName |
|---|
| 2613 | } |
|---|
| 2614 | } |
|---|
| 2615 | # La única gramática seleccionable en ht_funcs es Code |
|---|
| 2616 | lappend code_selected [list $object $objName $path] |
|---|
| 2617 | } |
|---|
| 2618 | |
|---|
| 2619 | if {[llength $code_selected] == 1} { |
|---|
| 2620 | set objName [lindex [lindex $code_selected 0] 1] |
|---|
| 2621 | set path [lindex [lindex $code_selected 0] 2] |
|---|
| 2622 | $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \ |
|---|
| 2623 | -command [list ::TolInspector::ViewDefinition $objName $path $grammar] |
|---|
| 2624 | } else { |
|---|
| 2625 | $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \ |
|---|
| 2626 | -menu $data_menu($grammar,File) |
|---|
| 2627 | foreach objInfo $code_selected { |
|---|
| 2628 | $data_menu($grammar,File) add command -label [lindex $objInfo 1]\ |
|---|
| 2629 | -command [list ::TolInspector::ViewDefinition\ |
|---|
| 2630 | [lindex $objInfo 1] [lindex $objInfo 2] $grammar] |
|---|
| 2631 | } |
|---|
| 2632 | } |
|---|
| 2633 | |
|---|
| 2634 | if { $InRootPool } { |
|---|
| 2635 | $data_menu(main) add command -label [mc "Remove from spool"] \ |
|---|
| 2636 | -command [list ::TolInspector::RemoveFromSpool $ht_funcs] |
|---|
| 2637 | } else { |
|---|
| 2638 | $data_menu(main) add command -label [mc "Add to spool"] \ |
|---|
| 2639 | -command [list ::TolInspector::AddToSpool $ht_funcs [lindex [$ht_tree get -full anchor] 1]] |
|---|
| 2640 | } |
|---|
| 2641 | $data_menu(main) add command -label [mc "To Eval window"] \ |
|---|
| 2642 | -command [list ::TolInspector::AddToEvalWindow $ht_funcs] |
|---|
| 2643 | $data_menu(main) add separator |
|---|
| 2644 | $data_menu(main) add command -label [mc "Select all"] \ |
|---|
| 2645 | -command [list ::TolInspector::SelectAll $ht_funcs] |
|---|
| 2646 | $data_menu(main) add command -label [mc "Toggle selection"] \ |
|---|
| 2647 | -command [list ::TolInspector::ToggleSelection $ht_funcs] |
|---|
| 2648 | tk_popup $data_menu(main) $x $y |
|---|
| 2649 | } |
|---|
| 2650 | } |
|---|
| 2651 | } |
|---|
| 2652 | |
|---|
| 2653 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2654 | proc ::TolInspector::PostTree { x y } { |
|---|
| 2655 | # |
|---|
| 2656 | # PURPOSE: Composes a popup menu for left treeview and displays it. Its |
|---|
| 2657 | # composed depending on the node clicked by user. |
|---|
| 2658 | # |
|---|
| 2659 | # PARAMETERS: |
|---|
| 2660 | # x -> x-coordinate where popup menu is drawn |
|---|
| 2661 | # y -> y-coordinate where popup menu is drawn |
|---|
| 2662 | # |
|---|
| 2663 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2664 | variable data_menu |
|---|
| 2665 | variable vars_selected |
|---|
| 2666 | variable ht_tree |
|---|
| 2667 | variable item_data |
|---|
| 2668 | variable data |
|---|
| 2669 | variable tolset |
|---|
| 2670 | variable tolindex |
|---|
| 2671 | variable item_id |
|---|
| 2672 | #puts "ht_tree: $ht_tree" |
|---|
| 2673 | #No terminado todavÃa |
|---|
| 2674 | #return |
|---|
| 2675 | array unset options_selected |
|---|
| 2676 | |
|---|
| 2677 | #puts "::TolInspector::PostTree $x $y" |
|---|
| 2678 | foreach it [array names data_menu] { |
|---|
| 2679 | $data_menu($it) delete 0 end |
|---|
| 2680 | } |
|---|
| 2681 | set InRootPool [string equal [lindex [$ht_tree get -full anchor] end-1] "root-pool"] |
|---|
| 2682 | #puts "InRootPool: $InRootPool" |
|---|
| 2683 | # InRootFiles has a value 1 if node is a File |
|---|
| 2684 | set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end-1] "root-files"] |
|---|
| 2685 | #puts "InRootFiles: $InRootFiles" |
|---|
| 2686 | # index of the selected node |
|---|
| 2687 | set node_act [$ht_tree index current] |
|---|
| 2688 | #puts "node_act: $node_act" |
|---|
| 2689 | if { [string length $node_act] } { |
|---|
| 2690 | set vars_selected [$ht_tree curselection] |
|---|
| 2691 | #puts "vars_selected: $vars_selected" |
|---|
| 2692 | if { [lsearch $vars_selected $node_act] >= 0 } { ;# Not root node |
|---|
| 2693 | set index [$ht_tree index anchor] |
|---|
| 2694 | #puts "index: $index" |
|---|
| 2695 | if { $index } { |
|---|
| 2696 | set info_node [split [lindex [$ht_tree get -full $index] end] "-"] |
|---|
| 2697 | #puts "info_node: $info_node" |
|---|
| 2698 | set node_type [lindex $info_node 0] |
|---|
| 2699 | #puts "node_type: $node_type" |
|---|
| 2700 | set node_name [lindex $info_node 1] |
|---|
| 2701 | #puts "node_name: $node_name" |
|---|
| 2702 | } else { ;# root node |
|---|
| 2703 | set node_type root |
|---|
| 2704 | set node_name root |
|---|
| 2705 | } |
|---|
| 2706 | # if user selects a root or a grammar doesn't nothing |
|---|
| 2707 | switch -regexp $node_type { |
|---|
| 2708 | root - |
|---|
| 2709 | grammar { return } |
|---|
| 2710 | } |
|---|
| 2711 | # label of object showed in the tree |
|---|
| 2712 | set objName [$ht_tree entry cget $index -label] |
|---|
| 2713 | #puts "objName: $objName" |
|---|
| 2714 | set object $objName |
|---|
| 2715 | |
|---|
| 2716 | if {$InRootFiles} { |
|---|
| 2717 | array set aryData [$ht_tree entry cget $index -data] |
|---|
| 2718 | if [info exist aryData(FileName)] { |
|---|
| 2719 | set objName $aryData(FileName) |
|---|
| 2720 | } |
|---|
| 2721 | } |
|---|
| 2722 | #puts "2objName: $objName" |
|---|
| 2723 | if { $InRootPool } { |
|---|
| 2724 | #puts "es InRootPool $item_id" |
|---|
| 2725 | set itemid $item_id |
|---|
| 2726 | #set object $data(pool,variables,$itemid) |
|---|
| 2727 | set object $data(pool,reference,$node_type) |
|---|
| 2728 | } else { |
|---|
| 2729 | #puts "NO InRootPool" |
|---|
| 2730 | if { [string length $tolset] } { |
|---|
| 2731 | set object [concat [list $tolset] $tolindex] |
|---|
| 2732 | } else { |
|---|
| 2733 | set object $objName |
|---|
| 2734 | } |
|---|
| 2735 | } |
|---|
| 2736 | #puts "object = $objName '[$ht_tree entry cget $index -data]'" |
|---|
| 2737 | #Tolcon_Trace "***********************************" {red} |
|---|
| 2738 | #Tolcon_Trace "index=$index, node_type=$node_type, node_name=$node_name" {red} |
|---|
| 2739 | #Tolcon_Trace "tolset=$tolset, tolindex=$tolindex, aryData= [$ht_tree entry cget $index -data]" {red} |
|---|
| 2740 | #Tolcon_Trace "object=$object, label=$objName" {red} |
|---|
| 2741 | #Tolcon_Trace "***********************************" {red} |
|---|
| 2742 | |
|---|
| 2743 | # |
|---|
| 2744 | # TICKET: #1438 |
|---|
| 2745 | # Por que se pregunta aqui por los objetos de consola? |
|---|
| 2746 | # |
|---|
| 2747 | set stackList [::tol::console stack list] |
|---|
| 2748 | #puts "stackList: $stackList" |
|---|
| 2749 | set stackValue {} |
|---|
| 2750 | foreach stackItem $stackList { |
|---|
| 2751 | #puts "stackItem: $stackItem" |
|---|
| 2752 | #puts "lindex $stackValue 1: [lindex $stackValue 1]" |
|---|
| 2753 | #puts "objName: $objName" |
|---|
| 2754 | if {[lindex $stackItem 1] eq $objName} { |
|---|
| 2755 | set stackValue $stackItem |
|---|
| 2756 | } |
|---|
| 2757 | break |
|---|
| 2758 | } |
|---|
| 2759 | #puts "stackValue: $stackValue" |
|---|
| 2760 | set grammar [lindex $stackValue 0] |
|---|
| 2761 | #puts "grammar: $grammar" |
|---|
| 2762 | #set full_data $item_data($index) ;# {value} {desc} {grammar} |
|---|
| 2763 | #set grammar [lindex $full_data 2] |
|---|
| 2764 | |
|---|
| 2765 | #foreach fun [::tol::info functions $grammar] { |
|---|
| 2766 | # set finfo [::tol::info functions $grammar $fun] |
|---|
| 2767 | # InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0 |
|---|
| 2768 | #} |
|---|
| 2769 | if {[catch {set info [::tol::info included $objName]}]} { |
|---|
| 2770 | if { !($grammar eq "")} { |
|---|
| 2771 | if {[catch {set info [::tol::info var [list $grammar $object]}]} { |
|---|
| 2772 | #set info [concat [list "$grammar" $objName ] [::tol::info var $grammar $objName]] |
|---|
| 2773 | set info [::tol::info var [list $grammar $objName]] |
|---|
| 2774 | #Tolcon_Trace "INFO de ::tol::info var Set objName" |
|---|
| 2775 | } else { |
|---|
| 2776 | set info [::tol::info var [list $grammar $object]] |
|---|
| 2777 | #Tolcon_Trace "INFO de ::tol::info var $grammar object" |
|---|
| 2778 | } |
|---|
| 2779 | set isFile [expr [lindex $info 5] == 4] |
|---|
| 2780 | } else { |
|---|
| 2781 | set isFile 0 |
|---|
| 2782 | } |
|---|
| 2783 | |
|---|
| 2784 | } else { |
|---|
| 2785 | set info [::tol::info included $objName] |
|---|
| 2786 | #Tolcon_Trace "INFO de ::tol::info included objName" |
|---|
| 2787 | set isFile 1 |
|---|
| 2788 | } |
|---|
| 2789 | #puts "paso" |
|---|
| 2790 | |
|---|
| 2791 | if $isFile { |
|---|
| 2792 | #puts "entro como fichero" |
|---|
| 2793 | $data_menu(main) add command -label [mc "View file"] \ |
|---|
| 2794 | -command [list ::TolInspector::ViewFile $objName] |
|---|
| 2795 | if $InRootFiles { |
|---|
| 2796 | $data_menu(main) add command -label [mc "Decompile file"] \ |
|---|
| 2797 | -command [list ::TolInspector::DecompileFile $objName] |
|---|
| 2798 | } |
|---|
| 2799 | } else { |
|---|
| 2800 | #puts "no entro como fichero" |
|---|
| 2801 | if { $grammar eq "Set" } { |
|---|
| 2802 | $data_menu(main) add command -label [mc "Table set"] \ |
|---|
| 2803 | -command [list ::TolInspector::TableSet $object] |
|---|
| 2804 | $data_menu(main) add command -label [mc "Draw set"] \ |
|---|
| 2805 | -command [list ::TolInspector::DrawSet $object] |
|---|
| 2806 | } |
|---|
| 2807 | } |
|---|
| 2808 | tk_popup $data_menu(main) $x $y |
|---|
| 2809 | } |
|---|
| 2810 | } |
|---|
| 2811 | } |
|---|
| 2812 | |
|---|
| 2813 | |
|---|
| 2814 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2815 | # Procedures asociated with tol inspector popup menu |
|---|
| 2816 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2817 | |
|---|
| 2818 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2819 | proc ::TolInspector::RemoveFromSpool {ht} { |
|---|
| 2820 | # |
|---|
| 2821 | # PURPOSE: Removes from spool all selected objects |
|---|
| 2822 | # |
|---|
| 2823 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2824 | variable vars_selected |
|---|
| 2825 | variable item_data |
|---|
| 2826 | variable tolset |
|---|
| 2827 | variable tolindex |
|---|
| 2828 | variable data |
|---|
| 2829 | |
|---|
| 2830 | foreach var $vars_selected { |
|---|
| 2831 | array set aryData [$ht entry cget $var -data] |
|---|
| 2832 | set itemid $aryData(Index) |
|---|
| 2833 | set path $aryData(Path) |
|---|
| 2834 | set reference $aryData(Reference) |
|---|
| 2835 | set grammar [lindex $item_data($itemid) 2] |
|---|
| 2836 | |
|---|
| 2837 | set objName [$ht entry cget $var -label] |
|---|
| 2838 | |
|---|
| 2839 | set _objpool [list "grammar" $grammar "objName" $objName "reference" $reference "path" $path] |
|---|
| 2840 | if {$grammar eq "Code"} { |
|---|
| 2841 | set graApply [lindex $aryData(Content) 0] |
|---|
| 2842 | lappend _objpool "graApply" $graApply |
|---|
| 2843 | } |
|---|
| 2844 | #Tolcon_Trace "OBJPOOL on REMOVE: $_objpool" |
|---|
| 2845 | |
|---|
| 2846 | # Buscamos el objeto (identificador: referencia) |
|---|
| 2847 | array set objpool $_objpool |
|---|
| 2848 | foreach _obj $data(pool,objects) { |
|---|
| 2849 | array set obj $_obj |
|---|
| 2850 | #Tolcon_Trace "obj(reference)=$obj(reference), objpool(reference)=$objpool(reference)" |
|---|
| 2851 | if {[string equal $obj(reference) $objpool(reference)]} { |
|---|
| 2852 | if {$obj(grammar) eq "Code"} { |
|---|
| 2853 | if {[string equal $obj(graApply) $objpool(graApply)]} { |
|---|
| 2854 | set idx [lsearch $data(pool,objects) $_obj] |
|---|
| 2855 | #Tolcon_Trace "El obj a quitar tiene idx=$idx" |
|---|
| 2856 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx] |
|---|
| 2857 | } |
|---|
| 2858 | } else { |
|---|
| 2859 | set idx [lsearch $data(pool,objects) $_obj] |
|---|
| 2860 | #Tolcon_Trace "El obj a quitar tiene idx=$idx" |
|---|
| 2861 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx] |
|---|
| 2862 | } |
|---|
| 2863 | } |
|---|
| 2864 | } |
|---|
| 2865 | } |
|---|
| 2866 | #Tolcon_Trace "P.O. after REMOVE: $data(pool,objects)" |
|---|
| 2867 | UpdatePoolObj |
|---|
| 2868 | } |
|---|
| 2869 | |
|---|
| 2870 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2871 | proc ::TolInspector::AddToSpool {ht origin} { |
|---|
| 2872 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2873 | variable vars_selected |
|---|
| 2874 | variable item_data |
|---|
| 2875 | variable tolset |
|---|
| 2876 | variable tolindex |
|---|
| 2877 | variable data |
|---|
| 2878 | |
|---|
| 2879 | foreach var $vars_selected { |
|---|
| 2880 | array set aryData [$ht entry cget $var -data] |
|---|
| 2881 | set itemid $aryData(Index) |
|---|
| 2882 | set path $aryData(Path) |
|---|
| 2883 | set grammar [lindex $item_data($itemid) 2] |
|---|
| 2884 | set objName [$ht entry cget $var -label] |
|---|
| 2885 | #puts "AddToSpool: Reference=$aryData(Reference) tolset=$tolset grammar=$grammar" |
|---|
| 2886 | if {[llength $aryData(Reference)]} { |
|---|
| 2887 | set reference $aryData(Reference) |
|---|
| 2888 | } else { |
|---|
| 2889 | if { [string length $tolset] } { |
|---|
| 2890 | #set object [concat [list $tolset] $tolindex $itemid] |
|---|
| 2891 | #set object [concat [list File $tolset] $tolindex $itemid] |
|---|
| 2892 | set object [concat $tolset $tolindex $itemid] |
|---|
| 2893 | #puts "AddToSpool: object=$object" |
|---|
| 2894 | set reference [::tol::info reference $object] |
|---|
| 2895 | } else { |
|---|
| 2896 | if {$grammar eq "Set"} { |
|---|
| 2897 | #puts "AddToSpool: origin=$origin" |
|---|
| 2898 | set reference [::tol::info reference [list Set $objName]] |
|---|
| 2899 | #Tolcon_Trace "reference de ::tol::info reference [list $objName]" |
|---|
| 2900 | } else { |
|---|
| 2901 | if [catch {set reference [::tol::info reference [list $grammar $objName]]}] { |
|---|
| 2902 | set reference $objName |
|---|
| 2903 | #Tolcon_Trace "reference NO SE QUE PONER" |
|---|
| 2904 | } |
|---|
| 2905 | #Tolcon_Trace "reference de ::tol::info reference $grammar $objName" |
|---|
| 2906 | } |
|---|
| 2907 | } |
|---|
| 2908 | } |
|---|
| 2909 | set _objpool [list "origin" $origin "grammar" $grammar "objName" $objName "reference" $reference "path" $path] |
|---|
| 2910 | if {$grammar eq "Code"} { |
|---|
| 2911 | set graApply [lindex $aryData(Content) 0] |
|---|
| 2912 | lappend _objpool "graApply" $graApply |
|---|
| 2913 | } |
|---|
| 2914 | #Tolcon_Trace "***************" |
|---|
| 2915 | #Tolcon_Trace "OBJPOOL on ADD:" |
|---|
| 2916 | #Tolcon_Trace "***************" |
|---|
| 2917 | #foreach {key value} $_objpool { |
|---|
| 2918 | # Tolcon_Trace " $key=$value" |
|---|
| 2919 | #} |
|---|
| 2920 | set inserted 0 |
|---|
| 2921 | # Si la referencia es igual, el objeto es el mismo (salvo para obj de tipo Code) |
|---|
| 2922 | array set objpool $_objpool |
|---|
| 2923 | foreach _obj $data(pool,objects) { |
|---|
| 2924 | array set obj $_obj |
|---|
| 2925 | if {[string equal $obj(reference) $objpool(reference)]} { |
|---|
| 2926 | #Si es de la gramatica Code miro a ver la gramatica sobre la que se aplica |
|---|
| 2927 | if {$objpool(grammar) eq "Code"} { |
|---|
| 2928 | if {[string equal $obj(graApply) $objpool(graApply)]} { |
|---|
| 2929 | set inserted 1 |
|---|
| 2930 | } |
|---|
| 2931 | } else { |
|---|
| 2932 | set inserted 1 |
|---|
| 2933 | } |
|---|
| 2934 | } |
|---|
| 2935 | } |
|---|
| 2936 | if {!$inserted} { |
|---|
| 2937 | lappend data(pool,objects) $_objpool |
|---|
| 2938 | #puts "AddToSpool: P.O. after ADD: $data(pool,objects)" |
|---|
| 2939 | } else { |
|---|
| 2940 | #puts "$_objpool ALREADY IN SPOOL" |
|---|
| 2941 | } |
|---|
| 2942 | } |
|---|
| 2943 | |
|---|
| 2944 | } |
|---|
| 2945 | |
|---|
| 2946 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2947 | proc ::TolInspector::AddToEvalWindow {ht} { |
|---|
| 2948 | # |
|---|
| 2949 | # PURPOSE: Adds names of selected objects (vars or functions) in treeview ht |
|---|
| 2950 | # to eval window |
|---|
| 2951 | # |
|---|
| 2952 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2953 | variable ht_vars |
|---|
| 2954 | variable vars_selected |
|---|
| 2955 | |
|---|
| 2956 | set names "" |
|---|
| 2957 | foreach var $vars_selected { |
|---|
| 2958 | lappend names [$ht entry cget $var -label] |
|---|
| 2959 | } |
|---|
| 2960 | ::TolConsole::ToEvalWindow [ListToStr $names] |
|---|
| 2961 | } |
|---|
| 2962 | |
|---|
| 2963 | |
|---|
| 2964 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2965 | proc ::TolInspector::SelectAll {ht} { |
|---|
| 2966 | # |
|---|
| 2967 | # PURPOSE: Selects all nodes of a given treeview |
|---|
| 2968 | # |
|---|
| 2969 | # PARAMETERS: |
|---|
| 2970 | # ht -> treeview's path |
|---|
| 2971 | # |
|---|
| 2972 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2973 | set found [$ht find] |
|---|
| 2974 | if {[llength $found] > 1} { |
|---|
| 2975 | $ht selection set [lindex $found 1] [lindex $found end] |
|---|
| 2976 | } |
|---|
| 2977 | } |
|---|
| 2978 | |
|---|
| 2979 | |
|---|
| 2980 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2981 | proc ::TolInspector::ToggleSelection {ht} { |
|---|
| 2982 | # |
|---|
| 2983 | # PURPOSE: Toggles selection of nodes of a given treeview |
|---|
| 2984 | # |
|---|
| 2985 | # PARAMETERS: |
|---|
| 2986 | # ht -> treeview's path |
|---|
| 2987 | # |
|---|
| 2988 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2989 | set found [$ht find] |
|---|
| 2990 | if {[llength $found] > 1} { |
|---|
| 2991 | $ht selection toggle [lindex $found 1] [lindex $found end] |
|---|
| 2992 | } |
|---|
| 2993 | } |
|---|
| 2994 | |
|---|
| 2995 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2996 | proc ::TolInspector::DrawSet {setref {type 0}} { |
|---|
| 2997 | # |
|---|
| 2998 | # PURPOSE: Graph a Set. For it it calls to a form for the selection of |
|---|
| 2999 | # columns to graph |
|---|
| 3000 | # |
|---|
| 3001 | # PARAMETERS: |
|---|
| 3002 | # setref -> Set to graph |
|---|
| 3003 | # type -> 0 for custom association of data columns |
|---|
| 3004 | # -> 1 for all data columns to first one |
|---|
| 3005 | # -> 2 for all data columns to generic |
|---|
| 3006 | # -> 3 for even data columns to odd ones |
|---|
| 3007 | # |
|---|
| 3008 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3009 | variable group_id |
|---|
| 3010 | variable w_tabset |
|---|
| 3011 | #puts "::TolInspector::DrawSet. setref: $setref" |
|---|
| 3012 | incr group_id |
|---|
| 3013 | if {[llength $setref] > 1} { |
|---|
| 3014 | set name [lindex [::tol::info variable $setref] 1] |
|---|
| 3015 | } else { |
|---|
| 3016 | set name $setref |
|---|
| 3017 | } |
|---|
| 3018 | set cmd tablecmd$group_id |
|---|
| 3019 | if {![catch {::tol::tableset create $cmd $setref}]} { |
|---|
| 3020 | switch $type { |
|---|
| 3021 | 0 { |
|---|
| 3022 | set tl [::project::CreateForm \ |
|---|
| 3023 | -width 500 -height 500 -type Graphs \ |
|---|
| 3024 | -iniconfig Graph \ |
|---|
| 3025 | -title [mc "Set graph: %s" $name] -helpkey "Tb4GraSet"] |
|---|
| 3026 | $tl withdraw |
|---|
| 3027 | set tlf [$tl getframe] |
|---|
| 3028 | if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $setref]] != 0} { |
|---|
| 3029 | bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd] |
|---|
| 3030 | pack $tlf.g -fill both -expand yes |
|---|
| 3031 | $tl restore |
|---|
| 3032 | update |
|---|
| 3033 | # Esta opción se debe aplicar cuando el gráfico esté empacado |
|---|
| 3034 | ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0 |
|---|
| 3035 | } else { |
|---|
| 3036 | destroy $tl |
|---|
| 3037 | return |
|---|
| 3038 | } |
|---|
| 3039 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3040 | } |
|---|
| 3041 | 1 - |
|---|
| 3042 | 2 - |
|---|
| 3043 | 3 { |
|---|
| 3044 | # windows |
|---|
| 3045 | set tl [::project::CreateForm \ |
|---|
| 3046 | -title [mc "Set graph: %s" $name] -type Graphs -iniconfig SetGraph] |
|---|
| 3047 | $tl withdraw |
|---|
| 3048 | set tlf [$tl getframe] |
|---|
| 3049 | set Instance [::SetGraphDialog::DrawSet $tlf.g $cmd $setref $type] |
|---|
| 3050 | bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd] |
|---|
| 3051 | pack $tlf.g -fill both -expand yes |
|---|
| 3052 | $tl restore |
|---|
| 3053 | update |
|---|
| 3054 | # Esta opción se debe aplicar cuando el gráfico esté empacado |
|---|
| 3055 | ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0 |
|---|
| 3056 | } |
|---|
| 3057 | } |
|---|
| 3058 | } else { |
|---|
| 3059 | tk_messageBox -type ok -icon warning \ |
|---|
| 3060 | -message [mc "Set is not graficable: %s" $::errorInfo] \ |
|---|
| 3061 | -parent $w_tabset -title [mc "Warning"] |
|---|
| 3062 | } |
|---|
| 3063 | } |
|---|
| 3064 | |
|---|
| 3065 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3066 | proc ::TolInspector::DrawMatrix {matref} { |
|---|
| 3067 | # |
|---|
| 3068 | # PURPOSE: draw the given matrix |
|---|
| 3069 | # |
|---|
| 3070 | # PARAMETERS: |
|---|
| 3071 | # matref -> reference to the tol matrix |
|---|
| 3072 | # |
|---|
| 3073 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3074 | variable group_id |
|---|
| 3075 | variable w_tabset |
|---|
| 3076 | |
|---|
| 3077 | incr group_id |
|---|
| 3078 | if {[llength $matref] > 1} { |
|---|
| 3079 | set name [lindex [::tol::info variable $matref] 1] |
|---|
| 3080 | } else { |
|---|
| 3081 | if { ([info exists obj]) } { |
|---|
| 3082 | set name $obj |
|---|
| 3083 | } |
|---|
| 3084 | } |
|---|
| 3085 | if { ([info exists name]) } { |
|---|
| 3086 | set cmd tablecmd$group_id |
|---|
| 3087 | if {![catch {::tol::tablematrix create $cmd $matref}]} { |
|---|
| 3088 | set tl [::project::CreateForm \ |
|---|
| 3089 | -width 500 -height 500 -type Graphs \ |
|---|
| 3090 | -iniconfig Graph \ |
|---|
| 3091 | -title [mc "Matrix graph: %s" $name] -helpkey "Tb4Gra"] |
|---|
| 3092 | $tl withdraw |
|---|
| 3093 | |
|---|
| 3094 | set tlf [$tl getframe] |
|---|
| 3095 | if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $matref]] != 0} { |
|---|
| 3096 | bind $tlf.g <Destroy> +[list ::tol::tablematrix destroy $cmd] |
|---|
| 3097 | pack $tlf.g -fill both -expand yes |
|---|
| 3098 | $tl restore |
|---|
| 3099 | update |
|---|
| 3100 | # Esta opción se debe aplicar cuando el gráfico esté empacado |
|---|
| 3101 | ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0 |
|---|
| 3102 | } else { |
|---|
| 3103 | destroy $tl |
|---|
| 3104 | return |
|---|
| 3105 | } |
|---|
| 3106 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3107 | } else { |
|---|
| 3108 | tk_messageBox -type ok -icon warning \ |
|---|
| 3109 | -message [mc "Matrix is not graficable: %s" $::errorInfo] \ |
|---|
| 3110 | -parent $w_tabset -title [mc "Warning"] |
|---|
| 3111 | } |
|---|
| 3112 | } |
|---|
| 3113 | } |
|---|
| 3114 | |
|---|
| 3115 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3116 | proc ::TolInspector::TableSet { set } { |
|---|
| 3117 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3118 | variable w_tabset |
|---|
| 3119 | variable group_id |
|---|
| 3120 | |
|---|
| 3121 | incr group_id |
|---|
| 3122 | if {[llength $set] > 1} { |
|---|
| 3123 | set nameSet [lindex [::tol::info variable $set] 1] |
|---|
| 3124 | } else { |
|---|
| 3125 | set nameSet $set |
|---|
| 3126 | } |
|---|
| 3127 | set setgrp group$group_id |
|---|
| 3128 | if {![catch {::tol::tableset create $setgrp $set}]} { |
|---|
| 3129 | # create |
|---|
| 3130 | set tl [::project::CreateForm \ |
|---|
| 3131 | -title "[mc "Set table"]: $nameSet" \ |
|---|
| 3132 | -iniconfig SetTable \ |
|---|
| 3133 | -type Tables -helpkey "Tb4Edt" |
|---|
| 3134 | ] |
|---|
| 3135 | set tlf [$tl getframe] |
|---|
| 3136 | # config |
|---|
| 3137 | btable $tlf.t -parent $tl \ |
|---|
| 3138 | -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \ |
|---|
| 3139 | -iniconfig btable |
|---|
| 3140 | $tlf.t fillSet $setgrp |
|---|
| 3141 | pack $tlf.t -fill both -expand yes |
|---|
| 3142 | bind $tlf.t <Destroy> +[list ::tol::tableset destroy $setgrp] |
|---|
| 3143 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3144 | update |
|---|
| 3145 | } else { |
|---|
| 3146 | tk_messageBox -type ok -icon warning -message [mc "Set not tabulable"]\ |
|---|
| 3147 | -parent $w_tabset -title [mc Warning] |
|---|
| 3148 | } |
|---|
| 3149 | } |
|---|
| 3150 | |
|---|
| 3151 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3152 | proc ::TolInspector::TableMatrix { matrix } { |
|---|
| 3153 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3154 | set mattb [::tol::matrix $matrix] |
|---|
| 3155 | # create |
|---|
| 3156 | set tl [::project::CreateForm \ |
|---|
| 3157 | -title "[mc {Matrix table}]: [lindex $mattb 0]" \ |
|---|
| 3158 | -iniconfig MatrixTable \ |
|---|
| 3159 | -type Tables -helpkey "Tb4Edt" |
|---|
| 3160 | ] |
|---|
| 3161 | set tlf [$tl getframe] |
|---|
| 3162 | # create matrix |
|---|
| 3163 | btable $tlf.t -parent $tl \ |
|---|
| 3164 | -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \ |
|---|
| 3165 | -iniconfig btable |
|---|
| 3166 | $tlf.t fillMatrix $mattb |
|---|
| 3167 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3168 | pack $tlf.t -fill both -expand yes |
|---|
| 3169 | |
|---|
| 3170 | #if {$grammar == "VMatrix"} { |
|---|
| 3171 | #::tol::console stack release "zxw._.wxz" |
|---|
| 3172 | #} |
|---|
| 3173 | } |
|---|
| 3174 | |
|---|
| 3175 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3176 | proc ::TolInspector::ExportBDTMatrix { matrix } { |
|---|
| 3177 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3178 | variable group_id |
|---|
| 3179 | |
|---|
| 3180 | incr group_id |
|---|
| 3181 | set tl [toplevel .top$group_id] |
|---|
| 3182 | wm title $tl "ExportBDTMatrix" |
|---|
| 3183 | |
|---|
| 3184 | #pack $tl.t -fill both -expand yes |
|---|
| 3185 | } |
|---|
| 3186 | |
|---|
| 3187 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3188 | proc ::TolInspector::DrawSerie { } { |
|---|
| 3189 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3190 | variable options_selected |
|---|
| 3191 | upvar \#0 ::TolInspector::options_selected(Serie) series_selected |
|---|
| 3192 | |
|---|
| 3193 | #puts "DrawSerie: series_selected=$series_selected" |
|---|
| 3194 | set series "" |
|---|
| 3195 | foreach it $series_selected { |
|---|
| 3196 | lappend series [lindex $it 0] |
|---|
| 3197 | } |
|---|
| 3198 | DrawSeries $series |
|---|
| 3199 | } |
|---|
| 3200 | |
|---|
| 3201 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3202 | proc ::TolInspector::DrawSeries { series {gcf ""}} { |
|---|
| 3203 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3204 | variable group_id |
|---|
| 3205 | |
|---|
| 3206 | if { [llength $series] } { |
|---|
| 3207 | incr group_id |
|---|
| 3208 | # series |
|---|
| 3209 | set sergrp group$group_id |
|---|
| 3210 | set t0 [time { |
|---|
| 3211 | eval "::tol::seriegrp create $sergrp $series" |
|---|
| 3212 | }] |
|---|
| 3213 | # name |
|---|
| 3214 | set name [$sergrp serie 0 name] |
|---|
| 3215 | if { [$sergrp serie size] > 1} { |
|---|
| 3216 | set name ${name}... |
|---|
| 3217 | } |
|---|
| 3218 | # create |
|---|
| 3219 | set t1 [time { |
|---|
| 3220 | set tl [::project::CreateForm \ |
|---|
| 3221 | -title [mc "Series graph: %s" $name] \ |
|---|
| 3222 | -type Graphs \ |
|---|
| 3223 | -iniconfig SeriesGraph \ |
|---|
| 3224 | -width 900 -height 650 -helpkey "Tb4GraSer" |
|---|
| 3225 | ]}] |
|---|
| 3226 | set tlf [$tl getframe] |
|---|
| 3227 | # configuration |
|---|
| 3228 | set t2 [time { |
|---|
| 3229 | set Instance [::SeriesGraph::Create $tlf.g $sergrp] |
|---|
| 3230 | }] |
|---|
| 3231 | #puts "t0 = $t0" |
|---|
| 3232 | #puts "t1 = $t1" |
|---|
| 3233 | #puts "t2 = $t2" |
|---|
| 3234 | if { $gcf != "" } { |
|---|
| 3235 | ::bayesGraph::LoadGCF $Instance $gcf |
|---|
| 3236 | } |
|---|
| 3237 | bind $tlf.g <Destroy> +[list ::tol::seriegrp destroy $sergrp] |
|---|
| 3238 | pack $tlf.g -fill both -expand yes |
|---|
| 3239 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3240 | update |
|---|
| 3241 | # Esta opción se debe aplicar cuando el gráfico esté empacado |
|---|
| 3242 | #::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0 |
|---|
| 3243 | } |
|---|
| 3244 | } |
|---|
| 3245 | |
|---|
| 3246 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3247 | proc ::TolInspector::DrawAutocorSerie { serie } { |
|---|
| 3248 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3249 | variable group_id |
|---|
| 3250 | |
|---|
| 3251 | incr group_id |
|---|
| 3252 | # title |
|---|
| 3253 | |
|---|
| 3254 | if {[llength $serie] > 1} { |
|---|
| 3255 | set nameSerie [lindex [::tol::info variable $serie] 1] |
|---|
| 3256 | } else { |
|---|
| 3257 | set nameSerie $serie |
|---|
| 3258 | } |
|---|
| 3259 | # create |
|---|
| 3260 | set tl [::project::CreateForm \ |
|---|
| 3261 | -title "[mc "Autocorrelation graph"]: $nameSerie" \ |
|---|
| 3262 | -iniconfig AutocorGraph \ |
|---|
| 3263 | -type Graphs \ |
|---|
| 3264 | -width 900 -height 650 -helpkey "Tb4GraAco" |
|---|
| 3265 | ] |
|---|
| 3266 | set tlf [$tl getframe] |
|---|
| 3267 | # configuration |
|---|
| 3268 | ::AutocorGraph::Create $tlf.g $serie |
|---|
| 3269 | $tl bind <Control-F4> "$tl kill; break" |
|---|
| 3270 | pack $tlf.g -fill both -expand yes |
|---|
| 3271 | update |
|---|
| 3272 | } |
|---|
| 3273 | |
|---|
| 3274 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3275 | proc ::TolInspector::TableSerie { } { |
|---|
| 3276 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3277 | variable options_selected |
|---|
| 3278 | variable group_id |
|---|
| 3279 | upvar \#0 ::TolInspector::options_selected(Serie) series_selected |
|---|
| 3280 | |
|---|
| 3281 | set series "" |
|---|
| 3282 | foreach it $series_selected { |
|---|
| 3283 | lappend series [lindex $it 0] |
|---|
| 3284 | } |
|---|
| 3285 | |
|---|
| 3286 | if { [llength $series] } { |
|---|
| 3287 | incr group_id |
|---|
| 3288 | |
|---|
| 3289 | set sergrp group$group_id |
|---|
| 3290 | eval "::tol::seriegrp create $sergrp $series" |
|---|
| 3291 | |
|---|
| 3292 | # create |
|---|
| 3293 | set tl [::project::CreateForm \ |
|---|
| 3294 | -title [mc "Time series table"] \ |
|---|
| 3295 | -iniconfig SeriesTable \ |
|---|
| 3296 | -type Tables -helpkey "Tb4Edt" |
|---|
| 3297 | ] |
|---|
| 3298 | set tlf [$tl getframe] |
|---|
| 3299 | # configuration |
|---|
| 3300 | btable $tlf.t -parent $tl \ |
|---|
| 3301 | -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \ |
|---|
| 3302 | -iniconfig btable |
|---|
| 3303 | $tlf.t fillSerie $sergrp |
|---|
| 3304 | bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp] |
|---|
| 3305 | pack $tlf.t -fill both -expand yes |
|---|
| 3306 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3307 | update |
|---|
| 3308 | } |
|---|
| 3309 | } |
|---|
| 3310 | |
|---|
| 3311 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3312 | proc ::TolInspector::TableAutocorSerie { serie } { |
|---|
| 3313 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3314 | variable group_id |
|---|
| 3315 | |
|---|
| 3316 | incr group_id |
|---|
| 3317 | # title |
|---|
| 3318 | if {[llength $serie] > 1} { |
|---|
| 3319 | set nameSerie [lindex [::tol::info variable $serie] 1] |
|---|
| 3320 | } else { |
|---|
| 3321 | set nameSerie $serie |
|---|
| 3322 | } |
|---|
| 3323 | # create |
|---|
| 3324 | set tl [::project::CreateForm \ |
|---|
| 3325 | -title "[mc "Autocorrelation table"]: $nameSerie" \ |
|---|
| 3326 | -iniconfig AutocorGraphTable \ |
|---|
| 3327 | -type Tables -helpkey "Tb4Edt" |
|---|
| 3328 | ] |
|---|
| 3329 | set tlf [$tl getframe] |
|---|
| 3330 | # configuration |
|---|
| 3331 | btable $tlf.t -parent $tl \ |
|---|
| 3332 | -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \ |
|---|
| 3333 | -iniconfig btable |
|---|
| 3334 | $tlf.t fillAutocor $serie "" |
|---|
| 3335 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3336 | pack $tlf.t -fill both -expand yes |
|---|
| 3337 | } |
|---|
| 3338 | |
|---|
| 3339 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3340 | proc ::TolInspector::TableStatisticsSerie { } { |
|---|
| 3341 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3342 | variable options_selected |
|---|
| 3343 | variable group_id |
|---|
| 3344 | upvar \#0 ::TolInspector::options_selected(Serie) series_selected |
|---|
| 3345 | |
|---|
| 3346 | set series "" |
|---|
| 3347 | foreach it $series_selected { |
|---|
| 3348 | lappend series [lindex $it 0] |
|---|
| 3349 | } |
|---|
| 3350 | |
|---|
| 3351 | if { [llength $series] } { |
|---|
| 3352 | incr group_id |
|---|
| 3353 | |
|---|
| 3354 | set sergrp group$group_id |
|---|
| 3355 | eval "::tol::seriegrp create $sergrp $series" |
|---|
| 3356 | # create |
|---|
| 3357 | set tl [::project::CreateForm \ |
|---|
| 3358 | -title [mc "Statistics table"] \ |
|---|
| 3359 | -iniconfig StatisticsTable \ |
|---|
| 3360 | -type Tables -helpkey "Tb4Edt" |
|---|
| 3361 | ] |
|---|
| 3362 | set tlf [$tl getframe] |
|---|
| 3363 | # configuration |
|---|
| 3364 | btable $tlf.t -parent $tl \ |
|---|
| 3365 | -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \ |
|---|
| 3366 | -iniconfig btable |
|---|
| 3367 | $tlf.t fillStatistics $sergrp |
|---|
| 3368 | bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp] |
|---|
| 3369 | $tl bind <Control-F4> [list $tl kill] |
|---|
| 3370 | pack $tlf.t -fill both -expand yes |
|---|
| 3371 | } |
|---|
| 3372 | } |
|---|
| 3373 | |
|---|
| 3374 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3375 | proc ::TolInspector::ViewTimeSet { tms args } { |
|---|
| 3376 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3377 | variable group_id |
|---|
| 3378 | |
|---|
| 3379 | incr group_id |
|---|
| 3380 | |
|---|
| 3381 | #puts "::TolInspector::ViewTimeSet $tms" |
|---|
| 3382 | # args |
|---|
| 3383 | array set opts [list \ |
|---|
| 3384 | -title "[mc "TimeSet calendar"]: $tms" \ |
|---|
| 3385 | -geometry {} |
|---|
| 3386 | ] |
|---|
| 3387 | array set opts $args |
|---|
| 3388 | |
|---|
| 3389 | # create |
|---|
| 3390 | set tl [::project::CreateForm \ |
|---|
| 3391 | -title $opts(-title) \ |
|---|
| 3392 | -iniconfig Calendar \ |
|---|
| 3393 | -type TimeSets -width 470 -height 345 -helpkey "Tb4Cal" |
|---|
| 3394 | ] |
|---|
| 3395 | # geometry |
|---|
| 3396 | $tl setgeometry $opts(-geometry) |
|---|
| 3397 | |
|---|
| 3398 | set tlf [$tl getframe] |
|---|
| 3399 | # configuration |
|---|
| 3400 | set tmscmd tms$group_id |
|---|
| 3401 | ::tol::timeset create $tmscmd $tms |
|---|
| 3402 | ::CalendarTms::Create $tlf.t $tmscmd |
|---|
| 3403 | bind $tlf.t <Destroy> +[list ::tol::timeset destroy $tmscmd] |
|---|
| 3404 | bind $tl <Control-F4> [list $tl kill] |
|---|
| 3405 | pack $tlf.t -fill both -expand yes |
|---|
| 3406 | |
|---|
| 3407 | return $tl |
|---|
| 3408 | } |
|---|
| 3409 | |
|---|
| 3410 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3411 | proc ::TolInspector::ViewDefinition {name path grammar} { |
|---|
| 3412 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3413 | variable w_tabset |
|---|
| 3414 | if {$path == ""} { |
|---|
| 3415 | tk_messageBox -type ok -icon warning\ |
|---|
| 3416 | -message [mc "Object %1\$s is not defined in a tol file" $name]\ |
|---|
| 3417 | -parent $w_tabset -title [mc Warning] |
|---|
| 3418 | return |
|---|
| 3419 | } |
|---|
| 3420 | set ext [file extension $path] |
|---|
| 3421 | switch -- $ext { |
|---|
| 3422 | .tol - |
|---|
| 3423 | .TOL { |
|---|
| 3424 | set Instance [::Editor::Open $path] |
|---|
| 3425 | update |
|---|
| 3426 | if {[string equal $grammar "Code"] || |
|---|
| 3427 | [string equal $grammar "Anything"]} { |
|---|
| 3428 | append txtFind " " $name "( )*\\(" |
|---|
| 3429 | } else { |
|---|
| 3430 | #append txtFind $grammar "( )+" $name |
|---|
| 3431 | append txtFind $name |
|---|
| 3432 | } |
|---|
| 3433 | #Me situo al principio del texto |
|---|
| 3434 | set editor [::Editor::GetText $Instance] |
|---|
| 3435 | tk::TextSetCursor $editor 1.0 |
|---|
| 3436 | ::BayesText::FindShow $editor 1 $txtFind 1 |
|---|
| 3437 | #::Editor::CmdFindNext $Instance $txtFind |
|---|
| 3438 | } |
|---|
| 3439 | .bst - |
|---|
| 3440 | .BST - |
|---|
| 3441 | .bdt - |
|---|
| 3442 | .BDT { |
|---|
| 3443 | # Igual luego se abre como tabla |
|---|
| 3444 | ::Editor::Open $path |
|---|
| 3445 | } |
|---|
| 3446 | } |
|---|
| 3447 | } |
|---|
| 3448 | |
|---|
| 3449 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3450 | proc ::TolInspector::ViewFile {name} { |
|---|
| 3451 | # |
|---|
| 3452 | # PURPOSE: |
|---|
| 3453 | # |
|---|
| 3454 | # PARAMETERS: |
|---|
| 3455 | # name -> cadena con el nombre de un archivo o el de una variable |
|---|
| 3456 | # que hace referencia a un archivo |
|---|
| 3457 | # |
|---|
| 3458 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3459 | # En name puede venir el nombre de un archivo o el de una variable |
|---|
| 3460 | # que hace referencia a un archivo. |
|---|
| 3461 | #puts "ViewFile. name=$name" |
|---|
| 3462 | if [file isfile $name] { |
|---|
| 3463 | set path $name |
|---|
| 3464 | } else { |
|---|
| 3465 | set path [::tol::info path $name] |
|---|
| 3466 | } |
|---|
| 3467 | ::Editor::Open $path |
|---|
| 3468 | } |
|---|
| 3469 | |
|---|
| 3470 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3471 | proc ::TolInspector::DecompileFile {name} { |
|---|
| 3472 | # |
|---|
| 3473 | # PURPOSE: |
|---|
| 3474 | # |
|---|
| 3475 | # PARAMETERS: |
|---|
| 3476 | # name -> cadena con el nombre de un archivo o el de una variable |
|---|
| 3477 | # que hace referencia a un archivo |
|---|
| 3478 | # |
|---|
| 3479 | # TODO: Actualmente en name solo puede llegar el nombre de un archivo |
|---|
| 3480 | # |
|---|
| 3481 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3482 | variable data |
|---|
| 3483 | #puts "DECOMPILE 1.1, name=$name" |
|---|
| 3484 | if {[file isfile $name]} { |
|---|
| 3485 | set path $name |
|---|
| 3486 | } else { |
|---|
| 3487 | set path [::tol::info path $name] |
|---|
| 3488 | } |
|---|
| 3489 | #puts "DECOMPILE 1.2" |
|---|
| 3490 | #Comprobar si el archivo ya está abierto y si es asà poner que no está compilado |
|---|
| 3491 | if [namespace exists ::Editor] { |
|---|
| 3492 | foreach ins [namespace children ::Editor] { |
|---|
| 3493 | upvar \#0 ${ins}::data dataEd |
|---|
| 3494 | if [string equal $dataEd(nameFile) $path] { |
|---|
| 3495 | set dataEd(isCompiled) 0 |
|---|
| 3496 | } |
|---|
| 3497 | } |
|---|
| 3498 | } |
|---|
| 3499 | #puts "DECOMPILE 1.3" |
|---|
| 3500 | #Quitar del spool todos los objetos provenientes de este archivo |
|---|
| 3501 | |
|---|
| 3502 | foreach _obj $data(pool,objects) { |
|---|
| 3503 | array set obj $_obj |
|---|
| 3504 | #Tolcon_Trace "REFERENCIA: $obj(reference)" |
|---|
| 3505 | if {[string equal [lindex $obj(reference) 0] $path]} { |
|---|
| 3506 | set idx [lsearch $data(pool,objects) $_obj] |
|---|
| 3507 | set data(pool,objects) [lreplace $data(pool,objects) $idx $idx] |
|---|
| 3508 | } |
|---|
| 3509 | } |
|---|
| 3510 | # https://www.tol-project.org/ticket/1483 |
|---|
| 3511 | catch { |
|---|
| 3512 | ::tol::decompile $path |
|---|
| 3513 | } |
|---|
| 3514 | ::TolInspector::UpdateFileRoot |
|---|
| 3515 | } |
|---|
| 3516 | |
|---|
| 3517 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3518 | proc ::TolInspector::ReadUserFunctions {} { |
|---|
| 3519 | # |
|---|
| 3520 | # PURPOSE: Recorre el set global que tiene la definicion de funciones y va |
|---|
| 3521 | # guardando esa informacion en arrays para almacenarla finalmente en |
|---|
| 3522 | # regFunLst |
|---|
| 3523 | # |
|---|
| 3524 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3525 | variable regFunLst |
|---|
| 3526 | |
|---|
| 3527 | #Set global que tiene la definicion de funciones |
|---|
| 3528 | set obj GuiFunction |
|---|
| 3529 | |
|---|
| 3530 | if { [llength [set infAry [TclInfoVar Set $obj]] ] } { |
|---|
| 3531 | #Tolcon_Trace "ReadUserFunctions: infAry = $infAry" |
|---|
| 3532 | array set info $infAry |
|---|
| 3533 | set nFun [lindex $info(CONTENT) 0] |
|---|
| 3534 | #Tolcon_Trace "Numero de funciones =$nFun" |
|---|
| 3535 | for {set idf 1} {$idf <= $nFun} {incr idf} { |
|---|
| 3536 | array set ifNameFun [TclInfoRef [list Set $obj $idf 1]] |
|---|
| 3537 | array set ifNameGui [TclInfoRef [list Set $obj $idf 2]] |
|---|
| 3538 | array set ifTypeGui [TclInfoRef [list Set $obj $idf 3]] |
|---|
| 3539 | array set ifTypeOut [TclInfoRef [list Set $obj $idf 4]] |
|---|
| 3540 | array set ifParams [TclInfoRef [list Set $obj $idf 5]] |
|---|
| 3541 | #Hago lindex $a(CONTENT) 0 para quitar las comillas |
|---|
| 3542 | set regFun($idf,nameFun) [lindex $ifNameFun(CONTENT) 0] |
|---|
| 3543 | set regFun($idf,nameGui) [lindex $ifNameGui(CONTENT) 0] |
|---|
| 3544 | set regFun($idf,typeGui) [lindex $ifTypeGui(CONTENT) 0] |
|---|
| 3545 | set regFun($idf,typeOut) [lindex $ifTypeOut(CONTENT) 0] |
|---|
| 3546 | set nPar [lindex $ifParams(CONTENT) 0] |
|---|
| 3547 | #Tolcon_Trace "Numero de parametros =$nPar" |
|---|
| 3548 | for {set idp 1} {$idp <= $nPar} {incr idp} { |
|---|
| 3549 | array set ipNameGui [TclInfoRef [list Set $obj $idf 5 $idp 1]] |
|---|
| 3550 | array set ipTypePar [TclInfoRef [list Set $obj $idf 5 $idp 2]] |
|---|
| 3551 | array set ipTypeSel [TclInfoRef [list Set $obj $idf 5 $idp 3]] |
|---|
| 3552 | array set ipListVal [TclInfoRef [list Set $obj $idf 5 $idp 4]] |
|---|
| 3553 | set regPar($idp,nameGui) [lindex $ipNameGui(CONTENT) 0] |
|---|
| 3554 | set regPar($idp,typePar) [lindex $ipTypePar(CONTENT) 0] |
|---|
| 3555 | set regPar($idp,typeSel) $ipTypeSel(CONTENT) |
|---|
| 3556 | set nVal [lindex $ipListVal(CONTENT) 0] |
|---|
| 3557 | #Tolcon_Trace "nVal=$nVal" |
|---|
| 3558 | set lstVal "" |
|---|
| 3559 | for {set idv 1} {$idv <= $nVal} {incr idv} { |
|---|
| 3560 | array set iVal [TclInfoRef [list Set $obj $idf 5 $idp 4 $idv]] |
|---|
| 3561 | lappend lstVal [lindex $iVal(CONTENT) 0] |
|---|
| 3562 | } |
|---|
| 3563 | set regPar($idp,lstVal) $lstVal |
|---|
| 3564 | } |
|---|
| 3565 | set regFun($idf,parameters) [array get regPar] |
|---|
| 3566 | array unset regPar |
|---|
| 3567 | #parray regFun |
|---|
| 3568 | } |
|---|
| 3569 | set regFunLst [array get regFun] |
|---|
| 3570 | } else { |
|---|
| 3571 | set regFunLst "" |
|---|
| 3572 | } |
|---|
| 3573 | } |
|---|
| 3574 | |
|---|
| 3575 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3576 | proc ::TolInspector::ShowMenuUserFunc {gra} { |
|---|
| 3577 | # |
|---|
| 3578 | # PURPOSE: Muestra un menu contextual que... |
|---|
| 3579 | # |
|---|
| 3580 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3581 | variable data_menu |
|---|
| 3582 | variable regFunLst |
|---|
| 3583 | |
|---|
| 3584 | #puts "ShowMenuUserFunc: gra=$gra" |
|---|
| 3585 | if {[expr [info exist ::TolInspector::regFunLst] && [llength $regFunLst] ]} { |
|---|
| 3586 | array set regFun $regFunLst |
|---|
| 3587 | regsub -all ,nameGui \ |
|---|
| 3588 | [array names regFun *,nameGui] "" lstFun |
|---|
| 3589 | foreach idf [lsort -integer $lstFun] { |
|---|
| 3590 | set typeGui [split $regFun($idf,typeGui) .] |
|---|
| 3591 | switch [lindex $typeGui 0] { |
|---|
| 3592 | Ite - Set { |
|---|
| 3593 | if {[lindex $typeGui 1] eq $gra} { |
|---|
| 3594 | $data_menu($gra,Functions) add command -label [mc $regFun($idf,nameGui)]\ |
|---|
| 3595 | -command [list ::TolInspector::CallUserFunction $gra $idf] |
|---|
| 3596 | } |
|---|
| 3597 | } |
|---|
| 3598 | default { |
|---|
| 3599 | } |
|---|
| 3600 | } |
|---|
| 3601 | } |
|---|
| 3602 | } |
|---|
| 3603 | } |
|---|
| 3604 | |
|---|
| 3605 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3606 | proc ::TolInspector::CallUserFunction {grammar idx} { |
|---|
| 3607 | # |
|---|
| 3608 | # PURPOSE: Para los tipos de funciones Ite y Set, muestra un dialogo que |
|---|
| 3609 | # pide los |
|---|
| 3610 | # |
|---|
| 3611 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 3612 | variable regFunLst |
|---|
| 3613 | variable group_id |
|---|
| 3614 | variable data |
|---|
| 3615 | variable options_selected |
|---|
| 3616 | |
|---|
| 3617 | upvar \#0 ::TolInspector::options_selected($grammar) items_selected |
|---|
| 3618 | #puts "CallUserFunction. grammar=$grammar, idx=$idx, items_selected=$items_selected" |
|---|
| 3619 | |
|---|
| 3620 | set all_objs [ list ] |
|---|
| 3621 | foreach it $items_selected { |
|---|
| 3622 | set tcl_ref [ lindex $it 0 ] |
|---|
| 3623 | set obj_addr [ ::tol::info address $tcl_ref ] |
|---|
| 3624 | lappend all_objs "GetObjectFromAddress(\"$obj_addr\")" |
|---|
| 3625 | } |
|---|
| 3626 | |
|---|
| 3627 | if { [ llength $all_objs ] } { |
|---|
| 3628 | incr group_id |
|---|
| 3629 | array set regFun $regFunLst |
|---|
| 3630 | set gui [bguifunction .t$group_id \ |
|---|
| 3631 | -title $regFun($idx,nameGui) \ |
|---|
| 3632 | -regpars $regFun($idx,parameters)] |
|---|
| 3633 | set txtPars [join [$gui get values] ,] |
|---|
| 3634 | if {$txtPars ne ""} { |
|---|
| 3635 | set txtPars ",$txtPars" |
|---|
| 3636 | } |
|---|
| 3637 | destroy $gui |
|---|
| 3638 | set typeGui [split $regFun($idx,typeGui) .] |
|---|
| 3639 | switch [lindex $typeGui 0] { |
|---|
| 3640 | Ite { |
|---|
| 3641 | foreach obj $all_objs { |
|---|
| 3642 | set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($obj $txtPars)" |
|---|
| 3643 | #Tolcon_Trace "Ite.cmd=$cmd" |
|---|
| 3644 | ::tol::console eval $cmd |
|---|
| 3645 | ::TolConsole::SaveEval $cmd |
|---|
| 3646 | } |
|---|
| 3647 | } |
|---|
| 3648 | Set { |
|---|
| 3649 | set obj_args [join $all_objs ,] |
|---|
| 3650 | set setCmd "SetOf[lindex $typeGui 1] ($obj_args)" |
|---|
| 3651 | set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($setCmd $txtPars)" |
|---|
| 3652 | #Tolcon_Trace "Set.cmd=$cmd" |
|---|
| 3653 | ::tol::console eval $cmd |
|---|
| 3654 | ::TolConsole::SaveEval $cmd |
|---|
| 3655 | } |
|---|
| 3656 | default { |
|---|
| 3657 | } |
|---|
| 3658 | } |
|---|
| 3659 | ::TolInspector::UpdateConsoleObj |
|---|
| 3660 | } |
|---|
| 3661 | } |
|---|
| 3662 | |
|---|
| 3663 | namespace eval ::LoadStatus { |
|---|
| 3664 | variable data |
|---|
| 3665 | } |
|---|
| 3666 | |
|---|
| 3667 | #proc ::LoadStatus::Show {file} { |
|---|
| 3668 | # |
|---|
| 3669 | # set f [toplevel .topStatus] |
|---|
| 3670 | # #wm protocol $path WM_DELETE_WINDOW [list ::Editor::OnDelete $this] |
|---|
| 3671 | # # bind Destroy más abajo |
|---|
| 3672 | # |
|---|
| 3673 | # label $f.lfile -text $file |
|---|
| 3674 | # # frame y label para barra de estado |
|---|
| 3675 | # set data(sb,frame) [frame $f.fop -relief groove -bd 1 -height 7] |
|---|
| 3676 | # set data(sb,objs) [label $f.fop.objs -relief groove -bd 1 -width 16] |
|---|
| 3677 | # set data(sb,files) [label $f.fop.files -text [mc "Not Compiled"] \ |
|---|
| 3678 | # -relief raised -bd 1 -width 16] |
|---|
| 3679 | # set data(sb,time) [label $f.fop.time -bd 1 -width 14] |
|---|
| 3680 | # set data(sb,rell) [label $f.fop.rell -relief groove -bd 1] |
|---|
| 3681 | # |
|---|
| 3682 | # |
|---|
| 3683 | # # empaquetamos los label de estado |
|---|
| 3684 | # pack $f.fop.objs $f.fop.files $f.fop.time -side left |
|---|
| 3685 | # pack $f.fop.rell -expand true -fill x |
|---|
| 3686 | # |
|---|
| 3687 | # grid $f.lfile -sticky news |
|---|
| 3688 | # grid $f.fop -sticky ews |
|---|
| 3689 | # |
|---|
| 3690 | # grid rowconfigure $f 1 -weight 1 |
|---|
| 3691 | # grid columnconfigure $f 0 -weight 1 |
|---|
| 3692 | # |
|---|
| 3693 | #} |
|---|
| 3694 | # |
|---|
| 3695 | # |
|---|
| 3696 | #proc ::LoadStatus::Hide {w} { |
|---|
| 3697 | # |
|---|
| 3698 | # |
|---|