Changeset fa673db in tol for tolbase/lib/byswidget/bfunctions

Timestamp:

Sep 22, 2009, 11:51:51 AM (17 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

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

Children:

55e561e

Parents:

83f123c

Message:

cleaning code of TolObj2TclObj and TolObj2TclObjNamed

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

File:

• tolbase/lib/byswidget/bfunctions/bftoltcl.tcl (modified) (5 diffs)

tolbase/lib/byswidget/bfunctions/bftoltcl.tcl

@@ -684 +684 @@
       array set it_info $it
       #puts "$it_info(grammar) $it_info(name) $it_info(content) "
-      set G $it_info(grammar)
-      if { $G eq "Set" || $G eq "NameBlock" } {
-        set value [ TolObj2TclObj [ eval list $obj $idx ] ]
-      } else {
-        set value $it_info(content)
-      }
-      lappend result $value
+      lappend result [ TolObj2TclObj [ eval list $obj $idx ] ]
       incr idx
     }
@@ -699 +693 @@
 }
 
+
+#///////////////////////////////////////////////////////////////////////////
+proc TolSet2TclListNamed { obj } {
+# PURPUSE: procedimiento de ayuda a TolObj2TclObjNamed para construir el
+#          valor asociado a un conjunto TOL donde sus elementos van con
+#          nombre.
+#
+# RETURNS: retorna una lista con los pares nombre valor de los elementos del
+#          conjunto TOL
+#///////////////////////////////////////////////////////////////////////////
+  set value [ list ]
+  set idx 1
+  tol::foreach it $obj {
+    #puts "$it_info(grammar) $it_info(name) $it_info(content) "
+    set it_pair [ TolObj2TclObjNamed [ eval list $obj $idx ] ]
+    # esto quedaria mejor con un {*}, no usaria el eval pues creo que
+    # "abre" toda la lista.
+    lappend value [ lindex $it_pair 0 ] [ lindex $it_pair 1 ]
+    incr idx
+  }
+  set value
+}
+
 #///////////////////////////////////////////////////////////////////////////
 proc TolObj2TclObjNamed { obj } {
 # PURPUSE: Dado una referencia a un objeto TOL retorna una representacion en
 #          TCL equivalente manteniendo los nombres de los objetos TOL.
-#          Si alguno de los objetos no tiene nombre se le asigna el nombre "".
-#          Esta funcion puede reemplazar a TolSet2TclLst.
-#
-# RETURN: Un lista Tcl de pares <nombre,valor> que representa el contenido
-#         con nombredel objeto TOL
+#          Si el objeto no tiene nombre se le asigna un nombre vacio ""
+#
+# RETURN: Un par nombre,valor
 #
 #///////////////////////////////////////////////////////////////////////////
@@ -714 +729 @@
   set grammar [ lindex $vinfo 0 ]
   if { $grammar eq "Set" || $grammar eq "NameBlock" } {
-    set result [ list ]
-    set idx 1
-    tol::foreach it $obj {
-      array set it_info $it
-      #puts "$it_info(grammar) $it_info(name) $it_info(content) "
-      set G $it_info(grammar)
-      if { $G eq "Set" || $G eq "NameBlock" } {
-        set value [ TolObj2TclObjNamed [ eval list $obj $idx ] ] 
-      } else {
-         set value $it_info(content)
-      }
-      lappend result $it_info(name) $value
-      incr idx
-    }
-    set result
+    set value [ TolSet2TclListNamed $obj ]
   } else {
-    lrange $vinfo 1 2
-  }
+    set value [ lindex $vinfo 2 ]
+  }
+  list [ lindex $vinfo 1 ] $value
 }
 
@@ -768 +770 @@
 proc test3.1 { } {
   tol::console eval {
-    Set {[[ 1, 2, Set kk = [[ 3, 4 ]] ]]}
+    Set {[[ 1, 2, Set kk = [[ 3, 4, "texto" ]] ]]}
   }
   set result [ TolObj2TclObj {Console 1} ]
@@ -777 +779 @@
 proc test3.2 { } {
   tol::console eval {
-    Set {[[ 1, 2, Set kk = [[ 3, 4 ]] ]]}
+    Set {[[ 1, 2, Set kk = [[ 3, 4, "texto" ]] ]]}
   }
   set result [ TolObj2TclObjNamed {Console 1} ]