Ignore:
Timestamp:
Jul 3, 2010, 8:58:14 PM (16 years ago)
Author:
Jorge Pérez <josp.jorge@…>
Branches:
1941-docker-image-to-test, devel, master
Children:
a939dea
Parents:
9797b96
Message:

closes #931: implemented what was requested, something similar should be done in order to explore directly the variables below Set and NameBlock nodes.

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • tolbase/lib/toltk/tolinspe.tcl

    r9797b96 r33b09bc  
    365365  $ht_tree entry configure root -label [mc "Tol Objects"]\
    366366           -icons [list $img $img]
     367
    367368  # creation of the node father "Grammars"
    368369  set img [::Bitmap::get Grammars] 
    … …  
    373374  # Inserts in the node of grammars a node by each grammar that exists in Tol
    374375  InsertGrammars
     376
     377  # creation of the node father "Packages"
     378  set img [::Bitmap::get "package"] 
     379  set blt_idx [$blt_tree insert root -label "root-packages"\
     380           -tags "root-packages"]
     381  $ht_tree entry configure $blt_idx -label [mc "Packages"]\
     382           -icons [list $img $img] -button yes
     383
    375384  # creation of the node father "Included Files"
    376385  set img [::Bitmap::get "Files"]
    … …  
    823832}
    824833
     834# este proc debe pasar a ser un getContainerReference
     835#
     836proc ::TolInspector::getPackageReference { treePath } {
     837  variable ht_tree
     838
     839  catch {
     840    set typeContainer "NameBlock"
     841    set order [ lindex  [ split [ lindex $treePath 2 ] "-" ] end ]
     842    incr order -1
     843    #puts "path,2 = [ lindex $treePath 2 ]"
     844    #puts "order = $order"
     845    set idx [ $ht_tree entry children "root-packages" $order $order ]
     846    set nameContainer [ $ht_tree entry cget $idx -label ]
     847    #puts "en root-package:"
     848    #puts "\torder=$order"
     849    #puts "\tidx=$idx"
     850    #puts "\nameContainer=$nameContainer"
     851    set container [ list $typeContainer $nameContainer ]
     852    if { [ llength $treePath ] > 3 } {
     853      foreach c [ lrange $treePath 3 end-1 ] {
     854        set orderItem [ lindex  [ split $c "-" ] end ]
     855        lappend container $orderItem
     856      }
     857      set tolindex [ lindex  [ split [ lindex $treePath end ] "-" ] end ]
     858    } else {
     859      set tolindex [ list ]
     860    }
     861  } msg
     862  #puts "::TolInspector::getPackageReference: $msg"
     863  return [ list $container $tolindex ]
     864}
     865
    825866#/////////////////////////////////////////////////////////////////////////////
    826867proc ::TolInspector::OpenObject { index } {
    … …  
    842883  #puts "OpenObject: index=$index"
    843884  set path [$ht_tree get -full $index]
     885  #puts "path = $path"
    844886  if { $index } {
    845887    set parent1 [lindex $path 1]
    846     if { [set isfile [string equal $parent1 "root-files"]] ||
     888    if { [set ispackage [string equal $parent1 "root-packages"]] ||
     889         [set isfile [string equal $parent1 "root-files"]] ||
    847890         [set isconsole [string equal $parent1 "root-console"]] ||
    848891         [string equal $parent1 "root-pool"] } {
    … …  
    850893      #puts "lpath = $lpath"
    851894      if { $lpath == 2 } {
    852         if { $isfile } {
     895        if { $ispackage } {
     896          InsertPackages
     897        } elseif { $isfile } {
    853898          InsertFiles
    854899        } elseif { $isconsole } {
    … …  
    863908        set node_prefix [lindex $leaf_info 0]
    864909        set _tolset $tolset
    865         if { [string equal $parent1 "root-pool"] } {
     910        if { $parent1 eq "root-packages" } {
     911          foreach {tolset tolindex} [ getPackageReference $path ] break
     912        } elseif { [string equal $parent1 "root-pool"] } {
    866913          #Tolcon_Trace "OpenObject. tolset=$tolset"
    867914          set tolset $data(pool,reference,[lindex $leaf_info 0])
    … …  
    916963
    917964#/////////////////////////////////////////////////////////////////////////////
     965proc ::TolInspector::InsertPackages {} {
     966#
     967# PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL
     968#          packages
     969#
     970#/////////////////////////////////////////////////////////////////////////////
     971  variable ht_tree
     972  #upvar \#0 ::TolTk::Images Images
     973   
     974  set order 1
     975  foreach pkg [::tol::info packages] {
     976    # takes an icon with the same name that the grammar
     977    set img [ ::Bitmap::get NameBlock ]
     978    $ht_tree insert -at "root-packages" end package-$order -label $pkg\
     979          -icons [list $img $img] -button yes
     980    incr order
     981  }
     982}
     983
     984#/////////////////////////////////////////////////////////////////////////////
    918985proc ::TolInspector::InsertGrammars {} {
    919986#
    … …  
    10961163  variable blt_tree
    10971164  variable gra_parent
    1098 
     1165  catch {
    10991166  #puts "InsertSubset, args=$args"
    11001167  set grammar [lindex $args 0]
    … …  
    11411208      -icons [list $icon $icon] -foreground $fcolor
    11421209  }
     1210} msg
     1211#puts "InsertSubSet: $msg"
    11431212}
    11441213
    … …  
    12661335  ClearHiertables
    12671336
     1337  set path [ $ht_tree get -full $index ]
    12681338  set tolset ""
    12691339  if { $index } {
    12701340    #puts "SelectObject index = $index"
    1271     #puts "SelectObject: full = [$ht_tree get -full $index]"
    1272     set info_node [split [lindex [$ht_tree get -full $index] end] "-"] ;# ojo si el path tiene -
     1341    #puts "SelectObject: full = $path"
     1342    set info_node [split [lindex $path end] "-"] ;# ojo si el path tiene -
    12731343    set node_type [lindex $info_node 0]
    12741344    set node_name [lindex $info_node 1]
    … …  
    12801350
    12811351  Busy
    1282   #puts "SelectObject: node_type = $node_type"
     1352  #puts "SelectObject: node_type = $node_type, node_name = $node_name"
    12831353  switch -regexp $node_type  {
    12841354    root {
    … …  
    12901360          #$w_tabset tab configure Functions -state disabled
    12911361        }
     1362        package {
     1363          puts "implementa el llenado del panel derecho"
     1364        }
    12921365        files {
    12931366          SelectFileRoot
    … …  
    13071380      set node_prefix $node_type
    13081381          #puts "SelectObject: node_prefix = $node_prefix"
    1309       if {[regexp -- "pool" $node_type]} {
     1382      if { $node_type eq "package" } {
     1383        foreach {tolset tolindex} [ getPackageReference $path ] break
     1384      } elseif {[regexp -- "pool" $node_type]} {
    13101385        set tolset $data(pool,reference,[lindex $node_type 0])
    13111386        #puts "SelectObject: Spool: tolset=$tolset, info_node=$info_node"
    … …  
    13181393          #lappend tolindex [lindex $info_node end]
    13191394          set tolindex [lrange $info_node 1 end]
    1320                   if {[lindex $tolset 0] eq "Console"} {
    1321                     set tolset [lindex $tolset 0] 
    1322                   } else {
    1323                     set tolset [lrange $tolset 0 1]
    1324                   }
     1395          if {[lindex $tolset 0] eq "Console"} {
     1396            set tolset [lindex $tolset 0] 
     1397          } else {
     1398            set tolset [lrange $tolset 0 1]
     1399          }
    13251400        }
    13261401      } elseif {[regexp -- "console(.+)" $node_type --> idx_con]} {
    1327             #puts "SelectObject: Console: tolset=$tolset info_node=$info_node idx_con=$idx_con"
     1402        #puts "SelectObject: Console: tolset=$tolset info_node=$info_node idx_con=$idx_con"
    13281403        set tolset "Console"
    13291404        #set idx [$ht_tree find -name $node_type]
    … …  
    16011676  if { $index } {
    16021677    set parent1 [lindex $path 1]
    1603     if { [string equal $parent1 "root-files"] ||
    1604      [string equal $parent1 "root-console"] ||
    1605      [string equal $parent1 "root-pool"] } {
     1678    if { [string equal $parent1 "root-packages"] ||
     1679         [string equal $parent1 "root-files"] ||
     1680         [string equal $parent1 "root-console"] ||
     1681         [string equal $parent1 "root-pool"] } {
    16061682      $ht_tree entry delete $index 0 end
    16071683    }
Note: See TracChangeset for help on using the changeset viewer.