Changeset 3a5bf7b in tol

Timestamp:

Jun 7, 2010, 4:52:25 PM (16 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

1941-docker-image-to-test, devel, master

Children:

b5ff1e8

Parents:

abd779c

Message:

tolbase takes into account MenuManager settings

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

Location:

tolbase/lib/toltk

Files:

• MenuManager.tcl (added)
• tolinspe.tcl (modified) (5 diffs)

tolbase/lib/toltk/tolinspe.tcl

@@ -1851 +1851 @@
 
 proc TolGui_GetMenuEntries { selection idx } {
+  #puts "TolGui_GetMenuEntries $selection $idx"
   array set instances {}
   array set menu_class {}
@@ -1876 +1877 @@
     lappend menu_info [ list $c $menu_class($c) $instances($c) ]
   }
+  #puts "$menu_info"
   set menu_info
+}
+
+proc TolGui_InsertEntriesFromMenuManager { targetMenu selection } {
+  set addrList [ list ]
+  foreach obj_info $selection {
+    set tcl_ref [ lindex $obj_info 0 ]
+    lappend addrList [ ::tol::info address $tcl_ref ]
+  }
+  MenuManager::insertEntriesForSelection $targetMenu $addrList
 }
 
@@ -1897 +1908 @@
 
 proc TolGui_InvokeMethod { method obj_addr } {
+  #puts "TolGui_InvokeMethod $method $obj_addr"
   set try [ catch {
     tol::console eval [ string map [ list %A $obj_addr %M $method ] {
@@ -2130 +2142 @@
             }
             NameBlock {
+              # entradas desde MenuManager
+              TolGui_InsertEntriesFromMenuManager \
+                  $data_menu(main) \
+                  $options_selected(NameBlock)
+              # entradas desde @MenuDesc
               set sel_length [ llength $options_selected(NameBlock) ]
               if { $sel_length } {
@@ -2137 +2154 @@
                           $options_selected(NameBlock) $idx_current ]
                 set num_options [ llength $all_nb_options ]
+                #puts "num_options = $num_options"
                 foreach mi $all_nb_options {
                   set _cname [ lindex $mi 0 ]
                   set cname [ string map [ list @ "" . _ ] $_cname ]
+                  #puts "cname = $cname"
                   foreach { ninst obj_addr entries } [ lindex $mi 1 ] break
                   set instances [ lindex $mi 2 ]
+                  if { $num_options > 1 } {
                   # creo el menu de la clase si no existe
-                  set mclass $data_menu(main).cls$cname
-                  if { ![ winfo exists $mclass ] } {
-                    menu $mclass -tearoff 0
-                  } else {
-                    $mclass delete 0 end
-                  }
-                  if { $num_options > 1 } {
+                    set mclass $data_menu(main).cls$cname
+                    if { ![ winfo exists $mclass ] } {
+                      menu $mclass -tearoff 0
+                    } else {
+                      $mclass delete 0 end
+                    }
                     $data_menu(main) add cascade -label $cname -menu $mclass
                     set target_menu $mclass