source: tol/tolbase/lib/toltk/bystable.tcl @ 21beb26

1941-docker-image-to-testdevel
Last change on this file since 21beb26 was 6d7779d, checked in by Jorge Pérez <josp.jorge@…>, 18 years ago

initial import

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@1 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 44.2 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : bystable.tcl
3# PURPOSE : This file contains a namespace called BayesTable with its
4#           functions. Its for creating a table and managing its events and
5#           changing its options. It is used as parent for other namespaces
6#           that fills tables data. Its abstracts the general funcionality of
7#           all kind of tables.
8#/////////////////////////////////////////////////////////////////////////////
9
10
11#/////////////////////////////////////////////////////////////////////////////
12# TESTING
13#/////////////////////////////////////////////////////////////////////////////
14# Put if {1} for testing this file.
15if {0} {
16  package require Tk
17  package require BWidget
18  package require BLT 
19  Bitmap::use
20  set toltk_script_path [file dirname [info script]]
21  set toltk_images_path [file join $toltk_script_path images]
22  lappend Bitmap::path $toltk_images_path
23  package require msgcat
24  namespace import msgcat::*
25}
26
27bind BysTable <Tab> {
28  if { [%W index active col] < [expr {[%W cget -cols] -1}] } {
29    ::tk::table::MoveCell %W 0 1
30  } elseif { [%W index active row] < [expr {[%W cget -rows] -1}] } {
31    ::tk::table::MoveCell %W 1 -[%W cget -cols]
32  } else {
33    %W insert rows end
34    ::tk::table::MoveCell %W 1 -[%W cget -cols]
35  }
36  focus %W
37  break
38}
39
40#/////////////////////////////////////////////////////////////////////////////
41  namespace eval ::BayesTable {
42#
43# PURPOSE: The purpose of this namespace is organize code and functions.
44#          A special namespace is created for each instance of BayesTable.
45#
46# VARIABLES:
47#   tmpOpt  -> temporary array used to store the widgets and variables of the
48#              options dialog.
49#
50#/////////////////////////////////////////////////////////////////////////////
51  variable tmpOpt
52}
53
54
55# Procedimientos
56proc ::BayesTable::GetInstance {w} {
57  return ::BayesTable::[winfo parent [winfo parent [winfo parent $w]]]
58}
59
60
61#/////////////////////////////////////////////////////////////////////////////
62  proc ::BayesTable::Create {path args} {
63#
64# PURPOSE: Creates an instance of a BayesTable. It creates the widget
65#
66# PARAMETERS:
67#   path -> path where the new table is stored
68#   args ->
69#          -OnWriteIni:
70#          -OnOptionCreate:
71#          -OnOptionDestroy:
72#          -OnOptionApply:
73#          -child: Child of the new table's Widget
74#          -onlywidget: Boolean to create the table by itself, or
75#                       create the table plus a button bar and a status bar.
76#          -clientproc:
77#          -argsWidget:
78#          -fillproc: Procedure that will fill the table.
79#
80# RETURN: The new created BayesTable instance
81#
82#/////////////////////////////////////////////////////////////////////////////
83
84  if {[expr {[llength $args] & 1}] != 0} {
85    return -code error "Invalid number of arguments given to ctext\
86           (uneven number): $args"
87  }
88  set Instance ::BayesTable::$path
89
90  array set cmdArgs $args
91  if {![info exists cmdArgs(-child)] } {
92    return -code error "Child not specified"
93  }
94 
95  # A namespace is created for each bayes table widget.
96
97  namespace eval $Instance {
98 
99    # data -> array with information about the instance:
100    #
101    # options ->
102    #
103    # widgets ->
104    #
105    # matrix ->
106    #
107    variable data
108    variable options
109    variable widgets
110    variable matrix
111  }
112
113  upvar \#0 ${Instance}::data data
114  upvar \#0 ${Instance}::widgets widgets
115  upvar \#0 ${Instance}::options options
116
117  if {[info exists cmdArgs(-OnWriteIni)] } {
118    set data(proc,OnWriteIni) $cmdArgs(-OnWriteIni)
119  }
120  if {[info exists cmdArgs(-OnOptionCreate)] } {
121    set data(proc,OnOptionCreate)  $cmdArgs(-OnOptionCreate)
122  }
123  if {[info exists cmdArgs(-OnOptionDestroy)] } {
124    set data(proc,OnOptionDestroy)  $cmdArgs(-OnOptionDestroy)
125  }
126  if {[info exists cmdArgs(-OnOptionApply)] } {
127    set data(proc,OnOptionApply)  $cmdArgs(-OnOptionApply)
128  }
129
130  # se crea el frame del widget bayesTable
131  set widgets(this)  [frame $path -class bayesTable]
132  set data(namespace) $cmdArgs(-child)
133  bind $widgets(this) <Destroy> [list ::BayesTable::Destroy $Instance]
134
135  set widgets(tb,path) [frame $widgets(this).tb -bd 2 -relief raised]
136  set widgets(cl,path) [frame $widgets(this).cl -bd 2 -relief raised]
137  set widgets(sb,path) [frame $widgets(this).sb -relief groove -bd 1 -height 7]
138  # Se crean la barra de botones y la barra de estado
139  if { ![info exists cmdArgs(-onlywidget)] ||
140       ![string equal $cmdArgs(-onlywidget) "yes"]} {
141    CreateToolBar $Instance
142    CreateStatusBar $Instance
143    set data(onlywidget) 0
144  } else  {
145    set data(onlywidget) 1
146  }
147  # Se crea la tabla y se rellena
148  if {[info exists cmdArgs(-clientproc)] == 1} {
149    eval $cmdArgs(-clientproc) $Instance
150  } else {
151    if {[info exists cmdArgs(-argsWidget)] == 1} { 
152      eval CreateWidget $Instance $widgets(cl,path) $cmdArgs(-argsWidget)
153    } else  {
154      CreateWidget $Instance $widgets(cl,path)
155    }
156  }
157
158  if {[info exists cmdArgs(-fillproc)] == 1} {
159    eval $cmdArgs(-fillproc) $Instance
160  }
161  if {[info exists cmdArgs(-fillproc)] == 1} {
162    AdjustTable $Instance
163  }
164  if $data(onlywidget) {
165    grid $widgets(cl,path) -sticky news
166    grid columnconfigure $path 0 -weight 1
167    grid rowconfigure    $path 0 -weight 1
168  } else {
169    grid $widgets(tb,path) -sticky ew
170    grid $widgets(cl,path) -sticky news
171    grid $widgets(sb,path) -sticky ew
172    grid columnconfigure $path 0 -weight 1
173    grid rowconfigure    $path 1 -weight 1
174  }
175
176
177  return $Instance
178}
179
180proc ::BayesTable::CreateWidget {this w args} {
181  upvar \#0 ${this}::data data
182  upvar \#0 ${this}::widgets widgets
183  upvar \#0 ${this}::options options
184
185  global tcl_platform toltk_images_path
186  global toltk_options
187
188  if { [string equal $tcl_platform(platform) "windows"] } {
189    set tvcur [file join ${toltk_images_path} treeview.cur]
190    regsub -all " " $tvcur {\ } tvcur
191    set bordercursor @$tvcur
192  } else {
193    set bordercursor \
194        "@[file join ${toltk_images_path} treeview.xbm] [file join ${toltk_images_path} treeview_m.xbm] black white"
195  }
196  set cmdArgs(-state) "disabled"
197  array set cmdArgs $args
198  ScrolledWindow $w.sw
199  #Creación de la tabla
200  set t [table $w.sw.t -variable ${this}::matrix -state $cmdArgs(-state)\
201                       -multiline 0 -selectmode extended -resizeborders col \
202                       -bordercursor $bordercursor -relief groove \
203                       -browsecommand [list ::BayesTable::Active $this %W %S %s] \
204                       -validate 1 -vcmd [list ::BayesTable::Validate $this] \
205                       -bg white -font $toltk_options(fonts,Label) -selecttitles 0 \
206                       -titlecols 1 -titlerows 1 -colseparator \t -rowseparator \n]
207  #Las dos últimas filas son configurables
208
209  bindtags $t [eval list [bindtags $t] BysTable]
210
211  set widgets(tktable) $t
212  set state $cmdArgs(-state)
213  #Configuramos los tags de las celdas
214  $t tag configure usr1   -bd 2                -relief raised -font $toltk_options(fonts,Title1)
215  $t tag configure usr2   -bg grey30 -fg white -relief flat   -font $toltk_options(fonts,Title1)
216
217  $t tag configure title  -bd 1 -bg $toltk_options(colors,SystemButtonFace) -fg black\
218                          -relief $toltk_options(relief,ridge) -anchor c -state $state
219  $t tag configure active -bd 1 -bg White -fg black -relief solid -anchor w\
220                          -font $toltk_options(fonts,Title1)
221  $t tag configure sel    -bd 1;# -fg black -bg Azure2
222  $t tag raise usr1
223  $t tag raise usr2
224
225  $w.sw setwidget $t
226  pack $w.sw -expand true -fill both
227
228
229  #Creación de un menú contextual
230  set menu [menu $w.sw.m -tearoff 0]
231  set widgets(menu) $menu
232  set mi [menu $w.sw.m.ins -tearoff 0]
233  set me [menu $w.sw.m.eli -tearoff 0]
234  set widgets(cl,menu) $menu
235  $menu add command -label [mc "Select all"] -accelerator CTRL+E\
236        -command [list ::BayesTable::CmdSelectAll $this]
237  $menu add command -label [mc "Delete"] -accelerator SUPR -state $state \
238        -command [list ::BayesTable::CmdDelete    $this]
239  $menu add separator
240  $menu add cascade -label [mc "Insert"]    -state $state -menu $mi
241  $menu add cascade -label [mc "Eliminate"] -state $state -menu $me
242  $mi add command -label [mc "Rows"]\
243        -command [list ::BayesTable::CmdModifyRowsCols $this insert rows] 
244  $mi add command -label [mc "Columns"]\
245        -command [list ::BayesTable::CmdModifyRowsCols $this insert cols] 
246  $me add command -label [mc "Rows"]\
247        -command [list ::BayesTable::CmdModifyRowsCols $this delete rows] 
248  $me add command -label [mc "Columns"]\
249        -command [list ::BayesTable::CmdModifyRowsCols $this delete cols] 
250
251  proc OnB3 { m w x y X Y} {
252     if ![llength [$w border mark $x $y]] {
253       tk_popup $m $X $Y
254     }
255  }
256  bind $t <ButtonPress-3> "::BayesTable::OnB3 $menu %W %x %y %X %Y"
257  bind $t <Double-ButtonPress-1> [list ::BayesTable::OnDblClickHeader $this]
258  bind $t <F3>        [list ::BayesTable::CmdFind      $this] 
259  bind $t <Delete>    [list ::BayesTable::CmdDelete    $this]
260  bind $t <Return>    [list ::BayesTable::CmdNext      $this]
261  bind $t <Control-KeyRelease> [list ::BayesTable::OnControlKey $this %K %k]
262}
263
264#///////////////////////////////////////////////////////////////////////////
265  proc ::BayesTable::OnControlKey {this keysym keycode} {
266#
267# PURPOSE: Control the "Control + Key Press"
268#
269# PARAMETERS: this ->  Instance of BayesTable
270#             keysym -> The keysym corresponding to the event,
271#                       substituted as a textual string
272#             keycode -> The keycode field from the event
273#
274#///////////////////////////////////////////////////////////////////////////
275  switch [string toupper $keysym] {
276    E { ::BayesTable::CmdSelectAll $this }
277    F { ::BayesTable::CmdFind      $this }
278    N { ::EditTable::CmdNew        $this }
279    A { ::EditTable::CmdOpen       $this }
280    S { ::EditTable::CmdSave       $this }
281    C { ::BayesTable::CmdCopy      $this }
282    V { ::BayesTable::CmdPaste     $this }
283  }   
284  if {$keysym == "X"} { tk_tableCut [GetTkTable $this] }
285}
286
287
288proc ::BayesTable::CreateToolBar {this} {
289  upvar \#0 ${this}::widgets widgets
290   
291  set f $widgets(tb,path)
292  set n_b [list \
293        "home"        "AdjustTable" ""\
294        "sep0"        "--"          ""\
295        "leftEnd"     "CmdFirst"    "[mc First]" \
296        "leftNext"    "CmdBack"     "[mc Back] " \
297        "rightNext"   "CmdNext"     "[mc Next] " \
298        "rightEnd"    "CmdLast"     "[mc Last] " \
299        "sep1"        "--"          ""\
300        "bcopy"        "CmdCopy"     "[mc Copy] (CTRL+C)" \
301        "bfind"        "CmdFind"     "[mc Find] (CTRL+F)" \
302        "bfilter"      "CmdFilter"   "[mc Filter] (ALT+F)" \
303        "sep2"        "--"          ""\
304        "ordAsc"      "CmdOrdAsc"   ""\
305        "ordDes"      "CmdOrdDes"   ""\
306        "sep3"        "--"          ""\
307        "tools"       "CmdOptions" "[mc Options]"\
308  ]
309  foreach {n_img n_proc n_hint} $n_b {
310    if {[string equal $n_proc "--"]} {
311      Separator $f.$n_img -orient vertical
312    } else {
313      set widgets(tb,$n_img) [Button $f.$n_img -image [::Bitmap::get ${n_img}] -bd 2 \
314           -relief link -helptext $n_hint -command [list ::BayesTable::$n_proc $this]]
315    }
316    pack $f.$n_img -side left -pady 2 -fill y -padx 1
317  }
318}
319
320proc ::BayesTable::CreateStatusBar {this} {
321  upvar \#0 ${this}::widgets widgets
322
323  set f $widgets(sb,path)
324  # frame y label para barra de estado
325  set widgets(sb,lRows) [label $f.rows -relief groove -bd 1 -width 16]
326  set widgets(sb,lPosi) [label $f.posi -relief groove -bd 1 -width 16]
327  set widgets(sb,lInfo) [label $f.info -relief groove -bd 1 -width 60 -anchor w -padx 4]
328  set widgets(sb,rell) [label $f.rell -relief groove -bd 1]
329
330  pack $f.rows $f.posi $f.info -side left
331  pack $f.rell -expand true -fill x
332}
333
334proc ::BayesTable::Save {this path {replace 0}} {
335  if { ![ catch { set fd [open $path w] } msgerr] } {
336    set table [GetTkTable $this]
337    set numCols [$table cget -cols]
338    set list    [$table get @0,0 end]
339    if $replace {
340      set list [ListReplace $list {} "?"]
341    }
342    set struct "{$numCols {\n} {} { ; }} {1 { ; } {} {}}"
343    set txt [ListToStrStruct $list $struct] 
344    puts $fd $txt
345    close $fd
346    return 1
347  }
348  error $msgerr
349}
350
351proc ::BayesTable::Open {this path} {
352  set table [GetTkTable $this]
353
354  if { ![catch {set fd [open $path r] } msgerr] } {
355    set txt [read -nonewline $fd]
356    set rsep [$table cget -rowseparator]
357    set csep [$table cget -colseparator]
358    $table configure -rowseparator "\n" -colseparator ";"
359    # Llamamos al manejador de pegado de datos en la tabla
360    PasteHandler $table 0,0 $txt
361    $table configure -rowseparator $rsep -colseparator $csep
362    # Los archivos de TOL que se abren tienen el separador de
363    #columna despues de la ultima columna, por eso quitamos una columna
364    # Faltaría comprobar si esto ocurre en todos los tipos de archivos
365    #que se abren con el editor de tablas
366    $table configure -cols [expr [$table cget -cols] -1]
367    close $fd
368    return 1
369  }
370  error $msgerr
371}
372
373proc ::BayesTable::SetMatrixInfo {this dim colTypes} {
374  upvar \#0 ${this}::options options
375  set tktable [GetTkTable $this]
376  $tktable configure -rows [lindex $dim 0] -cols [lindex $dim 1]
377}
378
379proc ::BayesTable::AddOptionCmd {this name proc args} {
380  upvar \#0 ${this}::widgets widgets
381  upvar \#0 ${this}::data    data
382
383  set f $widgets(tb,path)
384  array set cmdArgs $args
385
386  if {![info exists cmdArgs(-where)] ||
387      [string equal $cmdArgs(-where) "both"] ||
388      [string equal $cmdArgs(-where) "tool"] } {
389    if {[string equal $proc "--"]} {
390      Separator $f.$name -orient vertical
391    } else {
392      set widgets(tb,$name) [Button $f.$name -bd 2 -relief link -command [list $proc $this]]
393      if [info exists cmdArgs(-icon)] {
394        $f.$name configure -image [::Bitmap::get $cmdArgs(-icon)]
395      }
396      if [info exists cmdArgs(-hint)] {
397        $f.$name configure -helptext $cmdArgs(-hint)
398      }
399    }
400    pack $f.$name -side left -pady 2 -fill y -padx 1
401  }
402
403  if {[info exists cmdArgs(-where)] &&
404      ([string equal $cmdArgs(-where) "both"] ||
405       [string equal $cmdArgs(-where) "menu"]) } {
406    Tolcon_Trace "También en el menú contextual"
407  }
408}
409
410proc ::BayesTable::GetTkTable {this} {
411  upvar \#0 ${this}::widgets widgets
412  return $widgets(tktable)
413}
414
415proc ::BayesTable::GetMenu {this} {
416  upvar \#0 ${this}::widgets widgets
417  return $widgets(menu)
418}
419
420proc ::BayesTable::UnPackTkTable {this} {
421  set t [GetTkTable $this]
422  pack forget [winfo parent $t]
423  #pack forget $t
424}
425
426proc ::BayesTable::PackTkTable {this} {
427  set t [GetTkTable $this]
428  pack [winfo parent $t] -expand yes -fill both
429  #pack $t -expand yes -fill both
430}
431
432
433proc ::BayesTable::GetClientArea {this} {
434  upvar \#0 ${this}::widgets widgets
435  return $widgets(cl,path)
436}
437
438proc ::BayesTable::GetContextMenu {this} {
439  upvar \#0 ${this}::widgets widgets
440  return $widgets(cl,menu)
441}
442
443proc ::BayesTable::WriteRows {this text} {
444  upvar \#0 ${this}::widgets widgets
445  upvar \#0 ${this}::data    data
446  if !$data(onlywidget) {
447    $widgets(sb,lRows) configure -text $text
448  }
449}
450
451proc ::BayesTable::WritePosi {this text} {
452  upvar \#0 ${this}::widgets widgets
453  upvar \#0 ${this}::data    data
454  if !$data(onlywidget) {
455    $widgets(sb,lPosi) configure -text $text
456  }
457}
458
459proc ::BayesTable::WriteInfo {this text} {
460  upvar \#0 ${this}::widgets widgets
461  upvar \#0 ${this}::data    data
462  if !$data(onlywidget) {
463    $widgets(sb,lInfo) configure -text $text
464  }
465}
466
467proc ::BayesTable::SetElement {this i j value {asString 0}} {
468  upvar \#0 ${this}::matrix matrix
469  if $asString {
470    set matrix($i,$j) $value
471  } else  {
472    set matrix($i,$j) [::TolConsole::Format $value]
473  }
474}
475
476#/////////////////////////////////////////////////////////////////////////////
477proc ::BayesTable::SetSpans {this fil col fn cn} {
478#
479# PURPOSE: Combination of cells
480#
481# PARAMETERS:
482#   this -> Instance of BayesTable
483#   fil  -> Rows of table
484#   col  -> Column of table
485#   fn   -> Number of rows
486#   cn   -> Number of rows
487#
488#/////////////////////////////////////////////////////////////////////////////
489  set tabla [GetTkTable $this]
490  $tabla spans $fil,$col $fn,$cn
491}
492
493
494proc ::BayesTable::GetElement {this i j} {
495  upvar \#0 ${this}::matrix matrix
496  return $matrix($i,$j)
497}
498
499proc ::BayesTable::GetLocElements {this} {
500  return ${this}::matrix
501}
502
503proc ::BayesTable::Active {this W S s} {
504  upvar \#0 ${this}::options opt
505
506  #Actualizar información de la fila y columna actual
507  set row [lindex [split $S ,] 0]
508  set col [lindex [split $S ,] 1]
509  WritePosi $this "[mc Row]: $row, [mc Col]: $col"
510
511  #Rehacer completo porque las filas y columnas de título pueden ser varias
512  #return
513
514  for {set i 0} {$i < $opt(titlerows)} {incr i} {
515    for {set j 0} {$j < $opt(titlecols)} {incr j} {
516      regsub (.*), $s $i, otc ; # old table col
517      regsub ,(.*) $s ,$j otr ; # old table row
518      if {$otc != "" && $otr !=""} {
519        $W tag cell title $otc $otr
520      }
521
522      regsub (.*), $S $i, tc
523      regsub ,(.*) $S ,$j tr
524      if { ![string equal $tc "0,0"] && ![string equal $tr "0,0"]} {
525        $W tag cell usr1 $tc $tr
526      } else {
527        if {[string equal $tc "0,0"]} {
528          $W tag cell usr2 $tr
529        } else {
530          $W tag cell usr2 $tc
531        }
532      }
533    }
534  }
535
536}
537
538proc ::BayesTable::OnDblClickHeader { this } {
539  set tabla [GetTkTable $this]
540  # celda seleccionada
541  set cordenada [$tabla index active]
542  if {$cordenada != ""} {
543    set row [lindex [split $cordenada ,] 0]
544    set col [lindex [split $cordenada ,] 1]
545    # comprobamos si hemos pinchado en la cabereca (row = 0)
546    if {$row == 0} {
547      AdjustColumn $this $col
548    }
549  }
550}
551
552proc ::BayesTable::AdjustColumn {this column} {
553  set tbl [GetTkTable $this]
554  # control de spnas
555  set find 0
556  set lstSpan [$tbl spans]
557  if { [llength $lstSpan] } {
558    set find 1 
559    set lstInd ""
560    set ok 1
561    # lista con los indices
562    for {set x 0} {$x < [expr [llength $lstSpan] -1]} {incr x 2} {
563          lappend lstInd [lindex $lstSpan $x]
564    }
565  }
566  # buscamos ancho de columna
567  set maxLenFin 1
568  for {set i [$tbl cget -roworigin]} {$i <= [$tbl cget -rows]} {incr i} {
569    set maxLen [string length [$tbl get $i,$column]]
570    # comprobamos si la celda esta expandida horizontalmente
571    if { $find } {
572      set posi [lsearch $lstInd $i,$column]
573      if [expr $posi > -1] {
574        set fc [lindex $lstSpan [expr $posi * 2 + 1]]
575        set nc [string range $fc [expr [string first , $fc] + 1] end]
576        set maxLen [expr $maxLen / ($nc+1) + 3]
577      }
578    }
579    if {$maxLen > $maxLenFin} {
580      set maxLenFin $maxLen
581    }
582  }
583  # controlamos los spans
584  $tbl width $column [expr $maxLenFin + 1]
585}
586
587proc ::BayesTable::AdjustTable {this} {
588  set table [GetTkTable $this]
589  for {set i [$table cget -colorigin]} {$i < [$table cget -cols]} {incr i} {
590    ::BayesTable::AdjustColumn $this $i
591  }
592}
593
594proc ::BayesTable::Destroy {this} {
595  WriteIni $this
596  namespace delete $this
597}
598
599proc ::BayesTable::SetWidget {this key widget} {
600  upvar \#0 ${this}::widgets widgets
601  set widgets(cl,$key) $widget
602}
603
604proc ::BayesTable::GetWidget {this key} {
605  upvar \#0 ${this}::widgets widgets
606  return $widgets(cl,$key)
607}
608
609proc ::BayesTable::SetData {this key value} {
610  upvar \#0 ${this}::data data
611  set data($key) $value
612}
613
614proc ::BayesTable::GetData {this key} {
615  upvar \#0 ${this}::data data
616  return $data($key)
617}
618
619proc ::BayesTable::GetLocData {this key} {
620  return ${this}::data($key)
621}
622
623proc ::BayesTable::SetOption {this key value} {
624  upvar \#0 ${this}::options opt
625  set opt($key) $value
626}
627
628proc ::BayesTable::GetOption {this key} {
629  upvar \#0 ${this}::options opt
630  return $opt($key)
631}
632
633
634#/////////////////////////////////////////////////////////////////////////////
635  proc ::BayesTable::ReadIni {this} {
636#
637# PURPOSE: Reads general table options from .ini file.
638#
639# PARAMETERS:
640#   this  -> Instance of BayesTable
641#
642#/////////////////////////////////////////////////////////////////////////////
643  global toltk_options
644  upvar \#0 ${this}::data data
645
646  set rini ::iniFile::Read
647  set key $data(namespace)
648  SetOption $this bg           [$rini $key bg white]
649  SetOption $this font         [$rini $key font $toltk_options(fonts,Label)]
650  SetOption $this titlecols    [$rini $key titlecols     1]
651  SetOption $this titlerows    [$rini $key titlerows     1]
652  SetOption $this selecttitles [$rini $key selecttitles  1]
653  SetOption $this colSepType   [$rini $key colSepType TAB]
654  SetOption $this colSeparator [$rini $key colSeparator ""]
655  SetOption $this rowSepType   [$rini $key rowSepType RET]
656  SetOption $this rowSeparator [$rini $key rowSeparator ""]
657}
658
659
660proc ::BayesTable::WriteIni {this} {
661  upvar \#0 ${this}::data    data
662  upvar \#0 ${this}::widgets widgets
663  upvar \#0 ${this}::options opt
664
665  set wini ::iniFile::Write
666  set key $data(namespace)
667
668  if !$data(onlywidget) {
669    foreach op {bg font titlecols titlerows selecttitles} {
670      $wini $key $op $opt($op)
671    }
672    foreach op {colSepType colSeparator rowSepType rowSeparator} {
673      $wini $key $op $opt($op)
674    }
675  }
676  if [info exists ${this}::data(proc,OnWriteIni)] {
677    $data(proc,OnWriteIni) $this
678  }
679  ::iniFile::Flush
680}
681
682
683proc ::BayesTable::Configure {this} {
684  OptionsApplyStyle  $this
685  OptionsApplyTitle  $this
686  OptionsApplyExport $this
687}
688
689proc ::BayesTable::OptionsApply {this} {
690  upvar \#0 ${this}::data    data
691  #Save options before apply
692  OptionsSet $this
693  OptionsApplyStyle  $this
694  OptionsApplyTitle  $this
695  OptionsApplyExport $this
696  if [info exists ${this}::data(proc,OnOptionApply)] {
697    $data(proc,OnOptionApply) $this
698  }
699
700}
701
702proc ::BayesTable::OptionsApplyStyle {this} {
703  upvar \#0 ${this}::options opt
704  set table [GetTkTable $this]
705  foreach op {bg font} {
706    $table configure -$op $opt($op)
707  }
708}
709
710proc ::BayesTable::OptionsApplyTitle {this} {
711  upvar \#0 ${this}::options opt
712  set table [GetTkTable $this]
713  foreach op {titlecols titlerows selecttitles} {
714    $table configure -$op $opt($op)
715  }
716  UpdateInfoRows $this
717}
718
719proc ::BayesTable::UpdateInfoRows {this} {
720  upvar \#0 ${this}::options opt
721  set table [GetTkTable $this]
722  set dataRows [$table cget -rows]
723  WriteRows $this "$dataRows [mc rows] ($opt(titlerows) [mc title])"
724  #Tolcon_Trace "En UpdateInfoRows. rows: $dataRows"
725}
726
727proc ::BayesTable::OptionsApplyExport {this} {
728  upvar \#0 ${this}::options opt
729  set table [GetTkTable $this]
730
731  switch $opt(colSepType) {
732    RET   { $table configure -colseparator \n }
733    TAB   { $table configure -colseparator \t }
734    OTHER { $table configure -colseparator $opt(colSeparator) }
735  }
736  switch $opt(rowSepType) {
737    RET   { $table configure -rowseparator \n }
738    TAB   { $table configure -rowseparator \t }
739    OTHER { $table configure -rowseparator $opt(rowSeparator) }
740  }
741
742}
743
744proc ::BayesTable::CmdOptions {this} {
745  global toltk_options
746  upvar \#0 ${this}::widgets widgets
747  upvar \#0 ${this}::data data
748  set path $widgets(this)
749  set dialog [Dialog $path.t -title [mc "Table Options"] -modal local -parent $path]
750  wm protocol $dialog WM_DELETE_WINDOW [list ::BayesTable::OptionsDestroy $this $dialog]
751  wm resizable $dialog 0 0
752  set w [$dialog getframe]
753  set w_tabset [::blt::tabset $w.ts -relief flat -highlightthickness 0\
754                        -bd 0 -outerpad 0 -tier 2 -slant both -textside right\
755                -side left -rotate 90 ]
756 
757  #insertar tabset
758  $w_tabset insert end General
759  set f0 [frame $w_tabset.f0]
760  $w_tabset tab configure "General" -text [mc "General"]\
761           -window $f0 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
762  #Crear opciones generales
763  OptionsCreate $this $f0
764  #Crear opciones especificas
765  if [info exists ${this}::data(proc,OnOptionCreate)] {
766    $data(proc,OnOptionCreate) $this $w_tabset
767  }
768
769  set w_bbox \
770          [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
771          -homogeneous false]
772  $w_bbox add -text [mc "Accept"] -relief link \
773         -helptext [mc "Accept"] \
774          -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
775          -command  [list ::BayesTable::OptionsOK $this $dialog]
776  $w_bbox add -text [mc "Cancel"] -relief link \
777          -helptext [mc "Cancel"]\
778          -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
779          -command [list ::BayesTable::OptionsDestroy $this $dialog]
780  $w_bbox add -text [mc "Apply"] -relief link \
781          -helptext [mc "Apply"]\
782          -image [::Bitmap::get apply] -compound left -padx 5 -pady 1 \
783          -command [list ::BayesTable::OptionsApply $this]   
784 
785  pack $w_bbox -fill x -expand false -side bottom
786  pack $w_tabset -fill both -expand true
787   
788  $dialog draw
789}
790
791proc ::BayesTable::OptionsCreate {this frame} {
792  set w_tabset [::blt::tabset $frame.ts -relief flat -highlightthickness 0\
793                        -bd 0 -outerpad 0 -tier 2 -slant right -textside right]
794  $w_tabset insert end Export Style
795
796  set f1 [frame $w_tabset.f1]
797  set f2 [frame $w_tabset.f2]
798
799  $w_tabset tab configure "Export" -text [mc "Export"] -window $f1\
800    -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75 
801  $w_tabset tab configure "Style"     -text [mc "Style"]    -window $f2\
802    -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
803 
804  OptionsGet           $this
805  OptionsCreateExport  $this $f1
806  OptionsCreateStyle   $this $f2
807  #OptionsInit  $this
808  OptionsCheck $this
809  #OptionsSet   $this
810
811  grid $w_tabset -sticky news 
812  grid rowconfigure    $frame 0 -weight 1
813  grid columnconfigure $frame 0 -weight 1
814}
815
816proc ::BayesTable::OptionsCreateStyle {this w} {
817  variable tmpOpt
818
819  TitleFrame $w.tf1 -text [mc "Style"]
820  set f1 [$w.tf1 getframe]
821
822  label $f1.lFont -text [mc "Font"]:
823  ::Objects::FontCreate ::BayesTable::tmpOpt(var,font) $f1.bFont
824
825  label $f1.lColor -text [mc "Color"]:
826  ::Objects::ColorCreate ::BayesTable::tmpOpt(var,bg) $f1.fColor
827  frame $f1.f -width 25
828
829  grid $f1.f $f1.lFont $f1.bFont $f1.lColor $f1.fColor -sticky w -padx 2 -pady 1
830
831  grid rowconfigure    $f1 3 -weight 1
832  grid columnconfigure $f1 4 -weight 1
833  grid columnconfigure $f1 2 -pad   20
834
835  TitleFrame $w.tf2 -text [mc "Title"]
836  set f2 [$w.tf2 getframe]
837
838  label $f2.lTitleRows -text [mc "Number of rows to use as title area"]:
839  SpinBox $f2.sbTitleRows -range {0 3} -width 4 -justify right -editable false\
840      -textvariable ::BayesTable::tmpOpt(var,titlerows)
841  label $f2.lTitleCols -text [mc "Number of columns to use as title area"]:
842  SpinBox $f2.sbTitleCols -range {0 3} -width 4 -justify right -editable false\
843      -textvariable ::BayesTable::tmpOpt(var,titlecols)
844  checkbutton $f2.chSelectTitles -text [mc "Allow title cells in the selection"] \
845     -variable ::BayesTable::tmpOpt(var,selecttitles)
846
847  frame $f2.f -width 25
848  grid $f2.f $f2.lTitleRows $f2.sbTitleRows -sticky w -padx 2
849  grid ^     $f2.lTitleCols $f2.sbTitleCols -sticky w -padx 2
850  grid ^     $f2.chSelectTitles -           -sticky w -padx 2
851
852  grid rowconfigure    $f2 3 -weight 1
853  grid columnconfigure $f2 3 -weight 1
854
855  grid $w.tf1 -sticky news -padx 2
856  grid $w.tf2 -sticky news -padx 2
857  grid rowconfigure    $w 0 -weight 1
858  grid rowconfigure    $w 1 -weight 3
859  grid columnconfigure $w 0 -weight 1
860}
861
862proc ::BayesTable::OptionsCreateExport {this w} {
863  variable tmpOpt
864
865  TitleFrame $w.tf1 -text [mc "Columns separator"]
866  set f1 [$w.tf1 getframe]
867  set tmpOpt(widget,rbColSep1) [radiobutton $f1.rbColSep1 -text [mc Tab] \
868     -value TAB -highlightthickness 0 -pady 0 \
869     -variable ::BayesTable::tmpOpt(var,colSepType) \
870     -command [list ::BayesTable::OptionsCheckColSepType $this]]
871  set tmpOpt(widget,rbColSep2) [radiobutton $f1.rbColSep2 -text [mc Return] \
872     -value RET -highlightthickness 0 -pady 0 \
873     -variable ::BayesTable::tmpOpt(var,colSepType) \
874     -command [list ::BayesTable::OptionsCheckColSepType $this]]
875  radiobutton $f1.rbColSepN -text [mc Other]: \
876     -value OTHER -highlightthickness 0 -pady 0 \
877     -variable ::BayesTable::tmpOpt(var,colSepType) \
878     -command [list ::BayesTable::OptionsCheckColSepType $this]
879  set tmpOpt(widget,colSeparator) [Entry $f1.eColSep \
880     -width 5 -justify right -textvariable ::BayesTable::tmpOpt(var,colSeparator)]
881  frame $f1.f -width 25
882  #grid $f1.f $f1.rbColSep1 -           -sticky nw -padx 2 -pady 0
883  #grid ^     $f1.rbColSepN $f1.eColSep -sticky w  -padx 2 -pady 0
884  #grid rowconfigure    $f1 2 -weight 1
885  #grid columnconfigure $f1 2 -weight 1
886  grid $f1.f $f1.rbColSep1 $f1.rbColSep2 $f1.rbColSepN $f1.eColSep -sticky w  -padx 2 -pady 0
887  grid rowconfigure    $f1 1 -weight 1
888  grid columnconfigure $f1 4 -weight 1
889
890  TitleFrame $w.tf2 -text [mc "Rows separator"]
891  set f2 [$w.tf2 getframe]
892  set tmpOpt(widget,rbRowSep1) [radiobutton $f2.rbRowSep1 -text [mc Return] \
893     -value RET -highlightthickness 0 -pady 0 \
894     -variable ::BayesTable::tmpOpt(var,rowSepType) \
895     -command [list ::BayesTable::OptionsCheckRowSepType $this]]
896  set tmpOpt(widget,rbRowSep2) [radiobutton $f2.rbRowSep2 -text [mc Tab] \
897     -value TAB -highlightthickness 0 -pady 0 \
898     -variable ::BayesTable::tmpOpt(var,rowSepType) \
899     -command [list ::BayesTable::OptionsCheckRowSepType $this]]
900  radiobutton $f2.rbRowSepN -text [mc Other]: \
901     -value OTHER -highlightthickness 0 -pady 0 \
902     -variable ::BayesTable::tmpOpt(var,rowSepType) \
903     -command [list ::BayesTable::OptionsCheckRowSepType $this]
904  set tmpOpt(widget,rowSeparator) [Entry $f2.eRowSep \
905     -width 5 -justify right -textvariable ::BayesTable::tmpOpt(var,rowSeparator)]
906  checkbutton $f2.chOmitLast -text [mc "Omit last row separator (Excel)"] \
907     -variable ::BayesTable::tmpOpt(var,omitLast)
908  frame $f2.f -width 25
909  grid $f2.f $f2.rbRowSep1 $f2.rbRowSep2 $f2.rbRowSepN $f2.eRowSep -sticky w -padx 2 -pady 0
910  #grid ^     $f2.chOmitLast -            -           -sticky w -padx 2 -pady 0
911  grid rowconfigure    $f2 1 -weight 1
912  grid columnconfigure $f2 4 -weight 1
913
914  grid $w.tf1 -sticky news -padx 2
915  grid $w.tf2 -sticky news -padx 2
916  grid rowconfigure    $w 0 -weight 1
917  grid rowconfigure    $w 1 -weight 3
918  grid columnconfigure $w 0 -weight 1
919}
920
921
922#/////////////////////////////////////////////////////////////////////////////
923  proc ::BayesTable::OptionsCheck {this} {
924#
925# PURPOSE: Checks for all widgets from dialog options that need to be checked
926#          for enabling/disabling other associated controls.
927#
928# PARAMETERS:
929#   this   -> Instance of BayesTable
930#
931#/////////////////////////////////////////////////////////////////////////////
932  ::BayesTable::OptionsCheckColSepType $this
933  ::BayesTable::OptionsCheckRowSepType $this
934}
935
936proc ::BayesTable::OptionsCheckColSepType {this} {
937  variable tmpOpt
938
939  switch $tmpOpt(var,colSepType) {
940    TAB   {
941      focus $tmpOpt(widget,rbColSep1)
942      $tmpOpt(widget,colSeparator) configure -state disabled
943    }
944    RET   {
945      focus $tmpOpt(widget,rbColSep2)
946      $tmpOpt(widget,colSeparator) configure -state disabled
947    }
948    OTHER { $tmpOpt(widget,colSeparator) configure -state normal }
949  }
950}
951
952proc ::BayesTable::OptionsCheckRowSepType {this} {
953  variable tmpOpt
954
955  switch $tmpOpt(var,rowSepType) {
956    RET   {
957      focus $tmpOpt(widget,rbRowSep1)
958      $tmpOpt(widget,rowSeparator) configure -state disabled
959    }
960    TAB   {
961      focus $tmpOpt(widget,rbRowSep2)
962      $tmpOpt(widget,rowSeparator) configure -state disabled
963    }
964    OTHER { $tmpOpt(widget,rowSeparator) configure -state normal }
965  }
966}
967
968
969#/////////////////////////////////////////////////////////////////////////////
970  proc ::BayesTable::OptionsGet {this} {
971#
972# PURPOSE: Initializes all options variables and stores them into the
973#          temporary 'tmpOpt' array.
974#
975# PARAMETERS:
976#   this   -> Instance of BayesTable
977#
978#/////////////////////////////////////////////////////////////////////////////
979  upvar \#0 ${this}::options opt
980  variable tmpOpt
981
982  set table [GetTkTable $this]
983  foreach op {bg font titlecols titlerows selecttitles} {
984    set tmpOpt(var,$op) [$table cget -$op]
985  }
986  foreach op {colSepType colSeparator rowSepType rowSeparator} {
987    set tmpOpt(var,$op) $opt($op)
988  }
989}
990
991
992#/////////////////////////////////////////////////////////////////////////////
993  proc ::BayesTable::OptionsSet {this} {
994#
995# PURPOSE: Commits all options values from the temporary 'tmpOpt' array to
996#          other structure.
997#
998# PARAMETERS:
999#   this   -> Instance of BayesTable
1000#
1001#/////////////////////////////////////////////////////////////////////////////
1002  upvar \#0 ${this}::options options
1003  variable tmpOpt
1004
1005  regsub -all var, [array names ::BayesTable::tmpOpt var,*] "" optNames
1006  foreach it $optNames {
1007    set options($it) $tmpOpt(var,$it)
1008  }
1009}
1010
1011proc ::BayesTable::OptionsOK {this dialog} {
1012  OptionsApply   $this
1013  OptionsDestroy $this $dialog
1014}
1015
1016proc ::BayesTable::OptionsDestroy {this dialog} {
1017  upvar \#0 ${this}::data data
1018  variable tmpOpt
1019  #Destruir opciones especificas
1020  if [info exists ${this}::data(proc,OnOptionDestroy)] {
1021    $data(proc,OnOptionDestroy) $this
1022  }
1023  array unset tmpOpt
1024  destroy $dialog
1025}
1026
1027
1028proc ::BayesTable::CmdFirst {this} {
1029  set table [GetTkTable $this]
1030  $table see origin
1031}
1032
1033proc ::BayesTable::CmdBack {this} {
1034  set table [GetTkTable $this]
1035  ::tk::table::MoveCell $table -1  0
1036  #set cell [split [$table index active] ,]
1037  #$table selection clear all
1038  #$table activate  [expr [lindex $cell 0] -1],[lindex $cell 1] 
1039  #$table selection set active
1040  #$table see active
1041}
1042
1043proc ::BayesTable::CmdNext {this} {
1044  set table [GetTkTable $this]
1045  ::tk::table::MoveCell $table 1  0
1046}
1047
1048proc ::BayesTable::CmdLast {this} {
1049  set table [GetTkTable $this]
1050  $table see end
1051}
1052
1053proc ::BayesTable::CmdSelectAll {this} {
1054  set table [GetTkTable $this]
1055  ::tk::table::SelectAll $table
1056  #$table selection set origin end
1057}
1058
1059proc ::BayesTable::CmdDelete {this} {
1060  set table [GetTkTable $this]
1061  if {[llength [$table curselection]] > 1 } {
1062    $table curselection {}
1063    $table selection clear all
1064  }
1065}
1066
1067proc ::BayesTable::CmdModifyRowsCols {this oper item} {
1068  if {![string equal $oper "insert"] && ![string equal $oper "delete"]} { return }
1069  if {![string equal $item "rows"]   && ![string equal $item "cols"]  } { return }
1070
1071  set table [GetTkTable $this]
1072  set cells [$table curselection]
1073  if ![llength $cells] {
1074    set cells {0,0}
1075  }
1076  set rowIni [lindex [split [lindex $cells 0] ","] 0]
1077  set colIni [lindex [split [lindex $cells 0] ","] 1]
1078  set rowEnd [lindex [split [lindex $cells end] ","] 0]
1079  set colEnd [lindex [split [lindex $cells end] ","] 1]
1080  set rows [expr $rowEnd-$rowIni+1]
1081  set cols [expr $colEnd-$colIni+1]
1082
1083  switch $item {
1084    rows {
1085      switch $oper {
1086        insert { $table insert rows -holdselection $rowIni -$rows }
1087        delete { $table delete rows -holdselection $rowIni $rows }
1088      }
1089    }
1090    cols {
1091      switch $oper {
1092        insert { $table insert cols -holdselection $colIni -$cols }
1093        delete { $table delete cols -holdselection $colIni $cols }
1094      }
1095    }
1096  }
1097  UpdateInfoRows $this
1098}
1099
1100
1101proc ::BayesTable::CmdCopy {this} {
1102  # before delete clipboard
1103  clipboard clear
1104
1105  set table [GetTkTable $this]
1106  tk_tableCopy $table
1107}
1108
1109#/////////////////////////////////////////////////////////////////////////////
1110  proc ::BayesTable::CmdPaste {this} {
1111#
1112# PURPOSE: Paste information in the cell
1113#
1114# PARAMETERS:
1115#   this -> Instance of Bayes Table
1116#
1117#/////////////////////////////////////////////////////////////////////////////
1118  set table [GetTkTable $this]
1119  set txt [clipboard get]
1120  set p   [$table index active]
1121  if {![string length $p]} {
1122    set p 0,0
1123  }
1124  PasteHandler $table $p $txt
1125}
1126
1127#/////////////////////////////////////////////////////////////////////////////
1128proc ::BayesTable::PasteHandler {table cell txt} {
1129#
1130# PURPOSE: This procedure handles how data is pasted into the table widget.
1131#          This handles data in the default table selection form.
1132#          Allows paste data in title cells and grows in rows or/and columns
1133#          if necesary
1134#
1135# PARAMETERS:
1136#   table -> Name of a table widget
1137#   cell  -> Cell to start pasting in
1138#   txt   -> Text to paste
1139#
1140#/////////////////////////////////////////////////////////////////////////////
1141  # Calculo las filas y columnas necesarias para pegar 
1142  set rowIni [lindex [split $cell ","] 0]
1143  set colIni [lindex [split $cell ","] 1]
1144  set rsep [$table cget -rowseparator]
1145  set csep [$table cget -colseparator]
1146
1147  if {[string comp {} $rsep]} { set drows [split $txt $rsep] }
1148  set numRows [llength $drows]
1149  if [string equal [lindex $drows end] {}] {
1150    set numRows [incr numRows -1]
1151  }
1152  set numCols 0 
1153  foreach line $drows {
1154    #Tolcon_Trace "line=$line"
1155    if [expr [llength [split $line $csep]] > $numCols] {
1156      set numCols [llength [split $line $csep]]
1157    }
1158  }
1159  #Tolcon_Trace "rowIni=$rowIni, numRows=$numRows"
1160  #Tolcon_Trace "colIni=$colIni, numCols=$numCols"
1161
1162  #Si necesito más filas las creo 
1163  if [expr $rowIni+$numRows > [$table cget -rows]] {
1164    $table configure -rows [expr $rowIni+$numRows]
1165  }
1166  #Si necesito más columnas
1167  if [expr $colIni+$numCols > [$table cget -cols]] {
1168    $table configure -cols [expr $colIni+$numCols]
1169  }
1170  # En la versión 2.8 tktable no permite pegar en las celdas de título
1171  # así que le engañamos
1172  set titlerows [$table cget -titlerows]
1173  set titlecols [$table cget -titlecols]
1174  $table configure -titlerows 0 -titlecols 0
1175  #Tolcon_Trace "Llamada a tk_tablePasteHandler table=$table, p=$p, txt=$txt"
1176  tk_tablePasteHandler $table $cell $txt
1177  $table configure -titlerows $titlerows -titlecols $titlecols
1178}
1179
1180#/////////////////////////////////////////////////////////////////////////////
1181  proc ::BayesTable::CmdFind {this} {
1182#
1183# PURPOSE:
1184#
1185# PARAMETERS:
1186#   this -> Instance of Bayes Table
1187#
1188#/////////////////////////////////////////////////////////////////////////////
1189
1190  ::BayesTable::FindShow $this
1191}
1192
1193proc ::BayesTable::CmdFilter {this} {
1194}
1195proc ::BayesTable::CmdOrdAsc {this} {
1196}
1197proc ::BayesTable::CmdOrdDes {this} {
1198}
1199 
1200#/////////////////////////////////////////////////////////////////////////////
1201  proc ::BayesTable::FindText { this } {
1202#
1203# PURPOSE: Find the text in the table
1204#
1205# PARAMETERS:
1206#   this -> Instance of Bayes Table
1207#
1208# RETURN: A list with the coordinates of the cell in which is the text find.
1209#         Empty does not find it.
1210#
1211#/////////////////////////////////////////////////////////////////////////////
1212   
1213  upvar \#0 ${this}::data data
1214  #inizializamos valores
1215  set ok 0
1216  set rc ""
1217  #fijamos numero de filas y columnas y origen de fila y columna
1218  set r   [$data(tabla) cget -rows]
1219  set c   [$data(tabla) cget -cols]
1220  set ro  [$data(tabla) cget -roworigin]
1221  set co [$data(tabla) cget -colorigin]
1222  #celda activa
1223  if { ![catch {set pos [$data(tabla) index active]} msgerr] } {
1224    if {$pos eq "" } {
1225      set rp $ro
1226      set cp $co
1227    } else  {
1228      set pc [string first , $pos]
1229      set rp [string range $pos 0         [expr $pc - 1]]
1230      set cp [string range $pos [incr pc] end]
1231    }
1232  } else  {
1233    set rp $ro
1234    set cp $co
1235  }
1236  #establecemos direccion de busqueda
1237  if [string equal $data(find,dir) "forward"] {
1238    set dir 1
1239  } else {
1240    set dir -1
1241  } 
1242  #comprobamos si muyusculas minusculas
1243  if $data(find,case) {
1244    set nc ""   
1245  } else  {
1246    set nc -nocase   
1247  }
1248  set sw $data(tabla,next)
1249  #comparamos valores
1250  if {![string equal $data(find,text) ""]} {
1251    while {[expr ($ok == 0) && ($cp >= $co) && ($cp < $c)]} {
1252      while {[expr ($ok == 0) && ($rp >= $ro) && ($rp < $r)]} {
1253        set txt [$data(tabla) get $rp,$cp]
1254        if {[eval string match $nc [list $data(find,text)] [list $txt]]} {
1255          if {($sw eq "0") || ($pos ne "$rp,$cp")} {
1256            set ok 1 
1257            set rc "$rp $cp"
1258          }
1259          set sw 0
1260        }
1261        incr rp $dir
1262      }
1263      if {[expr ($dir == 1)]} {
1264        set rp $ro
1265      } else  {
1266        set rp [expr $r - 1]
1267      }
1268      incr cp $dir
1269    }
1270  }
1271  return $rc
1272}
1273       
1274#/////////////////////////////////////////////////////////////////////////////
1275  proc ::BayesTable::FindCreate { this } {
1276#
1277# PURPOSE: Creates a Find Dialog given a Instance
1278#
1279# PARAMETERS:
1280#   this -> Instance of Bayes Table
1281#
1282#/////////////////////////////////////////////////////////////////////////////
1283
1284  upvar \#0 ${this}::data data
1285
1286  set data(find,dir)   forward
1287  set dialog [Dialog $data(path) -title [mc "Find"]\
1288          -default 0 -modal none -parent $data(tabla)]
1289  set w [$dialog getframe]
1290  wm resizable $data(path) 0 0
1291 
1292  set data(frm,cad) [LabelEntry  $w.eTxt -width 35 -label "[mc "Find"]: " \
1293          -textvariable ${this}::data(find,text)]
1294  checkbutton $w.full -text [mc "Palabra completa"] \
1295          -variable ${this}::data(find,full) -pady 0 -state disabled
1296  checkbutton $w.case  -text [mc "Case sensitive"] \
1297          -variable ${this}::data(find,case) -pady 0
1298  TitleFrame $w.dir -bd 2 -relief groove -text [mc "Direction"]
1299  set f [$w.dir getframe]
1300  radiobutton $f.forward -text [mc "Forward"] -value forward \
1301          -variable ${this}::data(find,dir)\
1302          -highlightthickness 0 -pady 0
1303  radiobutton $f.backward -text [mc "Backward"] -value backward \
1304          -variable ${this}::data(find,dir)\
1305          -highlightthickness 0 -pady 0
1306  Button $w.findNext -text [mc "Find next"] -width 16 \
1307          -command [list ::BayesTable::FindNext $this] \
1308          -helptext [mc "Find next"]
1309  Button $w.cancelar -text [mc "Cancel"] -width 16 \
1310          -helptext "" -command "destroy $dialog"
1311 
1312  bind $dialog <Return> [list ::BayesTable::FindNext $this]
1313  bind $dialog <F3>     [list ::BayesTable::FindNext $this]
1314  bind $dialog <Escape> [list destroy $dialog]
1315
1316  # Hemos añadido un tag para la selección, hay que quitarle como el tag sel
1317  bind $data(tabla) <ButtonPress> +[list $data(tabla) tag delete found]
1318  grid $f.forward  $f.backward -sticky nw
1319 
1320  grid $w.eTxt -       $w.findNext -sticky nw -padx 5 -pady 2
1321  grid $w.full $w.dir  $w.cancelar -sticky ws -padx 5
1322  grid $w.case ^                   -sticky nw -padx 5
1323  wm geometry $dialog 360x90
1324  $dialog draw
1325  update
1326  focus $data(frm,cad)
1327  $data(frm,cad).e selection range 0 end
1328}
1329
1330#/////////////////////////////////////////////////////////////////////////////
1331  proc ::BayesTable::FindNext { this } {
1332#
1333# PURPOSE: Creates a Find Dialog given a Instance
1334#
1335# PARAMETERS:
1336#   this -> Instance of Bayes Table
1337#
1338#/////////////////////////////////////////////////////////////////////////////
1339
1340  upvar \#0 ${this}::data data
1341   
1342  set pos     [FindText $this]
1343  # comprobamos si ha encontrado algo
1344  if { $pos != "" } {
1345    set data(tabla,next) 1
1346    set p "[lindex $pos 0],[lindex $pos 1]"
1347    $data(tabla) selection clear all
1348    $data(tabla) see $p   
1349    $data(tabla) activate $p
1350#    $data(tabla) selection set $p
1351  } else {
1352    set data(tabla,next) 0
1353    if [string equal $data(find,dir) "forward"] {
1354      set msg "[mc SearchUpEndDoc].\n[mc FindFromBegin]"
1355    } else {
1356      set msg "[mc SearchUpBeginDoc].\n[mc FindFromEnd]"
1357    }
1358    if [winfo exists $data(path)] {
1359      set parent $data(path)
1360    } else  {
1361      set parent $data(tabla)
1362    }
1363    set rq [tk_messageBox -type okcancel -icon info -parent $parent\
1364            -title [mc "Table"] -message $msg]
1365    if {$rq == "ok"} {
1366      if [string equal $data(find,dir) "forward"] {
1367        set ro [$data(tabla) cget -roworigin]
1368        set co [$data(tabla) cget -colorigin]
1369        $data(tabla) activate "$ro,$co"
1370      } else {
1371        $data(tabla) activate end
1372      }
1373      FindNext $this
1374    }
1375  }
1376  # Debo quedarme yo con el foco, no la tabla
1377
1378  #focus $data(tabla)
1379}
1380
1381#/////////////////////////////////////////////////////////////////////////////
1382  proc ::BayesTable::FindShow {this {next 0} {txt ""}} {
1383#
1384# PURPOSE: Creates a Find Dialog given a Instance
1385#
1386# PARAMETERS:
1387#   this -> Instance of Bayes Table
1388#   next
1389#   txt
1390#
1391#/////////////////////////////////////////////////////////////////////////////
1392
1393  set tabla [GetTkTable $this]
1394  set Instance ::BayesTable::Find$tabla
1395  if { [lsearch [namespace children ::BayesTable] $Instance] != -1 } {
1396     
1397  } else  {
1398    namespace eval $Instance {
1399      variable data
1400      #data(find,text) --> texto a buscar
1401      #data(find,dir)  --> dirección de búsqueda
1402      #data(start)     --> indica desde donde se empieza a buscar
1403      #data(find,full) -->
1404      #data(find,case) -->
1405      #data(tabla)    --> el path del widget tabla en el q buscar
1406      #data(path)      --> el path del toplevel que muestra el cuado de búsqueda
1407      #data(frm,cad)   --> entry donde se inserta el texto a buscar
1408      #data(tabla,next) -> 0 primera busqueda, 1 sigiente busqueda
1409    }
1410  }
1411
1412  upvar \#0 ${Instance}::data data
1413
1414  set data(tabla) $tabla
1415  set data(namespace) "FindDialog"
1416  set data(path) ${tabla}.tFind
1417  if [winfo exist $data(path)] {
1418    raise $data(path)
1419    focus $data(frm,cad)
1420    $data(frm,cad).e selection range 0 end
1421    return
1422  }
1423
1424  set data(tabla,next) 0
1425  if {$txt != ""} {
1426    set data(find,dir)  forward
1427    set data(find,case) 1
1428    set data(find,text) $txt
1429  }
1430
1431  if {$next && [info exists ${Instance}::data(find,text)] && ($data(find,text) !="") } {
1432      FindNext $Instance
1433  } else {
1434      FindCreate $Instance
1435  }
1436}
Note: See TracBrowser for help on using the repository browser.