| 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : btreeview.tcl |
|---|
| 3 | # PURPOSE : Bayes Tree View. Treeview especial que permite la selección de |
|---|
| 4 | # nodos en jerarquía, es decir, si un padre tiene todos sus hijos |
|---|
| 5 | # seleccionados atomaticamente pasa a estar seleccionado. |
|---|
| 6 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 7 | |
|---|
| 8 | #@! OBSOLETO |
|---|
| 9 | #@! Usa BLT |
|---|
| 10 | |
|---|
| 11 | # include |
|---|
| 12 | if {0} { |
|---|
| 13 | # set toltk_script_path [file dirname [info script]] |
|---|
| 14 | |
|---|
| 15 | package require snit 0.91 |
|---|
| 16 | package require Tk |
|---|
| 17 | package require BLT |
|---|
| 18 | |
|---|
| 19 | package require msgcat |
|---|
| 20 | namespace import msgcat::* |
|---|
| 21 | } |
|---|
| 22 | |
|---|
| 23 | package require Tk |
|---|
| 24 | package require BLT |
|---|
| 25 | package require byscommon |
|---|
| 26 | |
|---|
| 27 | |
|---|
| 28 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 29 | ::snit::widgetadaptor btreeview { |
|---|
| 30 | # |
|---|
| 31 | # PURPOSE: Sobrecargamos un TreeView para que tenga nuevas funcionalidades |
|---|
| 32 | # |
|---|
| 33 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 34 | # opciones especificas |
|---|
| 35 | # breadonly -> componente en modo de lectura o lectura/escritura |
|---|
| 36 | # bmultiselect -> si se pueden seleccionar varios nodos a la vez |
|---|
| 37 | # bicosel -> si se muestra el icono del checkbutton |
|---|
| 38 | # bonselcmd -> comando a ejecutar cuando se selecciona un nodo |
|---|
| 39 | # bhelptext -> columna que se muestra como helptext |
|---|
| 40 | # btogglehier -> cambiar jerárquicamente si un item está o no seleccionado |
|---|
| 41 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 42 | variable items_selected |
|---|
| 43 | variable imgs |
|---|
| 44 | variable types |
|---|
| 45 | option -breadonly false |
|---|
| 46 | option -bmultiselect true |
|---|
| 47 | option -bicosel true |
|---|
| 48 | option -bonselcmd "" |
|---|
| 49 | option -bhelptext |
|---|
| 50 | option -bmenu |
|---|
| 51 | option -btogglehier true |
|---|
| 52 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 53 | constructor {args} { |
|---|
| 54 | # |
|---|
| 55 | # PURPOSE: Constructor de un btreeview. Crea una instancia de un TreeView |
|---|
| 56 | # |
|---|
| 57 | # PARAMETERS: |
|---|
| 58 | # args -> Lista de opciones especificas de un TreeView, mas las propias de |
|---|
| 59 | # un btreeview |
|---|
| 60 | # |
|---|
| 61 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 62 | global toltk_options |
|---|
| 63 | variable imgs |
|---|
| 64 | |
|---|
| 65 | set imgs [list ON [::Bitmap::get on] OFF [::Bitmap::get off] MED [::Bitmap::get med]] |
|---|
| 66 | # Widget que va a servir de contenedor para blistbox |
|---|
| 67 | |
|---|
| 68 | installhull using ::blt::treeview |
|---|
| 69 | |
|---|
| 70 | # Apply default arguments |
|---|
| 71 | $self configure -hideroot yes -linewidth 0 -activeicons "" \ |
|---|
| 72 | -selectbackground gray90 -selectforeground black \ |
|---|
| 73 | -highlightthickness 1 -borderwidth 1 -selectborderwidth 1 \ |
|---|
| 74 | -font $toltk_options(fonts,Label) -icons {} |
|---|
| 75 | |
|---|
| 76 | # Apply all arguments given: |
|---|
| 77 | $self configurelist $args |
|---|
| 78 | |
|---|
| 79 | # creamos menu |
|---|
| 80 | # No estan definidas las opciones |
|---|
| 81 | $self CreateMenu |
|---|
| 82 | |
|---|
| 83 | $self style configure text -bg white |
|---|
| 84 | $self column configure treeView -bg white |
|---|
| 85 | |
|---|
| 86 | eval $self column insert end type state childsON childsMED \ |
|---|
| 87 | parent [$self cget -bhelptext] -hide true |
|---|
| 88 | |
|---|
| 89 | bind $self <Button-1> +[list focus -force %W] |
|---|
| 90 | #$self bind all <Enter> +[list $self HelpText enter] |
|---|
| 91 | #$self bind all <Leave> +[list $self HelpText leave] |
|---|
| 92 | if [llength [$self cget -bhelptext]] { |
|---|
| 93 | DynamicHelp::add $self -command [list $self HelpText] |
|---|
| 94 | #set cmd [bind BwHelpVariable <Leave>] |
|---|
| 95 | #puts "cmd=$cmd" |
|---|
| 96 | # Habria que hacer que al salir el cursor del nodo desapareciese el helptext |
|---|
| 97 | #$self bind all <Leave> "DynamicHelp::_leave_info $self" |
|---|
| 98 | } |
|---|
| 99 | #variable ${selfns}::helptext |
|---|
| 100 | $self configure -selectcommand [list $self OnSelectCommand] |
|---|
| 101 | $self entry configure root -data {state NSE} -label "ROOT" |
|---|
| 102 | #bind $self <ButtonPress-1> [list $self OnSelectCommand] |
|---|
| 103 | } |
|---|
| 104 | |
|---|
| 105 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 106 | method OnSelectCommand {} { |
|---|
| 107 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 108 | Tolcon_Trace "Llamando a OnSelectCommand" |
|---|
| 109 | set index [$self index current] |
|---|
| 110 | if [$self cget -bmultiselect] { |
|---|
| 111 | $self ToggleNode $index |
|---|
| 112 | } else { |
|---|
| 113 | $self SelectAll OFF |
|---|
| 114 | $self ToggleNode $index |
|---|
| 115 | } |
|---|
| 116 | # Evaluo el comando del usuario |
|---|
| 117 | set cmd [$self cget -bonselcmd] |
|---|
| 118 | if {[llength $cmd]} { |
|---|
| 119 | eval $cmd |
|---|
| 120 | } |
|---|
| 121 | } |
|---|
| 122 | |
|---|
| 123 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 124 | method HelpText {} { |
|---|
| 125 | # |
|---|
| 126 | # PURPOSE: Returns the helptext related to the column specified in |
|---|
| 127 | # -bhelptext to the current node |
|---|
| 128 | # |
|---|
| 129 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 130 | set index [$self index current] |
|---|
| 131 | |
|---|
| 132 | set txt "" |
|---|
| 133 | if [llength $index] { |
|---|
| 134 | if [llength [$self cget -bhelptext]] { |
|---|
| 135 | array set aryData [$self entry cget $index -data] |
|---|
| 136 | set txt $aryData([$self cget -bhelptext]) |
|---|
| 137 | } |
|---|
| 138 | } |
|---|
| 139 | return $txt |
|---|
| 140 | } |
|---|
| 141 | |
|---|
| 142 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 143 | method CreateMenu {args} { |
|---|
| 144 | # |
|---|
| 145 | # PURPOSE: Append menu to treeview. |
|---|
| 146 | # |
|---|
| 147 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 148 | set m [menu $self.m -tearoff 0] |
|---|
| 149 | # read option |
|---|
| 150 | if [$self cget -bmultiselect] { |
|---|
| 151 | $m add command -label [mc "Select all"] -command [list $self SelectAll ON] |
|---|
| 152 | $m add command -label [mc "Unselect all"] -command [list $self SelectAll OFF] |
|---|
| 153 | $m add command -label [mc "Toggle selection"] -command [list $self ToggleSelect] |
|---|
| 154 | $m add separator |
|---|
| 155 | } |
|---|
| 156 | # read/write option |
|---|
| 157 | if {![$self cget -breadonly]} { |
|---|
| 158 | # delete |
|---|
| 159 | $m add command -label [mc "Delete all"] |
|---|
| 160 | $m add command -label [mc "Delete selected"] |
|---|
| 161 | $m add separator |
|---|
| 162 | } |
|---|
| 163 | # read option |
|---|
| 164 | # copy |
|---|
| 165 | set mc [menu $m.copy -tearoff 0] |
|---|
| 166 | $m add cascade -label [mc "Copy"] -menu $mc |
|---|
| 167 | $mc add command -label [mc "Copy all"] |
|---|
| 168 | $mc add command -label [mc "Copy selected"] |
|---|
| 169 | $mc add command -label [mc "Copy unselect"] |
|---|
| 170 | # count |
|---|
| 171 | $m add separator |
|---|
| 172 | $m add command -label [mc "Count elements"] |
|---|
| 173 | # file |
|---|
| 174 | $m add separator |
|---|
| 175 | set mf [menu $m.file -tearoff 0] |
|---|
| 176 | $m add cascade -label [mc "File"] -menu $mf |
|---|
| 177 | $mf add command -label "[mc "Save to file"] ..." |
|---|
| 178 | if {![$self cget -breadonly]} { |
|---|
| 179 | $mf add command -label "[mc "Load from file"] ..." |
|---|
| 180 | } |
|---|
| 181 | bind $self <Button-3> "tk_popup $m %X %Y" |
|---|
| 182 | } |
|---|
| 183 | |
|---|
| 184 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 185 | method bColumnInsert {args} { |
|---|
| 186 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 187 | eval $self column insert $args |
|---|
| 188 | # Asocio a la nueva columna (y a todas de momento) el |
|---|
| 189 | # procedimiento de ordenar la columna |
|---|
| 190 | # Coger de args los nombres de las columnas insertadas y |
|---|
| 191 | # asociar solo a estas (son del elto 1 de args hasta la |
|---|
| 192 | # aparición de la primera opcion (va con - deltante)) |
|---|
| 193 | foreach column [$self column names] { |
|---|
| 194 | $self column configure $column \ |
|---|
| 195 | -command [list [codename SortColumn] $self $column] |
|---|
| 196 | } |
|---|
| 197 | } |
|---|
| 198 | |
|---|
| 199 | # delegacion de metodos y opciones |
|---|
| 200 | delegate method * to hull |
|---|
| 201 | delegate option * to hull |
|---|
| 202 | |
|---|
| 203 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 204 | proc SortColumn {ht column} { |
|---|
| 205 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 206 | set old [$ht sort cget -column] |
|---|
| 207 | set decreasing 0 |
|---|
| 208 | if { "$old" == "$column" } { |
|---|
| 209 | set decreasing [$ht sort cget -decreasing] |
|---|
| 210 | set decreasing [expr !$decreasing] |
|---|
| 211 | } |
|---|
| 212 | $ht sort configure -decreasing $decreasing -column $column -mode integer |
|---|
| 213 | $ht configure -flat no |
|---|
| 214 | $ht sort auto yes |
|---|
| 215 | |
|---|
| 216 | blt::busy hold $ht |
|---|
| 217 | update |
|---|
| 218 | blt::busy release $ht |
|---|
| 219 | } |
|---|
| 220 | |
|---|
| 221 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 222 | method getSelected {{column ""} {from root}} { |
|---|
| 223 | # PURPOSE: Devuelve un dato correspondiente a una columna de los nodos |
|---|
| 224 | # seleccionados (con state=ON) a partir de un nodo dado |
|---|
| 225 | # PARAMETERS: |
|---|
| 226 | # column : Columna previamente definida cuyo dato se devuelve. Si no se |
|---|
| 227 | # especifica ninguna se devuelve el identificador del nodo |
|---|
| 228 | # from : Identificador del nodo desde el que se obtienen los nodos |
|---|
| 229 | # seleccionados. Por defecto root |
|---|
| 230 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 231 | variable items_selected |
|---|
| 232 | |
|---|
| 233 | if [$self cget -bmultiselect] { |
|---|
| 234 | set items_selected "" |
|---|
| 235 | $self _GetSelected $column $from |
|---|
| 236 | } else { |
|---|
| 237 | #Solo puede estar seleccionado uno o ninguno: |
|---|
| 238 | set it [$self curselection] |
|---|
| 239 | puts "it=$it" |
|---|
| 240 | if {$it ne ""} { |
|---|
| 241 | if {$column ne ""} { |
|---|
| 242 | array set aryData [$self entry cget $it -data] |
|---|
| 243 | set items_selected $aryData($column) |
|---|
| 244 | } else { |
|---|
| 245 | set items_selected [$self entry cget $it -label] |
|---|
| 246 | } |
|---|
| 247 | } else { |
|---|
| 248 | #Sin selección válida. Devolvemos vacío. |
|---|
| 249 | set items_selected "" |
|---|
| 250 | } |
|---|
| 251 | } |
|---|
| 252 | return $items_selected |
|---|
| 253 | } |
|---|
| 254 | |
|---|
| 255 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 256 | method _GetSelected {column {from root}} { |
|---|
| 257 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 258 | variable items_selected |
|---|
| 259 | foreach it [$self entry children $from] { |
|---|
| 260 | array set aryData [$self entry cget $it -data] |
|---|
| 261 | set state $aryData(state) |
|---|
| 262 | if {[string equal $state "ON"]} { |
|---|
| 263 | if {$column ne ""} { |
|---|
| 264 | lappend items_selected $aryData($column) |
|---|
| 265 | } else { |
|---|
| 266 | lappend items_selected [$self entry cget $it -label] |
|---|
| 267 | } |
|---|
| 268 | } |
|---|
| 269 | $self _GetSelected $column $it |
|---|
| 270 | } |
|---|
| 271 | } |
|---|
| 272 | |
|---|
| 273 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 274 | method SetNodeState {index new_state} { |
|---|
| 275 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 276 | #Tolcon_Trace "SetNodeState. index=$index, new_state=$new_state" |
|---|
| 277 | array set aryData [$self entry cget $index -data] |
|---|
| 278 | set state $aryData(state) |
|---|
| 279 | if { [string equal $state NSE] } return |
|---|
| 280 | if { [string equal $state $new_state] } { |
|---|
| 281 | $self _SetNodeState $index $new_state |
|---|
| 282 | } else { |
|---|
| 283 | $self ToggleNode $index |
|---|
| 284 | } |
|---|
| 285 | } |
|---|
| 286 | |
|---|
| 287 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 288 | method _SetNodeState {index state} { |
|---|
| 289 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 290 | array set aryData [$self entry cget $index -data] |
|---|
| 291 | |
|---|
| 292 | $self entry configure $index -data [list state $state] |
|---|
| 293 | set icons [$self GetImages $aryData(type) $state] |
|---|
| 294 | $self entry configure $index -icons $icons |
|---|
| 295 | } |
|---|
| 296 | |
|---|
| 297 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 298 | method ToggleNode {index} { |
|---|
| 299 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 300 | array set aryData [$self entry cget $index -data] |
|---|
| 301 | set state $aryData(state) |
|---|
| 302 | |
|---|
| 303 | set ctogglehier [$self cget -btogglehier] |
|---|
| 304 | |
|---|
| 305 | if { [string equal $state NSE] } return |
|---|
| 306 | set parent_idx $aryData(parent) |
|---|
| 307 | |
|---|
| 308 | if { [string equal $state ON] } { |
|---|
| 309 | $self _SetNodeState $index OFF |
|---|
| 310 | if $ctogglehier { |
|---|
| 311 | $self ToggleUp $parent_idx OFF ON |
|---|
| 312 | $self entry configure $index -data [list childsON 0 childsMED 0] |
|---|
| 313 | foreach it [$self entry children $index] { |
|---|
| 314 | $self ToggleDown $it OFF |
|---|
| 315 | } |
|---|
| 316 | } |
|---|
| 317 | } else { |
|---|
| 318 | $self _SetNodeState $index ON |
|---|
| 319 | if $ctogglehier { |
|---|
| 320 | $self ToggleUp $parent_idx ON $state |
|---|
| 321 | $self entry configure $index\ |
|---|
| 322 | -data [list childsON [$self entry size $index] childsMED 0] |
|---|
| 323 | foreach it [$self entry children $index] { |
|---|
| 324 | $self ToggleDown $it ON |
|---|
| 325 | } |
|---|
| 326 | } |
|---|
| 327 | } |
|---|
| 328 | } |
|---|
| 329 | |
|---|
| 330 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 331 | method ToggleUp {index state from} { |
|---|
| 332 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 333 | # state es el estado al que ha pasado el hijo que me ha llamado |
|---|
| 334 | # from es el estado en el que estaba el hijo que me ha llamado |
|---|
| 335 | array set aryData [$self entry cget $index -data] |
|---|
| 336 | set stateOld $aryData(state) |
|---|
| 337 | if { [string equal $stateOld NSE] } return |
|---|
| 338 | set childsON $aryData(childsON) |
|---|
| 339 | set childsMED $aryData(childsMED) |
|---|
| 340 | set childs [llength [$self entry children $index]] |
|---|
| 341 | switch -- $state { |
|---|
| 342 | ON { |
|---|
| 343 | incr childsON |
|---|
| 344 | if {[string equal $from MED]} { incr childsMED -1 } |
|---|
| 345 | if {$childsON == $childs} { |
|---|
| 346 | set stateNew ON |
|---|
| 347 | } else { |
|---|
| 348 | set stateNew MED |
|---|
| 349 | } |
|---|
| 350 | } |
|---|
| 351 | OFF { |
|---|
| 352 | if {[string equal $from ON]} { |
|---|
| 353 | incr childsON -1 |
|---|
| 354 | } else { |
|---|
| 355 | incr childsMED -1 |
|---|
| 356 | } |
|---|
| 357 | if {($childsON == 0) && ($childsMED == 0)} { |
|---|
| 358 | set stateNew OFF |
|---|
| 359 | } else { |
|---|
| 360 | set stateNew MED |
|---|
| 361 | } |
|---|
| 362 | } |
|---|
| 363 | MED { |
|---|
| 364 | incr childsMED |
|---|
| 365 | if {[string equal $from ON]} { incr childsON -1 } |
|---|
| 366 | set stateNew MED |
|---|
| 367 | } |
|---|
| 368 | } |
|---|
| 369 | |
|---|
| 370 | $self entry configure $index -data [list childsON $childsON childsMED $childsMED] |
|---|
| 371 | $self _SetNodeState $index $stateNew |
|---|
| 372 | if {$stateNew != $stateOld} { |
|---|
| 373 | #set list [lindex [$self get -full $index] 0] |
|---|
| 374 | #Para la versión 8.4.1 cambiado por |
|---|
| 375 | set list [$self get -full $index] |
|---|
| 376 | set parent_idx [$self find -name [lindex $list end-1]] |
|---|
| 377 | $self ToggleUp $parent_idx $stateNew $stateOld |
|---|
| 378 | } |
|---|
| 379 | } |
|---|
| 380 | |
|---|
| 381 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 382 | method ToggleDown {index state} { |
|---|
| 383 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 384 | set childs [$self entry children $index] |
|---|
| 385 | if {[string equal $state OFF]} { |
|---|
| 386 | $self entry configure $index -data [list childsON 0 childsMED 0] |
|---|
| 387 | } else { |
|---|
| 388 | if {[string equal $state ON]} { |
|---|
| 389 | $self entry configure $index -data [list childsON [llength $childs] childsMED 0] |
|---|
| 390 | } |
|---|
| 391 | } |
|---|
| 392 | $self _SetNodeState $index $state |
|---|
| 393 | foreach it $childs { |
|---|
| 394 | $self ToggleDown $it $state |
|---|
| 395 | } |
|---|
| 396 | } |
|---|
| 397 | |
|---|
| 398 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 399 | method GetImages {tipo state} { |
|---|
| 400 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 401 | variable imgs |
|---|
| 402 | array set aryImg $imgs |
|---|
| 403 | if [$self cget -bicosel] { |
|---|
| 404 | set icos [list $aryImg($state) $aryImg($state)] |
|---|
| 405 | } else { |
|---|
| 406 | set icos {} |
|---|
| 407 | } |
|---|
| 408 | return $icos |
|---|
| 409 | } |
|---|
| 410 | |
|---|
| 411 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 412 | method insertNode {parentId tipo state path {label {}} {others {}} } { |
|---|
| 413 | # PURPOSE: Inserta un nodo en el arbol, inicializando los atributos |
|---|
| 414 | # de tipo, estado y los relativos a la jerarquia del btreeview |
|---|
| 415 | # |
|---|
| 416 | # PARAMETERS: |
|---|
| 417 | # parentId: identificador del nodo padre |
|---|
| 418 | # tipo : |
|---|
| 419 | # state : ON,OFF indica si el checkbutton asociado estara o no activado |
|---|
| 420 | # path : |
|---|
| 421 | # label : |
|---|
| 422 | # others : list of pairs {column value} for columns previously defined |
|---|
| 423 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 424 | if {[string equal $label ""]} { |
|---|
| 425 | set label $path |
|---|
| 426 | } |
|---|
| 427 | set lstData [list type $tipo state $state childsON 0 childsMED 0 parent $parentId] |
|---|
| 428 | set idx [$self insert -at $parentId end $path -label $label \ |
|---|
| 429 | -data [concat $lstData $others]] |
|---|
| 430 | $self SetNodeState $idx $state |
|---|
| 431 | return $idx |
|---|
| 432 | } |
|---|
| 433 | |
|---|
| 434 | |
|---|
| 435 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 436 | method ToggleSelect {} { |
|---|
| 437 | # PURPOSE: Cambia el estado de los nodos seleccionados (marcados) |
|---|
| 438 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 439 | set lst [$self GetAllChildren] |
|---|
| 440 | foreach l $lst { |
|---|
| 441 | Tolcon_Trace "llamo a ToggleNode con l = $l" |
|---|
| 442 | $self ToggleNode $l |
|---|
| 443 | } |
|---|
| 444 | } |
|---|
| 445 | |
|---|
| 446 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 447 | method SelectAll {state} { |
|---|
| 448 | # PURPOSE: Marca todos los nodos hoja a un estado |
|---|
| 449 | # |
|---|
| 450 | # PARAMETERS: |
|---|
| 451 | # state : ON -> seleccionados |
|---|
| 452 | # OFF -> no seleccionados |
|---|
| 453 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 454 | set lst [$self GetAllChildren] |
|---|
| 455 | foreach l $lst { |
|---|
| 456 | $self SetNodeState $l $state |
|---|
| 457 | } |
|---|
| 458 | } |
|---|
| 459 | |
|---|
| 460 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 461 | method GetAllChildren {{id root}} { |
|---|
| 462 | # PURPOSE: Obtenemos todos los nodos hoja o terminales. Esto es, que no |
|---|
| 463 | # tienen hijos. |
|---|
| 464 | # RETURN: Devuelve una lista con los nodos que no tienen hijos |
|---|
| 465 | # |
|---|
| 466 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 467 | set lst [$self entry children $id] |
|---|
| 468 | if {[llength $lst]} { |
|---|
| 469 | foreach e $lst { |
|---|
| 470 | if {[info exists lstid]} { |
|---|
| 471 | set lstid [concat $lstid [$self GetAllChildren $e]] |
|---|
| 472 | } else { |
|---|
| 473 | set lstid [concat [$self GetAllChildren $e]] |
|---|
| 474 | } |
|---|
| 475 | } |
|---|
| 476 | } else { |
|---|
| 477 | return $id |
|---|
| 478 | } |
|---|
| 479 | if {[info exists lstid]} { |
|---|
| 480 | return $lstid |
|---|
| 481 | } else { |
|---|
| 482 | return {} |
|---|
| 483 | } |
|---|
| 484 | } |
|---|
| 485 | |
|---|
| 486 | oncget -bmenu { |
|---|
| 487 | return $self.m |
|---|
| 488 | } |
|---|
| 489 | |
|---|
| 490 | } |
|---|
| 491 | |
|---|
| 492 | package provide btreeview 1.0 |
|---|
| 493 | |
|---|
| 494 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 495 | proc test_btreeview {} { |
|---|
| 496 | # |
|---|
| 497 | # PURPOSE: Funcion de test de un BTreeView. Para poder ejecutarlo hay que |
|---|
| 498 | # situarse en el directorio tolbase/lib |
|---|
| 499 | # |
|---|
| 500 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 501 | |
|---|
| 502 | |
|---|
| 503 | # commands attached to the widgets |
|---|
| 504 | |
|---|
| 505 | proc ReCreateTree { readonly multiselect icosel } { |
|---|
| 506 | destroy .top.tf1.f.btv |
|---|
| 507 | btreeview .top.tf1.f.btv -height 260 -width 500 \ |
|---|
| 508 | -breadonly $readonly -bmultiselect $multiselect -bicosel $icosel\ |
|---|
| 509 | -bhelptext Size |
|---|
| 510 | #.top.tf1.f.btv bColumnInsert end Type Permissions Owner Group Size |
|---|
| 511 | .top.tf1.f.btv bColumnInsert end Type |
|---|
| 512 | #RellenaBTreeView root [file join [info dir script] testdir] |
|---|
| 513 | #RellenaBTreeView root "./byswidget/btreeview/testdir" [jym: se cambia para que no falle] |
|---|
| 514 | RellenaBTreeView root "c:/UnxUtils" |
|---|
| 515 | grid .top.tf1.f.btv -row 0 -column 0 -sticky new |
|---|
| 516 | grid columnconfigure .top.tf1.f 0 -weight 1 |
|---|
| 517 | grid rowconfigure .top.tf1.f 0 -weight 1 |
|---|
| 518 | } |
|---|
| 519 | |
|---|
| 520 | proc RellenaBTreeView { idParent path } { |
|---|
| 521 | puts "Path=$path" |
|---|
| 522 | foreach i [ glob $path/* ] { |
|---|
| 523 | set id [ lindex [file split $i] end ] |
|---|
| 524 | if { [ file isdirectory $i ] } { |
|---|
| 525 | set type "directory" |
|---|
| 526 | } else { |
|---|
| 527 | set type "file" |
|---|
| 528 | } |
|---|
| 529 | set atributos [file attributes $i] |
|---|
| 530 | |
|---|
| 531 | #set permissions [lindex $atributos [expr [lsearch -exact $atributos -permissions] + 1]] |
|---|
| 532 | #set owner [lindex $atributos [expr [lsearch -exact $atributos -owner] + 1]] |
|---|
| 533 | #set group [lindex $atributos [expr [lsearch -exact $atributos -group] + 1]] |
|---|
| 534 | set size [file size $i] |
|---|
| 535 | #set infCols [ list Type $type Permissions $permissions Owner $owner Group $group Size $size ] |
|---|
| 536 | set infCols [ list Type $type Size $size ] |
|---|
| 537 | set childid [ .top.tf1.f.btv insertNode $idParent Group OFF $id "" $infCols] |
|---|
| 538 | if { [ file isdirectory $i ] } { |
|---|
| 539 | RellenaBTreeView $childid $i |
|---|
| 540 | } |
|---|
| 541 | } |
|---|
| 542 | } |
|---|
| 543 | |
|---|
| 544 | proc ToggleBTreeView {} { |
|---|
| 545 | if { $::cb1 } { |
|---|
| 546 | set readonly true |
|---|
| 547 | } else { |
|---|
| 548 | set readonly false |
|---|
| 549 | } |
|---|
| 550 | if { $::cb2 } { |
|---|
| 551 | set multiselect true |
|---|
| 552 | } else { |
|---|
| 553 | set multiselect false |
|---|
| 554 | } |
|---|
| 555 | if { $::cb3 } { |
|---|
| 556 | set icosel true |
|---|
| 557 | } else { |
|---|
| 558 | set icosel false |
|---|
| 559 | } |
|---|
| 560 | ReCreateTree $readonly $multiselect $icosel |
|---|
| 561 | } |
|---|
| 562 | |
|---|
| 563 | # defining the widgets |
|---|
| 564 | |
|---|
| 565 | global toltk_options |
|---|
| 566 | set toltk_options(fonts,Label) {Arial 9} |
|---|
| 567 | |
|---|
| 568 | destroy .top |
|---|
| 569 | toplevel .top |
|---|
| 570 | |
|---|
| 571 | TitleFrame .top.tf1 -text "BTreeView test" |
|---|
| 572 | set f [.top.tf1 getframe] |
|---|
| 573 | #puts "constructor. ant, f=$f" |
|---|
| 574 | #btreeview $f.btv -height 260 -width 500 -bhelptext Size |
|---|
| 575 | #puts "constructor. des" |
|---|
| 576 | #$f.btv bColumnInsert end Type |
|---|
| 577 | #RellenaBTreeView root "./byswidget/btreeview/testdir" |
|---|
| 578 | ReCreateTree false false true |
|---|
| 579 | |
|---|
| 580 | TitleFrame .top.tf2 -text "Configure" |
|---|
| 581 | checkbutton .top.tf2.f.cb1 -text "Read Only" -command ToggleBTreeView |
|---|
| 582 | checkbutton .top.tf2.f.cb2 -text "Multiselect" -command ToggleBTreeView |
|---|
| 583 | checkbutton .top.tf2.f.cb3 -text "Show selection icon" -command ToggleBTreeView |
|---|
| 584 | .top.tf2.f.cb1 deselect |
|---|
| 585 | .top.tf2.f.cb2 deselect |
|---|
| 586 | .top.tf2.f.cb3 select |
|---|
| 587 | |
|---|
| 588 | |
|---|
| 589 | # packing all |
|---|
| 590 | |
|---|
| 591 | grid .top.tf1 -row 0 -column 0 -sticky "new" -padx 10 -pady 10 |
|---|
| 592 | grid .top.tf2 -row 1 -column 0 -sticky "new" -padx 10 -pady 10 |
|---|
| 593 | grid columnconfigure .top 0 -weight 1 |
|---|
| 594 | grid rowconfigure .top 0 -weight 0 |
|---|
| 595 | grid rowconfigure .top 1 -weight 1 |
|---|
| 596 | |
|---|
| 597 | grid .top.tf1.f.btv -row 0 -column 0 -sticky new |
|---|
| 598 | grid columnconfigure .top.tf1.f 0 -weight 1 |
|---|
| 599 | grid rowconfigure .top.tf1.f 0 -weight 1 |
|---|
| 600 | |
|---|
| 601 | grid .top.tf2.f.cb1 -row 0 -column 0 -sticky nw |
|---|
| 602 | grid .top.tf2.f.cb2 -row 1 -column 0 -sticky nw |
|---|
| 603 | grid .top.tf2.f.cb3 -row 2 -column 0 -sticky nw |
|---|
| 604 | grid columnconfigure .top.tf2.f 0 -weight 1 |
|---|
| 605 | } |
|---|
