From 5689251b4df7456f43a0d3b357672bbd9fc3a40c Mon Sep 17 00:00:00 2001 From: carmen rocco Date: Tue, 19 Sep 2006 23:21:31 +0000 Subject: *** empty log message *** svn path=/trunk/; revision=5973 --- extensions/gui/ix/toxy/tree.wid | 184 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 184 insertions(+) create mode 100755 extensions/gui/ix/toxy/tree.wid (limited to 'extensions/gui/ix/toxy/tree.wid') diff --git a/extensions/gui/ix/toxy/tree.wid b/extensions/gui/ix/toxy/tree.wid new file mode 100755 index 00000000..809b2670 --- /dev/null +++ b/extensions/gui/ix/toxy/tree.wid @@ -0,0 +1,184 @@ +package require treectrl +package require tkdnd +namespace eval ::ix { + variable _ + proc tree {t target title auto echo path delim} { + variable _ + puts "$t $target $title $echo $path $delim" + if {[$t element names] != "el1"} { + $t column create -text $title + $t element create el1 text -fill [list green {selected focus}] + $t style create s1 + $t style elements s1 el1 + } + bind $t {dnd drag %W} + bind $t { + set id [lindex [%W identify %x %y] 1] + if {$id ne "" && $id ne "tail"} { + %W activate $id + ::ix::tree_click %W [winfo name %W] + } + } + + dnd bindsource $t text/plain "return \[::ix::tree_get $t $target -1 -1\]" + bind $t "::ix::tree_out $t $target -1" + bind $t "::ix::tree_out $t $target -1" + bind $t "::ix::tree_out $t $target -1" + bind $t {} + bind $t { + variable _ + focus %W + set target [winfo name %W] + set id [lindex [%W identify %x %y] 1] + if {$id ne ""} { + %W activate $id + %W selection clear all + %W selection add $id + set path [::ix::tree_get %W $target 1 -1] + if {[winfo exists %W.rc] != 1} { + set m [menu %W.rc -tearoff no] + $m add command -label "path [::ix::tree_get %W $target -1 $id]" -state disabled + $m add command -label delete -command { + ::ix::tree_msg $target "delete [pdtk_enquote $path]" + set p [%W item parent $id] + %W item delete $id + if {[%W item numchildren $p] < 1} { + %W item configure $p -button no + } + } + $m add command -label new -command { + ::ix::tree_nameitem %W $target $path $id + } + $m add command -label copy -command {::ix::tree_msg $target "copy [pdtk_enquote $path]"} + $m add command -label cut -command {::ix::tree_msg $target "cut [pdtk_enquote $path]"} + $m add command -label paste -command {::ix::tree_msg $target "paste [pdtk_enquote $path]"} + } else { + %W.rc entryconfigure 0 -label "path [::ix::tree_get %W $target -1 $id]" + } + tk_popup %W.rc %X %Y + } else { + if {[winfo exists %W.rroot] != 1} { + set m [menu %W.rroot -tearoff no] + $m add command -label "new root" -command { + ::ix::tree_nameitem %W $target "" 0 + } + } + tk_popup %W.rroot %X %Y + } + } + set _($target:parentList) [list root {} {} {} {} {} {}] + set _($target:auto) $auto + set _($target:echo) $echo + set _($target:path) $path + set _($target:delim) $delim + } + proc tree_nameitem {t target path id} { + set path "$path/" + destroy .$path + toplevel .$path + entry .$path.entry -textvariable send_textvariable + .$path.entry delete 0 end + .$path.entry insert 0 [::ix::random_txt 6] + .$path.entry select from 0 + .$path.entry select adjust end +# if {$path == "/"} {set pathname ""} else {set pathname path} + set submit "::ix::tree_msg $target \"new \[pdtk_enquote \"$path\$send_textvariable\"\]\";::ix::tree_item $t $id \$send_textvariable;destroy .$path" + bind .$path.entry $submit + button .$path.ok -text "OK" -command $submit + button .$path.cancel -text cancel -command "destroy .$path" + pdtk_standardkeybindings .$path.entry + grid .$path.entry -sticky news -columnspan 2 + grid .$path.ok .$path.cancel -sticky news + grid columnconfigure .$path 1 -weight 1 + focus .$path.entry + } + proc random_txt {n} { + set i 0 + set text "" + while {$i < $n} { + set int [expr "int(floor(rand()*62))"] + if {$int < 10} {incr int 48} elseif {$int < 36} {incr int 55} else {incr int 61} + set text "$text[format %c $int]" + incr i + } + return $text + } + proc tree_item {t p text} { + set ti [$t item create] + $t item style set $ti 0 s1 + $t item text $ti 0 $text + $t item lastchild $p $ti + $t item configure $p -button yes + return $ti + } + proc tree_add {t target args} { + variable _ + set depth [lindex $args 0] + set text [lrange $args 1 end] + set p [lindex $_($target:parentList) $depth] + set ti [tree_item $t $p $text] + incr depth + set _($target:parentList) [lreplace $_($target:parentList) $depth $depth $ti] +# if {$_($target:auto) == 1} { +# tree_msg $target "new [tree_get $t $target -1 $ti]" +# } + } + proc tree_click {t target} { + variable _ + if {$_($target:auto) == 1} {tree_out $t $target -1} + } + proc tree_cmd {t target args} { + variable _ + puts "$t $args" + set r [eval "$t $args"] + if {$_($target:echo) == 1} {pd "$target.rp _cb $r;"} + } + proc tree_out {t target rec} { + tree_msg $target [tree_get $t $target $rec -1] + } + proc tree_msg {target msg} { + pd "$target.rp _cb $msg;" + } + proc tree_get {t target rec it} { + variable _ + if {$it < 0} {set it [$t index active]} + if {$rec < 0} {set rec $_($target:path)} + if {$rec > 0} {return [tree_getrec $t $target $it ""]} else { + set item [$t item text $it 0] + return $item + } + } + proc tree_getrec {t target tr dl} { + variable _ + if {$tr > 0} { + lappend dl $tr + tree_getrec $t $target [$t item parent $tr] $dl + } else { + set tr "" + for {set i [expr [llength $dl] - 1]} {0 <= $i} {incr i -1} { + set tr "$tr$_($target:delim)[$t item text [lindex $dl $i] 0]" + } + return $tr + } + } + proc tree_cfg {target item arg} { + variable _ + set _($target:$item) $arg + } + +} + +#> tree treectrl +#. -height 400 -width 200 +#. #title 1 #auto 1 #echo 0 #path 1 #delim "/" +#. -font {tahoma 8} -showroot yes -showrootbutton no -selectmode single +#. @list ::ix::tree_list .- .| .#args +#. @clear .- item delete all +#. @add ::ix::tree_add .- .| .#args +#. @cmd ::ix::tree_cmd .- .| .#args +#. @auto ::ix::tree_cfg .| auto .#1 +#. @echo ::ix::tree_cfg .| echo .#1 +#. @path ::ix::tree_cfg .| path .#1 +#. @delim ::ix::tree_cfg .| delim .#1 + +::ix::tree .- .| .#title .#auto .#echo .#path .#delim -- cgit v1.2.1