source: tol/tolbase/lib/byswidget/bcomboboxplus/bcomboboxplus.tcl

devel
Last change on this file was 20907d9, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933
Se prescinde de BLT en algunos widgets.
Otros que no se han convertido se marcan como obsoletos.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7342 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 52.4 KB
RevLine 
[6d7779d]1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : bcomboboxplus.tcl
3# PURPOSE : Bayes Combobox Plus. Component that allows to select an element,
4#           showing a list with all the information that necesary to select
5#           it.
6#           Once selected, the obtained result is divided for its
7#           presentation in 1+n parts: one for the key field and n for
8#           fields that we wish to show. n can be zero.
9#/////////////////////////////////////////////////////////////////////////////
10
11package require byscommon
12package require blistboxplus
13package require bentrydate
14
15
16#/////////////////////////////////////////////////////////////////////////////
17::snit::widget bcomboboxplus {
18#
19# PURPOSE: Bayes Combobox Plus. Allows to choose an element of a list.
20#
21#/////////////////////////////////////////////////////////////////////////////
22# SPECIFIC OPTIONS
23# colkey ->       Key column of comboboxplus. If it is not defined,
24#                 the first column is taken like key.
25# cols ->         List of columns of the comboboxplus. Including hidden
26#                 columns. Required.
27# hiddencols ->   Hidden columns of the comboboxplus. If it is not defined,
28#                 all columns are visible.
29# titles ->       Title of each one of labels in the comboboxplus.
30# colslb ->       Columns of the listboxplus, including the hidden columns.
31#                 If it is not defined, is taken the value of -cols.
32# hiddencolslb -> Hidden columns of the listboxplus. If it is not defined,
33#                 all columns are visible.
34# parent ->       Indicates the father where comboboxplus is located. If it
35#                 is not defined, the parent is .
36# showlabelkey -> If it has value 1 it shows label of the key on
37#                 bcomboboxplus. Default 0.
38# showlabels ->   If it has value 1 it shows the labels of not hidden fields
39#                 that hasn't the key. Default 0.
40# width ->        Width of entrys. Can be a list or a value (all entrys
41#                 will have the same width). Default 10.
42# keyhelptext ->  List of helptext that is showed when the mouse is over the
43#                 entry of the key.
44# helptexts ->    List of helptext that is showed when the mouse is over the
45#                 entrys of the fields.
46# modifycmd ->    Command to execute after selecting an item.
47# postcommand ->  Command to execute before showing the list.
48# color ->        Colour of the labels (red, blue, etc.). Default "black".
49# nrows ->        Number of visible rows of blistboxplus.
50# variable ->     Variable with text of entry key
51# text ->         Text of the entry of the key field.
52# widthlb ->      Width of the pop-up blistboxplus. Default 350. If has a
53#                 value "auto" it autoadjust to width of entry of the key.
54# keydate ->      If has a value 1, the widget of the key will be a
55#                 bentrydate instead of an Entry. This option only can be set
56#                 on creation time.
57# fieldsdate ->   Takes a list that for each field of bcomboboxplus, if has a
58#                 value 1, the widget of this field will be abentrydate
59#                 instead of an Entry. This option only can be set on
60#                 creation time.
61# font ->         Font used in the widget. Is a list with the name and the
62#                 size of the font.
63# varcol ->       Name of the field whose entry will be associated the
64#                 variable defined in the option -variable. If it's empty,
65#                  this variable will be associated to the entry of the key.
66# keypress ->     Activates the search by pressed keys
67# colkeypress ->  Column by which the search when pressing is made a key
68#
69# VARIABLES
70# lblKey ->           Label next to key field.
71# entryKey ->         Entry that content the key field.
72# arrowBtn ->         Arrow button.
73# created ->          Indicates if witget has been created.
74# fr ->               Pop-up frame with blistboxplus.
75# in ->               It takes a value 1 if the cursor is located in the
76#                     pop-up frame of listbox.
77# ncols ->            Number of columns.
78# colGrid($widget) -> Array with column where was grided the widget $widget.
79# e ->                Array of entrys (or bentrydates) of the fields
80# blstentry    -> lista de objetos entry visualizados
81#
82#/////////////////////////////////////////////////////////////////////////////
83  widgetclass Bcomboboxplus
84
85  option -titles       {}
86  option -cols         {}
87  option -hiddencols   {}
88  option -colslb       {}
89  option -hiddencolslb {}
90  option -parent       .
91  option -showlabelkey 0
92  option -showlabels   0
93  option -colkey       ""
94  option -width        10
95  option -keyhelptext  ""
96  option -helptexts    ""
97  option -modifycmd    ""
98  option -postcommand  ""
99  option -color        {Black}
100  option -nrows        5
101  option -widthlb      350
102  option -variable     ""
103  option -text         ""
104  option -keydate      0
105  option -fieldsdate   {}
106  option -font         {Arial 8}
107  option -varcol       ""
108  option -keypress     true
109  option -colkeypress  ""
110     
111  variable lblKey
112  variable entryKey
113  variable arrowBtn
114  variable menu 
115  variable lstBox
116  variable created 0 
117  variable fr
118  variable in
119  variable e
120  variable ncols 0 
121  variable helptexts
122  variable colGrid
123  variable varKey ""
124  variable blstentry {}
125  variable vez 0
126  variable lstPreVal {}
127  variable idxFind {}
128  variable valBusqueda ""
129 
130
131  #///////////////////////////////////////////////////////////////////////////
132  constructor {args} {
133  #
134  # PURPOSE: Constructor for bcomboboxplus.
135  #
136  # PARAMETERS:
137  #   args ->  List of options for comboboxplus
138  #
139  #///////////////////////////////////////////////////////////////////////////
140    $self configure  -font       [from args -font ""]
141    install lblKey    using Label        $self.lk -font [$self cget -font]     
142    install arrowbtn  using ArrowButton  $self.ab -dir bottom
143   
144    $self configure -keypress    [from args -keypress  true]
145    $self configure -colkeypress [from args -colkeypress ""]   
146    $self configure -keydate     [from args -keydate ""]
147    $self configure -fieldsdate  [from args -fieldsdate ""]
148    $self configure -cols        [from args -cols ""]
149    $self configure -colkey      [from args -colkey ""]
150    $self configure -widthlb     [from args -widthlb ""]
151    $self configure -width       [from args -width ""]
152
153    $self configure -keyhelptext [from args -keyhelptext ""]
154    $self configure -helptexts   [from args -helptexts ""]
155    $self configure -color       [from args -color ""]
156    $self configure -modifycmd   [from args -modifycmd ""]
157    $self configure -postcommand [from args -postcommand ""]   
158    $self configure -nrows       [from args -nrows ""]
159    $self configure -variable    [from args -variable ""]
160    $self configure -varcol      [from args -varcol ""]
161
162    # Create the widget
163    $self createwidget $args
164    $self configure -colslb       [from args -colslb ""]
165    $self configure -text         [from args -text ""]
166    $self configure -showlabels   [from args -showlabels ""]
167    $self configure -showlabelkey [from args -showlabelkey ""]
168    $self configure -titles       [from args -titles ""]
169
170    # Apply all arguments given:
171    $self configurelist $args
172   
173    # Widget is now created
174    set created 1
175   
176    # initializes the widget
177    $self _Init
178  }
179
180  #///////////////////////////////////////////////////////////////////////////
181  #
182  # PURPOSE: Methods cget & configure
183  #
184  #///////////////////////////////////////////////////////////////////////////   
185  onconfigure -width { lst } {   
186    if {[llength $lst]} { ;# 1 item
187    set aux $lst
188      for {set c 1} {$c<$ncols} {incr c} {
189        set lst [concat $lst $aux]
190      }
191    }
192    set options(-width) $lst
193    # Widget created
194    if {$created} {
195      $self.ek configure -width [lindex [$self cget -width ] [$self _PosKey]]       
196      #width of fields labels
197      for {set c 0} {$c<$ncols} {incr c} {
198        set name [lindex [$self cget -cols ] $c]
199        $e($name) configure -width [lindex [$self cget -width ] $c]       
200      }
201    }
202  }
203 
204
205  onconfigure -colkey { value } {
206    if {$value eq ""} {
207      set value [lindex [$self cget -cols] 0]
208    }
209    set options(-colkey) $value
210    # Widget created
211    if {$created == 1} {
212      set lbrow [$lstBox selection get]
213      # the selection now doesn't exists in blistboxplus
214      if {$lbrow != ""} {       
215        set selected [$lstBox get $lbrow]
216      }
217      # Updates the label and entry for the key field
218      $self.lk configure -text [lindex [$self cget -titles ] [$self _PosKey]]     
219      if { [$self.ek cget -text] != "" } {
220        if {$lbrow != ""} {
221          $self.ek configure -text  [lindex $selected [$self _PosKey]]
222        } else  {
223          # Imposible to update from blistboxplus
224          $self.ek configure -text  ""
225        }
226      }
227      # Updates other fields
228      for {set c 0} {$c<$ncols} {incr c} {
229        set name [lindex [$self cget -cols ] $c]
230        if {$lbrow != ""} {
231          $e($name) configure -text  [lindex $selected $c]
232        } else  {
233          # Imposible to update from blistboxplus
234          $e($name) configure -text  ""
235        }
236        # Grid this field
237       
238        grid $self.l$name
239        if { $name eq [lindex [$self cget -cols ] [$self _PosKey]]} {
240          #grid $self.e$name -sticky {}
241        } else {
242          grid $e($name) -sticky ew
243          grid columnconfigure $self $colGrid($e($name)) -weight 1
244        }
245      }
246      # Hides the field of the key in the other fields 
247      set name [lindex [$self cget -cols ] [$self _PosKey]]
248      grid remove $self.l$name
249      grid remove $e($name)
250      grid columnconfigure $self $colGrid($e($name)) -weight 0
251      $self configure -hiddencols [$self cget -hiddencols]
252    }
253  }
254   
255  onconfigure -titles { lst } {
256    set options(-titles) $lst
257    if {!($lst eq "")} {
258      # Configures the title of key field
259      $self.lk configure -text [lindex [$self cget -titles ] 0]
260      # Configures the rest of titles
261      for {set c 0} {$c<$ncols} {incr c} {
262        set name [lindex [$self cget -cols ] $c]
263        set shown [winfo exist $self.l$name]
264        if { $shown == 1 } {
265          $self.l$name configure -text [lindex [$self cget -titles ] $c]
266        }
267      }
268      $lstBox configure -titles $lst
269    }
270  }
271
272  onconfigure -cols { lst } {
273    set options(-cols) $lst
274    # Establishes the number of columns
275    set ncols [llength [$self cget -cols]]
276  }
277
278  onconfigure -hiddencols { lst } {
279    set options(-hiddencols) $lst
280    for {set c 0} {$c<$ncols} {incr c} {
281      if { $c != [$self _PosKey] } {
282        set aux [expr $c + 1]
283        set name [lindex [$self cget -cols ] $c]
284        set fieldCreated [lsearch -glob [grid slaves $self] $e($name)]
285        set hidden [lsearch -glob [$self cget -hiddencols ] $name]
286        if { $fieldCreated == "-1" } {
287          # Shows this field
288          grid $e($name)
289          grid columnconfigure $self $colGrid($e($name)) -weight 1
290          grid $self.l$name
291        }
292        if { $hidden != "-1" } {
293          # Hiddes this field
294          grid remove $e($name)
295          grid columnconfigure $self $colGrid($e($name)) -weight 0
296          grid remove $self.l$name
297        }
298      }
299    }
300    $self configure -showlabels [$self cget -showlabels]
301  }
302
303  onconfigure -showlabels { value } {
304    set options(-showlabels) $value
305    # Show labels
306    if { $value == 0 } {
307      # Show labels off
308      for {set c 0} {$c<$ncols} {incr c} {
309        if {$c != [$self _PosKey]} {
310          set name [lindex [$self cget -cols ] $c]
311          set exists [winfo exist $self.l$name]
312          if { $exists == 1 } {               
313            grid remove $self.l$name
314          }
315        }
316      }
317    } else {
318      # Show labels on
319      for {set c 0} {$c<$ncols} {incr c} {
320        if {$c != [$self _PosKey]} {
321          set name [lindex [$self cget -cols ] $c]
322          set exists [winfo exist $self.l$name]
323          if { $exists == 1 } {
324            set hidden [lsearch -glob [$self cget -hiddencols ] $name]
325            if { $hidden == -1 } {
326              grid $self.l$name
327            } else  {
328              grid remove $self.l$name
329            }
330          }
331        }
332      }
333    }
334  }
335
336  onconfigure -showlabelkey { value } {
337    set options(-showlabelkey) $value
338    if { $value == 0 } {
339      # Show label key off
340      grid remove $self.lk
341    } else {
342      # Show label key on       
343      grid $self.lk
344    }
345  }
346   
347  onconfigure -colslb { lst } {
348    if {$lst eq ""} {
349      set lst [$self cget -cols]
350    }
351    set options(-colslb) $lst
352    if { $created == 1 } {
353      $self _ShowList
354      $lstBox configure -cols $lst
355      $self _CloseList
356    } else  {
357      $lstBox configure -cols $lst
358    }
359  }
360
361  onconfigure -hiddencolslb { lst } {
362    set options(-hiddencolslb) $lst
363    if { $created == 1 } {
364      #$self _ShowList
365      eval $lstBox configure -hiddencols \
366        [lappend [$self cget -hiddencolslb] $lst]
367      #$self _CloseList
368    } else  {
369      eval $lstBox configure -hiddencols \
370        [lappend [$self cget -hiddencolslb] $lst]
371    }
372  }   
373
374  onconfigure -keyhelptext { value } {
375    set options(-keyhelptext) $value
376  }   
377
378  onconfigure -helptexts { lst } {
379    set options(-helptexts) $lst
380  }
381
382  onconfigure -color { value } {
383    set options(-color) $value
384  }
385
386  onconfigure -modifycmd { lst } {
387    set options(-modifycmd) $lst
388  }
389
390  onconfigure -postcommand { lst } {
391    set options(-postcommand) $lst
392  }
393   
394  onconfigure -nrows { value } {
395    set options(-nrows) $value
396  }
397   
398  onconfigure -widthlb { value } {
399    set options(-widthlb) $value
400  }
401
402  onconfigure -variable { value } {
403    if { $created == 1 } {
404      puts "Bcomboboxplus onconfigure -variable error: this option only\
405            can be configured on creation time."
406    } else {
407      if {[llength value] eq 0} {
408        # default value
409        set options(-variable) [varname varKey]   
410      } else {
411        set options(-variable) $value
412      }
413    }
414  }
415
416  onconfigure -text { value } {
417    set options(-text) $value
418    if { $created == 1 } {
419      $self.ek configure -text $value
420    }
421  }
422 
423  onconfigure -keydate { value } {
424    if { $created == 1 } {
425      puts "Bcomboboxplus onconfigure -keydate error: this option only can\
426            be configured on creation time."
427    } else {
428      set options(-keydate) $value     
429    }
430  }
431 
432  onconfigure -fieldsdate { lst } {
433    if { $created == 1 } {
434      puts "Bcomboboxplus onconfigure -fieldsdate error: this option only\
435            can be configured on creation time."
436    } else {
437      set options(-fieldsdate) $lst     
438    }
439  }
440 
441  onconfigure -varcol { value } {
442    if { $created == 1 } {
443      puts "Bcomboboxplus onconfigure -varcol error: this option only\
444            can be configured on creation time."
445    } else {
446      if {$value eq ""} {
447        # by default gives the -colkey option value
448        set options(-varcol) "key"
449      } else {
450        if { [lsearch -exact [$self cget -cols ] $value ] eq -1 } {
451          puts "Bcomboboxplus onconfigure -varcol error: the argument given \
452                '$value' must be a valid column."
453        } else {
454          set options(-varcol) $value
455        }
456      }
457    }   
458  }
459
460  #///////////////////////////////////////////////////////////////////////////
461  method createwidget { args } {
462  #
463  # PURPOSE: Creation of the objects that compose the widget.
464  #
465  # PARAMETERS:
466  #   args -> List of options for the bcomboboxplus.
467  #
468  #///////////////////////////////////////////////////////////////////////////
469    global tcl_platform
470    update
471    set blstentry {}
472    set colAct 0
473    # Creates the label, entry and arrowbutton for the key field
474    $self.lk configure -text [lindex [$self cget -titles ] [$self _PosKey]] \
475                       -helptext [$self cget -keyhelptext ] \
476                       -foreground [$self cget -color ]
477    # entryKey gives the type of widget set in option -keydate
478    if {[$self cget -keydate]} {
479      set entryKey  [bentrydate $self.ek ]
480    } else {
481      set entryKey  [Entry $self.ek -takefocus 1 -font [$self cget -font]]
482    }
483    lappend blstentry $entryKey
484    grid $self.lk -row 0 -column $colAct
485    incr colAct
486    grid $self.ek -row 0 -column $colAct -sticky ew
487    set colGrid($self.ek) $colAct
488
489    $self.ek configure -width [lindex [$self cget -width ] [$self _PosKey]]
490    $self.ek configure -helptext [$self cget -keyhelptext ]
491    grid columnconfigure $self $colAct -weight 1
492    incr colAct
493    $self.ab configure -helptext [mc "List of values"] \
494            -command [list $self _ShowList] -height 20 -highlightthickness 0 \
495            -borderwidth 1 -takefocus 0 -type button -ipadx 1
496    grid $self.ab -row 0 -column $colAct   
497    incr colAct   
498    # Creates labels and entrys for all fields
499    incr colAct
500    for {set c 0} {$c<$ncols} {incr c} {
501      set name [lindex [$self cget -cols ] $c]       
502      # Creates a label 
503      install l$name using Label $self.l$name -font  [$self cget -font] \
504                                        -foreground [$self cget -color ]
505      $self.l$name configure -text [lindex [$self cget -titles ] $c]
506      $self.l$name configure -helptext [lindex [$self cget -helptexts ] $c]
507      grid $self.l$name -row 0 -column $colAct   
508      incr colAct
509       
510      # Creates an entry
511      if { [info exist [lindex [$self cget -fieldsdate] $c] ] eq 0 } {
512        if { [ lindex [$self cget -fieldsdate] $c ] eq 1 } {         
513          set e($name) [bentrydate $self.ed$name]
514        } else {
515          set e($name) [Entry $self.en$name -font [$self cget -font] ]         
516        }
517      } else {
518        set e($name) [Entry $self.en$name -font  [$self cget -font] ]
519      }
520      lappend blstentry $e($name)
521     
522      set aux [$self cget -width ]
523      $e($name) configure -width [lindex [$self cget -width ] $c]
524      $e($name) configure -helptext [lindex [$self cget -helptexts ] $c]
525     
526      grid $e($name) -row 0 -column $colAct -sticky ew
527      grid columnconfigure $self $colAct -weight 1
528      set colGrid($e($name)) $colAct
529      incr colAct       
530    }
531    #Set the variable for the field of varname
532    if { !([$self cget -variable] eq "") } {
533      set varn [$self cget -variable ]
534      if { [$self cget -varcol ] eq "key" } {
535        # variable is set to the entry of the key
536        $self.ek configure -textvariable $varn
537      } else {
538        # variable is set to another entry
539        $e([$self cget -varcol ]) configure -textvariable $varn                                     
540      }
541    }
542    #Remove the label and entry on the fields
543    set name [lindex [$self cget -cols ] [$self _PosKey]]
544    grid remove $self.l$name
545    grid remove $e($name)
546    grid columnconfigure $self $colGrid($e($name)) -weight 0
547    #Top-level pull-down
548    set fr [toplevel $self.fr -borderwidth 0 -relief solid \
549            -highlightthickness 0 -takefocus 0 -bd 1 ]
550    wm withdraw $fr
551    if { [string equal $tcl_platform(platform) "windows"] } {
552      update idletasks
553    }
554    wm overrideredirect $fr 1
555    wm transient $fr [winfo toplevel $self]
556    wm withdraw  $fr
557    wm resizable $fr 0 0
558 
559    # width of the listboxplus
560    set wlb 0
561    for {set c 0} {$c < [llength $aux]} {incr c 1} {
562      set name [lindex [$self cget -cols ] $c]
563      set hidden [lsearch -glob [$self cget -hiddencols ] $name]
564      if {$hidden == -1} {
565        set wlb [expr $wlb + [lindex $aux $c ]  ]
566      }
567    }
568    set lstBox [blistboxplus $fr.blb -cols [ $self cget -colslb ] \
569            -hiddencols [ $self cget -hiddencolslb ] -parent $self \
570            -orientation vertical -selectmode single\
571            -width $wlb -font [$self cget -font] \
572            -exportselection false -border 0 -height 0 -nomenu 1]
573 
574    pack $lstBox -side top -fill both -expand yes
575    #grid $lstBox -sticky news
576    set in 1;
577    bind $fr <Enter> +[list $self _Enter]
578    bind $fr <Leave> +[list $self _Leave]
579    bind $fr <ButtonPress-1>    +[list $self _Hide ]
580    bind $fr <KeyPress-Escape>  +[list $self _Hide ]
581    set lb [$lstBox getlb]
582    bind $lb <Double-Button-1>  +[list $self _CloseList]
583    bind $lb <KeyPress-Return>  +[list $self _CloseList]
584    # Bindings
585    bind $self.ek <Key-Up>                +[list $self _SelectPrevious]
586    bind $self.ek <Key-Down>              +[list $self _SelectNext]
587    bind $self.ek <Key-Home>              +[list $self _SelectFirst]
588    bind $self.ek <Key-End>               +[list $self _SelectLast]
589    bind $self.ek <Double-ButtonPress-1>   [list $self _ShowList]
590    # menu
591    $self _CreateMenu
592  }
593
594
595  #///////////////////////////////////////////////////////////////////////////
596  method _CreateMenu {args} {
597  #
598  # PURPOSE: Append menu to listbox.
599  #
600  #///////////////////////////////////////////////////////////////////////////
601    install menu using menu $self.m -tearoff 0
602
603    $menu add command -label [mc "Select from a List"] \
604      -command "$self _ShowList"
605    $menu add command -label [mc "Unselect all"] \
606      -command "$self SetValueView {}"
607    $menu add command -label [mc "Copy"] \
608      -command "$self _CopySelected 0"
609    $menu add command -label [mc "Copy all"] \
610      -command "$self _CopySelected 1"
611   
612    $menu add command -label [mc "Search in list"] \
613      -command "$self _FindCreate"
614
615   
616   
617    bind $self.ek <Button-3> +[list tk_popup $menu %X %Y]
618  }
619 
620
621  #///////////////////////////////////////////////////////////////////////////
622  method _CopySelected { {all 0} } {
623  #
624  # PURPOSE: Copy the selected items to the clipboard
625  #
626  # PARAMETERS: all -> 1 : Copy all entrys
627  #                    0 : Copy only code
628  #
629  #///////////////////////////////////////////////////////////////////////////
630    clipboard clear
631    if {$all} {
632      set txt [$self values get]
633    } else {
634      set txt [$self values get [$self cget -colkey]]
635    }
636    clipboard append $txt
637  }   
638 
639 
640  #///////////////////////////////////////////////////////////////////////////
641  method _Init {} {
642  #
643  # PURPOSE: Method that initializes the widget.
644  #
645  #///////////////////////////////////////////////////////////////////////////
646    global tcl_platform
647   
648    if { ($tcl_platform(platform) eq "windows") } {
649      $self _ShowList 1   
650      $self _CloseList 1
651    }
652  }
653
654  #///////////////////////////////////////////////////////////////////////////
655  method _Enter { } {
656  #
657  # PURPOSE: Give value to the variable "in" when enter on frame of
658  #          listboxplus.
659  #
660  #///////////////////////////////////////////////////////////////////////////
661    set in 1
662  }
663       
664  #///////////////////////////////////////////////////////////////////////////
665  method _Leave { } {
666  #
667  # PURPOSE: Give value to the variable "in" when left on frame of
668  #          listboxplus.
669  #
670  #///////////////////////////////////////////////////////////////////////////
671    set in 0
672  }
673
674  #///////////////////////////////////////////////////////////////////////////
675  method _ShowList { {initial 0} } {
676  #
677  # PURPOSE: Shows the selection list in a new window
678  #
679  # PARAMETERS:
680  #   args -> List of options for the comboboxplus Witget
681  #
682  # TODO:
683  #   Leave creation of the widget to the CreateWitget method. This method
684  #   only shows, not create it.
685  #
686  #///////////////////////////////////////////////////////////////////////////
687    # ejecutamos comando previo a la visulizacion
688    if {[string length [$self cget -postcommand]  ] && $created} {
689      . configure -cursor watch
690      update
691      if {!$initial} {       
692        eval [$self cget -postcommand]
693      }
694      . configure -cursor ""
695      update
696    }
697    ;# if blistboxplus hasn't items, will not do show it
698    if { $created } {         
699      if {[winfo viewable $fr] == 1} {
700        wm withdraw $fr
701        grab release $fr
702      } else {
703        set vwidth [winfo reqwidth $fr]
704        set vheight [winfo reqheight $fr]
705        if {!([llength [$lstBox get]] eq 0)} {
706          wm deiconify $fr
707          #geometry
708          focus -force $fr
709          grab -global $fr
710        }
711      }
712      # Positioning the dialog
713      set posh [winfo rootx $self.ek] 
714      set posv [expr [winfo rooty $self.ek]+[winfo height $self.ek]]
715      # position of the right edge of listboxplus
716      set right [expr $posh + [winfo width $fr]]
717      # position of the inferior edge of listboxplus
718      set bottom [expr $posv + [winfo height $self.ek] \
719                             + [winfo height $fr]]
720      if { $right > [winfo vrootwidth $self] } {
721        #It is necessary to change the horizontal location
722          set posh [expr [winfo rootx $self.ek] + [winfo width $self.ek] \
723                                                     - [winfo width $fr] ]
724      }   
725      if { $bottom > [winfo vrootheight $self] } {
726        #It is necessary to change the vertical location
727        set posv [expr [winfo rooty $self.ek] - [winfo height $fr] ]
728      }
729      if {[$self cget -widthlb] eq "auto"} {
730        set width [winfo width $self.ek]
731      } else {
732        set width [$self cget -widthlb]
733      }
734      $lstBox configure -width $width
735      # Calculus of the height of blistboxplus
736      # Adjustment do not leave rows
737      set nVisibleRows [$self cget -nrows]   
738      set nRows [llength [$lstBox get]]
739      if {$nRows < $nVisibleRows} {
740        set nVisibleRows $nRows
741      }
742      # Adjustment of the height of listbox with/without title
743      if {[$self cget -showtitles]} {
744        set height \
745          [expr ($nVisibleRows * 19) + (($nVisibleRows - 1) * 2 ) + 22]
746      } else  {
747        set height \
748          [expr ($nVisibleRows * 19) + (($nVisibleRows - 1) * 2 ) + 2 ]
749      }
750      # Apply geometry
751      wm geometry $fr ${width}x$height+$posh+$posv
752      # check value previus ?
753      if {!$initial} {         
754        focus [$lstBox getlb]     
755        set lstPreVal [$self values get]
756        if {[string length [lindex $lstPreVal 0]]} {
757          lbOnKeyPress $lstBox \
758                       [string range [lindex $lstPreVal 0] end end] \
759                       [string range [lindex $lstPreVal 0] 0   end-1] \
760                       [clock clicks -milliseconds] 500
761        } else {
762          set id [lindex [$lstBox get] 0]
763          # we positioned ourselves in the first element
764          if {[string length $id]} {
765            $lstBox selection set $id
766            $lstBox see   $id
767             $lstBox focus $id
768          }
769        }
770      }
771    }
772    update
773  }
774
775  #///////////////////////////////////////////////////////////////////////////
776  method _CloseList { {initial 0} } {
777  #
778  # PURPOSE: Closes the selection list
779  #
780  #
781  #///////////////////////////////////////////////////////////////////////////
782    wm withdraw $fr
783    grab release $fr
784    if {$in == 1 } {
785      $self _ShowSelected
786    }
787    if {[string length [$self cget -modifycmd] ] && $created } {
788      . configure -cursor watch
789      update
790      if {!$initial} {     
791        eval [$self cget -modifycmd]
792      }
793      . configure -cursor ""
794      update
795    }
796    update
797  }
798
799  #///////////////////////////////////////////////////////////////////////////
800  method _Hide { } {
801  #
802  # PURPOSE:
803  #
804  #
805  #///////////////////////////////////////////////////////////////////////////
806    if {$in == 0 } {
807      wm withdraw $fr
808      grab release $fr
809    }
810  }
811
812  #///////////////////////////////////////////////////////////////////////////
813  method _ShowSelected { } {
814  #
815  # PURPOSE: Shows in bcomboboxplus the content of the row selected in
816  #          blistboxplus
817  #
818  #///////////////////////////////////////////////////////////////////////////
819    # Recover the row selected of blistboxplus
820    set lbrow [$lstBox selection get]
821    if {$lbrow != ""} {
822      # Recover the selected values
823      set selected [$lstBox get $lbrow]     
824      # Show the key value
825      $self.ek configure -text [lindex $selected [$self _PosKey]]
826      $self configure -text [lindex $selected [$self _PosKey]]
827      # Show the not hidden values
828      for {set c 0} {$c<$ncols} {incr c} {
829        if {$c != [$self _PosKey]} {
830            set name [lindex [$self cget -cols ] $c]
831          $e($name) configure -text  [lindex $selected $c]
832        }
833      }
834    }
835  }
836
837  #///////////////////////////////////////////////////////////////////////////
838  method selectIndex { index } {
839  #
840  # PURPOSE: Selects index in blistboxplus and shows the content in
841  #          bcomboboxplus
842  #
843  #///////////////////////////////////////////////////////////////////////////
844    #Index is got
845    set lbinx [$lstBox get]
846    #if the index is in the indexes list
847    if { [lsearch $lbinx $index ] != -1 } {
848      #first index
849      set first [lindex $lbinx 0]
850      #last index
851      set last [lindex $lbinx end]
852      #The previous selection is cleared
853      $lstBox selection clear $first $last
854      #And the new one is set
855      $lstBox selection set $index $index
856      $self _ShowSelected
857    }
858  }
859   
860  #///////////////////////////////////////////////////////////////////////////
861  method selectText { text { col "" } } {
862  #
863  # PURPOSE: Selects index with the given text in the given col in blistboxplus
864  #          and shows the content in bcomboboxplus
865  # PARAMETERS: text -> Text to search
866  #             col ->  column to search in
867  #
868  #///////////////////////////////////////////////////////////////////////////
869    if { $col == "" } {
870      set col [$self cget -colkey]
871    }
872    foreach inx [$self get] {
873      if { [$self get $inx $col] == $text } {
874        $self selectIndex $inx
875        break
876      }
877    }
878  }
879
880  #///////////////////////////////////////////////////////////////////////////
881  method _SelectFirst { } {
882  #
883  # PURPOSE: Selects the first row in blistboxplus and it automatically
884  #          updates it in bcomboboxplus
885  #
886  #///////////////////////////////////////////////////////////////////////////
887    if {[$self.ek cget -text] != ""} {
888      $lstBox first
889      $self _ShowSelected
890    }
891  }
892
893  #///////////////////////////////////////////////////////////////////////////
894  method _SelectLast { } {
895  #
896  # PURPOSE: Selects the last row in blistboxplus and it automatically
897  #          updates it in bcomboboxplus
898  #
899  #///////////////////////////////////////////////////////////////////////////
900    if {[$self.ek cget -text] != ""} {
901      $lstBox last
902      $self _ShowSelected
903    }
904  }
905   
906  #///////////////////////////////////////////////////////////////////////////
907  method _SelectPrevious { } {
908  #
909  # PURPOSE: Selects the previous row in blistboxplus and it automatically
910  #          updates it in bcomboboxplus
911  #
912  #///////////////////////////////////////////////////////////////////////////
913    if {[$self.ek cget -text] != ""} {
914      $lstBox previous
915      $self _ShowSelected
916    }
917  }
918       
919  #///////////////////////////////////////////////////////////////////////////
920  method _SelectNext { } {
921  #
922  # PURPOSE: Selects the following row in blistboxplus and it automatically
923  #          updates it in bcomboboxplus
924  #
925  #///////////////////////////////////////////////////////////////////////////
926    if {[$self.ek cget -text] != ""} {
927      $lstBox next
928      $self _ShowSelected
929    }
930  }
931
932  #///////////////////////////////////////////////////////////////////////////
933  method key { id {value ""} } {
934  #
935  # PURPOSE: Set the value of entry of the key, get the value of entry of
936  #          the key or clean this entry
937  #
938  # PARAMETERS:
939  #   id -> "set"
940  #         "get"
941  #         "clean"
942  #   value -> Value of the key for set operation
943  #
944  # RETURN: If id is "get" returns the value of the key entry
945  #
946  #///////////////////////////////////////////////////////////////////////////
947    if { $id eq "set" } {
948      $self.ek configure -text $value
949    } else {
950      if { $id eq "get" } {
951        return [$self.ek cget -text]
952      } else {
953        if { $id eq "clean" } {
954          $self.ek configure -text ""
955        }
956      }
957    }
958  }
959
960  #///////////////////////////////////////////////////////////////////////////
961  method values { id {lst ""} } {
962  #
963  # PURPOSE: Set the values of the entrys (excluding the key), get or clean
964  #
965  # PARAMETERS:
966  #   id -> "set"
967  #         "get"
968  #         "clean"
969  #   lst -> List of values of the entrys for set operation
970  #
971  # RETURN: If id is "get" returns the list with values of the entrys
972  #
973  #///////////////////////////////////////////////////////////////////////////
974    if { $id eq "set" } {
975      $self values clean
976      for {set c 0} {$c<$ncols} {incr c} {
977        set name [lindex [$self cget -cols ] $c]
978        $e($name) configure -text [lindex $lst $c]
979      }
980    } else {
981      if { $id eq "get" } {
982        if {[llength $lst] eq 1} { ;# returns a value
983          set lstAux ""
984          for {set c 0} {$c<$ncols} {incr c} {
985            set name [lindex [$self cget -cols ] $c]
986            if {[string compare $name $lst] eq 0} {
987                set lstAux [$e($name) cget -text]
988            }           
989          }
990          if { $lstAux eq "" } {
991             set lstAux [$self.ek cget -text]
992          }
993          set lst $lstAux
994        } else { ;# returns all values
995          set lst ""
996          for {set c 0} {$c<$ncols} {incr c} {
997            set name [lindex [$self cget -cols ] $c]
998            if { [$e($name) cget -text] eq "" } {
999              lappend lst [$self.ek cget -text]
1000           } else {
1001              lappend lst [$e($name) cget -text]
1002            }
1003          }
1004        }
1005        return $lst
1006      } else {
1007        if { $id eq "clean" } {
1008          for {set c 0} {$c<$ncols} {incr c} {
1009            set name [lindex [$self cget -cols ] $c]
1010            $e($name) configure -text ""
1011          }           
1012        }
1013      }
1014    }
1015  }
1016 
1017  #///////////////////////////////////////////////////////////////////////////
1018  method setEntry { name value } {
1019  #///////////////////////////////////////////////////////////////////////////
1020    if {$name eq [$self cget -colkey]} {
1021      $self.ek configure -text $value
1022    }
1023    $e($name) configure -text $value
1024  }
1025   
1026  #///////////////////////////////////////////////////////////////////////////
1027  method configureAll {opc val args} {
1028  #
1029  # PURPOSE: An option is applied all entry, including a the key
1030  #
1031  # PARAMETERS:
1032  #   opc: Option to apply
1033  #   val: Value associated to the option
1034  #
1035  #///////////////////////////////////////////////////////////////////////////
1036    # Values to entry of the key are introduced
1037    $self.ek configure -$opc $val   
1038    # Values to the rest of entrys are introduced
1039    for {set c 0} {$c<$ncols} {incr c} {
1040       set name [lindex [$self cget -cols ] $c]
1041       $e($name) configure -$opc $val
1042    }
1043  }
1044   
1045   
1046  #///////////////////////////////////////////////////////////////////////////
1047  method configureDesc {opc val args} {
1048  #
1049  # PURPOSE: We applied an option all entry, less to the key
1050  #
1051  # PARAMETERS:
1052  #   opc: Option to apply
1053  #   val: Value associated to the option
1054  #
1055  #///////////////////////////////////////////////////////////////////////////
1056    # Values are introduced
1057    for {set c 0} {$c<$ncols} {incr c} {
1058        set name [lindex [$self cget -cols ] $c]
1059        $e($name) configure -$opc $val
1060    }
1061  }
1062   
1063  #///////////////////////////////////////////////////////////////////////////
1064  method getEntryKey { } {
1065  #
1066  # PURPOSE: Returns the path to the entry with the key
1067  #
1068  #///////////////////////////////////////////////////////////////////////////
1069    return $self.ek
1070  }
1071
1072  #///////////////////////////////////////////////////////////////////////////
1073  method _PosKey { } {
1074  #
1075  # PURPOSE: Devuelve la posicion en la que se encuentra la clave dentro de
1076  #          la lista de columnas del bcomboboxplus
1077  #
1078  # RETURNS:
1079  #   Devuelve la posicion en la que se encuentra la clave
1080  #
1081  #///////////////////////////////////////////////////////////////////////////
1082     return [lsearch -glob [$self cget -cols] [$self cget -colkey]]
1083  }
1084       
1085  #///////////////////////////////////////////////////////////////////////////
1086  method activate {stt args} {
1087  #
1088  # PURPOSE: Aplicamos una opción a los elemetos del componente. Por un lado
1089  #          al entry del código, al botón y al resto de campos entry.
1090  #
1091  # PARAMETERS:
1092  #   stt: opción a aplicar
1093  #     normal    -> Code (yes) Button (no)  Desc (no)
1094  #     active    -> Code (yes) Button (no)  Desc (yes)
1095  #     select    -> Code (no)  Button (yes) Desc (no)
1096  #     disabled  -> Code (no)  Button (no)  Desc (yes)
1097  #     notactive -> Code (no)  Button (no)  Desc (no)
1098  #     allactive -> Code (yes) Button (yes) Desc (yes)
1099  #     descnoedit-> Code (yes) Button (yes) Desc (not editable)
1100  #
1101  #///////////////////////////////////////////////////////////////////////////
1102  # introducimos valores
1103    switch $stt {
1104      "normal" {
1105        BfoActivateWidget    $self.ek    $stt
1106        $self.ek configure   -editable   true
1107        BfoActivateWidget    $self.ab    "disabled"
1108        $self configureDesc  state       disabled
1109        $self configureDesc  editable    false
1110        bind $self.ek <Double-ButtonPress-1>   [list $self _ShowList]
1111      }
1112      "active" {
1113        BfoActivateWidget    $self.ek    "normal"
1114        $self.ek configure   -editable   true
1115        BfoActivateWidget    $self.ab    "disabled"
1116        $self configureDesc  state       normal
1117        $self configureDesc  editable    true
1118        bind $self.ek <Double-ButtonPress-1>   [list $self _ShowList]
1119      }
1120      "select" {
1121        BfoActivateWidget    $self.ek    "disabled"
1122        $self.ek configure   -editable   false
1123        BfoActivateWidget    $self.ab    "active"
1124        $self configureDesc  state       normal
1125        $self configureDesc  editable    false
1126        bind $self.ek <Double-ButtonPress-1>   {}
1127      }
1128      "disabled" {
1129        BfoActivateWidget    $self.ek    "disabled"
1130        $self.ek configure   -editable   false
1131        BfoActivateWidget    $self.ab    "disabled"
1132        $self configureDesc  state       normal
1133        $self configureDesc  editable    true
1134        bind $self.ek <Double-ButtonPress-1>   {}
1135      }
1136      "notactive" {
1137        BfoActivateWidget    $self.ek    "disabled"
1138        $self.ek configure   -editable   false
1139        BfoActivateWidget    $self.ab    "disabled"
1140        $self configureDesc  state       normal
1141        $self configureDesc  editable    false
1142        bind $self.ek <Double-ButtonPress-1>   {}
1143      }
1144      "allactive" {
1145        BfoActivateWidget    $self.ek    "normal"
1146        $self.ek configure   -editable   true
1147        $self configureDesc  state       normal
1148        eval BfoActivateWidget     $self.ab    active
1149        $self configureDesc  editable    true
1150        bind $self.ek <Double-ButtonPress-1>   [list $self _ShowList]
1151      }
1152      "descnoedit" {
1153        BfoActivateWidget    $self.ek    "normal"
1154        $self.ek configure   -editable   true
1155        $self configureDesc  state       normal
1156        eval BfoActivateWidget     $self.ab    active
1157        $self configureDesc  editable    false
1158        bind $self.ek <Double-ButtonPress-1>   [list $self _ShowList]
1159      }
1160      default {
1161        puts "BComboboxPlus Activate ERROR: invalid state: $stt"
1162      }
1163    }
1164  }
1165    #///////////////////////////////////////////////////////////////////////////
1166  method getwidget {} {
1167  #
1168  # PURPOSE: Obtenemos el nombre de todos los objetos creados
1169  #
1170  # PARAMETERS: lista con el path de los entrys creados
1171  #   
1172  #///////////////////////////////////////////////////////////////////////////
1173    return $blstentry
1174  }
1175 
1176    #///////////////////////////////////////////////////////////////////////////
1177  method SetValueView {lst args} {
1178  #
1179  # PURPOSE: Insertamos los valores en los entrys
1180  #
1181  # PARAMETERS: args -> lista con los valores a incluir, el primero es el del
1182  #             codigo
1183  #   
1184  #///////////////////////////////////////////////////////////////////////////
1185    # limpiamos valores visualizados
1186    $self values clean
1187    # introducuimos valores
1188    set i 0
1189    foreach obj $blstentry {
1190      set current [$obj cget -state]
1191      $obj configure -state normal
1192      $obj configure -text [lindex $lst $i]
1193      $obj configure -state $current
1194      incr i
1195    }
1196  }
1197   
1198   
1199   
1200#/////////////////////////////////////////////////////////////////////////////
1201   method _FindCreate { } {
1202#
1203# PURPOSE: Creates a Find Dialog given a Instance
1204#
1205#/////////////////////////////////////////////////////////////////////////////
1206  #upvar \#0 ${Instance}::data data
1207
1208  set dialog [Dialog $self.dg -title [mc "Find"]\
1209          -default 0 -modal none -parent $self]
1210  wm protocol $dialog WM_DELETE_WINDOW \
1211    [list $self _FindDestroy $dialog] 
1212  set w [$dialog getframe]
1213  wm resizable $self.dg 0 0
1214 
1215  set data(frm,cad) [LabelEntry  $w.eTxt -label "[mc "Find"]: " \
1216          -textvariable data($self,find,text)]
1217  checkbutton $w.case  -text [mc "Case sensitive"] \
1218          -variable data($self,find,case) -pady 0
1219  TitleFrame $w.dir -bd 2 -relief groove -text [mc "Direction"]
1220  set f [$w.dir getframe]
1221  radiobutton $f.forward -text [mc "Forward"] -value forward \
1222          -variable [varname data(find,dirbusqueda)] \
1223          -highlightthickness 0 -pady 0
1224  radiobutton $f.backward -text [mc "Backward"] -value backward \
1225          -variable [varname data(find,dirbusqueda)] \
1226          -highlightthickness 0 -pady 0
1227  Button $w.findNext -text [mc "Find next"] -width 16 \
1228          -command [list $self _FindNext] \
1229          -helptext [mc "Find next"]
1230  Button $w.cancelar -text [mc "Cancel"] -width 16 -helptext "" \
1231    -command [list $self _FindDestroy $dialog]
1232 
1233  bind $dialog <Return> [list $self _FindNext]
1234  bind $dialog <F3>     [list $self _FindNext]
1235  bind $dialog <Escape> [list $self _FindDestroy $dialog]
1236
1237  # Hemos añadido un tag para la selección, hay que quitarle como el tag sel
1238  #bind $data(editor) <ButtonPress> +[list $data(editor) tag delete found]
1239 
1240  grid $f.forward  $f.backward -sticky nw
1241 
1242  grid $w.eTxt  -       $w.findNext -sticky news -padx 5 -pady 2
1243  grid $w.case  $w.dir  $w.cancelar -sticky new  -padx 5
1244 
1245  grid columnconfigure $w  0 -weight 1
1246  grid columnconfigure $w  1 -weight 0
1247  grid rowconfigure    $w  0 -weight 0
1248  grid rowconfigure    $w  1 -weight 0
1249  grid rowconfigure    $w  2 -weight 0
1250  grid rowconfigure    $w 10 -weight 1
1251 
1252  wm geometry $dialog 360x90
1253  $dialog draw
1254  update
1255  focus $data(frm,cad)
1256  $data(frm,cad).e selection range 0 end
1257}
1258
1259#/////////////////////////////////////////////////////////////////////////////
1260method _FindNext { } {
1261#
1262# PURPOSE: Make the next find in editor
1263#
1264#///////////////////////////////////////////////////////////////////////////// 
1265  #  Coger la posición actual del cursor en el text y buscar desde ahí,
1266  variable data
1267 
1268  #dg.frame.eTxt.e
1269  set entryBus $self.dg.frame.eTxt.e
1270
1271  #set lstPreVal {}
1272  #set idxFind {}
1273  set data($self,indices) [$self entry children root]
1274  set auxVal "*[$entryBus cget -text]*"
1275 
1276  Tolcon_Trace "valBusqueda --> $valBusqueda"
1277  Tolcon_Trace "valor aux   --> $auxVal"
1278 
1279  if {$valBusqueda == ""} {
1280    Tolcon_Trace "LIMPIO VARIABLES 1"
1281    set lstPreVal {}
1282    set idxFind {}
1283    set vez 0
1284    set data($self,valBusqueda) *[$entryBus cget -text]*
1285    set valBusqueda $data($self,valBusqueda)
1286  } else {
1287    if {$valBusqueda != $auxVal} {
1288      Tolcon_Trace "LIMPIO VARIABLES 2"
1289      set lstPreVal {}
1290      set idxFind {}
1291      set vez 0
1292      set data($self,valBusqueda) $auxVal
1293    }
1294  }
1295 
1296  if {[llength $data($self,indices)]} {
1297    foreach idx $data($self,indices) {
1298       lappend lstPreVal [$self entry cget $idx -data]
1299    }
1300  }
1301 
1302  Tolcon_Trace "Direccion de búsqueda -> $data(find,dirbusqueda)"
1303  #Tolcon_Trace "LISTA --> $lstPreVal"
1304  Tolcon_Trace "combobox -> $self"
1305  #Tolcon_Trace "lstBox   -> $lstBox"
1306  #Tolcon_Trace "indices  -> $data($self,indices)"
1307  #Tolcon_Trace "Valor Buscado -> $data($self,valBusqueda)"
1308  Tolcon_Trace "VEZ -> $vez"
1309 
1310  if {[llength $lstPreVal]} {
1311    set pos 1
1312    if {![llength $idxFind]} {
1313        Tolcon_Trace "BUSCO"
1314        foreach elem $lstPreVal {
1315          set aux [lsearch $elem $data($self,valBusqueda)]
1316          if {$aux != -1} {
1317            Tolcon_Trace "Encontrado en pos -> $pos"
1318            lappend idxFind $pos
1319          }
1320          incr pos 1
1321        }
1322    }
1323    Tolcon_Trace "LISTA DE POSICIONES ENCONTRADAS --> $idxFind"
1324    if {[llength $idxFind]} {
1325      set ok 1
1326      Tolcon_Trace "Valor -> $idxFind"
1327      Tolcon_Trace "Tamaño lista -> [llength $idxFind]"
1328      $self selection clear 0 end
1329      if {[llength $idxFind] == 1} {
1330        Tolcon_Trace "IF"
1331        Tolcon_Trace "INTENTO POSICIONAR EL CURSOR -> [lindex $idxFind 0]"
1332        $self selectIndex [lindex $idxFind 0]
1333      } else {
1334        Tolcon_Trace "ELSE"
1335        if {$vez < [llength $idxFind]} {
1336           Tolcon_Trace "INTENTO POSICIONAR EL CURSOR -> [lindex $idxFind $vez]"
1337           $self selectIndex [lindex $idxFind $vez]
1338        } else {
1339           set rq \
1340            [tk_messageBox -type yesno -icon question \
1341              -title [mc "Confirmation. Restart search"] \
1342              -parent $entryBus \
1343              -message [mc "You have arrived to the end of list. Do you want to restart search?"]]
1344         
1345           if {[string equal $rq yes]} {
1346                set vez 0
1347                $self selection clear 0 end
1348                set lstPreVal {}
1349                set idxFind {}
1350                $self _FindNext
1351                return
1352           }
1353        }
1354      }     
1355    } else {
1356      set msg [mc {No coincidence was found in list}]
1357      ShowMessage W $msg $self
1358      set ok 0
1359    }
1360  } else {
1361    set msg [mc {No coincidence was found in list}]
1362    ShowMessage W $msg $self
1363    set ok 0
1364  }
1365   
1366  incr vez 1
1367}
1368
1369#/////////////////////////////////////////////////////////////////////////////
1370method _FindDestroy {dialog} {
1371#
1372# PURPOSE: Replace text in editor
1373#
1374#/////////////////////////////////////////////////////////////////////////////
1375  variable options
1376
1377  #upvar \#0 ${Instance}::data data
1378  # inizialization values
1379  #set options(find,dir)  $data(find,dir)
1380  #set options(find,case) $data(find,case)
1381
1382  # destroy
1383  set vez 0
1384  set entryBus $self.dg.frame.eTxt.e
1385  $entryBus configure -text ""
1386 
1387  destroy $dialog
1388}   
1389
1390   
1391   
1392   
1393   
1394  # delegation of methods and options
1395  delegate method * to lstBox
1396  delegate option * to lstBox
1397}
1398
1399
1400
1401 
1402 
1403
1404package provide bcomboboxplus 1.0
1405
1406
1407# ------- TEST CODE ----
1408
1409#/////////////////////////////////////////////////////////////////////////////
1410proc test_bcomboboxplus {} {
1411#
1412# PURPOSE: Test function bcomboboxplus
1413#
1414#/////////////////////////////////////////////////////////////////////////////
1415
1416  # defining the widgets
1417  namespace eval test_bcomboboxplus {
1418    variable var
1419  }
1420  set ::var ""
1421  destroy .top
1422  toplevel .top
1423  # key column
1424  set cc "c2"
1425  # all columns 
1426  set ca "c1 c2 c3 c4 c5 c6"
1427  # hidden columns 
1428  set ch "c4"
1429  # labels of bcomboboxplus 
1430  set clsf { {Label1} {Label 2} {Label 3} {Label 4} {Label 5} {Label 6} }
1431  # showlabels in bcomboboxplus
1432  set sl 0 
1433  set slk 0 
1434  # width of fields
1435  set wdh   "10 15 5 5 10 15"
1436  # blistboxplus content
1437  set lbc "{1 2 3 4 5 6} {one two three four five six}  \
1438            {uno dos tres cuatro cinco seis} \
1439            {k kk kkk kkkk kkkkk kkkkkk} {0 0 0 0 0 0} {@ # $ % | ?}"
1440  # visible columns of blistboxplus
1441  set cvLb "c1 c2 c3 c4"
1442  # hidden columns of blistboxplus 
1443  set chLb "c5 c6"
1444  # number of rows of blistboxplus
1445  set lbr 5
1446  # helptextkey
1447  set htk "helptext del campo clave"
1448  # helptexts
1449  set hts { {help c1} {help c2} {help c3} {help c4} {help c5} {help c6} }
1450  TitleFrame .top.f1 -text "BComboboxPlus test"
1451  set f1 [ .top.f1 getframe ]
1452  append tl $cvLb " " $chLb
1453 
1454  # Create bcomboboxplus
1455  set bcbp [bcomboboxplus $f1.bsf -cols $ca -keyhelptext $htk -helptexts $hts \
1456                        -color "Blue" -width $wdh -parent $f1 \
1457                        -titles $clsf -showlabels $sl -showlabelkey $slk \
1458                        -hiddencolslb $chLb -hiddencols $ch -colslb $tl \
1459                        -colkey $cc -variable "::test_bcomboboxplus::var" -varcol "c1"\
1460                        -modifycmd   [list puts "executing modifycmd"] \
1461                        -postcommand [list puts "executing postcommand"] ]
1462  # insert values in blistboxplus on bcomboboxplus           
1463  eval $f1.bsf insert end $lbc
1464  # Create frames
1465  TitleFrame .top.f2 -text [mc "Configure"]
1466  set f2 [ .top.f2 getframe ]
1467  TitleFrame $f2.f21 -text [mc "Combobox Plus"]
1468  set f21 [ $f2.f21 getframe ]
1469  LabelFrame $f21.f211
1470  set f211 [ $f21.f211 getframe ]
1471  TitleFrame $f2.f22 -text [mc "List Box"]
1472  set f22 [ $f2.f22 getframe ]
1473  # Test comboboxplus
1474  Label $f21.lf   -text [mc "Labels"]
1475  Label $f21.lc   -text [mc "Key column"]
1476  Label $f21.lv   -text [mc "Columns"]
1477  Label $f21.lh   -text [mc "Hidden columns"]
1478  Label $f21.lwdh -text [mc "Width of fields"]
1479  Entry $f21.ef   -width 30 -text $clsf
1480  Entry $f21.ec   -width 5  -text $cc
1481  Entry $f21.ev   -width 20 -text $ca
1482  Entry $f21.eh   -width 20 -text $ch 
1483  Entry $f21.ewdh -width 5  -text $wdh
1484  # variables associated to each checkbutton and buttons
1485  set ::varCbkl 0
1486  set ::varCb   0
1487  checkbutton $f211.cblk -text [mc "Show label key"] \
1488        -command { toggleShowLabelKey } -variable ::varCblk
1489  checkbutton $f211.cb -text [mc "Show labels"] \
1490            -command { toggleShowLabels } -variable ::varCb
1491  button $f211.bi -text [mc "Apply"] -command { applyCmd } -width 20
1492  # Test listbox
1493  Label $f22.lcn -text [mc "Content"]
1494  Label $f22.lf  -text [mc "Titles"]
1495  Label $f22.lh  -text [mc "Hidden columns"]
1496  Label $f22.lr  -text [mc "Number of rows"] 
1497  Entry $f22.ecn -text $lbc
1498  Entry $f22.eh  -width 20 -text $chLb
1499  Entry $f22.er  -text $lbr
1500  set ::varTlb 1 
1501  checkbutton $f22.cblb -text [mc "Show titles"] \
1502            -command { toggleShowTitles } -variable ::varTlb
1503  button $f22.bd  -text [mc "Apply"] -command { applyLbCmd } -width 20 
1504  # packing all
1505  grid .top.f1      -row 0  -column 0 -sticky news -padx 10 -pady 10
1506  grid .top.f2      -row 1  -column 0 -sticky news -padx 10 -pady 10
1507  grid columnconfigure .top 0 -weight 1
1508  grid rowconfigure    .top 0 -weight 0
1509  grid rowconfigure    .top 1 -weight 1   
1510  grid $f1.bsf -row 0 -column 0 -sticky "news"
1511  grid columnconfigure $f1 0 -weight 1
1512  grid rowconfigure $f1 0  -weight 1
1513  grid $f2.f21     -row 0  -column 0 -sticky news -padx 10 -pady 10
1514  grid $f2.f22     -row 0  -column 1 -sticky news -padx 10 -pady 10
1515  grid $f21.f211   -row 10 -column 0 -sticky news -columnspan 2
1516  grid $f21.lc     -row 0  -column 0 -sticky "news" -padx 10 -pady 2
1517  grid $f21.lv     -row 1  -column 0 -sticky "news" -padx 10 -pady 2
1518  grid $f21.lh     -row 2  -column 0 -sticky "news" -padx 10 -pady 2
1519  grid $f21.lf     -row 3  -column 0 -sticky "news" -padx 10 -pady 2
1520  grid $f21.lwdh   -row 4  -column 0 -sticky "news" -padx 10 -pady 2
1521  grid $f21.ec     -row 0  -column 1 -sticky "news" -padx 10 -pady 2
1522  grid $f21.ev     -row 1  -column 1 -sticky "news" -padx 10 -pady 2
1523  grid $f21.eh     -row 2  -column 1 -sticky "news" -padx 10 -pady 2
1524  grid $f21.ef     -row 3  -column 1 -sticky "news" -padx 10 -pady 2
1525  grid $f21.ewdh   -row 4  -column 1 -sticky "news" -padx 10 -pady 2 
1526  grid $f211.cblk  -row 1  -column 0 -sticky "news" -padx 10 -pady 2
1527  grid $f211.cb    -row 1  -column 1 -sticky "news" -padx 10 -pady 2
1528  grid $f211.bi    -row 1  -column 2 -sticky "news" -padx 10 -pady 2
1529  grid $f22.lcn    -row 1  -column 0 -sticky "news" -padx 10 -pady 2
1530  grid $f22.lh     -row 3  -column 0 -sticky "news" -padx 10 -pady 2
1531  grid $f22.lr     -row 4  -column 0 -sticky "news" -padx 10 -pady 2
1532  grid $f22.ecn    -row 1  -column 1 -sticky "news" -padx 10 -pady 2
1533  grid $f22.eh     -row 3  -column 1 -sticky "news" -padx 10 -pady 2
1534  grid $f22.er     -row 4  -column 1 -sticky "news" -padx 10 -pady 2
1535  grid $f22.bd     -row 5  -column 1 -sticky "news" -padx 10 -pady 2
1536  grid $f22.cblb   -row 5  -column 0 -sticky "news" -padx 10 -pady 2
1537
1538  proc applyCmd {} {
1539    .top.f1.f.bsf configure -titles     [.top.f2.f.f21.f.ef cget -text]
1540    .top.f1.f.bsf configure -hiddencols [.top.f2.f.f21.f.eh cget -text]
1541    .top.f1.f.bsf configure -colkey     [.top.f2.f.f21.f.ec cget -text]
1542    .top.f1.f.bsf configure -width      [.top.f2.f.f21.f.ewdh cget -text]
1543  }
1544
1545  proc applyLbCmd {} {
1546    .top.f1.f.bsf clear
1547    eval .top.f1.f.bsf insert end [.top.f2.f.f22.f.ecn cget -text]   
1548    .top.f1.f.bsf configure -colslb [.top.f2.f.f21.f.ev cget -text]
1549    .top.f1.f.bsf configure -hiddencolslb  [.top.f2.f.f22.f.eh cget -text]
1550    .top.f1.f.bsf configure -nrows  [.top.f2.f.f22.f.er cget -text]
1551  }
1552
1553  proc toggleShowLabels {} {
1554    if { [.top.f1.f.bsf cget -showlabels] } {
1555      .top.f1.f.bsf configure -showlabels 0
1556    } else {
1557      .top.f1.f.bsf configure -showlabels 1
1558    }
1559  }
1560
1561  proc toggleShowLabelKey {} {
1562    if { [.top.f1.f.bsf cget -showlabelkey] } {
1563      .top.f1.f.bsf configure -showlabelkey 0
1564    } else {
1565      .top.f1.f.bsf configure -showlabelkey 1
1566    }
1567  }
1568   
1569  proc toggleShowTitles {} {
1570    if { [.top.f1.f.bsf cget -showtitles] } {
1571      .top.f1.f.bsf configure -showtitles false
1572    } else {
1573      .top.f1.f.bsf configure -showtitles true
1574    }
1575  }
1576}
Note: See TracBrowser for help on using the repository browser.