Ignore:
Timestamp:
Nov 3, 2016, 8:59:28 AM (10 years ago)
Author:
Pedro Gea <pgea@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
e0578ae
Parents:
7a3f24e
Message:

Refs #1933
Se sustituye el uso de los widgets de BLT: ::blt::tree y ::blt::treeview por el árbol ::wtree basado en ::treectrl.
Se incorporan muchos cambios a la vez. Podrían destacarse los siguientes:

  • Se sustituye blt_tree y ht_tree por wt_tree, y de modo similar blt_vartree y ht_vars por wt_vars y blt_functree y ht_funcs por wt_funcs.
  • Se utilizan las columnas de ::wtree para almacenar la información de cada nodo. Esto simplifica algunos métodos que pueden reescribirse más fácilmente.
  • Se revisa el uso de algunos atributos (variable) usados para el paso de argumentos entre métodos. Desaparecen algunos de ellos y aparece el atributo arguments.
  • Se eliminan algunos métodos auxiliares de los que se podían prescindir y algunos que no estaban usándose.
  • Se prescinde del Spool principalmente por dos motivos: (1) estaba dando problemas y corregirlo conlleva bastante trabajo y (2) la consola puede servir para lo mismo una vez implementada la opción de menú que permite llevar cualquier objeto TOL a la consola. Se implementa esta opción.
  • Provisionalmente, tanto el árbol del inspector (::wtree izquierdo) como el listado de objetos (::wtree's derechos) muestran más columnas de lo necesario.
  • Se implementa el llenado del listado de objetos al seleccionar el nodo raíz de los paquetes.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7333 be4846ae-f051-483a-831f-b64e7d08527f

File:
1 edited

Legend:

Unmodified
Added
Removed

  • tolbase/lib/toltk/tolinspe__wtree2.tcl

    r7a3f24e r6207115  
    33proc ::TolInspector::ClearConsoleObj { } {
    44#/////////////////////////////////////////////////////////////////////////////
    5   variable ht_tree
    6   variable data
    7    
    8   set idx_con [$ht_tree index root-console]
    9   $ht_tree entry delete $idx_con 0 end
    10    
    11   #Quitamos del spool todos los objetos que provengan de la consola
    12   foreach _obj $data(pool,objects) {
    13     array set obj $_obj
    14     if {[string equal $obj(origin) "root-console"]} {
    15       set idx [lsearch $data(pool,objects) $_obj]
    16       set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
    17     }
    18   }
    19   UpdatePoolObj
    20   #Finalmente limpiamos el stack de la consola de tol
     5  variable wt_tree
     6
     7  foreach it [$wt_tree item children "root-console"] {
     8    $wt_tree item delete $it
     9  }
     10  #Limpiamos el stack de la consola de tol
    2111  ::tol::console stack release
    2212}
    2313
    2414#/////////////////////////////////////////////////////////////////////////////
    25 proc ::TolInspector::ClearConsoleObjSel {ht} {
     15proc ::TolInspector::ClearConsoleObjSel {wt} {
    2616#/////////////////////////////////////////////////////////////////////////////
    2717  variable vars_selected
    28   variable data
    2918
    3019  foreach var $vars_selected {
    31     set name [$ht entry cget $var -label]
     20    set name [$wt item text $var [WiName 0]]
    3221    #puts "name=$name"
    33     #Quitamos del spool todos los objetos que provengan de la consola
    34     foreach _obj $data(pool,objects) {
    35       array set obj $_obj
    36       #puts "_obj=$_obj"
    37       if {[string equal $obj(origin) "root-console"] && [string equal $obj(objName) $name]} {
    38         set idx [lsearch $data(pool,objects) $_obj]
    39         set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
    40       }
    41     }
    42     UpdatePoolObj
    43     #Finalmente quitamos el objeto de la consola de tol
     22    #Quitamos el objeto de la consola de tol
    4423    ::tol::console stack release $name
    4524  }
    … …  
    5029proc ::TolInspector::UpdateFileRoot { } {
    5130#///////////////////////////////////////////////////////////////////////////// 
    52   variable ht_tree
     31  variable wt_tree
    5332  set open 0
    54   set idx_file [$ht_tree index root-files]
    55   if { [$ht_tree entry isopen $idx_file] } {
    56     $ht_tree close $idx_file
     33  set idx_file [$wt_tree item id "root-files"]
     34  if { [$wt_tree item isopen $idx_file] } {
     35    $wt_tree collapse $idx_file
    5736    set open 1
    5837  }
    59   if { [$ht_tree index focus] == $idx_file } {
     38  #@! if { [$wt_tree index focus] == $idx_file }
     39  if { [$wt_tree item state get $idx_file focus] } {
    6040    SelectObject
    6141  }
    6242  if $open {
    63     $ht_tree open $idx_file
     43    $wt_tree expand $idx_file
    6444  }
    6545}
    … …  
    6848proc ::TolInspector::UpdateConsoleObj { } {
    6949#///////////////////////////////////////////////////////////////////////////// 
    70   variable ht_tree
    71 
    72   set idx_con [$ht_tree index root-console]
    73   if { [$ht_tree entry isopen $idx_con] } {
    74     $ht_tree close $idx_con
    75   }
    76   $ht_tree selection anchor root-console
    77   $ht_tree selection mark root-console
     50  variable wt_tree
     51
     52  set idx_con [$wt_tree item id "root-console"]
     53  if { [$wt_tree item isopen $idx_con] } {
     54    $wt_tree collapse $idx_con
     55  }
     56  #@! $ht_tree selection anchor root-console
     57  #@! $ht_tree selection mark root-console
     58  $wt_tree selection clear
     59  $wt_tree selection add $idx_con
    7860  #Tolcon_Trace "Abierto el nodo root-console"
    79   if { [$ht_tree index focus] == $idx_con } {
     61  if { [$wt_tree item state get $idx_con focus] } {
    8062    SelectObject
    8163  }
    8264}
    83 
    84 #/////////////////////////////////////////////////////////////////////////////
    85 proc ::TolInspector::UpdatePoolObj { } {
    86 #///////////////////////////////////////////////////////////////////////////// 
    87   variable ht_tree
    88 
    89   set idx_pool [$ht_tree index root-pool]
    90   if { [$ht_tree entry isopen $idx_pool] } {
    91     $ht_tree close $idx_pool
    92   }
    93   if { [$ht_tree index focus] == $idx_pool } {
    94     SelectObject
    95   }
    96 }
    97 
    9865
    9966#/////////////////////////////////////////////////////////////////////////////
    … …  
    11178  variable vars_selected
    11279  variable options_selected
    113   variable ht_vars
    114   variable ht_tree
    115   variable item_data
    116   variable data
    117 
    118   variable tolset
    119   variable tolindex
     80  variable wt_vars
     81  variable wt_tree
    12082
    12183  #User functions to contextual menu
    … …  
    12890    $data_menu($it) delete 0 end
    12991  }
    130   set InRootConsole [string equal [lindex [$ht_tree get -full anchor] end] "root-console"]
    131   set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
    132   set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end] "root-files"]
    133   #puts "PostVariable: InRootConsole,InRootPool,InRootFiles = $InRootConsole,$InRootPool,$InRootFiles"
    134   set node_act [$ht_vars index current]
     92 
     93  set parent [$wt_tree selection get 0]
     94  set parent_tolReference [$wt_tree item text $parent [WiTolReference 1]]
     95 
     96  set InRootConsole [string equal $parent_tolReference "Console"]
     97  set InRootFiles [string equal $parent_tolReference "File"]
     98  set InRootGrammars [string equal $parent_tolReference "Grammar"] 
     99 
     100  #puts "PostVariable: InRootConsole,InRootFiles = $InRootConsole,$InRootFiles"
     101  #@! set node_act [$ht_vars index current]
     102  set node_act [$wt_vars selection get end] ;# current
    135103  if { [string length $node_act] } {
    136     set vars_selected [$ht_vars curselection]
     104    #@! set vars_selected [$ht_vars curselection]
     105    set vars_selected [$wt_vars selection get 0 end] ;# curselection
    137106    if { [lsearch $vars_selected $node_act] >= 0 } {
    138107      foreach var $vars_selected {
    139         array set aryData [$ht_vars entry cget $var -data]
    140         #puts "PostVariable: aryData = [array get aryData]"
    141         set itemid $aryData(Index)
    142         set path   $aryData(Path)
    143         set grammar [lindex $item_data($itemid) 2]
    144         set objName [$ht_vars entry cget $var -label]
     108        set itemid  [$wt_vars item text $var [WiIndex 0]]
     109        set path    [$wt_vars item text $var [WiPath 0]]
     110        set grammar [$wt_vars item text $var [WiGrammar 0]]
     111        set objName [$wt_vars item text $var [WiName 0]]
     112        set object [$wt_vars item text $var [WiTolReference 0]] 
     113       
    145114        #puts "OBJECT=$objName, PATH=$path"
    146         if { $InRootPool } {
    147           set object $data(pool,variables,$itemid)
    148         } else {
    149           if {[llength $aryData(Reference)]} {
    150             #set object [lindex $aryData(Reference) 0]
    151             set object [lrange $aryData(Reference) 0 end]
    152           } else {
    153             if { [string length $tolset] } {
    154               #set object [concat [list File $tolset] $tolindex $itemid]
    155               set object [concat $tolset $tolindex $itemid]
    156               #puts "tolset = $tolset"
    157             } else {
    158               if [llength $objName] {
    159                 set object [list $grammar $objName]
    160               } else {
    161                 set object $objName
    162               }
    163             }
    164           }
    165         }
     115       
    166116        lappend all_objects $object
    167         #puts "PostVariable: OBJECT=$object OBJNAME=$objName TOLSET=$tolset PATH=$path GRAMMAR=$grammar"
    168117        switch -- $grammar {
    169118          Code    -
    … …  
    220169            VMatrix -
    221170            Matrix  {
    222               $data_menu(main) add cascade -label [mc "Export matrix"]\
     171              $data_menu(main) add cascade -label [mc "Export matrix"] \
    223172              -menu $data_menu(Matrix,Export)
    224173              if {[llength $options_selected($grammar)] == 1} {
    … …  
    238187                  -menu $data_menu(Matrix,Draw)
    239188                foreach objInfo $options_selected(Matrix) {
    240                   $data_menu(Matrix,Table) add command -label [lindex $objInfo 1]\
     189                  $data_menu(Matrix,Table) add command -label [lindex $objInfo 1] \
    241190                    -command [list ::TolInspector::TableMatrix [lindex $objInfo 0]]
    242                   $data_menu(Matrix,Export,BDT) add command -label [lindex $objInfo 1]\
     191                  $data_menu(Matrix,Export,BDT) add command -label [lindex $objInfo 1] \
    243192                    -command [list ::TolInspector::ExportBDTMatrix [lindex $objInfo 0]]
    244193                  $data_menu(Matrix,Draw) add command -label [lindex $objInfo 1] \
    … …  
    260209                set lblSerie "series"
    261210              }
    262               $data_menu(main) add command -label [mc "Draw $lblSerie"]\
     211              $data_menu(main) add command -label [mc "Draw $lblSerie"] \
    263212              -command ::TolInspector::DrawSerie
    264               $data_menu(main) add command -label [mc "Table $lblSerie"]\
     213              $data_menu(main) add command -label [mc "Table $lblSerie"] \
    265214              -command ::TolInspector::TableSerie             
    266215              if {[llength $options_selected(Serie)] == 1} {
    … …  
    276225                  -menu $data_menu(Serie,TableAutocor)
    277226                foreach objInfo $options_selected(Serie) {
    278                   $data_menu(Serie,DrawAutocor) add command -label [lindex $objInfo 1]\
     227                  $data_menu(Serie,DrawAutocor) add command -label [lindex $objInfo 1] \
    279228                    -command [list ::TolInspector::DrawAutocorSerie [lindex $objInfo 0]]
    280                   $data_menu(Serie,TableAutocor) add command -label [lindex $objInfo 1]\
     229                  $data_menu(Serie,TableAutocor) add command -label [lindex $objInfo 1] \
    281230                    -command [list ::TolInspector::TableAutocorSerie [lindex $objInfo 0]]
    282231                }
    283232              }
    284               $data_menu(main) add command -label [mc "Table statistics"]\
     233              $data_menu(main) add command -label [mc "Table statistics"] \
    285234                  -command ::TolInspector::TableStatisticsSerie
    286235            }
    … …  
    474423        # Store selection in oza
    475424
    476         if { $InRootPool } {
    477           $data_menu(main) add command -label [mc "Remove from spool"] \
    478             -command [list ::TolInspector::RemoveFromSpool $ht_vars]
    479         } else  {
    480           $data_menu(main) add command -label [mc "Add to spool"] \
    481             -command [list ::TolInspector::AddToSpool $ht_vars [lindex [$ht_tree get -full anchor] 1]]
    482         }
    483         $data_menu(main) add command -label [mc "To Eval window"] \
    484                 -command [list ::TolInspector::AddToEvalWindow $ht_vars]
     425        $data_menu(main) add command -label [mc "Add to Console"] \
     426                -command [list ::TolInspector::AddToConsole $wt_vars]
     427        $data_menu(main) add command -label [mc "Write into Eval"] \
     428                -command [list ::TolInspector::AddToEvalWindow $wt_vars]
    485429        $data_menu(main) add separator
    486430        if { $InRootConsole} {
    487431          $data_menu(main) add command -label [mc "Decompile"] \
    488             -command [list ::TolInspector::ClearConsoleObjSel $ht_vars]
     432            -command [list ::TolInspector::ClearConsoleObjSel $wt_vars]
    489433          $data_menu(main) add separator
    490434        }
    491435        $data_menu(main) add command -label [mc "Select all"] \
    492                 -command [list ::TolInspector::SelectAll $ht_vars]
     436                -command [list ::TolInspector::SelectAll $wt_vars]
    493437        $data_menu(main) add command -label [mc "Toggle selection"] \
    494                 -command [list ::TolInspector::ToggleSelection $ht_vars]
     438                -command [list ::TolInspector::ToggleSelection $wt_vars]
    495439        tk_popup $data_menu(main) $x $y
    496440      } ;#end del if
    … …  
    512456  variable data_menu
    513457  variable vars_selected
    514   variable ht_funcs
    515   variable ht_tree
    516   variable item_data
    517   variable data
    518  
    519   variable tolset
    520   variable tolindex
     458  variable wt_funcs
     459  variable wt_tree
    521460 
    522461  array unset options_selected
    … …  
    525464  }
    526465 
    527   set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
    528   set node_act [$ht_funcs index current]
     466  set node_act [$wt_funcs selection get 0] ;# current
    529467  if { [string length $node_act] } {
    530     set vars_selected [$ht_funcs curselection]
     468    set vars_selected [$wt_funcs selection get 0 end] ;# curselection
    531469    if { [lsearch $vars_selected $node_act] >= 0 } {
    532470      foreach var $vars_selected {
    533         array set aryData [$ht_funcs entry cget $var -data]
    534         set itemid $aryData(Index)
    535         set path   $aryData(Path)
    536         set grammar [lindex $item_data($itemid) 2]
    537         set objName [$ht_funcs entry cget $var -label]
    538        
    539         if { $InRootPool } {
    540           set object $data(pool,variables,$itemid)
    541         } else {
    542           if { [string length $tolset] } {
    543             set object [concat [list $tolset] $tolindex $itemid]
    544           } else {
    545             set object $objName
    546           }
    547         }
    548         # La única gramática seleccionable en ht_funcs es Code
     471        set itemid  [$wt_funcs item text $var [WiIndex 0]]
     472        set path    [$wt_funcs item text $var [WiPath 0]]
     473        set grammar [$wt_funcs item text $var [WiGrammar 0]]
     474        set objName [$wt_funcs item text $var [WiName 0]]
     475        set object [$wt_funcs item text $var [WiTolReference 0]]   
     476        # La única gramática seleccionable en wt_funcs es Code
    549477        lappend code_selected [list $object $objName $path]
    550478      }
    … …  
    564492        }
    565493      }
    566  
    567       if { $InRootPool } {
    568          $data_menu(main) add command -label [mc "Remove from spool"] \
    569                   -command [list ::TolInspector::RemoveFromSpool $ht_funcs]
    570       } else  {
    571          $data_menu(main) add command -label [mc "Add to spool"] \
    572                   -command [list ::TolInspector::AddToSpool $ht_funcs [lindex [$ht_tree get -full anchor] 1]]
    573       }
    574       $data_menu(main) add command -label [mc "To Eval window"] \
    575                 -command [list ::TolInspector::AddToEvalWindow $ht_funcs]
     494      $data_menu(main) add command -label [mc "Write into Eval"] \
     495                -command [list ::TolInspector::AddToEvalWindow $wt_funcs]
    576496      $data_menu(main) add separator
    577497      $data_menu(main) add command -label [mc "Select all"] \
    578               -command [list ::TolInspector::SelectAll $ht_funcs]
     498              -command [list ::TolInspector::SelectAll $wt_funcs]
    579499      $data_menu(main) add command -label [mc "Toggle selection"] \
    580               -command [list ::TolInspector::ToggleSelection $ht_funcs]
     500              -command [list ::TolInspector::ToggleSelection $wt_funcs]
    581501      tk_popup $data_menu(main) $x $y
    582502    }
    … …  
    597517  variable data_menu
    598518  variable vars_selected
    599   variable ht_tree
    600   variable item_data
    601   variable data
    602   variable tolset
    603   variable tolindex
    604   variable item_id
     519  variable wt_tree
     520  variable arguments
     521   
    605522  #puts "ht_tree: $ht_tree"
    606523  #No terminado todavía
    … …  
    612529    $data_menu($it) delete 0 end
    613530  }
    614   set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end-1] "root-pool"]
    615   #puts "InRootPool: $InRootPool"
    616   # InRootFiles has a value 1 if node is a File
    617   set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end-1] "root-files"]
    618   #puts "InRootFiles: $InRootFiles"
     531 
     532  #@!! revisar!! el uso de selection y node_act
     533  set selection [$wt_tree selection get 0]
     534  if { ![string length $selection] } { return }
     535 
     536  set tolReference [$wt_tree item text $selection [WiTolReference 1]]
     537  if { [llength $tolReference] == 2 } {
     538    set InRootFiles [string equal [lindex $tolReference 0] "File"]
     539  } else {
     540    set InRootFiles 0
     541  }
     542 
    619543  # index of the selected node
    620   set node_act [$ht_tree index current]
     544  set node_act [$wt_tree selection get 0] ;# current 
    621545  #puts "node_act: $node_act" 
    622546  if { [string length $node_act] } {
    623     set vars_selected [$ht_tree curselection]
     547    set vars_selected [$wt_tree selection get 0 end] ;# curselection   
    624548    #puts "vars_selected: $vars_selected"     
    625549    if { [lsearch $vars_selected $node_act] >= 0 } { ;# Not root node
    626       set index [$ht_tree index anchor]
    627       #puts "index: $index"   
    628       if { $index } {
    629         set info_node [split [lindex [$ht_tree get -full $index] end] "-"]
    630         #puts "info_node: $info_node" 
    631         set node_type [lindex $info_node 0]
    632         #puts "node_type: $node_type"         
    633         set node_name [lindex $info_node 1]
    634         #puts "node_name: $node_name"         
    635       } else { ;# root node
    636         set node_type root
    637         set node_name root
    638       }
    639       # if user selects a root or a grammar doesn't nothing
    640       switch -regexp $node_type  {
    641         root -
    642         grammar { return }
    643       }
     550      #@! set index [$ht_tree index anchor]
     551      set index [$wt_tree selection get 0]
     552     
     553      if { $index == 0 } return
     554      # if user selects a root or a grammar doesn't nothing     
     555      set tolReference [$wt_tree item text $index [WiTolReference 1]]
     556      if { [llength $tolReference] == 1 } return
     557     
    644558      # label of object showed in the tree
    645       set objName [$ht_tree entry cget $index -label]
    646       #puts "objName: $objName"
    647       set object $objName
    648 
     559      set objName [$wt_tree item text [WiName 1]]
     560      set object [$wt_tree item text [WiTolReference 1]]
     561     
    649562      if {$InRootFiles} {
    650         array set aryData [$ht_tree entry cget $index -data]
    651         if [info exist aryData(FileName)]  {
    652           set objName $aryData(FileName)
    653         }
    654       }
    655       #puts "2objName: $objName"   
    656       if { $InRootPool } {
    657         #puts "es InRootPool $item_id"       
    658         set itemid $item_id
    659         #set object $data(pool,variables,$itemid)
    660         set object $data(pool,reference,$node_type)
    661       } else {
    662         #puts "NO InRootPool"
    663         if { [string length $tolset] } {         
    664           set object [concat [list $tolset] $tolindex]
    665         } else {
    666           set object $objName
    667         }
    668       }
    669       #puts "object = $objName '[$ht_tree entry cget $index -data]'"
    670 #Tolcon_Trace "***********************************" {red}
    671 #Tolcon_Trace "index=$index, node_type=$node_type, node_name=$node_name" {red}
    672 #Tolcon_Trace "tolset=$tolset, tolindex=$tolindex, aryData= [$ht_tree entry cget $index -data]" {red}
    673 #Tolcon_Trace "object=$object, label=$objName" {red}
    674 #Tolcon_Trace "***********************************" {red}
    675      
    676       #
     563        set objName [$wt_tree item text $index [WiPath 1]]
     564      }   
    677565      # TICKET: #1438
    678566      # Por que se pregunta aqui por los objetos de consola?
    679       #
    680567      set stackList [::tol::console stack list]
    681568      #puts "stackList: $stackList"
    682569      set stackValue {}
    683570      foreach stackItem $stackList {
    684         #puts "stackItem: $stackItem"
    685         #puts "lindex $stackValue 1: [lindex $stackValue 1]"
    686         #puts "objName: $objName" 
    687571        if {[lindex $stackItem 1] eq $objName} {
    688572          set stackValue $stackItem
    … …  
    693577      set grammar [lindex $stackValue 0]     
    694578      #puts "grammar: $grammar"
    695       #set full_data $item_data($index) ;# {value} {desc} {grammar}   
    696       #set grammar [lindex $full_data 2]
    697579     
    698580      #foreach fun  [::tol::info functions $grammar] {
    … …  
    744626}
    745627
    746 #/////////////////////////////////////////////////////////////////////////////
    747 # Procedures asociated with tol inspector popup menu
    748 #/////////////////////////////////////////////////////////////////////////////
    749 
    750 #/////////////////////////////////////////////////////////////////////////////
    751 proc ::TolInspector::RemoveFromSpool {ht} {
    752 #
    753 # PURPOSE: Removes from spool all selected objects
    754 #
     628
     629#/////////////////////////////////////////////////////////////////////////////
     630proc ::TolInspector::AddToConsole {wt} {
    755631#/////////////////////////////////////////////////////////////////////////////
    756632  variable vars_selected
    757   variable item_data
    758   variable tolset
    759   variable tolindex
    760   variable data
    761633
    762634  foreach var $vars_selected {
    763     array set aryData [$ht entry cget $var -data]
    764     set itemid $aryData(Index)
    765     set path   $aryData(Path)
    766     set reference $aryData(Reference)
    767     set grammar [lindex $item_data($itemid) 2]
    768 
    769     set objName [$ht entry cget $var -label]
    770 
    771     set _objpool [list "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
    772     if {$grammar eq "Code"} {
    773       set graApply [lindex $aryData(Content) 0]
    774       lappend _objpool "graApply" $graApply
    775     }
    776     #Tolcon_Trace "OBJPOOL on REMOVE: $_objpool"
    777 
    778     # Buscamos el objeto (identificador: referencia)
    779     array set objpool $_objpool
    780     foreach _obj $data(pool,objects) {
    781       array set obj $_obj
    782       #Tolcon_Trace "obj(reference)=$obj(reference), objpool(reference)=$objpool(reference)"
    783       if {[string equal $obj(reference) $objpool(reference)]} {
    784         if {$obj(grammar) eq "Code"} {
    785           if {[string equal $obj(graApply) $objpool(graApply)]} {
    786             set idx [lsearch $data(pool,objects) $_obj]
    787             #Tolcon_Trace "El obj a quitar tiene idx=$idx"
    788             set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
    789           }
    790         } else {
    791           set idx [lsearch $data(pool,objects) $_obj]
    792           #Tolcon_Trace "El obj a quitar tiene idx=$idx"
    793           set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
    794         }
    795       }
    796     }
    797   }
    798   #Tolcon_Trace "P.O. after REMOVE: $data(pool,objects)"
    799   UpdatePoolObj
    800 }
    801 
    802 #/////////////////////////////////////////////////////////////////////////////
    803 proc ::TolInspector::AddToSpool {ht origin} {
    804 #/////////////////////////////////////////////////////////////////////////////
    805   variable vars_selected
    806   variable item_data
    807   variable tolset
    808   variable tolindex
    809   variable data
    810 
    811   foreach var $vars_selected {
    812     array set aryData [$ht entry cget $var -data]
    813     set itemid $aryData(Index)
    814     set path   $aryData(Path)
    815     set grammar [lindex $item_data($itemid) 2]
    816     set objName [$ht entry cget $var -label]
    817         #puts "AddToSpool: Reference=$aryData(Reference) tolset=$tolset grammar=$grammar"
    818     if {[llength $aryData(Reference)]} {
    819       set reference $aryData(Reference)
    820     } else {
    821       if { [string length $tolset] } {
    822         #set object [concat [list $tolset] $tolindex $itemid]
    823         #set object [concat [list File $tolset] $tolindex $itemid]
    824         set object [concat $tolset $tolindex $itemid]
    825         #puts "AddToSpool: object=$object"
    826         set reference [::tol::info reference $object]
    827       } else {
    828         if {$grammar eq "Set"} {
    829           #puts "AddToSpool: origin=$origin"
    830           set reference [::tol::info reference [list Set $objName]]
    831           #Tolcon_Trace "reference de ::tol::info reference [list $objName]"
    832         } else {
    833           if [catch {set reference [::tol::info reference [list $grammar $objName]]}] {
    834             set reference $objName
    835             #Tolcon_Trace "reference NO SE QUE PONER"
    836           }
    837           #Tolcon_Trace "reference de ::tol::info reference $grammar $objName"
    838         }
    839       }
    840     }
    841     set _objpool [list "origin" $origin "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
    842     if {$grammar eq "Code"} {
    843       set graApply [lindex $aryData(Content) 0]
    844       lappend _objpool "graApply" $graApply
    845     }
    846     #Tolcon_Trace "***************"
    847     #Tolcon_Trace "OBJPOOL on ADD:"
    848     #Tolcon_Trace "***************"
    849     #foreach {key value} $_objpool {
    850     #  Tolcon_Trace "  $key=$value"
    851     #}
    852     set inserted 0
    853     # Si la referencia es igual, el objeto es el mismo (salvo para obj de tipo Code)
    854     array set objpool $_objpool
    855     foreach _obj $data(pool,objects) {
    856       array set obj $_obj
    857       if {[string equal $obj(reference) $objpool(reference)]} {
    858         #Si es de la gramatica Code miro a ver la gramatica sobre la que se aplica
    859         if {$objpool(grammar) eq "Code"} {
    860           if {[string equal $obj(graApply) $objpool(graApply)]} {
    861             set inserted 1
    862           }
    863         } else {
    864           set inserted 1
    865         }
    866       }
    867     }
    868     if {!$inserted} {
    869       lappend data(pool,objects) $_objpool
    870       #puts "AddToSpool: P.O. after ADD: $data(pool,objects)"
    871     } else  {
    872       #puts "$_objpool ALREADY IN SPOOL"
    873     }
    874   }
    875  
    876 }
    877 
    878 #/////////////////////////////////////////////////////////////////////////////
    879 proc ::TolInspector::AddToEvalWindow {ht} {
    880 #
    881 # PURPOSE: Adds names of selected objects (vars or functions) in treeview ht
    882 #          to eval window
    883 #
    884 #/////////////////////////////////////////////////////////////////////////////
    885   variable ht_vars
     635    set reference [$wt item text $var [WiTolReference 0]]
     636    #Tolcon_Trace "GetObjectFromAddress(\"[::tol::info address $reference]\")"
     637    ::tol::console eval "GetObjectFromAddress(\"[::tol::info address $reference]\")"
     638  } 
     639  UpdateConsoleObj
     640}
     641
     642#/////////////////////////////////////////////////////////////////////////////
     643proc ::TolInspector::AddToEvalWindow {wt} {
     644#
     645# PURPOSE: Adds names of selected objects (vars or functions) in wtree wt to eval window
     646#
     647#/////////////////////////////////////////////////////////////////////////////
    886648  variable vars_selected
    887649
    888650  set names ""
    889651  foreach var $vars_selected {   
    890     lappend names [$ht entry cget $var -label]
     652    lappend names [$wt item text $var [WiName 0]]
    891653  }
    892654  ::TolConsole::ToEvalWindow [ListToStr $names]
    … …  
    894656
    895657#/////////////////////////////////////////////////////////////////////////////
    896 proc ::TolInspector::SelectAll {ht} {
    897 #
    898 # PURPOSE: Selects all nodes of a given treeview
     658proc ::TolInspector::SelectAll {wt} {
     659#
     660# PURPOSE: Selects all nodes of a given wtree
    899661#
    900662# PARAMETERS:
    901 #   ht -> treeview's path
    902 #
    903 #/////////////////////////////////////////////////////////////////////////////
    904   set found [$ht find]
    905   if {[llength $found] > 1} {
    906     $ht selection set [lindex $found 1] [lindex $found end]
    907   }
    908 }
    909 
    910 #/////////////////////////////////////////////////////////////////////////////
    911 proc ::TolInspector::ToggleSelection {ht} {
    912 #
    913 # PURPOSE: Toggles selection of nodes of a given treeview
     663#   wt -> wtree's object
     664#
     665#/////////////////////////////////////////////////////////////////////////////
     666  #set found [$ht find]
     667  #if {[llength $found] > 1} {
     668  #  $ht selection set [lindex $found 1] [lindex $found end]
     669  #}
     670  $wt selection add 0 end
     671}
     672
     673#/////////////////////////////////////////////////////////////////////////////
     674proc ::TolInspector::ToggleSelection {wt} {
     675#
     676# PURPOSE: Toggles selection of nodes of a given wtree
    914677#
    915678# PARAMETERS:
    916 #   ht -> treeview's path
    917 #
    918 #/////////////////////////////////////////////////////////////////////////////
    919   set found [$ht find]
    920   if {[llength $found] > 1} {
    921     $ht selection toggle [lindex $found 1] [lindex $found end]
    922   }
    923 }
     679#   wt -> wtree's object
     680#
     681#/////////////////////////////////////////////////////////////////////////////
     682  #set found [$ht find]
     683  #if {[llength $found] > 1} {
     684  #  $ht selection toggle [lindex $found 1] [lindex $found end]
     685  #}
     686  set sel [$wt selection get 0 end]
     687  $wt selection add 0 end
     688  $wt selection modify {} $sel 
     689}
     690
     691#/////////////////////////////////////////////////////////////////////////////
     692proc ::TolInspector::SelectionExpand { } {
     693#/////////////////////////////////////////////////////////////////////////////
     694  variable wt_vars
     695  set node [$wt_vars selection get 0]
     696  if {$node == ""} {
     697    ::TolInspector::SelectionCollapse
     698  } else {
     699    $wt_vars expand $node
     700  }
     701}
     702
     703#/////////////////////////////////////////////////////////////////////////////
     704proc ::TolInspector::SelectionCollapse { } {
     705#/////////////////////////////////////////////////////////////////////////////
     706  variable wt_tree
     707  set node [$wt_tree selection get 0]
     708  if {$node eq 0} {} else {
     709    set parent [$wt_tree item parent $node]
     710    $wt_tree collapse $node
     711    $wt_tree selection clear
     712    $wt_tree selection add $parent
     713  }
     714}
Note: See TracChangeset for help on using the changeset viewer.