Changeset a566515 in tol

Timestamp:

Feb 15, 2012, 2:53:26 PM (15 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

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

Children:

0d88c15

Parents:

699b7d8

Message:

fixes #1433, cuando el conjunto es estructurado se incluye la definición de la estructura en el panel info

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

Location:

tolbase/lib/toltk

Files:

• markuphelper.tcl (modified) (7 diffs)
• tolbase.tcl (modified) (1 diff)
• tolinspe.tcl (modified) (1 diff)

tolbase/lib/toltk/markuphelper.tcl

@@ -1 +1 @@
 namespace eval ::MarkupHelper {
-  variable markup
+  variable markup {}
+  variable backup {}
+  variable indent 0
 
   proc Init { } {
     variable markup {}
+    variable restore {}
+    variable indent 0
+  }
+
+  proc SetIndent { n } {
+    variable indent
+
+    if { $n >= 0 && n <= 9 } {
+      set indent n
+    }
+    return $indent
+  }
+
+  proc IncrIndent { d } {
+    variable indent
+
+    set n [ incr indent $d ]
+    if { $indent < 0 } {
+      set indent 0
+    } elseif { $indent > 9 } {
+      set indent 9
+    }
+    return $indent
+  }
+
+  proc Indent { } {
+    variable indent
+    variable markup
+
+    append markup [ string repeat ":" $indent ]
+  }
+
+  proc Backup { } {
+    variable markup
+    variable backup $markup
+
+    return $backup
+  }
+
+  proc Restore { } {
+    variable markup
+    variable backup
+
+    set old $markup
+    set markup $backup
+    return $old
   }
 
@@ -52 +100 @@
     variable markup
 
+    if { $markup eq "" } {
+      Indent
+    }
     array set opts { -tags {} -br 0 }
     array set opts $args
@@ -102 +153 @@
   }
 
+  proc CR { } {
+    variable markup
+
+    append markup "\n"
+  }
+
   proc BR { { br 1 } } {
     variable markup
+    variable indent
 
     if { $br } {
-      append markup " <br>"
+      if { $indent } {
+        append markup "\n"
+        Indent
+      } else {
+        append markup " <br>\n"
+      }
     }
   }
@@ -125 +188 @@
     }
     append markup "#---\n"
+  }
+
+  proc AppendHT { htBuffer } {
+    variable markup
+
+    append markup $htBuffer
   }
 
@@ -131 +200 @@
     array set opts $args
 
+    set extraHTInfo {}
     foreach {classOf insInfo insCont} {{} {} {}} break
     if { $grammar eq "NameBlock" } {
@@ -144 +214 @@
         set insCont [Tol_InstanceContent $objAddr]
       }
+      if { $insInfo ne "" } {
+        Backup
+        Init
+        Header2 [ mc "Instance's Info" ]
+        foreach line [ split $insInfo \n ] {
+          set s [ string index $line 0 ]
+          set e [ string index $line end ]
+          if { $s eq "\[" && $e eq "\]" } {
+            Text "[ string range $line 1 end-1 ]:" \
+                -tags {b} -br 1
+          } elseif { $s eq "{" && $e eq "}" } {
+            Text "[ string range $line 1 end-1 ]: " -tags {b}
+          } else {
+            Text \
+                [ Preprocess [ string trimright $line ] ] -br 1
+          }
+        }
+        set extraHTInfo [ Restore ]
+      }
+    } elseif { $grammar eq "Set" } {
+      if { [ info exists opts(-objref) ] } {
+        set objRef $opts(-objref)
+        set classOf [Tol_StructOfFromReference $objRef]
+      } elseif { [ info exists opts(-objaddr) ] } {
+        set objAddr $opts(-objaddr)
+        set classOf [Tol_StructOf $objAddr]
+      }
+      if { $classOf ne "" } {
+        Backup
+        Init
+        BR
+        Text [ mc "Definition:" ] -tags b
+        CR
+        IncrIndent 1
+        BR
+        Text "Struct" -tags b
+        Text " $classOf {"
+        IncrIndent 1
+        BR
+        set fields [ tol::info struct $classOf ]
+        set ll0 [ llength $fields ]
+        set ll1 [ expr { $ll0 -1 } ]
+        for { set fi 0 } { $fi < $ll0 } { incr fi } {
+          foreach {n t} [ lindex $fields $fi ] break
+          Text "$t" -tags b
+          Text " ${n};"
+          if { $fi == $ll1 } {
+            IncrIndent -1
+          }
+          BR
+        }
+        Text "}"
+        IncrIndent -1
+        BR
+        set extraHTInfo [ Restore ]
+      }
     }
     Text "Grammar: " -tags b
@@ -173 +299 @@
           [ Preprocess [ string trimright $desc ] ]
     }
-    if { $insInfo ne "" } {
-      Header2 "Instance's Info"
-      foreach line [ split $insInfo \n ] {
-        set s [ string index $line 0 ]
-        set e [ string index $line end ]
-        if { $s eq "\[" && $e eq "\]" } {
-          Text "[ string range $line 1 end-1 ]:" \
-              -tags {b} -br 1
-        } elseif { $s eq "{" && $e eq "}" } {
-          Text "[ string range $line 1 end-1 ]: " -tags {b}
-        } else {
-          Text \
-              [ Preprocess [ string trimright $line ] ] -br 1
-        }
-      }
-    }
+    AppendHT $extraHTInfo
     return [ GetText ]
   }

tolbase/lib/toltk/tolbase.tcl

@@ -557 +557 @@
     default {
       foreach {icon grammar name content path desc objRef} $args {}
-
       if { $grammar eq "Anything" } {
         if { [ regexp {/+\sClass\s} $content ] } {

tolbase/lib/toltk/tolinspe.tcl

@@ -2012 +2012 @@
   set addr [ ::tol::info address $objReference ]
   return [ Tol_ClassOf $addr ]
+}
+
+proc Tol_StructOf { obj_addr } {
+  set tolcode [ string map [ list %A $obj_addr ]  {
+    Text {
+      Anything obj = GetObjectFromAddress( "%A" );
+      // WriteLn( "Tol_StructOf " << Grammar( obj ) );
+      Text If( Grammar( obj ) == "Set", StructName( obj ), "" )
+    }
+  } ]
+  return [ lindex [ toltcl::eval $tolcode ] 0 ]
+}
+
+proc Tol_StructOfFromReference { objReference } {
+  set addr [ ::tol::info address $objReference ]
+  return [ Tol_StructOf $addr ]
 }