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__wtree1.tcl

    r7a3f24e r6207115  
    1 
    2 #/////////////////////////////////////////////////////////////////////////////
    3 proc ::TolInspector::_InsertChild { args } {
    4 #
    5 # PURPOSE: este proc es para ancapsular desc en una lista
    6 #
    7 #/////////////////////////////////////////////////////////////////////////////
    8     eval InsertChild [lrange $args 0 3] [list [list [lindex $args 4]]] [lrange $args 5 end]
    9 }
     1#/////////////////////////////////////////////////////////////////////////////
     2
     3proc ::TolInspector::WNodeDef { istree } {
     4  if { $istree } {
     5    return [list \
     6      [list {image text} -label Name] \
     7      [list text -label Index] \
     8      [list text -label Grammar] \
     9      [list text -label Content] \
     10      [list text -label Description] \
     11      [list text -label Path] \
     12      [list text -label Reference] \
     13      [list text -label "TOL Reference"] \
     14    ] 
     15  } else {
     16    return [list \
     17      [list text -label Index] \
     18      [list text -label Grammar] \
     19      [list {image text} -label Name] \
     20      [list text -label Content] \
     21      [list text -label Description] \
     22      [list text -label Path] \
     23      [list text -label Reference] \
     24      [list text -label "TOL Reference"] \
     25    ]
     26  }
     27}
     28
     29proc ::TolInspector::WNode {istree index grammar icon name content description path reference tolreference} {
     30  if { $istree } {
     31    return [list \
     32      [list $icon $name] \
     33      [list $index] \
     34      [list $grammar] \
     35      [list $content] \
     36      [list $description] \
     37      [list $path] \
     38      [list $reference] \
     39      [list $tolreference] \
     40    ]
     41  } else {
     42    return [list \
     43      [list $index] \
     44      [list $grammar] \
     45      [list $icon $name] \
     46      [list $content] \
     47      [list $description] \
     48      [list $path] \
     49      [list $reference] \
     50      [list $tolreference] \
     51    ]
     52  }
     53}
     54
     55proc ::TolInspector::WiName         { istree } { if {$istree} { return 0 } else { return 2 } }
     56proc ::TolInspector::WiIndex        { istree } { if {$istree} { return 1 } else { return 0 } }
     57proc ::TolInspector::WiGrammar      { istree } { if {$istree} { return 2 } else { return 1 } }
     58proc ::TolInspector::WiContent      { istree } { if {$istree} { return 3 } else { return 3 } }
     59proc ::TolInspector::WiDescription  { istree } { if {$istree} { return 4 } else { return 4 } }
     60proc ::TolInspector::WiPath         { istree } { if {$istree} { return 5 } else { return 5 } }
     61proc ::TolInspector::WiReference    { istree } { if {$istree} { return 6 } else { return 6 } }
     62proc ::TolInspector::WiTolReference { istree } { if {$istree} { return 7 } else { return 7 } }
    1063
    1164#/////////////////////////////////////////////////////////////////////////////
    1265proc ::TolInspector::InsertChild { args } {
    1366#
    14 # PURPOSE: Inserts a node in the corresponding treeview of the right panel.
     67# PURPOSE: Inserts a node in the corresponding wtree of the right panel.
    1568#
    1669# PARAMETERS:
    … …  
    2174#   args[4] -> desc
    2275#   Si grammar == "Code"
    23 #    args[5] -> ¿es una variable?
     76#    args[5] -> ¿es una variable?
    2477#   Si grammar == "Set" || "NameBlock"
    2578#    args[5] -> indexes of the set
    … …  
    2780#    args[7] -> has subset?
    2881#    args[8] -> subtype
    29 #    args[end] -> "Reference {reference}" end > 4
    30 #
    31 #/////////////////////////////////////////////////////////////////////////////
    32   variable ht_vars
    33   variable blt_vartree
    34   variable ht_funcs
    35   variable blt_functree
    36   variable gra_parent
    37 
    38   #puts "InsertChild: args=$args [info level 1]"
     82#
     83#/////////////////////////////////////////////////////////////////////////////
     84  variable wt_vars
     85  variable wt_funcs
     86
    3987  set grammar [lindex $args 0]
    40   set name [ lindex $args 1 ]
     88  set name    [lindex $args 1]
    4189  set content [lindex $args 2]
    4290  set path    [lindex $args 3]
    43   set desc    [lindex [lindex $args 4] 0]
    44 
    45 
    46   if {[llength [lindex $args end]] >= 2} {
    47     #set ref [list [lindex [lindex $args end] 0] [lrange [lindex $args end] 1 end]]
    48     set ref [concat [lindex [lindex $args end] 0] [lrange [lindex $args end] 1 end]]
    49   } else {
    50     set ref ""     
    51   }
    52   #puts "InsertChild: ref=$ref"
     91  set desc    [lindex $args 4]
     92
    5393  switch $grammar {
    5494    Code {
    5595      set isvar [lindex $args 5]
    5696      if { [string equal $isvar "1"] } {
    57         Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc $ref
     97        InsertItem $wt_vars $grammar $name $content $path $desc {}
    5898      } else {
    59         Insert_HTItem $ht_funcs $blt_functree $grammar $name $content $path $desc $ref
     99        InsertItem $wt_funcs $grammar $name $content $path $desc {}
    60100      }
    61101    }
    … …  
    66106      # args[6] is the flag file
    67107      # args[8] is the subtype
    68       Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc \
    69         [lindex $args 5] [lindex $args 6] [lindex $args 8] $ref
     108      InsertItem $wt_vars $grammar $name $content $path $desc [lindex $args 8]
     109      # [lindex $args 5] [lindex $args 6] [lindex $args 8] $ref
    70110    }
    71111    default {
    72       Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc $ref
    73     }
    74   }
    75 }
    76 
    77 # si grammar == "Set"
    78 #   args[0] -> indexes
    79 #   args[1] -> ¿is a file?
    80 #   args[2] -> subtype
    81 
    82 #/////////////////////////////////////////////////////////////////////////////
    83 proc ::TolInspector::Insert_HTItem {ht tree grammar name content path desc args} {
    84 #/////////////////////////////////////////////////////////////////////////////
    85   variable ht_tree
    86   variable tolset
    87   variable tolindex
    88   variable iterSet
    89   variable knownReference
    90   variable node_prefix
    91   variable item_data
    92   variable item_id
    93   variable gra_parent
     112      InsertItem $wt_vars $grammar $name $content $path $desc {}
     113    }
     114  }
     115}
     116
     117#/////////////////////////////////////////////////////////////////////////////
     118proc ::TolInspector::InsertItem {wt grammar name content path desc subtype} {
     119#/////////////////////////////////////////////////////////////////////////////
     120  variable wt_tree
     121  variable arguments
    94122
    95123  #upvar \#0 ::TolTk::Images Images
    96124
    97   #puts "ENTER: ::TolInspector::Insert_HTItem"
    98   if { $knownReference eq "" } {
    99     set objRef $iterSet
    100     lappend objRef $item_id
    101   } else {
    102     #puts "knownReference = $knownReference"
    103     set objRef $knownReference
    104   }
    105 
    106   #puts "\tobjRef = $objRef"
    107   if { $gra_parent eq "NameBlock" } {
     125  set parent_grammar $arguments(parent_grammar) 
     126
     127  #@ Si la llamada a InsertChild viene de SelectSet el argumento tolref
     128  #@ no está definido y se crea a partir de parent_tolref
     129  set tolref $arguments(tolref)
     130  if { $tolref eq "" } {
     131    set tolref $arguments(parent_tolref)
     132    lappend tolref $arguments(index)
     133  }
     134 
     135  if { $parent_grammar eq "NameBlock" } {
    108136    array set info_member [ FilterNameBlockMember $name ]
    109137    if { !$info_member(-show) } {
    110       incr item_id
     138      incr arguments(index)
    111139      return
    112140    }
    … …  
    118146  set brief_cont [TrimContent $grammar $content]
    119147  set brief_desc [TrimContent DONTCARE $desc]
    120   #puts "Insert_HTItem: args=$args"
    121   if {[llength [lindex $args end]] >= 2} {
    122     set ref_value [lindex [lindex $args end] 1]
    123   } elseif {[regexp -- "console" $node_prefix]} {
    124     set ref_value [list Console]
    125     eval lappend ref_value $tolindex $item_id
     148               
     149  set data3 $brief_cont
     150  if {$grammar eq "NameBlock"} {
     151    #(pgea) se utiliza la informacon de instancia
     152    #puts "Tol_ClassOfFromReference $tolref"
     153    set classOf [Tol_ClassOfFromReference $tolref]
     154    #puts "Tol_InstanceContentFromReference $tolref"
     155    set insCont [Tol_InstanceContentFromReference $tolref]
     156    if {$insCont ne ""} {
     157      set data3 [TrimContent $grammar $insCont]
     158    } elseif {$classOf ne ""} {
     159      set data3 $classOf
     160    }   
     161  }
     162
     163  #@ Se localiza el icono según la gramática
     164  if {$grammar eq "Set" || $grammar eq "NameBlock"} {
     165    if {$grammar eq "Set"} {
     166      set icon_grammar [SubTypeImage $subtype]
     167    } else {
     168      set objAddress [tol::info address $tolref]
     169      set icon_grammar [::ImageManager::getIconForInstance $objAddress]
     170    }
     171  } elseif { $grammar eq "Anything" } {
     172    set anyType [ tol::info Anything $tolref ]
     173    set icon_grammar [::Bitmap::get $anyType]
    126174  } else {
    127     set ref_value ""
    128   }
    129 
    130   #puts "Insert_HTItem: ref_value=$ref_value tolindex=$tolindex item_id=$item_id node_prefix=$node_prefix"
    131   #puts "\ttolset=$tolset"
    132   set data [list Index      $item_id \
    133                 Content     $brief_cont \
    134                 Path        $path \
    135                 Description $brief_desc \
    136                 Reference   $ref_value]
    137 
    138   if {$grammar eq "Set" || $grammar eq "NameBlock"} {
    139     if {[string length $tolset] || [regexp "console" $node_prefix]} {
    140       # OJO: si tolset == "" no implica que no estemos en un Set
    141       # por ejemplo un Set de la consola.
    142       set item [GetItemName $node_prefix [lindex $args 0]]
    143       #Tolcon_Trace "InsertHTItem. item(if): $item"
    144     } else {
    145       switch [lindex [$ht_tree get -full anchor] end] {
    146         root-files {
    147           set item file$item_id
    148         }
    149         root-console {
    150           set item console$item_id
    151         }
    152         root-pool {
    153           set item pool$item_id
    154         }
    155         default {
    156           set item item$item_id
    157         }
    158       }
    159     }
    160     # aqui hay que pedir el bitmap en funcion del subtype: args[2]
    161     if {$grammar eq "Set"} {
    162       #puts "*******Set $objRef *******"
    163       set icon_grammar [SubTypeImage [lindex $args 2]]
    164       set data [lreplace $data 9 9 $objRef] 
    165     } else {
    166       #(pgea) se reemplaza el valor de la referencia en data
    167       set data [lreplace $data 9 9 $objRef] 
    168       #(pgea) se utiliza la informacon de instancia
    169       #puts "Tol_ClassOfFromReference $objRef"
    170       set classOf [Tol_ClassOfFromReference $objRef]
    171       #puts "Tol_InstanceContentFromReference $objRef"
    172       set insCont [Tol_InstanceContentFromReference $objRef]
    173       if {$insCont ne ""} {
    174         set data [lreplace $data 3 3 [TrimContent $grammar $insCont]]
    175       } elseif {$classOf ne ""} {
    176         set data [lreplace $data 3 3 $classOf]
    177       }
    178       set objAddress [ tol::info address $objRef ]
    179       set icon_grammar [ ::ImageManager::getIconForInstance $objAddress ]
    180     }
    181   } elseif { $grammar eq "Anything" } {
    182     set item "item$item_id"
    183     set anyType [ tol::info anything $objRef ]
    184     set icon_grammar [ ::Bitmap::get $anyType ]
    185   } else {
    186     set item "item$item_id"
    187     set icon_grammar [ ::Bitmap::get $grammar ]
    188   }
    189   set idnew [$tree insert 0 -label $item]
    190   set label [OneLine $name]
    191   if {$label eq ""} {
    192     if {[set label $brief_desc] eq ""} {
    193       set label " "
    194     }
    195   }
    196   $ht entry configure $idnew -label $label \
    197       -icons [list $icon_grammar $icon_grammar] -data $data \
    198        -foreground $fcolor
    199   set item_data($item_id) [list $content $desc $grammar]
    200   incr item_id
     175    set icon_grammar [::Bitmap::get $grammar]
     176  }
     177 
     178  #? set label [OneLine $name]
     179  #? if {$label eq ""} {
     180  #?   if {[set label $brief_desc] eq ""} {
     181  #?     set label " "
     182  #?   }
     183  #? }
     184   
     185  #@ ::TolInspector::WNode istree
     186  #@   index grammar icon name
     187  #@   content description path
     188  #@   reference tolreference
     189  set wt_row [::TolInspector::WNode 0 \
     190    $arguments(index) $grammar $icon_grammar $name \
     191    $data3 $brief_desc $path \
     192    "" $tolref ]
     193 
     194  set idx [$wt insert $wt_row -at child -relative root]
     195  $wt item element configure $idx [WiIndex 0] eTXT -fill $fcolor ,\
     196    [WiName 0] eTXT -fill $fcolor , [WiContent 0] eTXT -fill $fcolor ,\
     197    [WiDescription 0] eTXT -fill $fcolor , [WiPath 0] eTXT -fill $fcolor
     198 
     199  incr arguments(index)
    201200}
    202201
    … …  
    208207#/////////////////////////////////////////////////////////////////////////////
    209208  variable w_tabset
    210   variable ht_vars
    211   variable ht_funcs
    212   variable item_data
     209  variable wt_vars
     210  variable wt_funcs
    213211  variable OnSelectItem
    214212
    215   $ht_vars  entry delete root 0 end
    216   $ht_funcs entry delete root 0 end
    217   $ht_vars column  configure Index -hide no
    218   $ht_funcs column configure Index -hide no
    219   catch {
    220     unset item_data
    221   }
     213  foreach it [$wt_vars item children root] {
     214    $wt_vars item delete $it
     215  }
     216  foreach it [$wt_funcs item children root] {
     217    $wt_funcs item delete $it
     218  } 
     219  #@ToDo $wt_vars  column configure Index -hide no
     220  #@ToDo $wt_funcs column configure Index -hide no
     221 
    222222  $w_tabset tab configure Variables -text [mc Variables] -state normal
    223223  $w_tabset tab configure Functions -state normal
    … …  
    228228}
    229229
    230 # este proc debe pasar a ser un getContainerReference
    231 #
    232 proc ::TolInspector::getPackageReference { treePath } {
    233   variable ht_tree
    234 
    235   #puts "::TolInspector::getPackageReference $treePath"
    236   catch {
    237     set typeContainer "NameBlock"
    238     set order [ lindex  [ split [ lindex $treePath 2 ] "-" ] end ]
    239     incr order -1
    240     #puts "path,2 = [ lindex $treePath 2 ]"
    241     #puts "order = $order"
    242     set idx [lindex [ $ht_tree entry children "root-packages"] $order]
    243     set nameContainer [ $ht_tree entry cget $idx -label ]
    244     #puts "en root-package:"
    245     #puts "\torder=$order"
    246     #puts "\tidx=$idx"
    247     #puts "\tnameContainer=$nameContainer"
    248     set container [ list $typeContainer $nameContainer ]
    249     if { [ llength $treePath ] > 3 } {
    250       foreach c [ lrange $treePath 3 end-1 ] {
    251         set orderItem [ lindex  [ split $c "-" ] end ]
    252         lappend container $orderItem
    253       }
    254       set tolindex [ lindex  [ split [ lindex $treePath end ] "-" ] end ]
    255     } else {
    256       set tolindex [ list ]
    257     }
    258   } msg
    259   #puts "::TolInspector::getPackageReference: $msg"
    260   #puts "::TolInspector::getPackageReference: [ list $container $tolindex ]"
    261   return [ list $container $tolindex ]
    262 }
    263 
    264 #/////////////////////////////////////////////////////////////////////////////
    265 proc ::TolInspector::OpenObject { index } {
    266 #
    267 # PURPOSE: Script called each time a node in ht_tree (left treeview) is
    268 #          opened.
     230#/////////////////////////////////////////////////////////////////////////////
     231proc ::TolInspector::OpenObject { node } {
     232#
     233# PURPOSE: Script called each time a node in wt_tree (left wtree) is opened.
    269234#
    270235# PARAMETERS:
    271 #   index : The id of the node opened
    272 #
    273 #/////////////////////////////////////////////////////////////////////////////
    274   variable tolset
    275   variable tolindex
    276   variable iterSet
    277   variable at_set
    278   variable node_prefix
    279   variable ht_tree
    280   variable data
    281 
    282   #puts "OpenObject: index=$index"
    283   set path [$ht_tree get -full $index]
    284   #puts "path = $path"
    285   if { $index } {
    286     set parent1 [lindex $path 1]
    287     if { [set ispackage [string equal $parent1 "root-packages"]] ||
    288          [set isfile [string equal $parent1 "root-files"]] ||
    289          [set isconsole [string equal $parent1 "root-console"]] ||
    290          [string equal $parent1 "root-pool"] } {
    291       set lpath [llength $path]
    292       #puts "lpath = $lpath"
    293       if { $lpath == 2 } {
    294         if { $ispackage } {
    295           InsertPackages
    296         } elseif { $isfile } {
    297           InsertFiles
    298         } elseif { $isconsole } {
    299           InsertConsoleObj
    300         } else {
    301           InsertPoolObj
    302         }
    303       } else {
    304         #puts "OpenObject: path = $path"
    305         set leaf [lindex $path end]
    306         set leaf_info [split $leaf "-"]
    307         set node_prefix [lindex $leaf_info 0]
    308         set _tolset $tolset
    309         if { $parent1 eq "root-packages" } {
    310           foreach {tolset tolindex} [ getPackageReference $path ] break
    311         } elseif { [string equal $parent1 "root-pool"] } {
    312           #Tolcon_Trace "OpenObject. tolset=$tolset"
    313           set tolset $data(pool,reference,[lindex $leaf_info 0])
    314           #puts "OpenObject: Spool: tolset=$tolset, leaf_info=$leaf_info"
    315           if { $lpath == 3 } {
    316             set tolindex [lrange $tolset 1 end]
    317             set tolset [lindex $tolset 0]
    318           } else {
    319             set tolindex [lrange $leaf_info 1 end]
    320                     if {[lindex $tolset 0] eq "Console"} {
    321                       set tolset [lindex $tolset 0] 
    322                     } else {
    323                       set tolset [lrange $tolset 0 1]
    324                     }
    325             #set tolindex [lrange $tolset 1 end]
    326             #set tolset [lindex $tolset 0]
    327             #lappend tolindex [lindex $leaf_info end]
    328           }
    329           #Tolcon_Trace "OpenObject. tolset=$tolset"
    330         } elseif {[regexp -- "console(.+)" $node_prefix --> idx_con]} {
    331           set tolset "Console"
    332           #puts "OpenObject: Console: leaf_info = $leaf_info"
    333           if {[llength $leaf_info] == 1} {
    334             set tolindex $idx_con
    335           } else {
    336             #set tolindex [list $idx_con [lrange $leaf_info 1 end]]
    337             set tolindex [lrange $leaf_info 1 end]
    338           }
    339         } else {
    340           set idx [$ht_tree find -name $node_prefix]
    341           array set aryData [$ht_tree entry cget $idx -data]
    342           set tolset [list File $aryData(FileName)]
    343           #set tolset [$ht_tree entry cget [$ht_tree find -name $node_prefix] -label]
    344           if { $lpath == 3 } {
    345             set tolindex ""
    346           } else {
    347             set tolindex [lrange $leaf_info 1 end]
    348           }
    349         }
    350         Busy
    351         set at_set $index
    352         set iterSet [eval list $tolset $tolindex]
    353         variable gra_parent [ GetParentGrammar $iterSet ]
    354         ::tol::forallchild $iterSet ::TolInspector::InsertSubset
    355         set tolset $_tolset
    356         NotBusy
    357       }
    358     }
     236#   node : The id of the node opened
     237#
     238#/////////////////////////////////////////////////////////////////////////////
     239  variable wt_tree
     240  variable arguments
     241 
     242  #@ No es necesario llenar ni el nodo root (0) ni root-grammars (1)
     243  if { $node == 0 } return
     244  if { $node == 1 } return 
     245
     246  #@ Argumentos pasados por atributo
     247  #@  + parent_node es usado por InsertSubset para saber dónde insertar
     248  set arguments(parent_node) $node
     249  set tolReference [$wt_tree item text $node [WiTolReference 1]]
     250 
     251  if { [llength $tolReference] == 1 } {
     252    #@ Aquí llegan los nodos raíz y las gramáticas
     253    switch $tolReference {
     254      Package InsertPackages
     255      File    InsertFiles
     256      Console InsertConsoleObj
     257      default return
     258    }
     259  } elseif { [lindex $tolReference 0] == "Grammar" } {
     260    return
     261  } else {
     262    Busy
     263    #@ Argumentos pasados por atributo
     264    #@  + parent_grammar es usado por InsertSubset para abrir o no un nodo
     265    #@  + parent_tolref es usado por InsertSubset para determinar tolref
     266    set arguments(parent_grammar) [GetParentGrammar $tolReference]     
     267    set arguments(parent_tolref) $tolReference
     268    ::tol::forallchild $tolReference ::TolInspector::InsertSubset
     269    NotBusy
    359270  }
    360271}
    … …  
    363274proc ::TolInspector::InsertPackages {} {
    364275#
    365 # PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL
    366 #          packages
    367 #
    368 #/////////////////////////////////////////////////////////////////////////////
    369   variable ht_tree
     276# PURPOSE: Inserts a node in wt_tree (left ::wtree) for each TOL packages
     277#
     278#/////////////////////////////////////////////////////////////////////////////
     279  variable wt_tree
    370280  #upvar \#0 ::TolTk::Images Images
    371    
     281 
    372282  set order 1
    373283  foreach pkg [::tol::info packages] {
    374284    # takes an icon with the same name that the grammar
    375285    set img [ ::Bitmap::get NameBlock ]
    376     $ht_tree insert -at "root-packages" end package-$order -label $pkg\
    377           -icons [list $img $img] -button yes
     286    set wt_row [::TolInspector::WNode 1 $order NameBlock $img $pkg "" "" "" "package-$order" "NameBlock $pkg"]       
     287    $wt_tree insert $wt_row -at child -relative "root-packages" \
     288      -tags "package-$order" -button yes
    378289    incr order
    379290  }
    … …  
    383294proc ::TolInspector::InsertGrammars {} {
    384295#
    385 # PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL
    386 #          grammar
    387 #
    388 #/////////////////////////////////////////////////////////////////////////////
    389   variable ht_tree
     296# PURPOSE: Inserts a node in wt_tree (left ::blt::treeview) for each TOL grammar
     297#
     298#/////////////////////////////////////////////////////////////////////////////
     299  variable wt_tree
    390300  #upvar \#0 ::TolTk::Images Images
    391    
     301 
    392302  set id 1
    393303  foreach g [::tol::info grammars] {
    394304    # takes an icon with the same name that the grammar
    395     set img [::Bitmap::get $g]
    396     $ht_tree insert -at "root-grammars" end grammar-$id -label $g\
    397           -icons [list $img $img]
     305    set img [::Bitmap::get $g] 
     306    set wt_row [::TolInspector::WNode 1 $id Grammar $img $g $g "" "" "grammar-$id" "Grammar $g"]     
     307    $wt_tree insert $wt_row -at child -relative "root-grammars" \
     308      -tags "grammar-$id" -button no
    398309    incr id
    399310  }
    400311}
    401312
    402 
    403313#/////////////////////////////////////////////////////////////////////////////
    404314proc ::TolInspector::InsertFiles { } {
    405315#
    406 # PURPOSE: Inserts a node in ht_tree (left treeview) for each Included file
    407 #
    408 #/////////////////////////////////////////////////////////////////////////////
    409   variable ht_tree
    410   variable blt_tree
     316# PURPOSE: Inserts a node in wt_tree (left treeview) for each Included file
     317#
     318#/////////////////////////////////////////////////////////////////////////////
     319  variable wt_tree
    411320
    412321  set index 1
    … …  
    418327    # tomar la imagen en funcion del subtype
    419328    set img [SubTypeImage $subtype]
    420     set tag_file "file$index"
    421     set blt_idx [$blt_tree insert "root-files" \
    422              -label $tag_file -tags $tag_file]
    423     # Tail del fichero. Podría hacerse configurable por el usuario
     329    # Tail del fichero. Podría hacerse configurable por el usuario
    424330    set label [file tail $f]
    425     $ht_tree entry configure $blt_idx -label $label\
    426     -icons  [list $img $img] -button $button -data [list "FileName" $f]
     331    set wt_row [::TolInspector::WNode 1 $index File $img $label $label "" $f "file-$index" [list File $f]]     
     332    #@ la columna FileName se incorpora en la columna 4
     333    $wt_tree insert $wt_row -at child -relative "root-files" \
     334      -tags "file-$index" -button $button
    427335    incr index
    428336  }
    429337}
    430338
    431 
    432339#/////////////////////////////////////////////////////////////////////////////
    433340proc ::TolInspector::InsertConsoleObj { } {
    434341#
    435 # PURPOSE: Inserts a node in ht_tree (left treeview) for each Console object
    436 #
    437 #/////////////////////////////////////////////////////////////////////////////
    438   variable ht_tree
    439   variable has_button 0
     342# PURPOSE: Inserts a node in wt_tree (left treeview) for each Console object
     343#
     344#/////////////////////////////////////////////////////////////////////////////
     345  variable wt_tree
    440346   
    441347  set index 1
    … …  
    452358      }
    453359      set name [lindex $co 1]
    454       #tol::forallchild $name HasSubset
    455360      set has_button [lindex $co 6]
    456361      if {$name eq ""} {
    … …  
    459364        }
    460365      }
    461       $ht_tree insert -at root-console end "console$index" -label $name \
    462           -icons  [list $icon $icon] -button $has_button -data [list "FileName" $index]
     366      set wt_row [::TolInspector::WNode 1 $index $grammar $icon $name "" "" "" "console-$index" "Console $index"]     
     367      #@ la columna FileName de ht_tree se incorpora en la columna 4
     368      $wt_tree insert $wt_row -at child -relative "root-console" \
     369        -tags "console-$index" -button $has_button     
    463370    }
    464371    incr index
    … …  
    466373}
    467374
    468 
    469 #/////////////////////////////////////////////////////////////////////////////
    470 proc ::TolInspector::InsertPoolObj { } {
    471 #
    472 # PURPOSE: Inserts a node in ht_tree (left treeview) for each object in Spool
    473 #
    474 #/////////////////////////////////////////////////////////////////////////////
    475   variable data
    476   variable ht_tree
    477   array unset data pool,reference,*
    478   set index 1
    479 
    480   foreach _obj $data(pool,objects) {
    481     #Tolcon_Trace "InsertPoolObj. _obj=$_obj"
    482     array set obj $_obj
    483     if { [string equal $obj(grammar) "Set"] || [string equal $obj(grammar) "NameBlock"] } {
    484       #Si la referencia del objeto tiene espacios en la ruta, el
    485       # llength me daría > 1, por eso añado la 2ª parte de la condicion
    486       if { ([llength $obj(reference)] > 1) && \
    487             ![string equal $obj(reference) $obj(objName)]} {
    488         set infoObj [::tol::info variable $obj(reference)]
    489       } else {
    490         if {[catch { set infoObj [concat [list "Set" $obj(reference)] \
    491                             [::tol::info included $obj(reference)]] }]} {
    492           set infoObj [concat [list "Set" $obj(reference)] \
    493                  [::tol::info variable "Set" $obj(reference)]]
    494         } else {
    495           # Insertamos el 1 de isFile
    496           set infoObj [linsert $infoObj 5 1]
    497         }
    498       }
    499       #Tolcon_Trace "infoObj=$infoObj"
    500       if {[set name [file tail [lindex $infoObj 1]]] eq ""} {
    501         if {[set name [TrimContent DONTCARE [lindex $infoObj 4]]] eq ""} {
    502           set name " "
    503         }
    504       }
    505       set has_button [lindex $infoObj 6]
    506       #set icon [SubTypeImage [lindex $infoObj 7]]
    507       if {$obj(grammar) eq "Set"} {
    508         set icon [SubTypeImage [lindex $infoObj 7]]
    509       } else  {
    510         #puts "en pool = $obj(reference)"
    511         set objAddress [ tol::info address $objRef ]
    512         set icon [ ::ImageManager::getIconForInstance $objAddress ]
    513       }
    514 
    515       $ht_tree insert -at root-pool end "pool$index" -label $name \
    516           -icon [list $icon $icon] -button $has_button
    517       #Tolcon_Trace "InsertPoolObj. name=$name"
    518       if { ([llength $obj(reference)] > 1) && \
    519             [string equal $obj(reference) $obj(objName)]} {
    520         set obj(reference) [list $obj(reference)]
    521       }
    522       set data(pool,reference,pool$index) $obj(reference)
    523     }
    524     incr index
    525   }
    526 }
    527 
    528 
    529375#/////////////////////////////////////////////////////////////////////////////
    530376proc ::TolInspector::InsertSubset { args } {
    531377#
    532 # PURPOSE: Inserts a node in ht_tree (left treeview) for each child of a Set
     378# PURPOSE: Inserts a node in wt_tree (left treeview) for each child of a Set
    533379#
    534380# PARAMETERS:
    … …  
    545391#
    546392#/////////////////////////////////////////////////////////////////////////////
    547   variable ht_tree
    548   variable at_set
    549   variable tolset
    550   variable iterSet
    551   variable node_prefix
    552   variable has_button 0
    553   variable blt_tree
    554   variable gra_parent
     393  variable wt_tree
     394  variable arguments
     395 
     396  #@ para saber dónde insertar
     397  set parent_node $arguments(parent_node)
     398  ## para distinguir set de nameblocks
     399  set parent_grammar $arguments(parent_grammar)
     400  #@ para obtener el icono de las instancias
     401  set parent_tolref $arguments(parent_tolref) 
     402 
     403#@# Tolcon_Trace "InsertSubset $args"   
    555404  catch {
    556405  #puts "InsertSubset, args=$args"
    … …  
    558407  if {$grammar eq "Set" || $grammar eq "NameBlock"} {
    559408    #puts "InsertSubset, args=$args"
    560     if { $gra_parent eq "NameBlock" } {
     409    if { $parent_grammar eq "NameBlock" } {
    561410      array set info_member [ FilterNameBlockMember [ lindex $args 1 ] ]
    562411      if { !$info_member(-show) } {
    … …  
    570419    }
    571420    set content [lindex $args 2]
    572     # idx es el indice completo desde el Set root
    573     set idx     [lindex $args 5]
     421    # indices es el indice completo desde el Set root
     422    set indices     [lindex $args 5]
    574423    set isfile  [lindex $args 6]
    575424    set has_button [lindex $args 7]
    576425    set subtype [lindex $args 8]
    577     #tol::forallchild $tolset $idx HasSubset
    578426    if {$grammar eq "Set"} {
    579427      set icon [SubTypeImage $subtype]
    580428    } else {
    581       set objRef $iterSet
    582       lappend objRef [ lindex $idx end ]
     429      set objRef $parent_tolref
     430      lappend objRef [ lindex $indices end ]
    583431      set objAddress [ tol::info address $objRef ]
    584432      set icon [ ::ImageManager::getIconForInstance $objAddress ]
    585433    }
    586     # Tail por si es un fichero. Podría hacerse configurable por el usuario
     434    # Tail por si es un fichero. Podría hacerse configurable por el usuario
    587435    set label [file tail $name]
    588     #puts [list InsertSubset, idx {lindex $args 5} = $idx]
    589     set idnew [ $blt_tree insert $at_set \
    590                    -label [ GetItemName $node_prefix $idx ] ]
    591 
    592     #puts "InsertSubset, node_prefix = $node_prefix"
    593     #puts "InsertSubset, idnew = $idnew"
    594     #puts "InsertSubset, -label = [GetItemName $node_prefix $idx]"
     436    #puts [list InsertSubset, indices {lindex $args 5} = $indices]
     437   
     438#noaun set obj_ref [lappend [$wt_tree item text $parent_node [WiTolReference 1] $indices] ]
     439#noaun Tolcon_Trace "Inserto un nodo nuevo. $obj_ref"
     440    set index [lindex $indices end]
     441    set tolRefe [eval list [$wt_tree item text $parent_node [WiTolReference 1]] $index]
     442    set wt_row [::TolInspector::WNode 1 $index $grammar $icon $label "" "" "" "" $tolRefe]
    595443
    596444    if {$label eq ""} {
    … …  
    599447      }
    600448    }
    601     $ht_tree entry configure $idnew -label $label -button $has_button \
    602       -icons [list $icon $icon] -foreground $fcolor
    603   }
    604 } msg
    605 #puts "InsertSubSet: $msg"
    606 }
    607 
    608 
     449
     450    set idnew [ $wt_tree insert $wt_row -at end -relative $parent_node -button $has_button]
     451    $wt_tree item element configure $idnew [WiName 1] eTXT -fill $fcolor
     452  }
     453  } msg
     454  #@! Tolcon_Trace "InsertSubSet: $msg"
     455}
    609456
    610457#/////////////////////////////////////////////////////////////////////////////
    611458proc ::TolInspector::SelectObject { } {
    612459#
    613 # PURPOSE: Script called each time a node in ht_tree (left treeview) is
    614 #          selected.
    615 #
    616 #/////////////////////////////////////////////////////////////////////////////
    617 
    618   #Tolcon_Trace "LLAMADA A SELECTOBJECT"
     460# PURPOSE: Script called each time a node in wt_tree (left wtree) is selected.
     461#
     462#/////////////////////////////////////////////////////////////////////////////
    619463  variable w_tabset
    620   variable ht_tree
    621   #variable set_type ""
    622   variable tolset
    623   variable tolindex
    624   #variable closing
    625   variable node_prefix ""
    626   variable data
    627   variable knownReference ""
    628 
    629   set index [$ht_tree index anchor]
    630    
    631   if { ![string length $index] } {
     464  variable wt_tree
     465  variable arguments
     466
     467  set node [$wt_tree selection get 0]
     468  if { ![string length $node] } return
     469  if { $node == 0 } {
    632470    ClearHiertables
    633471    return
    634472  }
     473 
     474  set tolReference [$wt_tree item text $node [WiTolReference 1]]
     475 
     476  Busy
     477  if { [llength $tolReference] == 1 } {
     478    #@ Aquí llegan los nodos raíz y las gramáticas
     479    #@ Argumentos pasados por atributo
     480    #@  + parent_grammar es usado por InsertItem para determinar el color de sus miembros si es NameBlock     
     481    set arguments(parent_grammar) ""
     482    switch $tolReference {
     483      Package SelectPackageRoot
     484      File    SelectFileRoot
     485      Console SelectConsoleRoot
     486      default ClearHiertables
     487    }
     488  } elseif { [lindex $tolReference 0] == "Grammar" } {
     489    #@ Argumentos pasados por atributo
     490    #@  + parent_grammar es usado por InsertItem para determinar el color de sus miembros si es NameBlock 
     491    set arguments(parent_grammar) ""
     492    SelectGrammar
     493  } else {
     494    SelectSet $tolReference
     495  }
     496  NotBusy
     497}
     498
     499#/////////////////////////////////////////////////////////////////////////////
     500proc ::TolInspector::SelectPackageRoot { } {
     501#
     502# PURPOSE: Script called each time 'Packages' node in wt_tree is
     503#          selected. Gets information about each node that must be in
     504#          packages, and inserts it in the right wtree.
     505#
     506#/////////////////////////////////////////////////////////////////////////////
     507  variable w_tabset
     508  variable arguments
     509 
     510  #@ Argumentos pasados por atributo
     511  #@  + index es usado e incrementado por InsertItem
     512  set arguments(index) 1
     513
    635514  ClearHiertables
    636 
    637   set path [ $ht_tree get -full $index ]
    638   set tolset ""
    639   if { $index } {
    640     #puts "SelectObject index = $index"
    641     #puts "SelectObject: full = $path"
    642     set info_node [split [lindex $path end] "-"] ;# ojo si el path tiene -
    643     set node_type [lindex $info_node 0]
    644     set node_name [lindex $info_node 1]
    645     #puts "SelectObject: info_node = $info_node"
    646   } else {
    647     set node_type root
    648     set node_name root
    649   }
    650 
    651   Busy
    652   #puts "SelectObject: node_type = $node_type, node_name = $node_name"
    653   switch -regexp $node_type  {
    654     root {
    655       switch $node_name {
    656         root -
    657         grammars {
    658           ClearHiertables
    659           #$w_tabset tab configure Variables -state disabled
    660           #$w_tabset tab configure Functions -state disabled
    661         }
    662         package {
    663           puts "implementa el llenado del panel derecho"
    664         }
    665         files {
    666           SelectFileRoot
    667         }
    668         console {
    669           SelectConsoleRoot
    670         }
    671         pool {
    672           SelectPoolRoot
    673         }
    674       }
    675     }
    676     grammar {
    677       SelectGrammar
    678     }
    679     default {
    680       set node_prefix $node_type
    681       #puts "SelectObject: node_prefix = $node_prefix"
    682       if { $node_type eq "package" } {
    683         foreach {tolset tolindex} [ getPackageReference $path ] break
    684       } elseif {[regexp -- "pool" $node_type]} {
    685         set tolset $data(pool,reference,[lindex $node_type 0])
    686         #puts "SelectObject: Spool: tolset=$tolset, info_node=$info_node"
    687         if { [llength $info_node] == 1 } {
    688           set tolindex [lrange $tolset 1 end]
    689           set tolset [lindex $tolset 0]
    690         } else {
    691           #set tolindex [lrange $tolset 1 end]
    692           #set tolset [lindex $tolset 0]
    693           #lappend tolindex [lindex $info_node end]
    694           set tolindex [lrange $info_node 1 end]
    695           if {[lindex $tolset 0] eq "Console"} {
    696             set tolset [lindex $tolset 0] 
    697           } else {
    698             set tolset [lrange $tolset 0 1]
    699           }
    700         }
    701       } elseif {[regexp -- "console(.+)" $node_type --> idx_con]} {
    702         #puts "SelectObject: Console: tolset=$tolset info_node=$info_node idx_con=$idx_con"
    703         set tolset "Console"
    704         #set idx [$ht_tree find -name $node_type]
    705         #array set aryData [$ht_tree entry cget $idx -data]
    706         #set tolindex [eval list $aryData(FileName) [lrange $info_node 1 end]]
    707         if {[llength $info_node] == 1} {
    708           set tolindex $idx_con
    709         } else {
    710           set tolindex [lrange $info_node 1 end]
    711           #set tolindex [concat [list $idx_con] $tolindex]
    712         }
    713       } else {
    714         set idx [$ht_tree find -name $node_type]
    715         array set aryData [$ht_tree entry cget $idx -data]
    716         #puts "SelectObject: FileName=$aryData(FileName) info_node=$info_node"
    717         set tolset [list File $aryData(FileName)]
    718         set tolindex [lrange $info_node 1 end]
    719         #set tolindex [lrange $info_node 2 end]
    720       }
    721       #puts "SelectObject end: tolset=$tolset, tolindex=$tolindex"
    722       SelectSet
    723     }
    724   }
    725   NotBusy
    726 }
    727 
     515  $w_tabset select 0 ;# Variables
     516 
     517  #@=> tiene que incrementarse automáticamente es el contador del foreach 
     518 
     519  foreach pkg [::tol::info packages] {
     520    set pi [::tol::info var "NameBlock $pkg"]
     521    #@ Argumentos pasados por atributo
     522    #@  + tolref es usado por InsertItem   
     523    set arguments(tolref) [list "NameBlock" $pkg]
     524    InsertChild NameBlock $pkg [lindex $pi 2] [lindex $pi 3] [lindex $pi 4] \
     525      $arguments(index) [lindex $pi 5] [lindex $pi 6] [lindex $pi 7]       
     526  }
     527}
    728528
    729529#/////////////////////////////////////////////////////////////////////////////
    730530proc ::TolInspector::SelectFileRoot { } {
    731531#
    732 # PURPOSE: Script called each time 'Included Files' node in ht_tree is
     532# PURPOSE: Script called each time 'Included Files' node in wt_tree is
    733533#          selected. Gets information about each node that must be in
    734 #          included files, and inserts it in the right treeview.
    735 #
    736 #/////////////////////////////////////////////////////////////////////////////
    737   variable item_id 1
     534#          included files, and inserts it in the right wtree.
     535#
     536#/////////////////////////////////////////////////////////////////////////////
    738537  variable w_tabset
    739   variable knownReference ""
     538  variable arguments
     539 
     540  #@ Argumentos pasados por atributo
     541  #@  + index es usado e incrementado por InsertItem
     542  set arguments(index) 1
    740543
    741544  ClearHiertables
    742545  $w_tabset tab configure Variables -text [mc Files]
    743546  #  $w_tabset tab configure Functions -state disabled
    744   $w_tabset select 0
     547  $w_tabset select 0 ;# Variables
     548 
     549  #@=> tiene que incrementarse automáticamente es el contador del foreach 
    745550  foreach f [lreverse [::tol::info included]] {
    746     # this catch is needed because info include could return files not
    747     # realy included.
    748     if { [ catch { ::tol::info included $f } fi ] } continue
    749     # tener en cuenta el subtype cuando lo retorne
    750     set knownReference [ list "File" $f ]
    751     InsertChild Set $f \
    752         [lindex $fi 0] [lindex $fi 1] [list [lindex $fi 2]] $item_id 1 [lindex $fi 3] [lindex $fi 4]
    753   }
    754 }
    755 
     551    # this catch is needed because info include could return files not really included
     552    if { [catch { ::tol::info included $f } fi] } continue
     553    #@ Argumentos pasados por atributo
     554    #@  + tolref es usado por InsertItem
     555    set arguments(tolref) [list "File" $f]
     556    set label [file tail $f]
     557    InsertChild Set $label [lindex $fi 0] [lindex $fi 2] [lindex $fi 1] \
     558      $arguments(index) 1 [lindex $fi 3] [lindex $fi 4]       
     559  }
     560}
    756561
    757562#/////////////////////////////////////////////////////////////////////////////
    758563proc ::TolInspector::SelectConsoleRoot { } {
    759564#
    760 # PURPOSE: Script called each time 'Console Objects' node in ht_tree is
     565# PURPOSE: Script called each time 'Console Objects' node in wt_tree is
    761566#          selected. Gets information about each node that must be in console,
    762 #          and inserts it in the right treeview.
     567#          and inserts it in the right wtree.
    763568#
    764569#/////////////////////////////////////////////////////////////////////////////
    765570  variable w_tabset
    766   variable ht_vars
    767   variable ht_funcs
    768   variable item_id 1
    769   variable iterSet "Console"
    770   variable knownReference ""
     571  variable wt_tree
     572  variable arguments
     573 
     574  #@ Argumentos pasados por atributo
     575  #@  + index es usado e incrementado por InsertItem
     576  set arguments(index) 1
    771577
    772578  ClearHiertables
    … …  
    777583 
    778584  foreach co [::tol::console stack list] {
    779    #puts "SelectConsoleRoot: co = $co"
    780    set gra  [lindex $co 0]
    781    set name [lindex $co 1]
    782    set cont [lindex $co 2]
    783    set path [lindex $co 3]
    784    set desc [lindex $co 4]
    785    set knownReference [ list Console $item_id ]
     585    #puts "SelectConsoleRoot: co = $co"
     586    set gra  [lindex $co 0]
     587    set name [lindex $co 1]
     588    set cont [lindex $co 2]
     589    set path [lindex $co 3]
     590    set desc [lindex $co 4]
     591    #@ Argumentos pasados por atributo
     592    #@  + tolref es usado por InsertItem
     593    set arguments(tolref) [list Console $arguments(index)]
    786594    switch [lindex $co 0 ] {
    787595      Code {
    788         InsertChild $gra $name $cont $path [list $desc] 0
     596        InsertChild $gra $name $cont $path $desc 0
    789597      }
    790598      NameBlock -
    791599      Set {
    792600        #puts "switch: SelectConsoleRoot $gra"
    793         InsertChild $gra $name $cont $path [list $desc] \
    794             $item_id [lindex $co 5] [lindex $co 6] [lindex $co 7] \
    795             [list Reference [list "Console" $item_id]]
     601        InsertChild $gra $name $cont $path $desc \
     602            $arguments(index) [lindex $co 5] [lindex $co 6] [lindex $co 7]
    796603      }
    797604      default {
    798         InsertChild $gra $name $cont $path [list $desc] \
    799             [list Reference [list "Console" $item_id]]
    800       }
    801     }
    802   }
    803   set knownReference ""
    804 }
    805 
    806 
    807 #/////////////////////////////////////////////////////////////////////////////
    808 proc ::TolInspector::SelectPoolRoot { } {
    809 #
    810 # PURPOSE: Script called each time 'Spool Objects' node in ht_tree is
    811 #          selected. Gets information about each node that must be in pool,
    812 #          and inserts it in the right treeview.
    813 #
    814 #/////////////////////////////////////////////////////////////////////////////
    815   variable w_tabset
    816   variable ht_vars
    817   variable data
    818   variable item_id 1
    819   variable knownReference ""
    820 
    821   ClearHiertables
    822   $ht_vars column  configure Index -hide yes
    823 
    824   array unset data pool,variables,*
    825   # Para cada uno de los objetos que debe haber en el spool
    826   # busco la información del nodo y lo inserto en el treeview de la derecha
    827   foreach _obj $data(pool,objects) {
    828     array set obj $_obj
    829     #Si la referencia del objeto tiene espacios en la ruta, el
    830     # llength me daría > 1, por eso añado la 2ª parte de la condicion
    831     #puts "SelectPoolRoot: obj(grammar)=$obj(grammar) obj(objName)=$obj(objName) obj(reference)=$obj(reference)"
    832     if { ([llength $obj(reference)] > 1) && ![string equal $obj(reference) $obj(objName)]} {
    833       if {$obj(grammar) eq "Code"} {
    834         set infoObj [concat [list $obj(grammar) $obj(objName)] \
    835             [::tol::info function $obj(reference)]]
    836       } else  {
    837         set infoObj [::tol::info variable $obj(reference)]
    838       }
    839       #Tolcon_Trace "tol info (var|function) reference"
    840     } else {
    841       if {[catch { set infoObj [concat [list "Set" $obj(reference)] \
    842                           [::tol::info included $obj(reference)]] }]} {
    843         if {$obj(grammar) eq "Code"} {
    844           set infoObj [concat [list $obj(grammar) $obj(reference)] \
    845                [::tol::info function $obj(graApply) $obj(reference)]]
    846         } else  {
    847           #set infoObj [concat [list $obj(grammar) $obj(reference)] \
    848           #     [::tol::info variable $obj(grammar) $obj(reference)]]
    849           set infoObj [::tol::info variable [list $obj(grammar) $obj(reference)]]
    850         }
    851         #Tolcon_Trace "tol info (var|function) Grammar nameGlobal"
    852       } else {
    853         # Insertamos el 1 de isFile
    854         set infoObj [linsert $infoObj 5 1]
    855         #Tolcon_Trace "tol info included"
    856       }
    857     }
    858     #Tolcon_Trace "INFOOBJ: $infoObj"
    859     set gra  [lindex $infoObj 0]
    860     set name [lindex $infoObj 1]
    861     set cont [lindex $infoObj 2]
    862     set path [lindex $infoObj 3]
    863     set desc [lindex $infoObj 4]
    864     set data(pool,variables,$item_id) $obj(reference)
    865 
    866     switch $gra {
    867       Code {
    868         InsertChild $gra $name $cont $path [list $desc] 0 "Reference $obj(reference)"
    869       }
    870       Set -
    871       NameBlock {
    872         set knownReference $obj(reference)
    873         InsertChild $gra $name $cont $path [list $desc] \
    874             $item_id [lindex $infoObj 5] [lindex $infoObj 6] [lindex $infoObj 7] "Reference $obj(reference)"
    875         set knownReference ""
    876       }
    877       default {
    878         InsertChild $gra $name $cont $path [list $desc] "Reference $obj(reference)"
    879       }
    880     }
    881   } 
    882 }
    883 
     605        InsertChild $gra $name $cont $path $desc
     606      }
     607    }
     608  }
     609  set arguments(tolref) ""
     610}
    884611
    885612#/////////////////////////////////////////////////////////////////////////////
    886613proc ::TolInspector::SelectGrammar { } {
    887614#
    888 # PURPOSE: Script called each time a Grammar node in ht_tree is selected. Gets
     615# PURPOSE: Script called each time a Grammar node in wt_tree is selected. Gets
    889616#          information about each var and function of this grammar, and
    890617#          inserts them in the right treeview.
    … …  
    892619#/////////////////////////////////////////////////////////////////////////////
    893620  variable w_tabset
    894   variable ht_tree
    895   variable ht_vars
    896   variable ht_funcs
    897   variable item_id 1
     621  variable wt_tree
    898622  variable OnSelectItem
    899   variable knownReference
    900 
    901   set knownReference ""
     623  variable arguments
     624 
     625  #@ Argumentos pasados por atributo
     626  #@  + index es usado e incrementado por InsertItem 
     627  set arguments(index) 1
     628 
    902629  ClearHiertables
    903   $ht_vars column  configure Index -hide yes
    904   $ht_funcs column configure Index -hide yes
    905   set grammar [$ht_tree entry cget anchor -label]
     630  #@! $ht_vars column  configure Index -hide yes
     631  #@! $ht_funcs column configure Index -hide yes
     632 
     633  set selAnchor [$wt_tree selection get 0]
     634 
     635  set grammar [$wt_tree item text $selAnchor [WiName 1] ]
    906636  if { [string compare $grammar "Anything"] } {
     637    #@ Por aquí si no es Anything
    907638    if { [string length $OnSelectItem] } {
    908639      $OnSelectItem [::tol::info grammars $grammar]
    909640    }
    910     foreach var  [::tol::info variables $grammar] {
     641    foreach var [::tol::info variables $grammar] {
    911642      if {[catch {
    912643        set vinfo [::tol::info variables [list $grammar $var]]
     644        #@ Devuelve:
     645        #@ Grammar Name Content Path Description [IsFile HasSubset ? Subtype?]
    913646      } msg]} {
    914647        Tol_HciWriter "<E>in ::TolInspector::SelectGrammar : $msg\n</E>"
    915648        continue
    916649      }
     650      #@ Argumentos pasados por atributo
     651      #@  + tolref es usado por InsertItem
     652      set arguments(tolref) [list $grammar $var]
     653      #@ InsertChild grammar name content path desc [Set|Nameblock: index isfile hassubset subtype] [Code: isvariable]
    917654      if { [string equal $grammar "Code"] } {
    918         #Tolcon_Trace "Code : -- $vinfo --"
    919         InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] 1 
     655        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [lindex $vinfo 4] 1 
    920656      } elseif { $grammar eq "Set" || $grammar eq "NameBlock" } {
    921         #Tolcon_Trace "Set : -- $vinfo --"
    922         set knownReference [ list $grammar $var ]
    923         InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] \
    924           $item_id [lindex $vinfo 5] [lindex $vinfo 6] [lindex $vinfo 7]
     657        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [lindex $vinfo 4] \
     658          $arguments(index) [lindex $vinfo 5] [lindex $vinfo 6] [lindex $vinfo 7]
    925659      } else {
    926         InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] $item_id 0
     660        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [lindex $vinfo 4]
    927661      } 
    928662    }
    … …  
    933667  foreach fun  [::tol::info functions $grammar] {
    934668    set finfo [::tol::info functions $grammar $fun]
    935     InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0   
    936   }
    937 }
    938 
    939 
    940 #/////////////////////////////////////////////////////////////////////////////
    941 proc ::TolInspector::SelectSet { } {
    942 #
    943 # PURPOSE: Script called each time a Set node in ht_tree is selected. Gets
     669    #@ Argumentos pasados por atributo
     670    #@  + tolref es usado por InsertItem   
     671    set arguments(tolref) [list Code $fun]
     672    InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [lindex $finfo 2] 0   
     673  }
     674}
     675
     676#/////////////////////////////////////////////////////////////////////////////
     677proc ::TolInspector::SelectSet { tolReference } {
     678#
     679# PURPOSE: Script called each time a Set node in wt_tree is selected. Gets
    944680#          information about each child of this set, and inserts it in the
    945681#          right treeview.
    946682#
    947 #/////////////////////////////////////////////////////////////////////////////
    948   variable ht_tree
    949   variable ht_vars
    950   variable ht_funcs
    951  
    952   variable tolset
    953   variable tolindex
    954   variable iterSet
     683#/////////////////////////////////////////////////////////////////////////////
    955684  variable var_id 1
    956685  variable fun_id 1
    957   variable item_id
    958   #variable selecting_set
    959  
    960   #  if { $selecting_set } {
    961   #puts "eoooo ..."
    962   #    return
    963   #  }
     686  variable arguments
     687 
    964688  ClearHiertables
    965   #  set selecting_set 1
    966   set item_id 1
    967  
    968   #puts "SelectSet: tolset=$tolset tolindex=$tolindex"
    969   set iterSet [eval list $tolset $tolindex]
    970   variable gra_parent [ GetParentGrammar $iterSet ]
    971   ::tol::forallchild $iterSet ::TolInspector::_InsertChild
    972   #  set selecting_set 0
    973 }
    974 
    975 
    976 #/////////////////////////////////////////////////////////////////////////////
    977 proc ::TolInspector::CloseObject { index } {
    978 #
    979 # PURPOSE: Script called each time a node in ht_tree (left treeview) is
    980 #          closed.
     689 
     690  #@ Argumentos pasados por atributo
     691  #@  + index es usado e incrementado por InsertItem     
     692  #@  + parent_grammar es usado por InsertItem para determinar el color de sus miembros si es NameBlock
     693  #@  + tolref indica a InsertItem que se ha de obtener desde parent_tolref
     694  #@  + parent_tolref es usado por InsertItem para encontrar tolref 
     695  set arguments(index) 1 
     696  set arguments(parent_grammar) [GetParentGrammar $tolReference]
     697  set arguments(tolref) ""
     698  set arguments(parent_tolref) $tolReference 
     699  ::tol::forallchild $tolReference ::TolInspector::InsertChild
     700}
     701
     702#/////////////////////////////////////////////////////////////////////////////
     703proc ::TolInspector::CloseObject { node } {
     704#
     705# PURPOSE: Script called each time a node in wt_tree (left treeview) is closed.
    981706#
    982707# PARAMETERS:
    983 #   index : The id of the node closed
    984 #
    985 #/////////////////////////////////////////////////////////////////////////////
    986   variable ht_tree
    987   #variable closing 1
    988   set path [$ht_tree get -full $index]
    989   if { $index } {
    990     set parent1 [lindex $path 1]
    991     if { [string equal $parent1 "root-packages"] ||
    992          [string equal $parent1 "root-files"] ||
    993          [string equal $parent1 "root-console"] ||
    994          [string equal $parent1 "root-pool"] } {
    995       $ht_tree entry delete $index 0 end
    996     }
    997   }
    998 }
    999 
    1000 
    1001 #/////////////////////////////////////////////////////////////////////////////
    1002 proc ::TolInspector::OpenVariable { index } {
    1003 #
    1004 # PURPOSE: ????
     708#   node : The id of the node closed
     709#
     710#/////////////////////////////////////////////////////////////////////////////
     711  variable wt_tree
     712 
     713  #@ No es necesario vaciar ni el nodo root (0) ni root-grammars (1)
     714  if { $node == 0 } return
     715  if { $node == 1 } return
     716  foreach it [$wt_tree item children $node] {
     717    $wt_tree item delete $it
     718  }   
     719}
     720
     721#/////////////////////////////////////////////////////////////////////////////
     722proc ::TolInspector::OpenVariable { node } {
     723#
     724# PURPOSE: Script called each time a node in wt_vars (right wtree) is opened.
    1005725#
    1006726# PARAMETERS:
    1007 #   index ->
    1008 #
    1009 #/////////////////////////////////////////////////////////////////////////////
    1010   variable tolset     ;# Name of the current TOL set variable
    1011   variable ht_vars    ;# ::blt::treeview of variables
    1012   variable ht_tree    ;# ::blt::treeview left
    1013   variable blt_tree   ;# ::blt::tree left
    1014   variable item_data  ;# Array to hold the full content & description of items
     727#   node : The id of the node opened
     728#
     729#/////////////////////////////////////////////////////////////////////////////
     730  variable wt_tree
     731  variable wt_vars
    1015732 
    1016   if { ![string length $index] } {
    1017     return
    1018   }
    1019   set node_anchor [lindex [$ht_tree get -full anchor] end]
    1020  
    1021   set tree_index -1
    1022   #puts "OpenVariable = $item_data([lindex [$ht_vars entry cget $index -data] end])"
    1023   if { ![regexp -- "grammar-" $node_anchor] } {
    1024     set grammar [lindex $item_data([lindex [$ht_vars entry cget $index -data] end]) 2]
     733  if { ![string length $node] } { return }
     734 
     735  set treeParent [$wt_tree selection get 0]
     736  set treeParent_tolRef [$wt_tree item text $treeParent [WiTolReference 1]]
     737 
     738  set treeNode -1
     739  if { [llength $treeParent_tolRef] > 1 } {
     740    set grammar [$wt_vars item text $node [WiGrammar 0]]
    1025741    if {$grammar eq "Set" || $grammar eq "NameBlock"} {
    1026       $ht_tree open anchor
    1027       #puts "full = [$ht_vars get -full $index]"
    1028       set local_name [lindex [$ht_vars get -full $index] end]
    1029       set idx_anchor [$ht_tree index anchor]
    1030       #puts "a buscar $local_name dentro de $idx_anchor"
    1031       if {[set tree_index [$blt_tree findchild $idx_anchor $local_name]] == -1} {
    1032         foreach idx [$ht_tree entry children anchor] {
    1033           if { [string equal $local_name [lindex [$ht_tree get -full $idx] end]] } {
    1034             set tree_index $idx
    1035             break
    1036           }
     742      $wt_tree item expand $treeParent
     743      #@ Se localiza el nodo seleccionado en el árbol (wt_tree)
     744      set index [$wt_vars item text $node [WiIndex 0]]     
     745      foreach node_i [$wt_tree item children $treeParent] {
     746        set index_i [$wt_tree item text $node_i [WiIndex 1]]
     747        if { [string equal $index $index_i] } {
     748          set treeNode $node_i
     749          break
    1037750        }
    1038751      }
    1039752    }
    1040753  }
    1041   if { $tree_index != -1 } {
     754  if { $treeNode != -1 } {
    1042755    update
    1043     blt::tv::SetSelectionAnchor $ht_tree $tree_index
    1044     set blt::tv::scroll 1
     756    $wt_tree selection clear   
     757    $wt_tree selection add $treeNode
     758   
     759#@!! REVISAR 
     760#@!! blt::tv::SetSelectionAnchor $ht_tree $treeNode
     761#@!! set blt::tv::scroll 1
    1045762    #$ht_tree selection clearall
    1046     #$ht_tree see $tree_index
    1047     #$ht_tree focus $tree_index
    1048     #$ht_tree selection set $tree_index
    1049     #$ht_tree selection anchor $tree_index
     763    #$ht_tree see $treeNode
     764    #$ht_tree focus $treeNode
     765    #$ht_tree selection set $treeNode
     766    #$ht_tree selection anchor $treeNode
    1050767    #set blt::Hiertable::scroll 1
    1051768  }
    1052769}
    1053770
    1054 
    1055 #/////////////////////////////////////////////////////////////////////////////
    1056 proc ::TolInspector::SelectItem { ht } {
     771#/////////////////////////////////////////////////////////////////////////////
     772proc ::TolInspector::SelectItem { wt } {
    1057773#
    1058774# PURPOSE: Procedure that is executed when the user selects an element of
    1059 #          the trees of variables orfunctions.
     775#          the trees of variables or functions.
    1060776#          First it take all the arguments necessary of the node of tree to
    1061777#          execute the procedure stored in the variable OnSelectItem, and
    1062778#          later executes it passing those arguments.
    1063779#
    1064 # PARAMETERS: path of ht_* (::blt::treeview of variables or of functions)
    1065 #
    1066 #/////////////////////////////////////////////////////////////////////////////
    1067  # variable w_text       ;# TODO: ????
    1068   variable OnSelectItem ;#Command to invoke on SelectItem in ht_*
    1069   variable item_data    ;# Array to hold the full content & description of items
    1070  
    1071   set entry [$ht index anchor] ;# id of entry selected 
     780# PARAMETERS: path of wt_* (::wtree of variables or of functions)
     781#
     782#/////////////////////////////////////////////////////////////////////////////
     783# variable w_text       ;# TODO: ????
     784  variable OnSelectItem ;#Command to invoke on SelectItem in wt_*
     785 
     786  #@! set entry [$wt selection anchor] ;# id of entry selected
     787  set entry [$wt selection get end] ;# id of entry selected
     788 
     789  Tolcon_Trace "SelectItem $entry"
     790
    1072791  if { [string length $OnSelectItem] } {
    1073792    # there are associated command
    1074793    if { [string length $entry] } {
    1075       # almost one entry of ht_* selected
    1076       array set aryData [$ht entry cget $entry -data]
    1077       set name [$ht entry cget $entry -label] ;# name of item
    1078       set itemid $aryData(Index)              ;# id of item
    1079       set path   $aryData(Path)               ;# path of file of item
    1080       #(pgea) se anyade la propiedad Reference
    1081       set objRef $aryData(Reference)          ;# info of item
    1082       set full_data $item_data($itemid) ;# {value} {desc} {grammar}       
    1083       set value [lindex $full_data 0]   ;# value of item PE:
    1084                                          # Anything Field(Set s, Text nombre)
    1085 
     794      # almost one entry of wt_* selected
     795      set name   [$wt item text $entry [WiName 0]] ;# name of item
     796  Tolcon_Trace "SelectItem $name"     
     797      set itemid [$wt item text $entry [WiIndex 0]] ;# id of item
     798  Tolcon_Trace "SelectItem $itemid"         
     799      set path   [$wt item text $entry [WiPath 0]] ;# path of file of item
     800      set objRef [$wt item text $entry [WiTolReference 0]] ;# info of item
     801      set value [$wt item text $entry [WiContent 0]]
    1086802      if { [string equal \"\n\" $value] } {
    1087803        # hasn't value       
    … …  
    1090806        set value [string trim $value]
    1091807      }
    1092       set desc [string trim [lindex $full_data 1]]
    1093       set grammar [lindex $full_data 2]
    1094       set icon [lindex [$ht entry cget $entry -icons] 0]
     808      set desc [$wt item text $entry [WiDescription 0]]
     809      set grammar [$wt item text $entry [WiGrammar 0]]
     810      set icon [$wt item image $entry [WiName 0] ]
    1095811      #(pgea) lista de argumentos que recibe ::TolConsole::OnInfo
    1096812      set args [list $icon $grammar $name $value $path $desc $objRef]
    … …  
    1101817  }
    1102818  return
    1103 #;# TODO: ????
    1104 #  if { [string length $entry] } {
    1105 #    FillText $ht $entry
    1106 #  } else {
    1107 #    $w_text delete 1.0 end
    1108 #  }
    1109 }
    1110 
    1111 #/////////////////////////////////////////////////////////////////////////////
    1112 #(pgea) se usa?
    1113 proc ::TolInspector::FillText { ht entry } {
    1114 #/////////////////////////////////////////////////////////////////////////////
    1115   variable w_text
    1116   variable item_data
    1117   #upvar #0 ::TolTk::Images Images
    1118 
    1119   $w_text delete 1.0 end
    1120   array set aryData [$ht entry cget $entry -data]
    1121   set name [$ht entry cget $entry -label]
    1122   set itemid $aryData(Index)
    1123   set full_data $item_data($itemid)
    1124  
    1125   set value [lindex $full_data 0]
    1126   if { [string equal \"\n\" $value] } {
    1127     set value {"\n"}
    1128   }
    1129   set desc [string trim [lindex $full_data 1]]
    1130   set grammar [lindex $full_data 2]
    1131   set icon [lindex [$ht entry cget $entry -icons] 0]
    1132   foreach {prop val} [list "Grammar: " $grammar "Name: " $name "Value: " [string trim $value]] {
    1133     set idx_start [$w_text index "end -1 chars"]
    1134     $w_text insert end $prop
    1135     set idx_end   [$w_text index "end -1 chars"]
    1136     $w_text tag add tagLabel $idx_start $idx_end
    1137     if {[string equal $prop "Grammar: "]} {
    1138       $w_text image create end -image $icon
    1139       $w_text insert end "  "
    1140     }
    1141     $w_text insert end "$val\n"
    1142     $w_text tag add tagValue $idx_end [$w_text index "end -1 chars"]
    1143   }
    1144   $w_text tag configure tagLabel -font fnBold
    1145   $w_text tag configure tagValue -wrap none
    1146   if { [string length $desc] } {
    1147     set idx_start [$w_text index "end -1 chars"]
    1148     $w_text insert end "Description\n"
    1149     set idx_end [$w_text index "end -1 chars"]
    1150     $w_text tag add tagPropLabel $idx_start $idx_end
    1151     $w_text insert end $desc
    1152     $w_text tag add tagPropValue $idx_end [$w_text index "end -1 chars"]
    1153     $w_text tag configure tagPropLabel -font fnBold -underline 1
    1154     $w_text tag configure tagPropValue -wrap word
    1155   }
    1156 }
    1157 
    1158 #proc ::TolInspector::GetIndexes { nodeid } {
    1159 #  variable ht_tree
    1160 #  # No se utiliza
    1161 #  # name is prefix-i1-i2-i3-...-in
    1162 #
    1163 #  if { $nodeid } {
    1164 #    lrange [split [$ht_tree get $nodeid] "-"] 1 end
    1165 #  } else list
    1166 #}
     819}
Note: See TracChangeset for help on using the changeset viewer.