Changeset e3362cc in tol for tolbase/lib/toltk

Timestamp:

Jul 23, 2010, 8:35:19 PM (16 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

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

Children:

7adc51c

Parents:

3844cff

Message:

fixes #945, ticket done & test updated, see also commit [2400], updating new functions in tclIndex

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

Location:

tolbase/lib/toltk

Files:

• ImageManager.tcl (modified) (3 diffs)
• tclIndex (modified) (1 diff)
• tolinspe.tcl (modified) (5 diffs)

tolbase/lib/toltk/ImageManager.tcl

@@ +1 @@
+package require BWidget
+
 namespace eval ::ImageManager {
 }
@@ -17 +19 @@
 }
 
-proc ::ImageManager::getIconForClass { className } {
-  set rvar "__getIconForClass__"
-  set tolExpr [ string map [ list %N $className %RV $rvar ] {
+proc ::ImageManager::getIconForInstance { objAddress } {
+  set rvar "__getIconForInstance__"
+  set tolExpr [ string map [ list %A $objAddress %RV $rvar ] {
     Text %RV = {
-      Real test = ObjectExist( "Code", "GuiTools::ImageManager::getIconForClass" );
-      Text imageName = If( test, 
-                           GuiTools::ImageManager::getIconForClass( "%N" ), 
-                           "" );
+      Real test = ObjectExist( "Code", "GuiTools::ImageManager::getIconForInstance" );
+      // obtengo el nombre del imagen
+      Text imageName = If( test, {
+                           NameBlock obj = GetObjectFromAddress( "%A" );
+                           Text GuiTools::ImageManager::getIconForInstance( obj )
+                          }, "" );
+      // obtengo el id del recurso que es el id de la imagen Tk
       Text GuiTools::ImageManager::getImageResourceId( imageName )
     }
@@ -32 +37 @@
   set value [ string trim [ lindex $info 2 ] \" ]
   tol::console stack release $rvar
-  return $value
+  return [ expr {$value eq "" ? [::Bitmap::get "NameBlock"] : $value} ]
 }

tolbase/lib/toltk/tclIndex

@@ -170 +170 @@
 set auto_index(::funcSearch::SearchWord) [list source [file join $dir fusearch.tcl]]
 set auto_index(::ImageManager::getImageResourceId) [list source [file join $dir ImageManager.tcl]]
-set auto_index(::ImageManager::getIconForClass) [list source [file join $dir ImageManager.tcl]]
+set auto_index(::ImageManager::getIconForInstance) [list source [file join $dir ImageManager.tcl]]
 set auto_index(::MatrixTable::Create) [list source [file join $dir mattable.tcl]]
 set auto_index(::MatrixTable::Fill) [list source [file join $dir mattable.tcl]]

tolbase/lib/toltk/tolinspe.tcl

@@ -796 +796 @@
         set objRef $knownReference
       }
-      set classOf [ Tol_ClassOfFromReference $objRef ]
-      set iconClass [ ::ImageManager::getIconForClass $classOf ]
-      set icon_grammar \
-          [ expr {$iconClass eq "" ? [::Bitmap::get "NameBlock"] : $iconClass} ]
+      set objAddress [ tol::info address $objRef ]
+      set icon_grammar [ ::ImageManager::getIconForInstance $objAddress ]
     }
   } else {
@@ -1062 +1060 @@
       } else  {
         set objRef [ list "Console" $index ]
-        set classOf [ Tol_ClassOfFromReference $objRef ]
-        set iconClass [ ::ImageManager::getIconForClass $classOf ]
-        set icon \
-            [ expr {$iconClass eq "" ? [::Bitmap::get "NameBlock"] : $iconClass} ]
+        set objAddress [ tol::info address $objRef ]
+        set icon [ ::ImageManager::getIconForInstance $objAddress ]
       }
       set name [lindex $co 1]
@@ -1124 +1120 @@
       } else  {
         puts "en pool = $obj(reference)"
-        set classOf [ Tol_ClassOfFromReference $obj(reference) ]
-        set iconClass [ ::ImageManager::getIconForClass $classOf ]
-        set icon \
-            [ expr {$iconClass eq "" ? [::Bitmap::get "NameBlock"] : $iconClass} ]
+        set objAddress [ tol::info address $objRef ]
+        set icon [ ::ImageManager::getIconForInstance $objAddress ]
       }
 
@@ -1190 +1184 @@
   set grammar [lindex $args 0]
   if {$grammar eq "Set" || $grammar eq "NameBlock"} {
-    puts "InsertSubset, args=$args"
+    #puts "InsertSubset, args=$args"
     if { $gra_parent eq "NameBlock" } {
       array set info_member [ FilterNameBlockMember [ lindex $args 1 ] ]
@@ -1214 +1208 @@
       set objRef $iterSet
       lappend objRef [ lindex $idx end ]
-      puts "objRef = $objRef"
-      set classOf [ Tol_ClassOfFromReference $objRef ]
-      set iconClass [ ::ImageManager::getIconForClass $classOf ]
-      set icon \
-          [ expr {$iconClass eq "" ? [::Bitmap::get "NameBlock"] : $iconClass} ]
+      set objAddress [ tol::info address $objRef ]
+      set icon [ ::ImageManager::getIconForInstance $objAddress ]
     }
     # Tail por si es un fichero. Podría hacerse configurable por el usuario