source: tol/tolbase/lib/toltk/bystable.tcl @ e933fd6

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

Refs #1933
Se sustituyen los ::blt::tabset por NoteBook de BWidget. En total se sustituyeron 19 tabsets.
Se suspenden un par de widgets que parece que no se usan, y por tanto tampoco se les ha sustituido ::blt::tabset: bsersel, btab. bchilddetail tampoco parece usarse.
Se corrige un problem en InsertItem de tolinspe.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7337 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 [NoteBook $w.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
754  #insertar tabset
755  set num_i 0
756  set lab_i General
757  $w_tabset insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
758  set tab_i [$w_tabset getframe $lab_i]
759  $tab_i configure -borderwidth 2 -background \#d9d9d9   
760  set f$num_i [frame $tab_i.f]
761  pack $tab_i.f -fill both -expand yes 
762  $w_tabset raise [$w_tabset pages 0]
763 
764  OptionsCreate $this $f0
765  #Crear opciones especificas
766  if [info exists ${this}::data(proc,OnOptionCreate)] {
767    $data(proc,OnOptionCreate) $this $w_tabset
768  } 
769
770  set w_bbox \
771          [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
772          -homogeneous false]
773  $w_bbox add -text [mc "Accept"] -relief link \
774         -helptext [mc "Accept"] \
775          -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
776          -command  [list ::BayesTable::OptionsOK $this $dialog]
777  $w_bbox add -text [mc "Cancel"] -relief link \
778          -helptext [mc "Cancel"]\
779          -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
780          -command [list ::BayesTable::OptionsDestroy $this $dialog]
781  $w_bbox add -text [mc "Apply"] -relief link \
782          -helptext [mc "Apply"]\
783          -image [::Bitmap::get apply] -compound left -padx 5 -pady 1 \
784          -command [list ::BayesTable::OptionsApply $this]   
785 
786  pack $w_bbox -fill x -expand false -side bottom
787  pack $w_tabset -fill both -expand true
788   
789  $dialog draw
790}
791
792proc ::BayesTable::OptionsCreate {this frame} {
793  set w_tabset [NoteBook $frame.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
794  set num_i 0
795  foreach lab_i [list Export Style] {
796    $w_tabset insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
797    set tab_i [$w_tabset getframe $lab_i]
798    $tab_i configure -borderwidth 2 -background \#d9d9d9
799    incr num_i   
800    set f$num_i [frame $tab_i.f]
801    pack $tab_i.f -fill both -expand yes 
802  }
803  $w_tabset raise [$w_tabset pages 0]
804 
805  OptionsGet           $this
806  OptionsCreateExport  $this $f1
807  OptionsCreateStyle   $this $f2
808  #OptionsInit  $this
809  OptionsCheck $this
810  #OptionsSet   $this
811
812  $w_tabset compute_size
813  grid $w_tabset -sticky news 
814  grid rowconfigure    $frame 0 -weight 1
815  grid columnconfigure $frame 0 -weight 1
816}
817
818proc ::BayesTable::OptionsCreateStyle {this w} {
819  variable tmpOpt
820
821  TitleFrame $w.tf1 -text [mc "Style"]
822  set f1 [$w.tf1 getframe]
823
824  label $f1.lFont -text [mc "Font"]:
825  ::Objects::FontCreate ::BayesTable::tmpOpt(var,font) $f1.bFont
826
827  label $f1.lColor -text [mc "Color"]:
828  ::Objects::ColorCreate ::BayesTable::tmpOpt(var,bg) $f1.fColor
829  frame $f1.f -width 25
830
831  grid $f1.f $f1.lFont $f1.bFont $f1.lColor $f1.fColor -sticky w -padx 2 -pady 1
832
833  grid rowconfigure    $f1 3 -weight 1
834  grid columnconfigure $f1 4 -weight 1
835  grid columnconfigure $f1 2 -pad   20
836
837  TitleFrame $w.tf2 -text [mc "Title"]
838  set f2 [$w.tf2 getframe]
839
840  label $f2.lTitleRows -text [mc "Number of rows to use as title area"]:
841  SpinBox $f2.sbTitleRows -range {0 3} -width 4 -justify right -editable false\
842      -textvariable ::BayesTable::tmpOpt(var,titlerows)
843  label $f2.lTitleCols -text [mc "Number of columns to use as title area"]:
844  SpinBox $f2.sbTitleCols -range {0 3} -width 4 -justify right -editable false\
845      -textvariable ::BayesTable::tmpOpt(var,titlecols)
846  checkbutton $f2.chSelectTitles -text [mc "Allow title cells in the selection"] \
847     -variable ::BayesTable::tmpOpt(var,selecttitles)
848
849  frame $f2.f -width 25
850  grid $f2.f $f2.lTitleRows $f2.sbTitleRows -sticky w -padx 2
851  grid ^     $f2.lTitleCols $f2.sbTitleCols -sticky w -padx 2
852  grid ^     $f2.chSelectTitles -           -sticky w -padx 2
853
854  grid rowconfigure    $f2 3 -weight 1
855  grid columnconfigure $f2 3 -weight 1
856
857  grid $w.tf1 -sticky news -padx 2
858  grid $w.tf2 -sticky news -padx 2
859  grid rowconfigure    $w 0 -weight 1
860  grid rowconfigure    $w 1 -weight 3
861  grid columnconfigure $w 0 -weight 1
862}
863
864proc ::BayesTable::OptionsCreateExport {this w} {
865  variable tmpOpt
866
867  TitleFrame $w.tf1 -text [mc "Columns separator"]
868  set f1 [$w.tf1 getframe]
869  set tmpOpt(widget,rbColSep1) [radiobutton $f1.rbColSep1 -text [mc Tab] \
870     -value TAB -highlightthickness 0 -pady 0 \
871     -variable ::BayesTable::tmpOpt(var,colSepType) \
872     -command [list ::BayesTable::OptionsCheckColSepType $this]]
873  set tmpOpt(widget,rbColSep2) [radiobutton $f1.rbColSep2 -text [mc Return] \
874     -value RET -highlightthickness 0 -pady 0 \
875     -variable ::BayesTable::tmpOpt(var,colSepType) \
876     -command [list ::BayesTable::OptionsCheckColSepType $this]]
877  radiobutton $f1.rbColSepN -text [mc Other]: \
878     -value OTHER -highlightthickness 0 -pady 0 \
879     -variable ::BayesTable::tmpOpt(var,colSepType) \
880     -command [list ::BayesTable::OptionsCheckColSepType $this]
881  set tmpOpt(widget,colSeparator) [Entry $f1.eColSep \
882     -width 5 -justify right -textvariable ::BayesTable::tmpOpt(var,colSeparator)]
883  frame $f1.f -width 25
884  #grid $f1.f $f1.rbColSep1 -           -sticky nw -padx 2 -pady 0
885  #grid ^     $f1.rbColSepN $f1.eColSep -sticky w  -padx 2 -pady 0
886  #grid rowconfigure    $f1 2 -weight 1
887  #grid columnconfigure $f1 2 -weight 1
888  grid $f1.f $f1.rbColSep1 $f1.rbColSep2 $f1.rbColSepN $f1.eColSep -sticky w  -padx 2 -pady 0
889  grid rowconfigure    $f1 1 -weight 1
890  grid columnconfigure $f1 4 -weight 1
891
892  TitleFrame $w.tf2 -text [mc "Rows separator"]
893  set f2 [$w.tf2 getframe]
894  set tmpOpt(widget,rbRowSep1) [radiobutton $f2.rbRowSep1 -text [mc Return] \
895     -value RET -highlightthickness 0 -pady 0 \
896     -variable ::BayesTable::tmpOpt(var,rowSepType) \
897     -command [list ::BayesTable::OptionsCheckRowSepType $this]]
898  set tmpOpt(widget,rbRowSep2) [radiobutton $f2.rbRowSep2 -text [mc Tab] \
899     -value TAB -highlightthickness 0 -pady 0 \
900     -variable ::BayesTable::tmpOpt(var,rowSepType) \
901     -command [list ::BayesTable::OptionsCheckRowSepType $this]]
902  radiobutton $f2.rbRowSepN -text [mc Other]: \
903     -value OTHER -highlightthickness 0 -pady 0 \
904     -variable ::BayesTable::tmpOpt(var,rowSepType) \
905     -command [list ::BayesTable::OptionsCheckRowSepType $this]
906  set tmpOpt(widget,rowSeparator) [Entry $f2.eRowSep \
907     -width 5 -justify right -textvariable ::BayesTable::tmpOpt(var,rowSeparator)]
908  checkbutton $f2.chOmitLast -text [mc "Omit last row separator (Excel)"] \
909     -variable ::BayesTable::tmpOpt(var,omitLast)
910  frame $f2.f -width 25
911  grid $f2.f $f2.rbRowSep1 $f2.rbRowSep2 $f2.rbRowSepN $f2.eRowSep -sticky w -padx 2 -pady 0
912  #grid ^     $f2.chOmitLast -            -           -sticky w -padx 2 -pady 0
913  grid rowconfigure    $f2 1 -weight 1
914  grid columnconfigure $f2 4 -weight 1
915
916  grid $w.tf1 -sticky news -padx 2
917  grid $w.tf2 -sticky news -padx 2
918  grid rowconfigure    $w 0 -weight 1
919  grid rowconfigure    $w 1 -weight 3
920  grid columnconfigure $w 0 -weight 1
921}
922
923
924#/////////////////////////////////////////////////////////////////////////////
925  proc ::BayesTable::OptionsCheck {this} {
926#
927# PURPOSE: Checks for all widgets from dialog options that need to be checked
928#          for enabling/disabling other associated controls.
929#
930# PARAMETERS:
931#   this   -> Instance of BayesTable
932#
933#/////////////////////////////////////////////////////////////////////////////
934  ::BayesTable::OptionsCheckColSepType $this
935  ::BayesTable::OptionsCheckRowSepType $this
936}
937
938proc ::BayesTable::OptionsCheckColSepType {this} {
939  variable tmpOpt
940
941  switch $tmpOpt(var,colSepType) {
942    TAB   {
943      focus $tmpOpt(widget,rbColSep1)
944      $tmpOpt(widget,colSeparator) configure -state disabled
945    }
946    RET   {
947      focus $tmpOpt(widget,rbColSep2)
948      $tmpOpt(widget,colSeparator) configure -state disabled
949    }
950    OTHER { $tmpOpt(widget,colSeparator) configure -state normal }
951  }
952}
953
954proc ::BayesTable::OptionsCheckRowSepType {this} {
955  variable tmpOpt
956
957  switch $tmpOpt(var,rowSepType) {
958    RET   {
959      focus $tmpOpt(widget,rbRowSep1)
960      $tmpOpt(widget,rowSeparator) configure -state disabled
961    }
962    TAB   {
963      focus $tmpOpt(widget,rbRowSep2)
964      $tmpOpt(widget,rowSeparator) configure -state disabled
965    }
966    OTHER { $tmpOpt(widget,rowSeparator) configure -state normal }
967  }
968}
969
970
971#/////////////////////////////////////////////////////////////////////////////
972  proc ::BayesTable::OptionsGet {this} {
973#
974# PURPOSE: Initializes all options variables and stores them into the
975#          temporary 'tmpOpt' array.
976#
977# PARAMETERS:
978#   this   -> Instance of BayesTable
979#
980#/////////////////////////////////////////////////////////////////////////////
981  upvar \#0 ${this}::options opt
982  variable tmpOpt
983
984  set table [GetTkTable $this]
985  foreach op {bg font titlecols titlerows selecttitles} {
986    set tmpOpt(var,$op) [$table cget -$op]
987  }
988  foreach op {colSepType colSeparator rowSepType rowSeparator} {
989    set tmpOpt(var,$op) $opt($op)
990  }
991}
992
993
994#/////////////////////////////////////////////////////////////////////////////
995  proc ::BayesTable::OptionsSet {this} {
996#
997# PURPOSE: Commits all options values from the temporary 'tmpOpt' array to
998#          other structure.
999#
1000# PARAMETERS:
1001#   this   -> Instance of BayesTable
1002#
1003#/////////////////////////////////////////////////////////////////////////////
1004  upvar \#0 ${this}::options options
1005  variable tmpOpt
1006
1007  regsub -all var, [array names ::BayesTable::tmpOpt var,*] "" optNames
1008  foreach it $optNames {
1009    set options($it) $tmpOpt(var,$it)
1010  }
1011}
1012
1013proc ::BayesTable::OptionsOK {this dialog} {
1014  OptionsApply   $this
1015  OptionsDestroy $this $dialog
1016}
1017
1018proc ::BayesTable::OptionsDestroy {this dialog} {
1019  upvar \#0 ${this}::data data
1020  variable tmpOpt
1021  #Destruir opciones especificas
1022  if [info exists ${this}::data(proc,OnOptionDestroy)] {
1023    $data(proc,OnOptionDestroy) $this
1024  }
1025  array unset tmpOpt
1026  destroy $dialog
1027}
1028
1029
1030proc ::BayesTable::CmdFirst {this} {
1031  set table [GetTkTable $this]
1032  $table see origin
1033}
1034
1035proc ::BayesTable::CmdBack {this} {
1036  set table [GetTkTable $this]
1037  ::tk::table::MoveCell $table -1  0
1038  #set cell [split [$table index active] ,]
1039  #$table selection clear all
1040  #$table activate  [expr [lindex $cell 0] -1],[lindex $cell 1] 
1041  #$table selection set active
1042  #$table see active
1043}
1044
1045proc ::BayesTable::CmdNext {this} {
1046  set table [GetTkTable $this]
1047  ::tk::table::MoveCell $table 1  0
1048}
1049
1050proc ::BayesTable::CmdLast {this} {
1051  set table [GetTkTable $this]
1052  $table see end
1053}
1054
1055proc ::BayesTable::CmdSelectAll {this} {
1056  set table [GetTkTable $this]
1057  ::tk::table::SelectAll $table
1058  #$table selection set origin end
1059}
1060
1061proc ::BayesTable::CmdDelete {this} {
1062  set table [GetTkTable $this]
1063  if {[llength [$table curselection]] > 1 } {
1064    $table curselection {}
1065    $table selection clear all
1066  }
1067}
1068
1069proc ::BayesTable::CmdModifyRowsCols {this oper item} {
1070  if {![string equal $oper "insert"] && ![string equal $oper "delete"]} { return }
1071  if {![string equal $item "rows"]   && ![string equal $item "cols"]  } { return }
1072
1073  set table [GetTkTable $this]
1074  set cells [$table curselection]
1075  if ![llength $cells] {
1076    set cells {0,0}
1077  }
1078  set rowIni [lindex [split [lindex $cells 0] ","] 0]
1079  set colIni [lindex [split [lindex $cells 0] ","] 1]
1080  set rowEnd [lindex [split [lindex $cells end] ","] 0]
1081  set colEnd [lindex [split [lindex $cells end] ","] 1]
1082  set rows [expr $rowEnd-$rowIni+1]
1083  set cols [expr $colEnd-$colIni+1]
1084
1085  switch $item {
1086    rows {
1087      switch $oper {
1088        insert { $table insert rows -holdselection $rowIni -$rows }
1089        delete { $table delete rows -holdselection $rowIni $rows }
1090      }
1091    }
1092    cols {
1093      switch $oper {
1094        insert { $table insert cols -holdselection $colIni -$cols }
1095        delete { $table delete cols -holdselection $colIni $cols }
1096      }
1097    }
1098  }
1099  UpdateInfoRows $this
1100}
1101
1102
1103proc ::BayesTable::CmdCopy {this} {
1104  # before delete clipboard
1105  clipboard clear
1106
1107  set table [GetTkTable $this]
1108  tk_tableCopy $table
1109}
1110
1111#/////////////////////////////////////////////////////////////////////////////
1112  proc ::BayesTable::CmdPaste {this} {
1113#
1114# PURPOSE: Paste information in the cell
1115#
1116# PARAMETERS:
1117#   this -> Instance of Bayes Table
1118#
1119#/////////////////////////////////////////////////////////////////////////////
1120  set table [GetTkTable $this]
1121  set txt [clipboard get]
1122  set p   [$table index active]
1123  if {![string length $p]} {
1124    set p 0,0
1125  }
1126  PasteHandler $table $p $txt
1127}
1128
1129#/////////////////////////////////////////////////////////////////////////////
1130proc ::BayesTable::PasteHandler {table cell txt} {
1131#
1132# PURPOSE: This procedure handles how data is pasted into the table widget.
1133#          This handles data in the default table selection form.
1134#          Allows paste data in title cells and grows in rows or/and columns
1135#          if necesary
1136#
1137# PARAMETERS:
1138#   table -> Name of a table widget
1139#   cell  -> Cell to start pasting in
1140#   txt   -> Text to paste
1141#
1142#/////////////////////////////////////////////////////////////////////////////
1143  # Calculo las filas y columnas necesarias para pegar 
1144  set rowIni [lindex [split $cell ","] 0]
1145  set colIni [lindex [split $cell ","] 1]
1146  set rsep [$table cget -rowseparator]
1147  set csep [$table cget -colseparator]
1148
1149  if {[string comp {} $rsep]} { set drows [split $txt $rsep] }
1150  set numRows [llength $drows]
1151  if [string equal [lindex $drows end] {}] {
1152    set numRows [incr numRows -1]
1153  }
1154  set numCols 0 
1155  foreach line $drows {
1156    #Tolcon_Trace "line=$line"
1157    if [expr [llength [split $line $csep]] > $numCols] {
1158      set numCols [llength [split $line $csep]]
1159    }
1160  }
1161  #Tolcon_Trace "rowIni=$rowIni, numRows=$numRows"
1162  #Tolcon_Trace "colIni=$colIni, numCols=$numCols"
1163
1164  #Si necesito más filas las creo 
1165  if [expr $rowIni+$numRows > [$table cget -rows]] {
1166    $table configure -rows [expr $rowIni+$numRows]
1167  }
1168  #Si necesito más columnas
1169  if [expr $colIni+$numCols > [$table cget -cols]] {
1170    $table configure -cols [expr $colIni+$numCols]
1171  }
1172  # En la versión 2.8 tktable no permite pegar en las celdas de título
1173  # así que le engañamos
1174  set titlerows [$table cget -titlerows]
1175  set titlecols [$table cget -titlecols]
1176  $table configure -titlerows 0 -titlecols 0
1177  #Tolcon_Trace "Llamada a tk_tablePasteHandler table=$table, p=$p, txt=$txt"
1178  tk_tablePasteHandler $table $cell $txt
1179  $table configure -titlerows $titlerows -titlecols $titlecols
1180}
1181
1182#/////////////////////////////////////////////////////////////////////////////
1183  proc ::BayesTable::CmdFind {this} {
1184#
1185# PURPOSE:
1186#
1187# PARAMETERS:
1188#   this -> Instance of Bayes Table
1189#
1190#/////////////////////////////////////////////////////////////////////////////
1191
1192  ::BayesTable::FindShow $this
1193}
1194
1195proc ::BayesTable::CmdFilter {this} {
1196}
1197proc ::BayesTable::CmdOrdAsc {this} {
1198}
1199proc ::BayesTable::CmdOrdDes {this} {
1200}
1201 
1202#/////////////////////////////////////////////////////////////////////////////
1203  proc ::BayesTable::FindText { this } {
1204#
1205# PURPOSE: Find the text in the table
1206#
1207# PARAMETERS:
1208#   this -> Instance of Bayes Table
1209#
1210# RETURN: A list with the coordinates of the cell in which is the text find.
1211#         Empty does not find it.
1212#
1213#/////////////////////////////////////////////////////////////////////////////
1214   
1215  upvar \#0 ${this}::data data
1216  #inizializamos valores
1217  set ok 0
1218  set rc ""
1219  #fijamos numero de filas y columnas y origen de fila y columna
1220  set r   [$data(tabla) cget -rows]
1221  set c   [$data(tabla) cget -cols]
1222  set ro  [$data(tabla) cget -roworigin]
1223  set co [$data(tabla) cget -colorigin]
1224  #celda activa
1225  if { ![catch {set pos [$data(tabla) index active]} msgerr] } {
1226    if {$pos eq "" } {
1227      set rp $ro
1228      set cp $co
1229    } else  {
1230      set pc [string first , $pos]
1231      set rp [string range $pos 0         [expr $pc - 1]]
1232      set cp [string range $pos [incr pc] end]
1233    }
1234  } else  {
1235    set rp $ro
1236    set cp $co
1237  }
1238  #establecemos direccion de busqueda
1239  if [string equal $data(find,dir) "forward"] {
1240    set dir 1
1241  } else {
1242    set dir -1
1243  } 
1244  #comprobamos si muyusculas minusculas
1245  if $data(find,case) {
1246    set nc ""   
1247  } else  {
1248    set nc -nocase   
1249  }
1250  set sw $data(tabla,next)
1251  #comparamos valores
1252  if {![string equal $data(find,text) ""]} {
1253    while {[expr ($ok == 0) && ($cp >= $co) && ($cp < $c)]} {
1254      while {[expr ($ok == 0) && ($rp >= $ro) && ($rp < $r)]} {
1255        set txt [$data(tabla) get $rp,$cp]
1256        if {[eval string match $nc [list $data(find,text)] [list $txt]]} {
1257          if {($sw eq "0") || ($pos ne "$rp,$cp")} {
1258            set ok 1 
1259            set rc "$rp $cp"
1260          }
1261          set sw 0
1262        }
1263        incr rp $dir
1264      }
1265      if {[expr ($dir == 1)]} {
1266        set rp $ro
1267      } else  {
1268        set rp [expr $r - 1]
1269      }
1270      incr cp $dir
1271    }
1272  }
1273  return $rc
1274}
1275       
1276#/////////////////////////////////////////////////////////////////////////////
1277  proc ::BayesTable::FindCreate { this } {
1278#
1279# PURPOSE: Creates a Find Dialog given a Instance
1280#
1281# PARAMETERS:
1282#   this -> Instance of Bayes Table
1283#
1284#/////////////////////////////////////////////////////////////////////////////
1285
1286  upvar \#0 ${this}::data data
1287
1288  set data(find,dir)   forward
1289  set dialog [Dialog $data(path) -title [mc "Find"]\
1290          -default 0 -modal none -parent $data(tabla)]
1291  set w [$dialog getframe]
1292  wm resizable $data(path) 0 0
1293 
1294  set data(frm,cad) [LabelEntry  $w.eTxt -width 35 -label "[mc "Find"]: " \
1295          -textvariable ${this}::data(find,text)]
1296  checkbutton $w.full -text [mc "Palabra completa"] \
1297          -variable ${this}::data(find,full) -pady 0 -state disabled
1298  checkbutton $w.case  -text [mc "Case sensitive"] \
1299          -variable ${this}::data(find,case) -pady 0
1300  TitleFrame $w.dir -bd 2 -relief groove -text [mc "Direction"]
1301  set f [$w.dir getframe]
1302  radiobutton $f.forward -text [mc "Forward"] -value forward \
1303          -variable ${this}::data(find,dir)\
1304          -highlightthickness 0 -pady 0
1305  radiobutton $f.backward -text [mc "Backward"] -value backward \
1306          -variable ${this}::data(find,dir)\
1307          -highlightthickness 0 -pady 0
1308  Button $w.findNext -text [mc "Find next"] -width 16 \
1309          -command [list ::BayesTable::FindNext $this] \
1310          -helptext [mc "Find next"]
1311  Button $w.cancelar -text [mc "Cancel"] -width 16 \
1312          -helptext "" -command "destroy $dialog"
1313 
1314  bind $dialog <Return> [list ::BayesTable::FindNext $this]
1315  bind $dialog <F3>     [list ::BayesTable::FindNext $this]
1316  bind $dialog <Escape> [list destroy $dialog]
1317
1318  # Hemos añadido un tag para la selección, hay que quitarle como el tag sel
1319  bind $data(tabla) <ButtonPress> +[list $data(tabla) tag delete found]
1320  grid $f.forward  $f.backward -sticky nw
1321 
1322  grid $w.eTxt -       $w.findNext -sticky nw -padx 5 -pady 2
1323  grid $w.full $w.dir  $w.cancelar -sticky ws -padx 5
1324  grid $w.case ^                   -sticky nw -padx 5
1325  wm geometry $dialog 360x90
1326  $dialog draw
1327  update
1328  focus $data(frm,cad)
1329  $data(frm,cad).e selection range 0 end
1330}
1331
1332#/////////////////////////////////////////////////////////////////////////////
1333  proc ::BayesTable::FindNext { this } {
1334#
1335# PURPOSE: Creates a Find Dialog given a Instance
1336#
1337# PARAMETERS:
1338#   this -> Instance of Bayes Table
1339#
1340#/////////////////////////////////////////////////////////////////////////////
1341
1342  upvar \#0 ${this}::data data
1343   
1344  set pos     [FindText $this]
1345  # comprobamos si ha encontrado algo
1346  if { $pos != "" } {
1347    set data(tabla,next) 1
1348    set p "[lindex $pos 0],[lindex $pos 1]"
1349    $data(tabla) selection clear all
1350    $data(tabla) see $p   
1351    $data(tabla) activate $p
1352#    $data(tabla) selection set $p
1353  } else {
1354    set data(tabla,next) 0
1355    if [string equal $data(find,dir) "forward"] {
1356      set msg "[mc SearchUpEndDoc].\n[mc FindFromBegin]"
1357    } else {
1358      set msg "[mc SearchUpBeginDoc].\n[mc FindFromEnd]"
1359    }
1360    if [winfo exists $data(path)] {
1361      set parent $data(path)
1362    } else  {
1363      set parent $data(tabla)
1364    }
1365    set rq [tk_messageBox -type okcancel -icon info -parent $parent\
1366            -title [mc "Table"] -message $msg]
1367    if {$rq == "ok"} {
1368      if [string equal $data(find,dir) "forward"] {
1369        set ro [$data(tabla) cget -roworigin]
1370        set co [$data(tabla) cget -colorigin]
1371        $data(tabla) activate "$ro,$co"
1372      } else {
1373        $data(tabla) activate end
1374      }
1375      FindNext $this
1376    }
1377  }
1378  # Debo quedarme yo con el foco, no la tabla
1379
1380  #focus $data(tabla)
1381}
1382
1383#/////////////////////////////////////////////////////////////////////////////
1384  proc ::BayesTable::FindShow {this {next 0} {txt ""}} {
1385#
1386# PURPOSE: Creates a Find Dialog given a Instance
1387#
1388# PARAMETERS:
1389#   this -> Instance of Bayes Table
1390#   next
1391#   txt
1392#
1393#/////////////////////////////////////////////////////////////////////////////
1394
1395  set tabla [GetTkTable $this]
1396  set Instance ::BayesTable::Find$tabla
1397  if { [lsearch [namespace children ::BayesTable] $Instance] != -1 } {
1398     
1399  } else  {
1400    namespace eval $Instance {
1401      variable data
1402      #data(find,text) --> texto a buscar
1403      #data(find,dir)  --> dirección de búsqueda
1404      #data(start)     --> indica desde donde se empieza a buscar
1405      #data(find,full) -->
1406      #data(find,case) -->
1407      #data(tabla)    --> el path del widget tabla en el q buscar
1408      #data(path)      --> el path del toplevel que muestra el cuado de búsqueda
1409      #data(frm,cad)   --> entry donde se inserta el texto a buscar
1410      #data(tabla,next) -> 0 primera busqueda, 1 sigiente busqueda
1411    }
1412  }
1413
1414  upvar \#0 ${Instance}::data data
1415
1416  set data(tabla) $tabla
1417  set data(namespace) "FindDialog"
1418  set data(path) ${tabla}.tFind
1419  if [winfo exist $data(path)] {
1420    raise $data(path)
1421    focus $data(frm,cad)
1422    $data(frm,cad).e selection range 0 end
1423    return
1424  }
1425
1426  set data(tabla,next) 0
1427  if {$txt != ""} {
1428    set data(find,dir)  forward
1429    set data(find,case) 1
1430    set data(find,text) $txt
1431  }
1432
1433  if {$next && [info exists ${Instance}::data(find,text)] && ($data(find,text) !="") } {
1434      FindNext $Instance
1435  } else {
1436      FindCreate $Instance
1437  }
1438}
Note: See TracBrowser for help on using the repository browser.