Changeset 64bb607 in tol

Timestamp:

Jun 18, 2009, 1:28:49 PM (17 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

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

Children:

4c3ff30

Parents:

cfc30c0

Message:

TolInspector::CallUserFunction use the address obtained from tol::info address and pass the object to the gui functions through the TOL function GetObjectFromAddress

relates to #695.

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

File:

• tolbase/lib/toltk/tolinspe.tcl (modified) (4 diffs)

tolbase/lib/toltk/tolinspe.tcl

@@ -1305 +1305 @@
       set node_prefix $node_type
           #puts "SelectObject: node_prefix = $node_prefix"
-          if {[regexp -- "pool" $node_type]} {
+      if {[regexp -- "pool" $node_type]} {
         set tolset $data(pool,reference,[lindex $node_type 0])
         #puts "SelectObject: Spool: tolset=$tolset, info_node=$info_node"
@@ -3188 +3188 @@
   #puts "CallUserFunction. grammar=$grammar, idx=$idx, items_selected=$items_selected"
   
-  set itemsName ""
+  set all_objs [ list ]
   foreach it $items_selected {
-    set namTol [TclRefToNameTol $it]
-    if  {[string length $namTol]} {
-      lappend itemsName [TclRefToNameTol $it]
-      #lappend itemsName [lindex $it 1]
-    } else {
-      tk_messageBox -type ok -icon info \
-                    -message [mc "VarWithoutNameNotFunc"] \
-                    -title [mc "Warning"]
-      return 0
-    }
-  }
-
-  if { [llength $itemsName] } {
+    set tcl_ref [ lindex $it 0 ]
+    set obj_addr [ ::tol::info address $tcl_ref ]
+    lappend all_objs "GetObjectFromAddress(\"$obj_addr\")"
+  }
+
+  if { [ llength $all_objs ] } {
     incr group_id
     array set regFun $regFunLst
     set gui [bguifunction .t$group_id \
-       -title $regFun($idx,nameGui) \
-       -regpars $regFun($idx,parameters)]
+                 -title $regFun($idx,nameGui) \
+                 -regpars $regFun($idx,parameters)]
     set txtPars [join [$gui get values] ,]
     if {$txtPars ne ""} {
@@ -3216 +3209 @@
     switch [lindex $typeGui 0] {
       Ite {
-        foreach item $itemsName {
-          set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($item $txtPars)"
+        foreach obj $all_objs {
+          set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($obj $txtPars)"
           #Tolcon_Trace "Ite.cmd=$cmd"
           ::tol::console eval $cmd
@@ -3224 +3217 @@
       }
       Set {
-        set item [join $itemsName ,]
-        set setCmd "SetOf[lindex $typeGui 1] ($item)"
+        set obj_args [join $all_objs ,]
+        set setCmd "SetOf[lindex $typeGui 1] ($obj_args)"
         set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($setCmd $txtPars)"
         #Tolcon_Trace "Set.cmd=$cmd"