Changeset cc64b09 in tol for tolbase/lib/wtree/wtree.tcl

Timestamp:

Nov 24, 2016, 11:58:38 AM (10 years ago)

Author:

Pedro Gea <pgea@…>

Branches:

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

Children:

f738c05

Parents:

6dc91d2

Message:

Refs #1933
Se revisan los binds respecto a wtree y su treectrl.
Se quitan los métodos específicos para la creación de columnas e inserción de nodos que quedaban en tolinspe.
Se añade un update del nodo de paquetes para que se actualice ante un "require".
Se revisan los métodos de botón derecho para que aparezcan sólo sobre los objetos seleccionados.
Se añade un método a wtree para gestionar el color de todas las columnas de un nodo.
Se añaden las columnas al root de wtree.

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

File:

• tolbase/lib/wtree/wtree.tcl (modified) (8 diffs)

tolbase/lib/wtree/wtree.tcl

@@ -280 +280 @@
     }
   }
+  
+  method item-identify {x y} {
+    $self identify
+  
+  }
 
   constructor { args } {
@@ -347 +352 @@
         [ mymethod EditCallback accept %I %C %E %t ]
 
-    bind $tree <ButtonPress-1> [ mymethod OnButtonPress1 %x %y ]
-    bind $tree <Control-ButtonPress-1> { }
-    bind $tree <Shift-ButtonPress-1> { }
+    #@ El bind se hace con $self para poder ser modificado externamente
+    #@ Hay mas binds en _configure_bindings
+    bind $self <ButtonPress-1>         [mymethod OnButtonPress1 %x %y]
+    bind $self <Control-ButtonPress-1> {}
+    bind $self <Shift-ButtonPress-1>   {}
 
     set height [font metrics [$tree cget -font] -linespace]
@@ -393 +400 @@
 
     focus $tree
-
+    
+    #@ Se antepone la configuración de $args para que el nodo root esté o no
+    #@ y se le pueda aplicar la configuración de columnas
+    $self configurelist $args
     $self _configure_bindings
     $self _conf-columns -columns $options(-columns)
     $self _conf-contextmenu -contextmenu $options(-contextmenu)
-    $self configurelist $args
+
     if { !$options(-filter) } {
       grid remove $win.frameFilter
@@ -410 +420 @@
   method CancelEdit { } {
     ::TreeCtrl::EditClose $tree entry 0 0
+  }
+  
+  method item-color { item color } {
+    set args {}
+    set first 1
+    foreach c [ $tree column list ] {
+      # extraigo el style asociado a la columna
+      set columnStyle [ $tree column cget $c -itemstyle ]
+      # extraigo los elementos del style
+      set styleElements [ $tree style elements $columnStyle ]
+      # busco si eTXT es uno de esos elementos
+      if { [ lsearch $styleElements "eTXT" ] != -1 } {
+        if { $first } {
+          set first 0
+        } else {
+          lappend args {,}
+        }
+        lappend args $c eTXT -fill $color
+      }
+    }
+    return [eval $self item element configure $item $args]
   }
 
@@ -425 +456 @@
       # busco si eTXT es uno de esos elementos
       if { [ lsearch $styleElements "eTXT" ] != -1 } {
-        # el root no tiene styles
+        # el root no tiene styles | #@ ya sí
         catch {
           append itemText [ $tree item element cget $item $c eTXT -text ] " "
@@ -649 +680 @@
   method _configure_bindings { } {
 
-    bind $tree <Double-ButtonPress-1> "[mymethod DoubleButton1 %W %x %y] ; break"
-    bind $tree <Return> "[mymethod KeyPressReturn %W] ; break"
-
-    bind $tree <ButtonPress-3> [ mymethod Button3 %W %x %y %X %Y]
-
-    bind $tree <Escape> "[mymethod KeyPressEscape] ; break"
+    #@ El bind se hace con $self para poder ser modificado externamente
+    #@ Hay mas binds en el constructor
+    bind $self <Double-ButtonPress-1> "[mymethod DoubleButton1 %W %x %y] ; break"
+    bind $self <Return>               "[mymethod KeyPressReturn %W] ; break"
+    bind $self <ButtonPress-3>         [mymethod Button3 %W %x %y %X %Y]
+    bind $self <Escape>               "[mymethod KeyPressEscape] ; break"
 
     $tree notify bind $tree <Header-invoke> [mymethod SortbyColumn %W %C]
@@ -773 +804 @@
                       -image $opts(-image) \
                       -itembackground "\#e0e8f0 {}" \
-                      -tags $opts(-tags) ]
+                      -tags $opts(-tags) -expand 1]
       # "
       set column_info($idx,ID) $colID
@@ -801 +832 @@
       # asocio el style a la columna
       $tree column configure $colID -itemstyle $s
+      
+      #@ Se añaden las columnas al nodo root si está visible
+      if { [$tree cget -showroot] } {
+        $tree item style set root $colID $s
+      }
+      
       incr idx
     }