Changeset 1681 for branches

Timestamp:

Apr 1, 2010, 10:58:58 AM (14 years ago)

Author:

gah

Message:

 

Location:

branches/blt4

Files:

• examples/zoo/filechoice/tool.xml (modified) (1 diff)
• gui/scripts/controlOwner.tcl (modified) (2 diffs)
• gui/scripts/filechoiceentry.tcl (modified) (4 diffs)
• gui/scripts/filelistentry.tcl (modified) (11 diffs)

branches/blt4/examples/zoo/filechoice/tool.xml

@@ -70 +70 @@
         <description>From the home directory</description>
         <label>Choose Files</label>
+       <icon>
+          R0lGODlhGgASAKEBAAAAAP///////////yH+FUNyZWF0ZWQgd2l0aCBUaGUgR0lNUAAh+QQBCgAB
+          ACwAAAAAGgASAAACLoyPqcvtD8CRj8VZrYw8h/tRn2eA4Eiaosa1qttC1EmW81qrtbYvdG8DCodE
+          RQEAOw==
+                </icon>
     </about>
+
     <pattern>@@input.choice(stats)@@</pattern>
   </filelist>

branches/blt4/gui/scripts/controlOwner.tcl

@@ -320 +320 @@
         # send out any callback notifications
         foreach owner [array names _owner2paths] {
-            puts stderr "owner=$_owner $_owner2paths($owner) path=$path"
             foreach pattern $_owner2paths($owner) {
                 if {[string match $pattern $path]} {
-                    puts stderr "owner=$_owner calling $_callbacks($owner/$pattern)"
                     uplevel #0 $_callbacks($owner/$pattern)
                     break
@@ -408 +406 @@
             set i [lsearch -exact $plist $path]
             if {$i < 0} { lappend _owner2paths($owner) $path }
-            puts stderr "_callbacks($owner/$path)=$cb"
             set _callbacks($owner/$path) $cb
         }

branches/blt4/gui/scripts/filechoiceentry.tcl

@@ -185 +185 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::FileChoiceEntry::_rebuild {} {
-    puts stderr "filechoiceentry rebuild"
     set _rebuildPending 0
     # get rid of any existing choices
@@ -199 +198 @@
         set glob [string trim [$_owner xml get $_path.$cname]]
         # Successively replace each template with its value.
-        puts stderr "before glob=$glob"
         while { [regexp -indices {@@[^@]*@@} $glob range] } {
             foreach {first last} $range break
@@ -206 +204 @@
             set cpath [string range $glob $i1 $i2]
             set value [$_owner xml get $cpath.current]
-            puts stderr "$cpath.current: value=$value"
             if { $value == "" } {
-                puts stderr "$_owner xml get $cpath.default"
                 set value [$_owner xml get $cpath.default]
-                puts stderr "$cpath.default: value=$value"
             }
             set glob [string replace $glob $first $last $value]
@@ -252 +247 @@
 itcl::body Rappture::FileChoiceEntry::_tooltip {} {
     set tip [string trim [$_owner xml get $_path.about.description]]
-    puts stderr "tip=$tip, $_owner=$_owner path=$_path.about.description"
     # get the description for the current choice, if there is one
     set str [$itk_component(choice) value]

branches/blt4/gui/scripts/filelistentry.tcl

@@ -27 +27 @@
     private variable _owner ""    ;# thing managing this control
     private variable _path ""     ;# path in XML to this number
+    private variable _icon ""
 
     constructor {owner path args} { 
@@ -39 +40 @@
     public method tooltip {}
 
-    private method Toggle { id }
     protected method _rebuild {}
     protected method _newValue { args }
     protected method _tooltip {}
     protected method _whenidle {}
-
 }
 
@@ -87 +86 @@
             -tree $_tree \
             -font "Arial 9" \
-            -flat yes -separator / 
-    }
-    $itk_component(tree) column insert 0 "show" \
-        -text "" -weight 0.0 -pad 0 -borderwidth 0 
-    $itk_component(tree) style checkbox "check" -showvalue no \
-        -onvalue 1 -offvalue 0
+            -flat yes -separator /  \
+            -selectcommand [itcl::code $this _newValue]
+    }
     $itk_component(tree) column configure "treeView" -justify left \
         -weight 1.0 -text "" -pad 0 -borderwidth 0 -edit no
-    $itk_component(tree) column configure "show" -style "check" -pad {0 0} \
-        -edit no
     pack $itk_component(scrollset) -fill both -expand yes
 
     blt::table $itk_interior \
         0,0 $itk_component(scrollset) -fill both  
-    $_tree trace create all "show" w [itcl::code $this _newValue]
     bind $itk_component(tree) <<Value>> [itcl::code $this _newValue]
-    $itk_component(tree) bin Entry <Double-ButtonPress-1> \
-        +[itcl::code $this Toggle current]
-
+
+    # Standard ButtonPress-1
+    $itk_component(tree) bind Entry <ButtonPress-1> {   
+        Rappture::FileListEntry::SetSelectionAnchor %W current yes set
+        set blt::TreeView::_private(scroll) 1
+    }
+    # Standard B1-Motion
+    $itk_component(tree) bind Entry <B1-Motion> { 
+        set blt::TreeView::_private(x) %x
+        set blt::TreeView::_private(y) %y
+        set index [%W nearest %x %y]
+        Rappture::FileListEntry::SetSelectionAnchor %W $index yes set
+    }
+    # Standard ButtonRelease-1
+    $itk_component(tree) button bind all <ButtonRelease-1> {
+        set index [%W nearest %x %y blt::TreeView::_private(who)]
+        if { [%W index current] == $index && 
+             $blt::TreeView::_private(who) == "button" } {
+            %W see -anchor nw current
+            %W toggle current
+        }
+    }
+    # Shift-ButtonPress-1
+    $itk_component(tree) bind Entry <Shift-ButtonPress-1> {     
+        Rappture::FileListEntry::SetSelectionAnchor %W current yes set
+        set blt::TreeView::_private(scroll) 1
+    }
+    # Shift-B1-Motion
+    $itk_component(tree) bind Entry <Shift-B1-Motion> { 
+        set blt::TreeView::_private(x) %x
+        set blt::TreeView::_private(y) %y
+        set index [%W nearest %x %y]
+        if { [%W cget -selectmode] == "multiple" } {
+            %W selection mark $index
+        } else {
+            Rappture::FileListEntry::SetSelectionAnchor %W $index yes set
+        }
+    }
+    # Shift-ButtonRelease-1
+    $itk_component(tree) bind Entry <Shift-ButtonRelease-1> { 
+        if { [%W cget -selectmode] == "multiple" } {
+            %W selection anchor current
+        }
+        after cancel $blt::TreeView::_private(afterId)
+        set blt::TreeView::_private(afterId) -1
+        set blt::TreeView::_private(scroll) 0
+    }
+    $itk_component(tree) bind Entry <Control-ButtonPress-1> {   
+        Rappture::FileListEntry::SetSelectionAnchor %W current no toggle
+        set blt::TreeView::_private(scroll) 1
+    }
+    $itk_component(tree) bind Entry <Control-B1-Motion> { 
+        set blt::TreeView::_private(x) %x
+        set blt::TreeView::_private(y) %y
+        set index [%W nearest %x %y]
+        if { [%W cget -selectmode] == "multiple" } {
+            %W selection mark $index
+        } else {
+            Rappture::FileListEntry::SetSelectionAnchor %W $index no toggle
+        }
+    }
+    $itk_component(tree) bind Entry <Control-ButtonRelease-1> { 
+        if { [%W cget -selectmode] == "multiple" } {
+            %W selection anchor current
+        }
+        after cancel $blt::TreeView::_private(afterId)
+        set blt::TreeView::_private(afterId) -1
+        set blt::TreeView::_private(scroll) 0
+    }
     # First time, parse the <pattern> elements to generate notify callbacks
     # for each template found. 
@@ -123 +182 @@
     $_owner notify sync
     eval itk_initialize $args
+
+    # if the control has an icon, plug it in
+    set str [$_owner xml get $path.about.icon]
+    if {$str != ""} {
+        set _icon [image create picture -data $str]
+    }
     _rebuild
 }
@@ -155 +220 @@
             return
         }
-        foreach id [$_tree children root] { 
+        foreach id [$itk_component(tree) curselection] { 
             set path [$_tree get $id "path" ""] 
             set path2id($path) $id
         }
         set paths [split $newval ,]
-        $_tree set all "show" 0
-        foreach path $paths {
-            if { [info exists path2id($path)] } {
-                $_tree set $path2id($path) "show" 1
-            }
-        }
     } elseif {[llength $args] != 0} {
         error "wrong # args: should be \"value ?-check? ?newval?\""
@@ -174 +233 @@
     #
     set list {}
-    foreach id [$_tree children root] { 
-        if { [$_tree get $id "show" 0] } {
-            set path [$_tree get $id "path" ""] 
-            if { $path != "" } {
-                lappend list $path
-            }
+    foreach id [$itk_component(tree) curselection] { 
+        set path [$_tree get $id "path" ""] 
+        if { $path != "" } {
+            lappend list $path
         }
     }
@@ -221 +278 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::FileListEntry::_rebuild {} {
-    puts stderr "filelistentry rebuild"
-
     set _rebuildPending 0
 
@@ -256 +311 @@
             set first $tail
         }
+        set tail [file root $tail]
         set id [$_tree index root->"$tail"]
         if { $id < 0 } {
@@ -266 +322 @@
         if {$len > $max} { set max $len }
     }
+    $itk_component(tree) entry configure all -icon $_icon
     eval $_tree delete [$_tree tag nodes unused]
     $itk_component(tree) configure -width $max
-    $itk_component(tree) selection set 0
+    #$itk_component(tree) selection set 0
 }
 
@@ -290 +347 @@
 itcl::body Rappture::FileListEntry::_tooltip {} {
     set tip [string trim [$_owner xml get $_path.about.description]]
-    puts stderr "tip=$tip, $_owner=$_owner path=$_path.about.description"
     # get the description for the current choice, if there is one
     set path ""
@@ -322 +378 @@
 }
 
-itcl::body Rappture::FileListEntry::Toggle { index } {
-    set id [$itk_component(tree) index $index]
-    set show [$_tree get $id "show" 0]
-    set show [expr $show==0]
-    $_tree set $id "show" $show
-}
+proc Rappture::FileListEntry::SetSelectionAnchor { w tagOrId clear how } {
+    set index [$w index $tagOrId]
+    if { $clear } {
+        $w selection clearall
+    }
+    $w see $index
+    $w focus $index
+    $w selection $how $index
+    $w selection anchor $index
+}
+
+