source: tol/tolbase/lib/byswidget/blistboxplus/blistboxplus.tcl @ cc64b09

1941-docker-image-to-testdevel
Last change on this file since cc64b09 was cc64b09, checked in by Pedro Gea <pgea@…>, 10 years ago

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
  • Property mode set to 100644
File size: 45.6 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : blistboxplus.tcl
3# PURPOSE : Bayes List Box. ListBox con opciones sobre su elementos y varias
4#           columnas
5#/////////////////////////////////////////////////////////////////////////////
6
7package require byscommon
8package require bfunctions
9package require bfieldsdialog
10
11proc debug_init { } {
12  catch {
13    file delete "/tmp/debug_tcl.out"
14  }
15}
16
17proc debug_msg { msg } {
18  catch {
19    set fd [open "/tmp/debug_tcl.out" "a"]
20    puts $fd $msg
21    close $fd
22  }
23}
24
25#/////////////////////////////////////////////////////////////////////////////
26::snit::widget blistboxplus {
27#
28# PURPOSE: ListBox con columnas, menu contextual y caracteristicas adicionales
29#
30#/////////////////////////////////////////////////////////////////////////////
31# opciones especificas
32# readonly -> componente en modo de lectura o lectura/escritura
33# keypress -> Activa la busqueda de filas mediante la pulsacion de teclas
34# colkeypress -> Indica por que columna se busca al pulsar una tecla
35# parent -> indica el padre donde se ubica el blistbox
36# cols -> columnas del listbox
37# hiddencols -> columnas del listbox que no se mostraran
38# filtercols -> columnas del listbox que por las que puede realizarse filtrado
39# initialdir -> directorio inicial para los dialogos de lec/esc de archivos,...
40# orientation -> orientation for de add dialog
41# icon -> icono que se mostrará como primera columna, si no hay icono la
42#  columna no se mostrará
43# nomenu -> Si es 1, no se mostrará el menu contextual
44# titles -> Lista con los titulos a mostrar en cada una de las columnas.
45# values -> List of initial values to load in widget
46# valuesinsert -> List of values to selection element
47# iniconfig -> Nombre que se asigna al listboxplus para identificar sus
48#           opciones en el archivo de configuración .ini por defecto "" en
49#           ese caso no se guardaran las opciones
50#
51# variables
52# listbox -> el treeview que hace de listbox propiamente
53# menu -> el menu contextual del listbox
54# xbar -> horizontal scrollbar
55# ybar -> vertical scrollbar
56# afterTime -> tiempo desde que se pulso la ultima tecla
57# listKey -> lista de teclas pulsadas
58#/////////////////////////////////////////////////////////////////////////////
59  widgetclass Blistboxplus
60
61  option -readonly  0
62  option -selectmode  extended
63  option -keypress    true
64  option -colkeypress ""   
65  option -parent    {}
66  option -cols {}
67  option -hiddencols {}
68  option -filtercols {}
69  option -initialdir {}
70  option -orientation vertical
71  option -showtitles true
72  option -icon ""
73  option -nomenu 0
74  option -titles {}
75  option -values {}
76  option -valuesinsert {}
77  option -iniconfig ""
78 
79  #@O treeview options
80  option -exportselection false
81  option -linewidth 1 ;# unused
82  option -selectbackground "unused"
83 
84  variable _listbox
85  variable menu
86  variable xbar
87  variable ybar
88 
89  variable afterTime 0
90  variable listKey   ""
91  variable currentId 0
92  variable created   0
93
94  #///////////////////////////////////////////////////////////////////////////
95  constructor {args} {
96  #
97  # PURPOSE: Constructor de un blistboxplus. Crea una instancia de un Listbox
98  #
99  # PARAMETERS:
100  #   args -> opciones
101  #
102  #///////////////////////////////////////////////////////////////////////////
103    debug_init
104
105    debug_msg "install listbox ..."
106
107    if {1} {
108      #@T install _listbox using ::blt::treeview $win.lb -hideroot yes \
109          -activeicons "" -icons {} -selectmode multiple \
110          -selectbackground grey -selectforeground white \
111          -highlightthickness 0 -borderwidth 1 -selectborderwidth 1 \
112          -nofocusselectbackground grey -font {Arial 9} -flat yes
113      install _listbox using ::wtree $win.lb -table 0 -filter no \
114        -background white -showroot 0 -selectmode extended -showheader 1 \
115        -highlightbackground gray75 -highlightcolor black \
116        -highlightthickness 0 -font {Arial 9}
117    } else {
118      set _listbox [::wtree $win.lb -table 0 -filter no \
119        -background white -showroot 0 -selectmode extended -showheader 1 \
120        -highlightbackground gray75 -highlightcolor black \
121        -highlightthickness 0 -font {Arial 9}]
122      #@T set _listbox [::blt::treeview $win.lb -hideroot yes \
123                        -activeicons "" -icons {} -selectmode multiple \
124                        -selectbackground grey -selectforeground white \
125                        -highlightthickness 0 -borderwidth 1 \
126                        -selectborderwidth 1 \
127                        -nofocusselectbackground grey -font {Arial 9} -flat yes]
128    }
129
130    debug_msg "despues de install listbox"
131
132    install menu using menu $win.m -tearoff 0
133    #@!scroll install xbar using scrollbar $win.sbh -orient horizontal \
134                                           -command "$win xview"
135    #@!scroll install ybar using scrollbar $win.sbv -orient vertical \
136                                           -command "$win yview"
137
138    #bindtags is modified to make possible to associate binds to self
139    $_listbox configure -bindtags [list $self Blistboxplus]
140
141    #@T! $_listbox style  configure text     -bg white
142    #@T! to do
143
144    #@T! $_listbox column configure treeView -bg white
145    #@T! to do   
146
147    $self configure -readonly [from args -readonly]
148    $self _CreateMenu 
149   
150    # Apply all arguments given:
151    $self configurelist $args
152
153    #@T! $_listbox configure -xscrollcommand "$xbar set"
154    #@T! $_listbox configure -yscrollcommand "$ybar set"
155    #@T! to do   
156    if { $options(-parent) eq "" } {
157      $self configure -parent [winfo parent $win]
158    }
159   
160    # bind
161    #@!bind
162    #@T! $_listbox bind all <KeyPress> +[list $self _OnKeyPress %A]
163    #@T! to do   
164    bind $_listbox <KeyPress> +[list $self _OnKeyPress %A]
165   
166    $self configure -nomenu [from args -nomenu]
167    $self configure -filtercols [from args -filtercols]
168
169    #pack
170    grid $_listbox -row 0 -column 0 -sticky news
171    #@!scroll grid $ybar -row 0 -column 1 -sticky ns
172    #@!scroll grid $xbar -row 1 -column 0 -sticky ew
173    grid columnconfigure $self 0 -weight 1
174    grid rowconfigure    $self 0 -weight 1
175
176    #@!scroll ::autoscroll::autoscroll $ybar
177    #@!scroll ::autoscroll::autoscroll $xbar
178    debug_msg "voy a pillarte: antes de _ReadIni"
179    $self _ReadIni
180    debug_msg "pase?"
181    set created 1
182  }
183
184  #///////////////////////////////////////////////////////////////////////////
185  destructor {
186  #
187  # PURPOSE: Funciones a evaluar al eliminar la instancia de blistboxplus.
188  #
189  # PARAMETERS:
190  #   self: toplevel
191  #
192  #///////////////////////////////////////////////////////////////////////////
193    # Save .ini
194    catch [list $self _WriteIni ]
195  }
196
197  #///////////////////////////////////////////////////////////////////////////
198  #
199  # PURPOSE: Metodos cget y configure
200  #
201  #///////////////////////////////////////////////////////////////////////////
202
203  onconfigure -cols { lst } {
204    set options(-cols) $lst
205    #@T! foreach col [$self column names] {
206    #@T!   $_listbox column delete $col
207    #@T! }
208    $_listbox column delete all
209    #@T! foreach col $options(-cols) {
210    #@T!   $_listbox column insert end $col -justify left
211    #@T!   $_listbox column configure $col -command "$self _SortByColumn [list $col]" -titleborderwidth 1
212    #@T! }
213   
214    set lstx [list [list image -label Icon -tags Icon] ]
215    foreach col $lst {
216      #set colx [list text -label [msgcat::mc $col] -tags $col]
217      set colx [list text -label $col -tags $col]
218      lappend lstx $colx
219    }
220    #@! Tolcon_Trace "lstx $lstx"
221    $_listbox configure -columns $lstx
222   
223    if { $options(-icon) == "" } {
224      #@T! $_listbox column configure "BLT TreeView $_listbox" -hide 1
225      $_listbox column configure Icon -visible 0
226    } else {
227      #@T! $_listbox column configure "BLT TreeView $_listbox" -hide 0
228      $_listbox column configure Icon -visible 1
229    }
230   
231    #@T adds
232    $_listbox column configure first -expand yes -weight 1
233    $_listbox column configure all -itembackground ""   
234  }
235
236  onconfigure -hiddencols { lst } {
237    set options(-hiddencols) $lst
238    foreach col [$self column names] {
239      if { "-1" eq [lsearch $options(-hiddencols) $col] } {
240        #@T! $_listbox column configure $col -hide 0
241        $_listbox column configure $col -visible 1
242      } else {
243        #@T! $_listbox column configure $col -hide 1
244        $_listbox column configure $col -visible 0
245      }
246    }
247  }
248
249  onconfigure -showtitles { bool } {
250    set options(-showtitles) $bool
251    #@O $_listbox configure -showtitles $bool
252    $_listbox configure -showheader $bool   
253    #@O! $_listbox show
254  }
255
256  onconfigure -icon { icon } {
257    set options(-icon) $icon
258    if { $icon != "" } {
259      #@T! $_listbox column configure "BLT TreeView $_listbox" -min 16 -max 16 \
260      #@T!   -hide 0 -titleborderwidth 1
261      #@T! $_listbox configure -icons [list [Bitmap::get $icon] [Bitmap::get $icon]]
262      $_listbox column configure Icon -minwidth 16 -maxwidth 16 -visible 1 ;# -titleborderwidth 1
263     
264    } else {
265      #@T! $_listbox column configure "BLT TreeView $_listbox" -hide 1
266      $_listbox column configure Icon -visible 0
267    }
268  }
269
270  onconfigure -titles { titles } {
271    set options(-titles) $titles
272    set c 0
273    set cols [$self column names]
274    foreach col $cols {
275     #@O $self column configure $col -title [mc [lindex $titles $c] ]
276     $_listbox column configure $col -text [mc [lindex $titles $c] ]
277     incr c 1     
278    }
279  }
280
281  onconfigure -values { lst } {
282    $self clear
283    eval $self insert end $lst
284  }
285
286  onconfigure -nomenu { bool } {
287    set options(-nomenu) $bool
288    if {$bool} {
289      # no mostrar menu
290      bind $self  <Button-3>   ""
291    } else {
292      # mostrar menu
293      bind $self  <Button-3>   "tk_popup $menu %X %Y"
294    }
295  }
296
297  onconfigure -readonly { bool } {
298    if {!($created)} {
299      set options(-readonly) $bool       
300    } else {
301      puts "Blistboxplus widget error: option -readonly only can be set on \
302            creation time"
303    }
304  }
305 
306  onconfigure -selectmode { mode } {
307    if { $mode eq "multiple" } {
308      set options(-selectmode) "extended"
309    } else {
310      set options(-selectmode) $mode
311    }
312    $_listbox configure -selectmode $options(-selectmode)
313  } 
314
315  onconfigure -filtercols { lst } {
316    set cols [$self cget -cols]   
317    set hiddencols [$self cget -hiddencols]
318    if { [llength cols] && [llength hiddencols]} {
319      set filtercols {}
320      foreach col $cols {
321        if {([lsearch -exact $hiddencols  $col])} {
322          lappend filtercols $col
323        }
324      }
325      set options(-filtercols) $filtercols   
326    } else {
327      if { [llength cols] } {
328        set options(-filtercols) $options(-cols)
329      }
330    }
331  }
332 
333  onconfigure -exportselection { bool } {
334    if { $bool } {
335      error "\[blistboxplus\] option -exportselection should be 'no'"
336    }
337  }
338 
339  #///////////////////////////////////////////////////////////////////////////
340  method show { args } {
341  #///////////////////////////////////////////////////////////////////////////
342    error "\[blistboxplus\] method show unimplemented"
343  }
344 
345  #///////////////////////////////////////////////////////////////////////////
346  method hide { args } {
347  #///////////////////////////////////////////////////////////////////////////
348    error "\[blistboxplus\] method hide unimplemented"
349  }
350 
351  #///////////////////////////////////////////////////////////////////////////
352  method sort { args } {
353  #///////////////////////////////////////////////////////////////////////////
354    if { [lindex $args 1] eq "configure" } {
355      if { [lindex $args 2] eq "-column" } {
356        return [$self _SortByColumn [lindex $args 3]]
357      } else {
358        return
359      }
360    } elseif { [lindex $args 1] eq "auto" } {
361      #@O! Nothing to do ??
362      return
363    } else {
364      return
365    }     
366  }
367
368  #///////////////////////////////////////////////////////////////////////////
369  method _CreateMenu {args} {
370  #
371  # PURPOSE: Append menu to listbox.
372  #
373  #///////////////////////////////////////////////////////////////////////////
374    # read option
375    $menu add command -label [mc "Select all"] \
376      -command "$self _SelectAll"  -accelerator CTRL+E
377    $menu add command -label [mc "Unselect all"] \
378      -command "$self selection clearall" -accelerator CTRL+U
379    $menu add command -label [mc "Toggle selection"] \
380      -command "$self _ToggleSelection" -accelerator CTRL+I
381    # read/write option
382    if {!([$self cget -readonly])} {
383      # delete
384      $menu add separator
385      $menu add command -label [mc "Insert"] \
386                -command "$self _OpenWR" -accelerator Ins
387      $menu add command -label [mc "Delete all"]  \
388        -command "$self clear"  -accelerator CTRL+D
389      $menu add command -label [mc "Delete selected"] \
390        -command "lbDeleteSelection $self"
391    }
392    # read option
393    # copy
394    $menu add separator
395    $menu add command -label [mc "Filter"] -command "$self _OpenFD"
396    $menu add command -label [mc "Unfilter"] -command "$self _RemoveFilter"
397    $menu add separator
398    set mc [menu $menu.copy -tearoff 0]
399    $menu add cascade -label [mc "Copy"] -menu $mc
400    $mc add command -label [mc "Copy all"] \
401      -command "$self _CopyToClipBoard 1 1" -accelerator CTRL+A
402    $mc add command -label [mc "Copy selected"] \
403      -command "$self _CopyToClipBoard 1 0" -accelerator CTRL+C
404    $mc add command -label [mc "Copy unselect"] \
405      -command "$self _CopyToClipBoard 0 1"
406    # count
407    $menu add separator
408    $menu add command -label [mc "Count elements"] \
409      -command "$self _ShowCountItems" -accelerator CTRL+N
410    # file
411    $menu add separator
412    set mf [menu $menu.file -tearoff 0]
413    $menu add cascade -label [mc "File_lbp"] -menu $mf
414    $mf add command -label "[mc "Save to file"] ..." \
415      -command "$self _SaveToFile 1 1"
416    if {![$self cget -readonly]} {
417      $mf add command -label "[mc "Load form file"] ..." \
418        -command "$self _LoadFromFile"
419    }
420    # bindings 
421    bind $_listbox <Control-KeyRelease> +[list $self _OnControlKey $self %K %k]
422    bind $_listbox <Key-Delete>         "lbDeleteSelection $self" 
423    bind $_listbox <Key-Insert>         "$self _OpenWR"
424    bind $_listbox <Shift-Up>           "$self addPrevious"
425    bind $_listbox <Shift-Down>         "$self addNext"
426    bind $_listbox <Up>                 "$self previous"
427    bind $_listbox <Down>               "$self next"
428    bind $_listbox <Home>               "$self first"
429    bind $_listbox <End>                "$self last"
430    bind $_listbox <Shift-Home>         "$self addAllPrevious"
431    bind $_listbox <Shift-End>          "$self addAllNext"
432    bind $_listbox <Button-1>           +[list focus -force %W]   
433  }
434   
435  method curselection {} {
436    set cursel [$_listbox selection get]
437    if { [expr [llength $cursel] <= 1] } { return $cursel }
438    set curselx {}
439    foreach it $cursel {
440      lappend curselx [list $it [$_listbox item order $it]]
441    } 
442    set curselxs [lsort -index end $curselx]
443    set cursels {}
444    foreach it $curselxs {
445      lappend cursels [lindex $it 0]
446    }
447    return $cursels
448   
449    #set firstPos [$_listbox item order [lindex $cursel 0]]
450    #set lastPos [$_listbox item order [lindex $cursel end]]
451    #if { [expr $firstPos <= $lastPos] } {
452    #  Tolcon_Trace "right!"
453    #  foreach it $cursel {
454    #    Tolcon_Trace "$it [$_listbox item order $it]"
455    #  }
456    #  return $cursel
457    #} else {
458    #  Tolcon_Trace "reversed!"
459    #  foreach it $cursel {
460    #    Tolcon_Trace "$it [$_listbox item order $it]"
461    #  }   
462    #  return [lreverse $cursel]
463    #}
464  }
465     
466  #///////////////////////////////////////////////////////////////////////////
467  method getMenu { } {
468  #
469  # PURPOSE: Devuelve el menu del blistboxplus para poder modificarlo y
470  #          ampliarlo
471  #
472  # RETURN: La variable de instancia que apunta al menu
473  #
474  #/////////////////////////////////////////////////////////////////////////// 
475    return $menu
476  }
477
478  #///////////////////////////////////////////////////////////////////////////
479  method _OnKeyPress {key} {
480  #
481  # PURPOSE: Activa la fila que coincide con las teclas pulsadas. Distinge
482  #          entre muysuculas y minusculas
483  #
484  # PARAMETERS: key -> tecla pulsada
485  #
486  #///////////////////////////////////////////////////////////////////////////
487    if {[$self cget -keypress]} {
488      set diference 500
489      set result [lbOnKeyPress $self $key $listKey $afterTime $diference \
490        [$self cget -colkeypress]]
491      set listKey   [lindex $result 0]
492      set afterTime [lindex $result 1]
493    }
494  }
495
496  #///////////////////////////////////////////////////////////////////////////
497  method _OnControlKey {_lb keysym keycode} {
498  #
499  # PURPOSE: Controla es uso de teclas rápidas para le ejecución de funciones
500  #
501  # PARAMETERS: _lb -> self
502  #             keysym -> The keysym corresponding to the event,
503  #                       substituted as a textual string
504  #             keycode -> The keycode field from the event
505  #
506  #///////////////////////////////////////////////////////////////////////////
507    switch [string toupper $keysym] {
508      E { $_lb _SelectAll }
509      C { lbToClipBoard $_lb 1 0 }
510     
511      A { $self _CopyToClipBoard 1 1 }
512      D { $self clear }
513      I { $self _ToggleSelection }
514      U { $self selection clearall }
515      N { $self _ShowCountItems }
516    }
517  } 
518
519  #///////////////////////////////////////////////////////////////////////////
520  method _ShowCountItems {} {
521  #
522  # PURPOSE: Shows information on the selection of the elements
523  #
524  #///////////////////////////////////////////////////////////////////////////
525    set info [lbCountItems $self]
526    set msg "[mc "Total"]: [lindex $info 0] \n\
527             [mc "Selected"]: [lindex $info 1] \n\
528             [mc "Not Selected"]: [lindex $info 2]"
529    if {[string length [$self cget -parent]]} {
530      set par $self
531    } else {
532      set par [$self cget -parent]
533    }
534    tk_messageBox -default ok \
535                  -icon info  \
536                  -message $msg \
537                  -type ok \
538                  -parent $par \
539                  -title [mc "numero de elementos"]
540  }
541
542  #/////////////////////////////////////////////////////////////////////////////
543  method _ToggleSelection {} {
544  #
545  # PURPOSE: Toggle selection elements
546  #
547  #/////////////////////////////////////////////////////////////////////////////
548    foreach i [$self get] {
549      $self selection toggle $i
550    }
551  }
552
553  #///////////////////////////////////////////////////////////////////////////
554  method _SelectAll { } {
555  #
556  # PURPOSE: Selection all
557  #
558  #///////////////////////////////////////////////////////////////////////////
559    foreach i [$self get] {
560      $self selection set $i
561    }
562  }
563
564  #/////////////////////////////////////////////////////////////////////////////
565  method _CopyToClipBoard { sl unSe {pref ""} {suf ""} {sep "\n"}} {
566  #
567  # PURPOSE: copy the elements indicates in clipboard
568  #
569  # PARAMETERS:
570  #   sl   -> Copy items selections
571  #   unSe -> Copy items not selections
572  #   pref -> Text to concatenate in the beginning. Default ""
573  #   suf  -> Text to concatenate in the end. Default ""
574  #   sep  -> Separating text of elements. Default "\n"
575  #
576  #/////////////////////////////////////////////////////////////////////////////
577    # items to copy
578    set lst {}
579    if { $sl } {
580      foreach i [$self curselection] {
581        lappend lst [$self get $i]
582      }
583    }
584    if { $unSe } {
585      foreach i [$self selection get unselected] {
586        lappend lst [$self get $i]
587      }
588    }
589    # copy
590    set str [ListToStr $lst $sep $pref $suf]
591    clipboard clear
592    clipboard append $str
593  }
594
595  #/////////////////////////////////////////////////////////////////////////////
596  method _SaveToFile {se unSe {pref ""} {suf ""} {sep "\n"}} {
597  #
598  # PURPOSE: Save the content from listbox in a file
599  #
600  # PARAMETERS:
601  #    sl   -> Copy items selections
602  #   unSe -> Copy items not selections
603  #   pref -> Text to concatenate in the beginning. Default ""
604  #   suf  -> Text to concatenate in the end. Default ""
605  #   sep  -> Separating text of elements. Default "\n"
606  #
607  #/////////////////////////////////////////////////////////////////////////////
608    # select file
609    set filNam [tk_getSaveFile -parent $self -title [mc "File selector"] \
610                               -initialdir $options(-initialdir)]
611
612    if {$filNam != ""} {
613      set options(-initialdir) [file dirname $filNam]   
614      # open file to write
615      if { ![ catch { set fd [open $filNam w] } msgerr] } {
616        # text to save
617        set lst {}
618        if { $se } {
619          foreach i [$self selection get selected] {
620            lappend lst [$self get $i]
621          }
622        }
623        if { $unSe } {
624          foreach i [$self selection get unselected] {
625            lappend lst [$self get $i]
626          }
627        }
628        set str [ListToStr $lst $sep $pref $suf]
629        # write
630        puts -nonewline $fd $str
631        close $fd
632        return 1
633      }
634      error $msgerr
635    }
636  }
637
638  #/////////////////////////////////////////////////////////////////////////////
639  method  _LoadFromFile { } {
640  #
641  # PURPOSE: Load the content from listbox in a file
642  #
643  #/////////////////////////////////////////////////////////////////////////////
644    # select file   
645    set filNam [tk_getOpenFile -parent $self -title [mc "File selector"] \
646                               -initialdir $options(-initialdir)]   
647
648    if {$filNam != ""} {
649      set options(-initialdir) [file dirname $filNam]
650      # open file to read
651      if { ![ catch { set fd [open $filNam r] } msgerr] } {
652         while { [gets $fd line ] >= 0} {
653           $self add $line
654         }
655         close $fd     
656         return 1
657      }
658      error $msgerr
659    }
660  }
661
662  #///////////////////////////////////////////////////////////////////////////
663  method _SortByColumn { col } {
664  #
665  # PURPOSE: Sorts the ListBox by the values of the given column
666  # PARAMETERS:
667  #  col -> the column which the sort is performed
668  #
669  #///////////////////////////////////////////////////////////////////////////
670
671    #@O!
672    return [$_listbox SortbyColumn $_listbox $col]
673 
674    set numofel [$self size]
675    set lst [list]
676    set fulllst [$self get]
677
678    foreach i $fulllst {
679      lappend lst [$self get $i ]
680    }
681# lst:    contains a list of values
682    set coln 0
683    set cols [$self cget -cols]
684    set hidcols [$self cget -hiddencols]
685    for { set j 0 } { $j < [llength $cols] } { incr j } {
686      if {[lindex $cols $j] eq $col} {
687        set coln $j
688      }
689    }
690# coln:   contains the index of the column to be ordered
691    set lst [lsort -index $coln $lst]
692    $self clear
693    for { set i 0 } { $i < $numofel } { incr i } {
694      set el [lindex $lst $i ]
695      $self insert end $el
696    }
697
698  }
699
700  #///////////////////////////////////////////////////////////////////////////
701  proc _AddWR { elem father } {
702  #
703  # PURPOSE: adds the item introduced in the dialog to the selected list
704  #
705  # PARAMETERS:
706  #  elem -> the element to insert from the add dialog
707  #  father -> The dialog's window pathname
708  #
709  #///////////////////////////////////////////////////////////////////////////
710    foreach ele $elem {
711      $father insert 0 $ele
712    }
713  }
714
715  #//////////////////////////////////////////////////////////////////////////
716  method _OpenWR {} {
717  #
718  # PURPOSE: Calls (and creates) an add dialog for insert by hand elements
719  #
720  #///////////////////////////////////////////////////////////////////////////
721    destroy $self.dw
722   
723    if {![catch {eval $options(-valuesinsert)} res]} {
724      set valuesinsert $res
725    } else {
726      set valuesinsert $options(-valuesinsert)
727    }
728   
729    if {$valuesinsert == ""} {
730      set dialog  [bfieldsdialog $self.dw -title [mc "Insert element"] \
731                  -parent $self -orientation $options(-orientation) \
732                  -fields $options(-cols) -procedure [codename _AddWR] \
733                  -buttons { add exit } -titles $options(-titles) \
734                  -list $valuesinsert]
735    } else {       
736      set dialog  [bfieldsdialog $self.dw -title [mc "Insert element"] \
737                  -parent $self -orientation $options(-orientation) \
738                  -fields $options(-cols) -procedure [codename _AddWR] \
739                  -buttons { add addall exit } -titles $options(-titles) \
740                  -list $valuesinsert]
741    }
742    $dialog draw
743  }
744
745  #///////////////////////////////////////////////////////////////////////////
746  proc _Filter { elem father } {
747  #
748  # PURPOSE: Filters the listbox with the filter suministred
749  #
750  # PARAMETERS:
751  #  elem -> the list with the filter fields
752  #  father -> The dialog's window pathname
753  #
754  #///////////////////////////////////////////////////////////////////////////
755    eval $father filter $elem
756  }
757
758  #//////////////////////////////////////////////////////////////////////////
759  method _OpenFD {} {
760  #
761  # PURPOSE: Calls (and creates) a add dialog for getting a filter
762  #
763  #///////////////////////////////////////////////////////////////////////////
764
765    destroy $self.fd
766    set dialog  [bfieldsdialog $self.fd -title [mc "Filter elements"] \
767                -parent $self -orientation $options(-orientation) \
768                -fields $options(-filtercols) -procedure [codename _Filter] \
769                -buttons { info apply accept cancel } \
770                -titles $options(-titles)]
771    $dialog configure -info \
772"Los filtros admiten expresiones regulares:
773
774  expresiones regulares básicas:
775    - literales: caracteres simples
776    - brackets:  conincide con cualquier caracter especificado dentro
777       tambien pueden expecificarse rangos pe \[a-d\] equivale a \[abcd\]
778       o indicar la no coincidencia colocando como primer caracter ^
779       rangos predefinidos:
780        \[:alnum:\] equivale a \[0-9a-zA-Z\]
781        \[:alpha:\] equivale a \[a-zA-Z\]
782        \[:digit:\] equivale a \[0-9\]
783        \\w equivale a \[:alnum:\]
784        \\W equivale a \[^:alnum:\]
785        para incluir el literal - ponerlo al final del braquet
786        para incluir el literal ^ ponerlo en cualquier lugar menos el primero
787    - punto . : coincide con cualquier caracter simple
788    - ^ y $ : coinciden respectivamente con el principio o final de linea
789    - caracteres especiales: los caracteres que tienen significado en las
790      expresiones regulares pueden escribirse precediendolos con \\
791   
792  operadores sobre las expresiones:
793    - <e1><e2>: concatenacion, la expresion resultante coincide si coinciden
794         secuencialmente las expresiones
795    - <e1>|<e2> : disyuncion, coincide si coincide alguna de las expresiones
796    - <e>? : opcionalidad, coincide si la expresion anterior coincide 0 o 1 vez
797    - <e>* : repeticion, coincide si la expresion anterior coincide 0 o mas veces
798    - <e>+ : repeticion, coincide si la expresion anterior coincide 1 o mas veces
799    - <e>{n} : repeticion, coincide si la expresion anterior coincide  n veces
800    - <e>{n,} : repeticion, coincide si la exp anterior coincide n o mas veces
801    - <e>{n,m} : repeticion, coincide si la exp anterior coincide por lo menos n
802         y no mas de m veces
803
804  precedencia de los operadores:
805    - los operadores de repeticion tienen preferencia sobre la concatenacion
806    - la concatenacion tiene preferencia sobre la disyuncion
807    - las reglas pueden alterarse con el uso de parentesis
808"
809       
810    $dialog draw
811  }
812
813  #///////////////////////////////////////////////////////////////////////////
814  method _WriteIni { } {
815  #
816  # PURPOSE: Guarda en el .ini informacion referente al blistboxplus
817  #
818  #
819  #///////////////////////////////////////////////////////////////////////////
820    if { [$self cget -iniconfig] ne "" } {
821      # comprobamos cargado namespace y variable de .ini
822      if {[namespace exists ::iniFile]} {
823        set wini ::iniFile::Write
824        set nm [$self cget -iniconfig]
825        if {![string length $nm]} {
826          set nm $self
827        }
828        $wini $nm initialdir $options(-initialdir)
829      }
830    }
831  }
832
833  #///////////////////////////////////////////////////////////////////////////
834  method _ReadIni { } {
835  #
836  # PURPOSE: Recupera del .ini informacion referente al blistboxplus
837  #
838  #
839  #///////////////////////////////////////////////////////////////////////////
840    if { [$self cget -iniconfig] ne "" } {
841      # comprobamos cargado namespace y variable de .ini
842      if {[namespace exists ::iniFile]} {
843        set rini ::iniFile::Read
844        set nm [$self cget -iniconfig]
845        if {![string length $nm]} {
846          set nm $self
847        }
848        set stt [::iniFile::ReadWMState $rini $nm]
849        set inid [$rini $nm initialdir ""]       
850        if {[string length $inid]} {
851            set options(-initialdir) $inid
852        }
853      }
854    }
855  }
856
857  #///////////////////////////////////////////////////////////////////////////
858  method selection { args } {
859  #
860  # PURPOSE: extends the original command to extend capabilities
861  #
862  # PARAMETERS:
863  #   args: arguments
864  #
865  #///////////////////////////////////////////////////////////////////////////
866    if { [lindex $args 0] eq "get" } {
867      if { [lindex $args 1] eq "unselected" } {
868        set result {}
869        set selected [$self curselection]
870        foreach i [$self get] {
871          if { "-1" eq [lsearch $selected $i] } {
872            lappend result $i
873          }
874        }
875        return $result
876      } else {
877        return [$self curselection]
878      }
879    }
880    eval $_listbox selection $args
881  }
882
883  #///////////////////////////////////////////////////////////////////////////
884  method insert { pos args } {
885  #
886  # PURPOSE: inserts an element into de listbox
887  #
888  # PARAMETERS:
889  #   args: a list of elements to insert, each element is a list with column
890  #   data
891  #
892  #///////////////////////////////////////////////////////////////////////////   
893    if { [lindex $args 0] eq "cols" } {
894      set cols [lindex $args 1]
895      set args [lrange $args 2 end]
896    } else {
897      set cols $options(-cols)
898    }
899   
900    switch [llength $cols] {
901      1 {
902        # una sola columna
903        foreach dats $args {
904          set datos [list [lindex $cols 0] $dats]
905          #@ Crea y completa los datos de un nodo
906          set node [$_listbox item create -parent root -button 0 -open 0]
907          eval $_listbox item text $node $datos
908          if { $options(-icon) != "" } {
909            $_listbox item image $node [Bitmap::get $options(-icon)]
910          }         
911          incr currentId
912        }       
913      }
914      default {
915        # mas de una columna
916        foreach dats $args {
917          set i 0
918          set datos {}
919          foreach col $cols {
920            lappend datos $col [lindex $dats $i]
921            incr i
922          }
923          #@ Crea y completa los datos de un nodo
924          set node [$_listbox item create -parent root -button 0 -open 0]
925          eval $_listbox item text $node $datos
926          if { $options(-icon) != "" } {
927            $_listbox item image $node [Bitmap::get $options(-icon)]
928          }
929          incr currentId
930        }
931      }
932    }
933  }
934
935  #///////////////////////////////////////////////////////////////////////////
936  method add { args } {
937  #
938  # PURPOSE: appends elements to dthe listbox
939  #
940  # PARAMETERS:
941  #   args: a list of elements to insert, each element is a list with column
942  #   data
943  #
944  #///////////////////////////////////////////////////////////////////////////
945    eval $self insert end $args
946  }
947
948  #///////////////////////////////////////////////////////////////////////////
949  method delete { args } {
950  #
951  # PURPOSE: deletes elements from the listbox
952  #
953  # PARAMETERS:
954  #   args: the tags or ids of the items to be deleted
955  #   data
956  #
957  #///////////////////////////////////////////////////////////////////////////
958    if { "-1" eq [lsearch $args 0] } {
959      eval $_listbox item delete $args
960    } else {
961      puts "Root node can't be deleted"
962    }
963  }
964
965  #/////////////////////////////////////////////////////////////////////////// 
966  method getlb {} {
967  #
968  # PURPOSE: Get path of blistboxplus
969  #
970  #/////////////////////////////////////////////////////////////////////////// 
971    return $_listbox
972  }
973
974  #///////////////////////////////////////////////////////////////////////////
975  method get { {ids ""} {cols ""}} {
976  #
977  # PURPOSE: retrieves data from an entry identified by id
978  #
979  # PARAMETERS:
980  #  id: id list of nodes
981  #  cols: name of the cols from which retrieve data
982  #
983  #///////////////////////////////////////////////////////////////////////////
984    if { $ids eq "" } {
985      set items [$_listbox item children root]
986      return $items
987    }
988 
989    set result {}
990 
991    if { "$cols" eq "" } {
992      set cols [$self column names]
993    }
994
995    foreach id $ids {
996      set elem {}   
997      foreach col $cols {
998        lappend elem [$_listbox item text $id $col]
999      }
1000      lappend result $elem
1001    }
1002     
1003    if { [llength $ids] eq 1 } {   
1004      return [lindex $result 0]
1005    }
1006   
1007    return $result
1008  }
1009
1010  #///////////////////////////////////////////////////////////////////////////
1011  method set { id data {cols ""}} {
1012  #
1013  # PURPOSE: inserts data to an entry identified by id
1014  #
1015  # PARAMETERS:
1016  #  id: id of the node
1017  #  data: data to insert
1018  #  cols: name of the cols from which retrieve data
1019  #
1020  #///////////////////////////////////////////////////////////////////////////
1021    if { "$cols" eq "" } {
1022      set cols [$self column names]
1023    }   
1024    set datos {}
1025    set i 0   
1026    foreach col $cols {
1027      lappend datos $col
1028      lappend datos [lindex $data $i]
1029      incr i
1030    }
1031    return [eval $_listbox item text $id $datos]
1032  }
1033
1034  #///////////////////////////////////////////////////////////////////////////
1035  method first {} {
1036  #
1037  # PURPOSE: Selects and returns the first row of blistboxplus
1038  #
1039  # RETURN: The index of first row
1040  #
1041  #///////////////////////////////////////////////////////////////////////////
1042    set all [$self get]
1043    set selected [$self selection get]
1044    if {$selected != ""} {   
1045      foreach item $selected { 
1046        $self selection clear $item
1047      }
1048    }
1049    if { !([llength [$self get]] eq 0)} {
1050      $self selection set [lindex $all 0]
1051    }
1052    return [lindex $all 0]
1053  }
1054
1055  #///////////////////////////////////////////////////////////////////////////
1056  method last {} {
1057  #
1058  # PURPOSE: Selects and returns the last row of blistboxplus
1059  #
1060  # RETURN: The index of last row
1061  #
1062  #///////////////////////////////////////////////////////////////////////////
1063    set all [$self get]
1064    set selected [$self selection get]
1065    if {$selected != ""} {
1066      foreach item $selected {
1067        $self selection clear $item
1068      }             
1069    }
1070    if { !([llength [$self get]] eq 0)} {
1071      $self selection set [lindex $all [expr [llength $all] - 1]]
1072    }
1073    return [lindex $all [expr [llength $all] - 1]]           
1074  }
1075
1076  #///////////////////////////////////////////////////////////////////////////
1077  method addPrevious {} {
1078  #
1079  # PURPOSE: adds the row previous to the present selection
1080  #
1081  # RETURN: The index of the row previous
1082  #
1083  #///////////////////////////////////////////////////////////////////////////
1084    set all [$self get]
1085    set selected [$self selection get]
1086    if {$selected == ""} {
1087      return -1
1088    } else  {
1089      set firstSelected [lindex $selected 0]
1090      set first [lindex $all 0]
1091      if { $first == $firstSelected } {
1092        return [lindex $all 0]
1093      } else  {
1094        set allPosition [lsearch -exact $all $firstSelected]
1095        set firstSelected [lindex $all [expr $allPosition - 1]]
1096        #set firstSelected [expr $firstSelected - 1]
1097        $self selection set $firstSelected
1098        return $firstSelected
1099      }
1100    }
1101  }
1102
1103  #///////////////////////////////////////////////////////////////////////////
1104  method addNext {} {
1105  #
1106  # PURPOSE: Adds the following row to the present selection
1107  #
1108  # RETURN: The index of the following row
1109  #
1110  #///////////////////////////////////////////////////////////////////////////
1111    set all [$self get]
1112    set selected [$self selection get]
1113    if {$selected == ""} {
1114      return -1     
1115    } else  {
1116      set lastSelected [lindex $selected [expr [llength $selected] - 1] ]
1117      set last [lindex $all [expr [llength $all] - 1]]
1118      if { $last == $lastSelected } {
1119        return [lindex $all [expr [llength $all] - 1]]
1120      } else  {
1121        set allPosition [lsearch -exact $all $lastSelected]
1122        set lastSelected [lindex $all [expr $allPosition + 1]]
1123        $self selection set $lastSelected
1124        return $lastSelected
1125      }
1126    }   
1127  }
1128
1129  #///////////////////////////////////////////////////////////////////////////
1130  method previous {} {
1131  #
1132  # PURPOSE: selects the row previous to the present selection
1133  #
1134  # RETURN: The index of the row previous
1135  #
1136  #///////////////////////////////////////////////////////////////////////////
1137    set all [$self get]
1138    set selected [$self selection get]
1139    if {$selected == ""} {
1140      return -1
1141    } else  {
1142      foreach item $selected {
1143        $self selection clear $item
1144      }
1145      set firstSelected [lindex $selected 0]
1146      set first [lindex $all 0]
1147      if { $first == $firstSelected } {
1148        $self selection set $firstSelected
1149        return [lindex $all 0]
1150      } else  {
1151        set allPosition [lsearch -exact $all $firstSelected]
1152        set firstSelected [lindex $all [expr $allPosition - 1]]
1153        $self selection set $firstSelected
1154        return $firstSelected
1155      }
1156    }
1157  }
1158
1159  #///////////////////////////////////////////////////////////////////////////
1160  method next {} {
1161  #
1162  # PURPOSE: selects the following row to the present selection
1163  #
1164  # RETURN: The index of the following row
1165  #
1166  #///////////////////////////////////////////////////////////////////////////
1167    set all [$self get]
1168    set selected [$self selection get]
1169    if {$selected == ""} {
1170      return -1
1171    } else  {
1172      foreach item $selected {
1173        $self selection clear $item
1174      }
1175      set lastSelected [lindex $selected [expr [llength $selected] - 1] ]
1176      set last [lindex $all [expr [llength $all] - 1]]
1177      if { $last == $lastSelected } {
1178        $self selection set $lastSelected
1179        return [lindex $all [expr [llength $all] - 1]]
1180      } else  {
1181        set allPosition [lsearch -exact $all $lastSelected]
1182        set lastSelected [lindex $all [expr $allPosition + 1]]
1183        $self selection set $lastSelected
1184        return $lastSelected
1185      }
1186    }
1187  }
1188
1189  #///////////////////////////////////////////////////////////////////////////
1190  method addAllPrevious {} {
1191  #
1192  # PURPOSE: Selects all the previous rows
1193  #
1194  # RETURN: The index of the first row
1195  #
1196  #///////////////////////////////////////////////////////////////////////////
1197    set all [$self get]
1198    set selected [$self selection get]
1199    if {$selected == ""} {
1200      return -1
1201    } else  {
1202      set firstSelected [lindex $selected 0]
1203      set first [lindex $all 0]
1204      set allPosition [lsearch -exact $all $firstSelected]
1205      while { $allPosition != 0 } {
1206        $self addPrevious
1207        #$self selection set $firstSelected
1208        set selected [$self selection get]
1209        set allPosition [lsearch -exact $all $firstSelected]
1210        if { $allPosition != 0 } {
1211          set firstSelected [lindex $all [expr $allPosition - 1]]
1212        }
1213      } 
1214      return [lindex $firstSelected]
1215    }
1216  }
1217
1218  #///////////////////////////////////////////////////////////////////////////
1219  method addAllNext {} {
1220  #
1221  # PURPOSE: Selects all the following rows
1222  #
1223  # RETURN: The index of the last row
1224  #
1225  #///////////////////////////////////////////////////////////////////////////
1226    set all [$self get]
1227    set selected [$self selection get]
1228    if {$selected == ""} {
1229      return -1
1230    } else  {
1231      set lastSelected [lindex $selected [expr [llength $selected] - 1] ]
1232      set last [lindex $all [expr [llength $all] - 1]] 
1233      set allPosition [lsearch -exact $all $lastSelected]
1234      while {$allPosition != [expr [llength $all] -1]} {
1235        $self addNext
1236        set selected [$self selection get]
1237        set lastSelected [lindex $selected [expr [llength $selected] - 1] ]
1238        set allPosition [lsearch -exact $all $lastSelected]
1239      }
1240      return $lastSelected
1241    }
1242  }
1243
1244  #///////////////////////////////////////////////////////////////////////////
1245  method clear {} {
1246  #
1247  # PURPOSE: deletes all nodes
1248  #
1249  #///////////////////////////////////////////////////////////////////////////
1250    foreach i [$self get] {
1251      if { 0 eq $i } { continue }
1252      $self delete $i
1253    }
1254  }
1255
1256  #///////////////////////////////////////////////////////////////////////////
1257  method size {} {
1258  #
1259  # PURPOSE: calculates the listbox size
1260  #
1261  #///////////////////////////////////////////////////////////////////////////
1262    return [$_listbox entry size root]
1263  }
1264
1265  #///////////////////////////////////////////////////////////////////////////
1266  method column { args } {
1267  #
1268  # PURPOSE: modifies a particular case of column -> column names
1269  #
1270  #///////////////////////////////////////////////////////////////////////////
1271    if { [lindex $args 0] eq "names" } {
1272      set names {}
1273      foreach col [lrange [$_listbox column list] 1 end] {
1274        lappend names [$_listbox column tag names $col]
1275      }
1276      return $names
1277    } elseif { [lindex $args 0] eq "configure" } {
1278      return [eval $_listbox column $args]
1279    } else {
1280      return [eval $_listbox column id $args]
1281    } 
1282  }
1283
1284  #///////////////////////////////////////////////////////////////////////////
1285  method filter { filters } {
1286  #
1287  # PURPOSE: filters the listbox elements matching filters for each col in cols
1288  #
1289  # PARAMETERS:
1290  #  filters: list of filters for the columns above
1291  #
1292  #///////////////////////////////////////////////////////////////////////////
1293    $self configure -flat no
1294    foreach inx [$self get] {
1295      set datos [$self get $inx $options(-filtercols)]
1296      set match 1
1297      for { set i 0 } { $i < [llength $filters] } { incr i } {
1298        set match [expr $match & [regexp [lindex $filters $i] [lindex $datos $i]]]
1299      }
1300      if { ! $match } {
1301        $_listbox hide $inx
1302      } else {
1303        $_listbox show $inx
1304      }
1305    }
1306    $self configure -flat yes
1307
1308  }
1309
1310  #///////////////////////////////////////////////////////////////////////////
1311  method _RemoveFilter { } {
1312  #
1313  # PURPOSE: filters the listbox elements matching filters for each col in cols
1314  #
1315  # PARAMETERS:
1316  #  filters: list of filters for the columns above
1317  #
1318  #///////////////////////////////////////////////////////////////////////////
1319    $_listbox configure -flat no
1320    $_listbox show all
1321    $_listbox configure -flat yes
1322  }
1323
1324  #///////////////////////////////////////////////////////////////////////////
1325  method icon { id icon } {
1326  #
1327  # PURPOSE: changes the icon for an entry identified by id
1328  #
1329  # PARAMETERS:
1330  #  id: the identificator of the entry
1331  #  icon: the icon image (must be 16x16
1332  #
1333  #///////////////////////////////////////////////////////////////////////////
1334    $_listbox entry configure $id \
1335      -icons [list [Bitmap::get $icon] [Bitmap::get $icon]]
1336  }
1337
1338  # delegacion de metodos y opciones
1339  delegate method * to _listbox
1340  delegate option * to _listbox
1341}
1342
1343package provide blistboxplus 1.0
1344
1345# ------- TEST CODE ----
1346
1347#/////////////////////////////////////////////////////////////////////////////
1348proc test_blistboxplus {} {
1349#
1350# PURPOSE: Funcion de test de un blistcontrol
1351#
1352#///////////////////////////////////////////////////////////////////////////// 
1353  # defining the widgets
1354  variable data
1355  set data(-selected) 1
1356 
1357  destroy .top
1358  toplevel .top -width 200 -height 100
1359   
1360  TitleFrame .top.f1 -text "BListBoxPlus test"
1361  set f1 [ .top.f1 getframe ]
1362  blistboxplus $f1.blb -cols { col1 col2 col3 col4 } -parent $f1 \
1363                    -height 150 -width 500 -orientation vertical \
1364                    -hiddencols {col4}
1365  $f1.blb insert end {1 2 3 4} {one two three four} {uno dos tres cuatro} \
1366                     {k kk kkk kkkk} {0 0 0 0} {@ # $ %}
1367 
1368  TitleFrame .top.f2 -text "Configure"
1369  set f2 [ .top.f2 getframe ]
1370  LabelEntry $f2.lei -width 5 -label Index -text 1
1371  LabelEntry $f2.lee -width 5 -label End
1372  LabelEntry $f2.lec -width 50 -label Content -text "{hay que introducir cada} \
1373     {fila entre corchetes y} {entre estos los items}"
1374  checkbutton $f2.cb -text "Allow multiple selection" \
1375    -command { toggleSelectModeCmd }
1376  $f2.cb select
1377  button $f2.bi -text "Insert" -command { insertCmd }
1378  button $f2.bd -text "Delete" -command { deleteCmd }
1379  button $f2.br -text "Reset" -command { resetCmd }
1380  $f2.bi configure -width 20
1381  $f2.bd configure -width 20
1382  # packing all
1383 
1384  grid .top.f1 -row 0 -column 0 -sticky "new" -padx 10 -pady 10
1385  grid .top.f2 -row 1 -column 0 -sticky "new" -padx 10 -pady 10
1386  grid columnconfigure .top 0 -weight 1
1387  grid rowconfigure .top 0 -weight 0
1388  grid rowconfigure .top 1 -weight 1
1389 
1390  grid $f1.blb -row 0 -column 0 -sticky "new"
1391  grid columnconfigure $f1 0 -weight 1
1392  grid rowconfigure $f1 0 -weight 1
1393
1394  grid $f2.lec -row 0 -column 0 -sticky "new" -columnspan 3
1395  grid $f2.lei -row 1 -column 0 -sticky "new"
1396  grid $f2.lee -row 1 -column 1 -sticky "new"
1397   
1398  grid $f2.cb  -row 1 -column 2 -sticky "new"
1399  grid $f2.bi  -row 2 -column 0 -sticky "new"
1400  grid $f2.bd  -row 2 -column 1 -sticky "new"
1401  grid $f2.br  -row 2 -column 2 -sticky "new"
1402  grid columnconfigure $f2 0 -weight 0
1403  grid columnconfigure $f2 1 -weight 0
1404  grid columnconfigure $f2 2 -weight 1
1405  grid rowconfigure $f2 0 -weight 0
1406  grid rowconfigure $f2 1 -weight 0
1407  grid rowconfigure $f2 2 -weight 0
1408
1409  puts "WIDGET blistboxplus: $f1.blb"
1410 
1411  # commands attached to the widgets
1412  proc insertCmd {} {
1413    eval .top.f1.f.blb insert [.top.f2.f.lei cget -text] \
1414                              [.top.f2.f.lec cget -text]
1415  }
1416 
1417  proc deleteCmd {} {
1418    .top.f1.f.blb delete [.top.f2.f.lei cget -text] \
1419                         [.top.f2.f.lee cget -text]
1420  }
1421 
1422  proc resetCmd {} {
1423    .top.f1.f.blb clear
1424    .top.f1.f.blb insert end {1 2 3 4} {one two three four} \
1425      {uno dos tres cuatro} {k kk kkk kkkk} {0 0 0 0} {@ # $ %}
1426  }
1427 
1428  proc toggleSelectModeCmd {} {
1429    if { [.top.f1.f.blb cget -selectmode] eq "multiple" } {
1430      .top.f1.f.blb configure -selectmode single
1431    } else {
1432      .top.f1.f.blb configure -selectmode multiple
1433    }
1434  }
1435}
1436
Note: See TracBrowser for help on using the repository browser.