Changeset 6b3f93a in tol

Timestamp:

Feb 10, 2011, 9:48:18 AM (16 years ago)

Author:

Pedro Gea <pgea@…>

Branches:

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

Children:

ecd37ad

Parents:

e7fa2f1

Message:

Se introducen los siguientes cambios:
En la información en columnas del inspector:

• Se oculta la columna con la referencia-tcl del objeto.
• Se modifica el contenido de la columna "content" para las instancias.

En la pestaña de información de TOLBase:

• Se muestran opcionalmente (si no es vacío) tanto el campo "path" como la descripción.
• Se renombra el campo "Value" a "Content" por coherencia con las columnas del inspector y se utiliza la información de instancia como en las columnas.
• Se muestra la información específica de las instancias.

Refs #1092

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

Location:

tolbase/lib/toltk

Files:

• tolbase.tcl (modified) (2 diffs)
• tolinspe.tcl (modified) (6 diffs)

tolbase/lib/toltk/tolbase.tcl

@@ -174 +174 @@
   # INFO CONSOLE COMPONENT
   set widgets(info) $sw3.info
-  set w_info [text $widgets(info) -wrap word -cursor ""\
+  #(pgea) se elimina  -wrap word
+  set w_info [text $widgets(info) -cursor ""\
      -state disabled -font $data(font,info)]
   $sw3 setwidget $w_info
@@ -450 +451 @@
     }
     default {
+      #(pgea) se modifica el mecanismo de escritura de la información
+      #(pgea) en tolbase incluyendo la información de instancia
+      proc w_insert {w_info w_text w_token w_tag} {
+        set idx_start [$w_info index "end -1 chars"]
+        $w_info insert end $w_text
+        $w_info insert end $w_token
+        set idx_end   [$w_info index "end -1 chars"]
+        $w_info tag add $w_tag $idx_start $idx_end
+      }
       #$w_info configure -wrap none
-      foreach {icon grammar name value path desc} $args {}
-        foreach {prop val} [list "Grammar: " $grammar "Name: " $name "Value: " $value "Path: " $path] {
-        set idx_start [$w_info index "end -1 chars"]
-        $w_info insert end $prop
-        set idx_end   [$w_info index "end -1 chars"]
-        $w_info tag add tagLabel $idx_start $idx_end
-        if {[string equal $prop "Grammar: "]} {
-          $w_info image create end -image $icon
-          $w_info insert end "  "
+      foreach {icon grammar name content path desc objRef} $args {}
+      #(pgea) Si es NameBlock busco su clase e información de instancia
+      if {$grammar eq "NameBlock" && [string length $objRef]} {
+        set classOf [Tol_ClassOfFromReference $objRef]
+        set insInfo [Tol_InstanceInfoFromReference $objRef]
+        set insCont [Tol_InstanceContentFromReference $objRef]
+      } else {
+        set classOf ""
+        set insInfo ""
+        set insCont ""
+      }
+      if {$classOf eq ""} { 
+        w_insert $w_info Grammar ": " tagLabel
+        $w_info image create end -image $icon
+        $w_info insert end " "
+        w_insert $w_info $grammar "\n" tagValue
+      } else { 
+        w_insert $w_info Class ": " tagLabel
+        $w_info image create end -image $icon
+        $w_info insert end " "
+        w_insert $w_info $classOf "\n" tagValue
+      }
+      w_insert $w_info Name ": " tagLabel
+      w_insert $w_info $name "\n" tagValue
+      w_insert $w_info Content ": " tagLabel
+      if {$insCont ne ""} {
+        w_insert $w_info $insCont "\n" tagValue
+      } elseif {$classOf ne ""} {
+        w_insert $w_info $classOf "\n" tagValue
+      } else {
+        w_insert $w_info $content "\n" tagValue
+      }
+      if {$path ne ""} {
+        w_insert $w_info Path ": " tagLabel
+        w_insert $w_info $path "\n" tagValue
+      }
+      if {$desc ne ""} {
+        w_insert $w_info Description ":\n" tagLabel
+        w_insert $w_info $desc "\n" tagValue
+      }
+      #(pgea) se añade la información de instancia (si hay)
+      if { [string length $insInfo] } {
+        set brNeed 0
+        set attr 0
+        set lines [split $insInfo \n]
+        foreach line $lines {
+          set lineLen [string length $line]
+          set lineIni [string index $line 0]
+          set lineFin [string index $line [expr $lineLen-1]]
+          set lineIF "$lineIni$lineFin"
+          if { [string eq $lineIF {[]}] } {
+            set lineLabel [string range $line 1 [expr $lineLen-2]]
+            w_insert $w_info $lineLabel ":\n" tagLabelB
+          } elseif { [string eq $lineIF {{}}] } {
+            set lineLabel [string range $line 1 [expr $lineLen-2]]
+            w_insert $w_info $lineLabel ": " tagLabelB
+          } else {
+            w_insert $w_info $line "\n" tagValue
+          }
         }
-        $w_info insert end "$val\n"
-        $w_info tag add tagValue $idx_end [$w_info index "end -1 chars"]
       }
       $w_info tag configure tagLabel -font fnBold
       $w_info tag configure tagValue -wrap none
-      if { [string length $desc] } {
-        set idx_start [$w_info index "end -1 chars"]
-        $w_info insert end "Description\n"
-        set idx_end [$w_info index "end -1 chars"]
-        $w_info tag add tagPropLabel $idx_start $idx_end
-        $w_info insert end $desc
-        $w_info tag add tagPropValue $idx_end [$w_info index "end -1 chars"]
-        $w_info tag configure tagPropLabel -font fnBold -underline 1
-        #$w_info tag configure tagPropValue -wrap word
-      }
+      $w_info tag configure tagLabelB -font fnBold -foreground navy
       $w_tabset select 2
     }

tolbase/lib/toltk/tolinspe.tcl

@@ -194 +194 @@
       -bg white -justify left -activetitlebackground gray90
   # columns Content Path & Description
-  $ht column insert end Content Path Description Reference\
+  #(pgea) se oculta la columna correspondiente a la referencia
+  $ht column insert end Content Path Description\
       -bg white -justify left -activetitlebackground gray90 -pad 3
+  $ht column insert end Reference -hide true
   foreach c {Index Content Path Description} {
     $ht column configure $c -text [mc "$c"]
@@ -795 +797 @@
         puts "knownReference = $knownReference"
         set objRef $knownReference
+      }
+      #(pgea) se reemplaza el valor de la referencia en data
+      set data [lreplace $data 9 9 $objRef]  
+      #(pgea) se utiliza la información de instancia
+      set classOf [Tol_ClassOfFromReference $objRef]
+      set insCont [Tol_InstanceContentFromReference $objRef]
+      if {$insCont ne ""} {
+        set data [lreplace $data 3 3 [TrimContent $grammar $insCont]]
+      } elseif {$classOf ne ""} {
+        set data [lreplace $data 3 3 $classOf]
       }
       set objAddress [ tol::info address $objRef ]
@@ -1809 +1821 @@
       set itemid $aryData(Index)              ;# id of item
       set path   $aryData(Path)               ;# path of file of item
+      #(pgea) se añade la propiedad Reference
+      set objRef $aryData(Reference)          ;# info of item
       set full_data $item_data($itemid) ;# {value} {desc} {grammar}       
       set value [lindex $full_data 0]   ;# value of item PE:
@@ -1822 +1836 @@
       set grammar [lindex $full_data 2]
       set icon [lindex [$ht entry cget $entry -icons] 0]
-      set args [list $icon $grammar $name $value $path $desc]
+      #(pgea) lista de argumentos que recibe ::TolConsole::OnInfo
+      set args [list $icon $grammar $name $value $path $desc $objRef]
     } else {
       set args ""
@@ -1838 +1853 @@
 
 #/////////////////////////////////////////////////////////////////////////////
+#(pgea) ¿se usa?
 proc ::TolInspector::FillText { ht entry } {
 #/////////////////////////////////////////////////////////////////////////////
@@ -1965 +1981 @@
   set addr [ ::tol::info address $objReference ]
   return [ Tol_ClassOf $addr ]
+}
+
+#(pgea) nueva función para obtener la información de instancia
+proc Tol_InstanceInfo { obj_addr } {
+  tol::console eval [ string map [ list %A $obj_addr ] {
+    Text __gui_instanceinfo__ = {
+      Anything __intance__ = GetObjectFromAddress("%A");
+      Text If(ObjectExist("Code", "__intance__::_.get.autodoc.info"), 
+        __intance__::_.get.autodoc.info(?), "")
+    }
+  } ]
+  set info [ tol::info variable {Text __gui_instanceinfo__} ]
+  set x [ string trim [ lindex $info 2 ]  \" ]
+  tol::console stack release __gui_instanceinfo__
+  set x
+}
+
+#(pgea) nueva función para obtener la información de instancia
+proc Tol_InstanceInfoFromReference { objReference } {
+  set addr [ ::tol::info address $objReference ]
+  return [ Tol_InstanceInfo $addr ]
+}
+
+#(pgea) nueva función para obtener el contenido de la instancia
+proc Tol_InstanceContent { obj_addr } {
+  tol::console eval [ string map [ list %A $obj_addr ] {
+    Text __gui_instancecontent__ = {
+      Anything __intance__ = GetObjectFromAddress("%A");
+      Text If(ObjectExist("Code", "__intance__::_.get.autodoc.content"), 
+        __intance__::_.get.autodoc.content(?), "")
+    }
+  } ]
+  set info [ tol::info variable {Text __gui_instancecontent__} ]
+  set x [ string trim [ lindex $info 2 ]  \" ]
+  tol::console stack release __gui_instancecontent__
+  set x
+}
+
+#(pgea) nueva función para obtener el contenido de la instancia
+proc Tol_InstanceContentFromReference { objReference } {
+  set addr [ ::tol::info address $objReference ]
+  return [ Tol_InstanceContent $addr ]
 }