Context Navigation

btable.tcl @ 20907d9

1941-docker-image-to-testdevel

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

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

git-svn-id: https://www.tol-project.org/svn/tolp/trunk@7342 be4846ae-f051-483a-831f-b64e7d08527f

Property mode set to 100755

File size: 142.6 KB

Line
1	#/////////////////////////////////////////////////////////////////////////////
2	# FILE : btable.tcl
3	# PURPOSE : Bayes Table.
4	#/////////////////////////////////////////////////////////////////////////////
5
6	#@! OBSOLETO
7	#@! Usa BLT
8
9	package require byscommon
10	package require BLT
11	package require Tktable
12	package require snit
13	package require BWidget
14	package require bfunctions
15	package require bmultiselect
16	package require bfont
17	package require bcolor
18	package require tclodbc
19
20	if { [string equal $tcl_platform(platform) "windows"] } {
21	package require cwind
22	}
23
24
25	#/////////////////////////////////////////////////////////////////////////////
26	::snit::widget btable {
27	#
28	# PURPOSE: Bayes Table. Widget that manages tables
29	# Specific options:
30	# -parent-> btable's parent
31	# -toolbar-> show/hide toolbar
32	# -statusbar-> show/hide statusbar
33	# -function-> function applied to selected cells shown in statusbar
34	# -path-> path of the open file
35	# -typelist-> list of the filtered types in open/save dialog
36	# -defext-> default extension in which files will be saved
37	# -defpath-> default path in which open dialog starts
38	# -defsavepath-> default path in which save dialog starts
39	# -checkcolumn->
40	# -internalvalues->
41	# -closecmd-> command to execute when closing the table
42	# -poseditcmd-> command to execute when a new file is opened or saved
43	# -iniconfig -> Header in .ini file
44	# -bgalt-> flag that sets if alternated row background is used
45	# -bgalt1-> Color that will be used in odd rows
46	# -bgalt2-> Color that will be used in even rows
47	# -postordercmd -> command to execute when order
48	#
49	# variables:
50	# tb-> toolbar
51	# tab-> table
52	# sb-> statusbar
53	# sw-> scrollwindow
54	# widget-> widgets path
55	# data-> widgets data
56	# created-> created flag
57	#/////////////////////////////////////////////////////////////////////////////
58	widgetclass Btable
59
60	option -parent {}
61	option -toolbar 1
62	option -statusbar 1
63	option -function {None}
64	option -path {}
65	option -typelist {{"Bayes Struct Table" {".bst"}}
66	{"Bayes Data Table" {".bdt"}}
67	{"Bayes Matrix Table" {".bmt"}}
68	{"All Files" {"*"} }}
69	option -defext {}
70	option -defsavepath {/}
71	option -defopenpath {/}
72	option -internalvalues 0
73	option -checkcolumn 0
74	option -closecmd {}
75	option -posteditcmd {}
76	option -iniconfig {}
77	option -state {normal}
78	option -cols 4
79	option -rows 5
80	option -bgalt 0
81	option -bgalt1 white
82	option -bgalt2 white
83	option -toolenable {}
84	option -tooldisable {}
85	option -postordercmd {}
86
87	variable widget
88	variable data
89	variable created
90
91	#///////////////////////////////////////////////////////////////////////////
92	constructor {args} {
93	#
94	# PURPOSE: btable constructor. An instance of btable is created.
95	#
96	# PARAMETERS:
97	# args -> options
98	#
99	#///////////////////////////////////////////////////////////////////////////
100	set created 0
101	#Toolbar
102	set widget(tb) [frame $self.tb -bd 2 -relief raised]
103	#Frame
104	set widget(fr) [frame $self.fr -bd 2 -relief raised -width 400 -height 500]
105	#Statusbar
106	set widget(sb) [frame $self.sb -relief groove -bd 1 -height 7]
107	#Scrollwindow
108	set widget(sw) [ScrolledWindow $widget(fr).sw]
109	#Table with default options
110	install tab using table $widget(sw).t \
111	-variable matrix \
112	-multiline 0 -selectmode extended -resizeborders col \
113	-relief groove \
114	-browsecommand [list $self _Active %W %S %s] \
115	-validate 1 -vcmd [list $self _Validate %S] \
116	-selecttitles 0 \
117	-titlecols 0 -titlerows 1 -colseparator \t -rowseparator \n \
118	-usecommand 1 -command [list $self _Command %i %C %s] \
119	-rowtagcommand [list $self _RowTag]
120
121	set widget(tab) $tab
122
123	puts btable:$self
124
125	#variables containing types and formats and edited files are initialized
126	set data(types) {}
127	set data(formats) {}
128
129	$self createwidget
130
131	#options are configured from command line
132	$self configure -path [from args -path ""]
133	$self configure -cols [from args -cols ""]
134	$self configure -rows [from args -rows ""]
135	$self configure -parent [from args -parent ""]
136	$self configure -toolbar [from args -toolbar ""]
137	$self configure -statusbar [from args -statusbar ""]
138	$self configure -function [from args -function ""]
139	$self configure -typelist [from args -typelist ""]
140	$self configure -defsavepath [from args -defsavepath ""]
141	$self configure -defopenpath [from args -defopenpath ""]
142	$self configure -internalvalues [from args -internalvalues ""]
143	$self configure -checkcolumn [from args -checkcolumn ""]
144	$self configure -closecmd [from args -closecmd ""]
145	$self configure -posteditcmd [from args -posteditcmd ""]
146	$self configure -iniconfig [from args -iniconfig ""]
147	$self configure -bgalt [from args -bgalt ""]
148	$self configure -bgalt1 [from args -bgalt1 ""]
149	$self configure -bgalt2 [from args -bgalt2 ""]
150	$self configure -toolenable [from args -toolenable ""]
151	$self configure -tooldisable [from args -tooldisable ""]
152	$self configure -postordercmd [from args -postordercmd ""]
153
154
155	$self configurelist $args
156
157	#iniFile is readed
158	$self _ReadIni
159
160	if {[winfo class [$self cget -parent]] == "Toplevel"} {
161	wm protocol [$self cget -parent] WM_DELETE_WINDOW [list $self _CmdClose]
162	} elseif {[winfo class [$self cget -parent]] == "Mdidoc"} {
163	[$self cget -parent] configure -closecmd [list $self _CmdClose]
164	}
165	# The widget is created
166	set created 1
167	}
168
169	#///////////////////////////////////////////////////////////////////////////
170	destructor {
171	#
172	# PURPOSE: Destroy the trace asociated with -posteditcmd
173	#
174	#///////////////////////////////////////////////////////////////////////////
175	trace vdelete options(-path) w [$self cget -posteditcmd]
176	}
177
178	#///////////////////////////////////////////////////////////////////////////
179	#
180	# PURPOSE: Methods cget & configure
181	#
182	#///////////////////////////////////////////////////////////////////////////
183	onconfigure -cols { arg } {
184	set cols [$self cget -cols]
185	if { $arg == 0 } {
186	set arg 1
187	}
188	if { $cols > $arg } {
189	set data(types) [lreplace $data(types) $arg $cols]
190	set data(formats) [lreplace $data(formats) $arg $cols]
191	} elseif { $cols < $arg } {
192	for { set i $cols } { $i < $arg } { incr i } {
193	set data(types) [linsert $data(types) end text]
194	set data(formats) [linsert $data(formats) end {}]
195	}
196	}
197	$widget(tab) configure -cols $arg
198	}
199
200	onconfigure -rows { arg } {
201	if { $arg == 0 } {
202	set arg 1
203	}
204	$widget(tab) configure -rows $arg
205	$self _UpdateInfoRows
206	}
207
208	oncget -cols {
209	return [$widget(tab) cget -cols]
210	}
211
212	oncget -rows {
213	return [$widget(tab) cget -rows]
214	}
215
216
217	onconfigure -function { lst } {
218	set totitle [string totitle $lst]
219	set options(-function) $totitle
220	if {$created} {
221	$self _UpdateFunc
222	}
223	}
224
225	onconfigure -path { lst } {
226	set options(-path) $lst
227	#When the path is changed, New or Open methods are triggered automaticly
228	if {$lst == ""} {
229	$self _New
230	} else {
231	$self _Open $lst
232	}
233	}
234
235	onconfigure -toolbar { lst } {
236	set options(-toolbar) $lst
237	#The toolbar is hidden/shown
238	if {$lst == 0} {
239	grid remove $widget(tb)
240	} else {
241	grid $widget(tb)
242	}
243	}
244
245	onconfigure -statusbar { lst } {
246	set options(-statusbar) $lst
247	#The statusbar is hidden/shown
248	if {$lst == 0} {
249	grid remove $widget(sb)
250	} else {
251	grid $widget(sb)
252	}
253	}
254
255	onconfigure -typelist { lst } {
256	set options(-typelist) $lst
257	}
258
259	onconfigure -defext { lst } {
260	set options(-defext) $lst
261	}
262
263	onconfigure -defopenpath { lst } {
264	set options(-defopenpath) $lst
265	}
266
267	onconfigure -defsavepath { lst } {
268	set options(-defsavepath) $lst
269	}
270
271	onconfigure -internalvalues { lst } {
272	set options(-checkcolumn) $lst
273	}
274
275	onconfigure -checkcolumn { lst } {
276	set options(-checkcolumn) $lst
277	}
278
279	onconfigure -closecmd { lst } {
280	set options(-closecmd) $lst
281	}
282
283	onconfigure -posteditcmd { lst } {
284	if { $options(-posteditcmd) != "" } {
285	#The previous trace is deleted
286	trace vdelete options(-path) w $options(-posteditcmd)
287	}
288	set options(-posteditcmd) $lst
289	#A trace to the new variable is added
290	trace variable options(-path) w $options(-posteditcmd)
291	}
292
293	onconfigure -state { value } {
294	#the -state option of the tkTable is changed
295	$widget(tab) configure -state $value
296	set options(-state) $value
297	#edition button of the toolbar are shown/hidden
298	set lst { replace ordAsc ordDes ordAdv }
299	if {$value == "normal" } {
300	foreach but $lst {
301	$widget(tb).$but configure -state normal
302	}
303	$widget(sw).m entryconfigure 6 -state normal
304	$widget(sw).m entryconfigure 8 -state normal
305	$widget(sw).m entryconfigure 9 -state normal
306	} else {
307	foreach but $lst {
308	$widget(tb).$but configure -state disabled
309	}
310	$widget(sw).m entryconfigure 6 -state disabled
311	$widget(sw).m entryconfigure 8 -state disabled
312	$widget(sw).m entryconfigure 9 -state disabled
313	}
314	}
315
316	onconfigure -bgalt { arg } {
317	set options(-bgalt) $arg
318	if { $options(-bgalt) } {
319	if { [expr ![$self tag exist bgalt1] && ![$self tag exist bgalt1]] } {
320	$self tag configure bgalt1 -bg [$self cget -bgalt1]
321	$self tag configure bgalt2 -bg [$self cget -bgalt2]
322	}
323	} else {
324	if { [expr [$self tag exist bgalt1] && [$self tag exist bgalt1]] } {
325	$self tag delete bgalt1
326	$self tag delete bgalt2
327	}
328	}
329	$self configure -padx [$self cget -padx]
330	}
331
332	onconfigure -bgalt1 { arg } {
333	set options(-bgalt1) $arg
334	$self tag configure bgalt1 -bg $arg
335	}
336
337	onconfigure -bgalt2 { arg } {
338	set options(-bgalt2) $arg
339	$self tag configure bgalt2 -bg $arg
340	}
341
342	onconfigure -toolenable { lst } {
343	# Enable buttons on demand, by the given list.
344	if { [llength $lst] != 0 } {
345	$self _ToolEnable $lst
346	}
347	}
348
349	onconfigure -tooldisable { lst } {
350	# Enable buttons on demand, by the given list.
351	if { [llength $lst] != 0 } {
352	$self _ToolDisable $lst
353	}
354	}
355
356	onconfigure -postordercmd { lst } {
357	set options(-postordercmd) $lst
358	}
359
360	#///////////////////////////////////////////////////////////////////////////
361	method createwidget { } {
362	#
363	# PURPOSE: The widget is created and packed
364	#
365	#///////////////////////////////////////////////////////////////////////////
366	#Table tags are configured
367	$self tag configure title -bd 1 -fg black -bg "light grey" -anchor c -state normal
368	$self tag configure found -bd 1 -fg black -bg yellow
369
370	$self _CreateToolBar
371	$self _CreateStatusBar
372	$self _CreateMenu
373	$self _CreateBinds
374
375	#Links scrollwindow with the table
376	$widget(sw) setwidget $widget(tab)
377
378	pack $widget(sw) -expand true -fill both
379
380	grid $widget(tb) -column 0 -row 0 -sticky ew
381	grid $widget(fr) -column 0 -row 1 -sticky news
382	grid $widget(sb) -column 0 -row 2 -sticky ew
383	grid columnconfigure $self 0 -weight 1
384	grid rowconfigure $self 1 -weight 1
385	}
386
387	#///////////////////////////////////////////////////////////////////////////
388	method _CreateToolBar { } {
389	#
390	# PURPOSE: Create the toolbar with buttons icons and commands associated
391	#
392	#///////////////////////////////////////////////////////////////////////////
393	set f $widget(tb)
394	set n_b [list \
395	"bnew" "_CmdNew" "[mc [list New white table]] (CTRL+N)"\
396	"bopen" "cmdOpen" "[mc Open] (CTRL+O)"\
397	"bsave" "_CmdSave" "[mc Save] (CTRL+S)"\
398	"bsaveas" "_CmdSaveAs" "[mc "Save As"] (CTRL+G)"\
399	"sep0" "--" ""\
400	"home" "_AdjustTable" "[mc "Adjust table"]"\
401	"sep1" "--" ""\
402	"leftEnd" "_CmdFirst" "[mc First]" \
403	"reverse" "_CmdBack" "[mc Back] " \
404	"play" "_CmdNext" "[mc Next] " \
405	"rightEnd" "_CmdLast" "[mc Last] " \
406	"sep2" "--" ""\
407	"bcopy" "_CmdCopy" "[mc Copy] (CTRL+C)" \
408	"bfind" "_CmdFind" "[mc Find] (CTRL+F)" \
409	"replace" "_CmdReplace" "[mc Replace] (CTRL+R)" \
410	"bfilter" "_CmdFilter" "[mc Filter] (ALT+F)" \
411	"sep3" "--" ""\
412	"ordAsc" "_CmdOrdAsc" "[mc "Order increasingly"]"\
413	"ordDes" "_CmdOrdDes" "[mc "Order decreasingly"]"\
414	"ordAdv" "_CmdOrdAdv" "[mc "Advanced order"]"\
415	"sep4" "--" ""\
416	"tools" "_CmdOptions" "[mc Options]"\
417	"sep5" "--" ""\
418	"xl-logo" "_CmdExcel" "[mc Excel]"\
419	]
420	foreach {n_img n_proc n_hint} $n_b {
421	if {[string equal $n_proc "--"]} {
422	Separator $f.$n_img -orient vertical
423	} else {
424	set widget(tb,$n_img) \
425	[Button $f.$n_img -image [::Bitmap::get ${n_img}] -bd 2 \
426	-relief link -helptext $n_hint \
427	-command [list $self $n_proc ]]
428	}
429
430	pack $f.$n_img -side left -pady 2 -fill y -padx 1
431	}
432	$widget(tb,bfilter) configure -state disabled
433	}
434
435	#///////////////////////////////////////////////////////////////////////////
436	method _ToolEnable { lst } {
437	#
438	# PURPOSE: Enable the list group given by parameter
439	#
440	# PARAMETERS: list of groups of buttons to enable. Posible values are:
441	# file -> first group of buttons (new, open, save)
442	# adjust -> home button (used to adjust the table)
443	# navigation -> Navigation buttons (first,previous, next,last)
444	# edition -> edition buttons (copy, find, replace, filter)
445	# order -> ordering buttons (ascending, descending, advanced)
446	# options -> table options button
447	# export -> export group (export to excel)
448	# all -> enable all groups of buttons
449	# none -> disable all groups of buttons
450	#
451	#///////////////////////////////////////////////////////////////////////////
452	# Buttons related with each option:
453	set lstFile { bnew bopen bsave}
454	set lstAdjust { home }
455	set lstNavigation { leftEnd reverse play rightEnd }
456	set lstEdition { bcopy bfind replace bfilter }
457	set lstOrder { ordAsc ordDes ordAdv }
458	set lstOptions { tools }
459	set lstExport { xl-logo }
460
461	set lstEnable {}
462
463	foreach group $lst {
464	# Fill the list of buttons to be enabled, without duplicates
465	if { [string equal $group "file"] } {
466	if { ([lsearch -exact -dictionary -ascii $lstEnable bnew] == -1) } {
467	set lstAux [concat $lstEnable $lstFile]
468	set lstEnable $lstAux
469	}
470	}
471	if { [string equal $group "adjust"] } {
472	if { ([lsearch -exact -dictionary -ascii $lstEnable home] == -1) } {
473	set lstAux [concat $lstEnable $lstAdjust]
474	set lstEnable $lstAux
475	}
476	}
477	if { [string equal $group "navigation"] } {
478	if { ([lsearch -exact -dictionary -ascii $lstEnable leftEnd] == -1) } {
479	set lstAux [concat $lstEnable $lstNavigation]
480	set lstEnable $lstAux
481	}
482	}
483	if { [string equal $group "edition"] } {
484	if { ([lsearch -exact -dictionary -ascii $lstEnable bcopy] == -1) } {
485	set lstAux [concat $lstEnable $lstEdition]
486	set lstEnable $lstAux
487	}
488	}
489	if { [string equal $group "order"] } {
490	if { ([lsearch -exact -dictionary -ascii $lstEnable ordAsc] == -1) } {
491	set lstAux [concat $lstEnable $lstOrder]
492	set lstEnable $lstAux
493	}
494	}
495	if { [string equal $group "options"] } {
496	if { ([lsearch -exact -dictionary -ascii $lstEnable tools] == -1) } {
497	set lstAux [concat $lstEnable $lstOptions]
498	set lstEnable $lstAux
499	}
500	}
501	if { [string equal $group "export"] } {
502	if { ([lsearch -exact -dictionary -ascii $lstEnable xl-logo] == -1) } {
503	set lstAux [concat $lstEnable $lstExport]
504	set lstEnable $lstAux
505	}
506	}
507	if { [string equal $group "all"] } {
508	set lstEnable [concat $lstFile $lstAdjust $lstNavigation $lstEdition \
509	$lstOrder $lstOptions $lstExport]
510	}
511	if { [string equal $group "none"] } {
512	$self _ToolDisable all
513	}
514	}
515
516	foreach butt $lstEnable {
517	$widget(tb,$butt) configure -state normal
518	}
519	}
520
521	#///////////////////////////////////////////////////////////////////////////
522	method _ToolDisable { lst } {
523	#
524	# PURPOSE: Disable the list group given by parameter
525	#
526	# PARAMETERS: list of groups of buttons to disable. Posible values are:
527	# file -> first group of buttons (new, open, save)
528	# adjust -> home button (used to adjust the table)
529	# navigation -> Navigation buttons (first,previous, next,last)
530	# edition -> edition buttons (copy, find, replace, filter)
531	# order -> ordering buttons (ascending, descending, advanced)
532	# options -> table options button
533	# export -> export group (export to excel)
534	# all -> disable all groups of buttons
535	# none -> enable all groups of buttons
536	#
537	#///////////////////////////////////////////////////////////////////////////
538	# Buttons related with each option:
539	set lstFile { bnew bopen bsave}
540	set lstAdjust { home }
541	set lstNavigation { leftEnd reverse play rightEnd }
542	set lstEdition { bcopy bfind replace bfilter }
543	set lstOrder { ordAsc ordDes ordAdv }
544	set lstOptions { tools }
545	set lstExport { xl-logo }
546
547	set lstDisable {}
548
549	foreach group $lst {
550	# Fill the list of buttons to be disabled, without duplicates
551	if { [string equal $group "file"] } {
552	if { ([lsearch -exact -dictionary -ascii $lstDisable bnew] == -1) } {
553	set lstAux [concat $lstDisable $lstFile]
554	set lstDisable $lstAux
555	}
556	}
557	if { [string equal $group "adjust"] } {
558	if { ([lsearch -exact -dictionary -ascii $lstDisable home] == -1) } {
559	set lstAux [concat $lstDisable $lstAdjust]
560	set lstDisable $lstAux
561	}
562	}
563	if { [string equal $group "navigation"] } {
564	if { ([lsearch -exact -dictionary -ascii $lstDisable leftEnd] == -1) } {
565	set lstAux [concat $lstDisable $lstNavigation]
566	set lstDisable $lstAux
567	}
568	}
569	if { [string equal $group "edition"] } {
570	if { ([lsearch -exact -dictionary -ascii $lstDisable bcopy] == -1) } {
571	set lstAux [concat $lstDisable $lstEdition]
572	set lstDisable $lstAux
573	}
574	}
575	if { [string equal $group "order"] } {
576	if { ([lsearch -exact -dictionary -ascii $lstDisable ordAsc] == -1) } {
577	set lstAux [concat $lstDisable $lstOrder]
578	set lstDisable $lstAux
579	}
580	}
581	if { [string equal $group "options"] } {
582	if { ([lsearch -exact -dictionary -ascii $lstDisable tools] == -1) } {
583	set lstAux [concat $lstDisable $lstOptions]
584	set lstDisable $lstAux
585	}
586	}
587	if { [string equal $group "export"] } {
588	if { ([lsearch -exact -dictionary -ascii $lstDisable xl-logo] == -1) } {
589	set lstAux [concat $lstDisable $lstExport]
590	set lstDisable $lstAux
591	}
592	}
593	if { [string equal $group "all"] } {
594	set lstDisable [concat $lstFile $lstAdjust $lstNavigation $lstEdition \
595	$lstOrder $lstOptions $lstExport]
596	}
597	if { [string equal $group "none"] } {
598	$self _ToolEnable all
599	}
600	}
601
602	foreach butt $lstDisable {
603	$widget(tb,$butt) configure -state disabled
604	}
605	}
606
607	#///////////////////////////////////////////////////////////////////////////
608	method _CreateStatusBar { } {
609	#
610	# PURPOSE: Create the statusbar
611	#
612	#///////////////////////////////////////////////////////////////////////////
613	set f $widget(sb)
614
615	#Rows info
616	set widget(sb,lRows) [label $f.rows -relief groove -bd 1 -width 16]
617	#Position info
618	set widget(sb,lPosi) [label $f.posi -relief groove -bd 1 -width 16]
619	#Saved/NotSaved flag
620	set widget(sb,lInfo) [label $f.info -relief groove -bd 1 -width 3]
621	#Function applied to selected cells
622	set widget(sb,lFunc) [label $f.func -relief groove -bd 1 -width 30 \
623	-anchor w -padx 4]
624	#Fill extra space
625	set widget(sb,rell) [label $f.rell -relief groove -bd 1]
626
627	pack $f.rows $f.posi $f.info $f.func -side left
628	pack $f.rell -expand true -fill x
629
630	#Function menu (appears when mouse right button is clicked over function
631	#label
632	$self _CreateMenuFunc
633
634	set f $widget(sb,lFunc)
635	#bind that shows the menu
636	bind $f <ButtonPress-3> \
637	[list $self _CmdOnB3Func $widget(menufunc) %W %x %y %X %Y]
638	}
639
640	#///////////////////////////////////////////////////////////////////////////
641	method _CreateMenuFunc { } {
642	#
643	# PURPOSE: Create menu with all the possible functions for the selected
644	# cells
645	#
646	#///////////////////////////////////////////////////////////////////////////
647	#Creación de un menú contextual
648	set menu [menu $widget(sb,lFunc).m -tearoff 0]
649	set widget(menufunc) $menu
650	#Sum
651	$menu add command -label [mc "Sum"] \
652	-command [list $self configure -function "sum"]
653	#Average
654	$menu add command -label [mc "Avg"] \
655	-command [list $self configure -function "avg"]
656	#Count
657	$menu add command -label [mc "Count"] \
658	-command [list $self configure -function "count"]
659	#Count numbers
660	$menu add command -label [mc "Count num"] \
661	-command [list $self configure -function "countn"]
662	#Max
663	$menu add command -label [mc "Max"] \
664	-command [list $self configure -function "max"]
665	#Min
666	$menu add command -label [mc "Min"] \
667	-command [list $self configure -function "min"]
668	#None
669	$menu add command -label [mc "None"] \
670	-command [list $self configure -function "none"]
671	}
672
673
674	#///////////////////////////////////////////////////////////////////////////
675	method _CreateMenu { } {
676	#
677	# PURPOSE: Create the popup menu for the table
678	#
679	#///////////////////////////////////////////////////////////////////////////
680	#Creación de un menú contextual
681	set menu [menu $widget(sw).m -tearoff 0]
682	set widget(menu) $menu
683	set mi [menu $widget(sw).m.ins -tearoff 0]
684	set me [menu $widget(sw).m.eli -tearoff 0]
685	set mt [menu $widget(sw).m.type -tearoff 0]
686	set mc [menu $widget(sw).m.copy -tearoff 0]
687	set mf [menu $widget(sw).m.func -tearoff 0]
688
689	$menu add command -label ""
690	$menu add cascade -label [mc "Set column type"] -menu $mt
691	$menu add command -label [mc "Set column format"] \
692	-command [list $self _CmdSetFormat]
693	$menu add separator
694	$menu add cascade -label [mc "Special copy"] -menu $mc
695	$menu add command -label [mc "Select all"] -accelerator CTRL+E\
696	-command [list $self _CmdSelectAll]
697	$menu add command -label [mc "Delete"] -accelerator SUPR \
698	-command [list $self _CmdDelete]
699	$menu add separator
700	$menu add cascade -label [mc "Insert"] -menu $mi
701	$menu add cascade -label [mc "Eliminate"] -menu $me
702	$mi add command -label [mc "Rows"] \
703	-command [list $self _CmdInsertRows]
704	$mi add command -label [mc "Columns"] \
705	-command [list $self _CmdInsertCols]
706	$me add command -label [mc "Rows"] \
707	-command [list $self _CmdDeleteRows]
708	$me add command -label [mc "Columns"] \
709	-command [list $self _CmdDeleteCols]
710	$mt add command -label [mc "Date"] \
711	-command [list $self _CmdSetType date]
712	$mt add command -label [mc "Text"] \
713	-command [list $self _CmdSetType text]
714	$mt add command -label [mc "Real"] \
715	-command [list $self _CmdSetType real]
716	$mc add command -label [mc "Copy headers"] -accelerator CTRL+H \
717	-command [list $self _CmdSpecialCopy headers]
718	$mc add command -label [mc "Copy table"] -accelerator CTRL+A \
719	-command [list $self _CmdSpecialCopy table]
720	if { [TclInfoExists Set GuiFunctionTablePrj] } {
721	$menu add separator
722	$menu add cascade -label [mc "Functions"] -menu $mf
723	}
724	}
725
726	#///////////////////////////////////////////////////////////////////////////
727	method _CreateBinds { } {
728	#
729	# PURPOSE: Create binds
730	#
731	#///////////////////////////////////////////////////////////////////////////
732	set t $widget(tab)
733	bind $t <ButtonPress-3> [list $self _CmdOnB3 $widget(menu) %W %x %y %X %Y]
734	bind $t <Double-ButtonPress-1> [list $self _OnDblClickHeader]
735	bind $t <F3> [list $self _CmdFind]
736	bind $t <F4> [list $self _CmdReplace]
737	bind $t <Delete> [list $self _CmdDelete]
738	bind $t <Return> [list $self _CmdNext]
739	bind $t <KP_Enter> [list $self _CmdNext]
740	bind $t <Control-KeyRelease> [list $self _OnControlKey %K %k]
741	}
742
743	#///////////////////////////////////////////////////////////////////////////
744	method _OnControlKey {keysym keycode} {
745	#
746	# PURPOSE: Control the "Control + Key Press"
747	#
748	# PARAMETERS: keysym -> The keysym corresponding to the event,
749	# substituted as a textual string
750	# keycode -> The keycode field from the event
751	#
752	#///////////////////////////////////////////////////////////////////////////
753	switch [string toupper $keysym] {
754	E { $self _CmdSelectAll }
755	F { $self _CmdFind }
756	R { $self _CmdReplace }
757	N { $self _CmdNew }
758	O { $self cmdOpen }
759	S { $self _CmdSave }
760	X { $self _CmdCut }
761	C { $self _CmdCopy }
762	H { $self _CmdSpecialCopy headers }
763	A { $self _CmdSpecialCopy table }
764	V { $self _CmdPaste }
765	J { puts $data(types) }
766	K { puts $data(formats) }
767	}
768	}
769
770	#///////////////////////////////////////////////////////////////////////////
771	method _IsSaved { val } {
772	#
773	# PURPOSE: Prints information in statusbar about file save status.
774	#
775	# PARAMETERS: val -> Saved/NotSaved flag
776	#
777	#///////////////////////////////////////////////////////////////////////////
778	if { [$self cget -state] != "disabled" } {
779	set data(isSaved) $val
780	if {$val == 0} {
781	$widget(sb,lInfo) configure -text "*"
782	} else {
783	$widget(sb,lInfo) configure -text ""
784	}
785	}
786	}
787
788	#/////////////////////////////////////////////////////////////////////////////
789	method _InitState {from} {
790	#
791	# PURPOSE: Initializes some table properties and variables according to the
792	# state of table editor.
793	#
794	# PARAMETERS:
795	# from -> State that defines values for the variables
796	#
797	#/////////////////////////////////////////////////////////////////////////////
798	switch $from {
799	new {
800	$self configure -titlecols 0
801	$self configure -rows 5 -cols 4
802	$self _IsSaved 1
803	$self _UpdateInfoRows
804	$self _UpdateTypes
805	}
806	open {
807	$self configure -titlecols 0
808	$self _IsSaved 1
809	$self _UpdateInfoRows
810	$self _UpdateTypes
811	$self _AdjustTable
812	}
813	save {
814	$self _IsSaved 1
815	}
816	matrix - autocor {
817	$self _IsSaved 1
818	# $self configure -state disabled
819	$self configure -titlecols 1
820	$self _UpdateInfoRows
821	$self _UpdateTypes $from
822	$self _AdjustTable
823	}
824	sql {
825	$self _IsSaved 1
826	# $self configure -state disabled
827	$self configure -titlecols 0
828	$self _UpdateInfoRows
829	$self _AdjustTable
830	}
831	default {
832	$self _IsSaved 1
833	# $self configure -state disabled
834	$self configure -titlecols 0
835	$self _UpdateInfoRows
836	$self _UpdateTypes $from
837	$self _AdjustTable
838	}
839	}
840	}
841
842	#///////////////////////////////////////////////////////////////////////////
843	method getMenu { } {
844	#
845	# PURPOSE: Return path to the menu
846	#
847	# RETURN: Path that points to menu
848	#
849	#///////////////////////////////////////////////////////////////////////////
850	return $widget(menu)
851	}
852
853	#///////////////////////////////////////////////////////////////////////////
854	method getToolBar { } {
855	#
856	# PURPOSE: Return path to the toolbar
857	#
858	# RETURN: Path that points to toolbar
859	#
860	#///////////////////////////////////////////////////////////////////////////
861	return $widget(tb)
862	}
863
864	#///////////////////////////////////////////////////////////////////////////
865	method getTable { } {
866	#
867	# PURPOSE: Return path to the table
868	#
869	# RETURN: Path that points to table
870	#
871	#///////////////////////////////////////////////////////////////////////////
872	return $widget(tab)
873	}
874
875	#///////////////////////////////////////////////////////////////////////////
876	method getStatusBar { } {
877	#
878	# PURPOSE: Return path to statusbar
879	#
880	# RETURN: Path that points to statusbar
881	#
882	#///////////////////////////////////////////////////////////////////////////
883	return $widget(sb)
884	}
885
886	#///////////////////////////////////////////////////////////////////////////
887	method getLastCell { } {
888	#
889	# PURPOSE: Return last cell where right mouse button was clicked
890	#
891	# RETURN: Last cell where right mouse button was clicked
892	#
893	#///////////////////////////////////////////////////////////////////////////
894	return $data(lastrow),$data(lastcol)
895	}
896
897	#///////////////////////////////////////////////////////////////////////////
898	method getSelectedRows { } {
899	#
900	# PURPOSE: Return last cell where right mouse button was clicked
901	#
902	# RETURN: Last cell where right mouse button was clicked
903	#
904	#///////////////////////////////////////////////////////////////////////////
905	set selrows [$self curselection]
906	}
907
908	#///////////////////////////////////////////////////////////////////////////
909	method _ReadIni { } {
910	#
911	# PURPOSE: Reads Ini file in case it exists and configures all the options
912	# according with the values read.
913	#
914	#///////////////////////////////////////////////////////////////////////////
915	global tcl_platform
916
917	if { [info exist ::iniFile::idIni] && \
918	[string length [$self cget -iniconfig]] } {
919	set rini ::iniFile::Read
920	set key [$self cget -iniconfig]
921	$self configure -bg [$rini $key bg "white"]
922	$self configure -bgalt [$rini $key bgalt 0]
923	$self configure -bgalt1 [$rini $key bgalt1 "white"]
924	$self configure -bgalt2 [$rini $key bgalt2 "white"]
925	$self configure -font [$rini $key font "helvetica 9"]
926	if { [$rini $key colseparator "TAB"] == "TAB" } {
927	$self configure -colseparator "\t"
928	} elseif { [$rini $key colseparator "TAB"] == "RET" } {
929	$self configure -colseparator "\n"
930	} else {
931	$self configure -colseparator [$rini $key colseparator "\t"]
932	}
933	#col and row separators are stored in special way if they are \n or \t
934	if { [$rini $key rowseparator "RET"] == "TAB" } {
935	$self configure -rowseparator "\t"
936	} elseif { [$rini $key rowseparator "RET"] == "RET" } {
937	$self configure -rowseparator "\n"
938	} else {
939	$self configure -rowseparator [$rini $key rowseparator "\n"]
940	}
941	$self configure -function [$rini $key function "None"]
942	#depending on the operating system the path is set
943	if { [string equal $tcl_platform(platform) "windows"] } {
944	$self configure -defsavepath [$rini $key defsavepath "c:\\"]
945	$self configure -defopenpath [$rini $key defopenpath "c:\\"]
946	} else {
947	$self configure -defsavepath [$rini $key defsavepath "/"]
948	$self configure -defopenpath [$rini $key defopenpath "/"]
949	}
950
951	$self configure -internalvalues [$rini $key internalvalues 0]
952	$self configure -checkcolumn [$rini $key checkcolumn 0]
953	# options find and replace
954	set data(find,dir) [$rini $key FindDir forward]
955	set data(find,case) [$rini $key FindCase 0]
956	set data(find,full) [$rini $key FindFull 0]
957	set data(replace,dir) [$rini $key ReplaceDir forward]
958	set data(replace,case) [$rini $key ReplaceCase 0]
959	set data(replace,full) [$rini $key ReplaceFull 0]
960	}
961	}
962
963	#///////////////////////////////////////////////////////////////////////////
964	method _WriteIni { } {
965	#
966	# PURPOSE: Writes Ini file in case it exists with some of the current
967	# options of the table
968	#
969	#///////////////////////////////////////////////////////////////////////////
970	if { [info exist ::iniFile::idIni] && \
971	[string length [$self cget -iniconfig]] } {
972	set wini ::iniFile::Write
973	set key [$self cget -iniconfig]
974	foreach op {bg font function internalvalues \
975	checkcolumn defsavepath defopenpath bgalt bgalt1 bgalt2} {
976	$wini $key $op [$self cget -$op]
977	}
978	#col and row separators are stored in special way if they are \n or \t
979	foreach op { rowseparator colseparator } {
980	if { [$self cget -$op] == "\n" } {
981	$wini $key $op RET
982	} elseif { [$self cget -colseparator] == "\t" } {
983	$wini $key $op TAB
984	} else {
985	$wini $key $op [$self cget -$op]
986	}
987	}
988	# options find and replace
989	$wini $key FindDir $data(find,dir)
990	$wini $key FindCase $data(find,case)
991	$wini $key FindFull $data(find,full)
992	$wini $key ReplaceDir $data(replace,dir)
993	$wini $key ReplaceCase $data(replace,case)
994	$wini $key ReplaceFull $data(replace,full)
995	::iniFile::Flush
996	}
997	}
998
999	#///////////////////////////////////////////////////////////////////////////
1000	method _New { } {
1001	#
1002	# PURPOSE: Open new blank document in the table editor
1003	#
1004	#///////////////////////////////////////////////////////////////////////////
1005	$self configure -state normal
1006	$self _DeleteRows 0 [$self cget -rows]
1007	$self _DeleteCols 0 [$self cget -cols]
1008	for {set i 0} {$i < [$self cget -rows]} {incr i} {
1009	$self set 0,$i ""
1010	}
1011	$self _InitState new
1012	}
1013
1014	#///////////////////////////////////////////////////////////////////////////
1015	method _Open { path } {
1016	#
1017	# PURPOSE: Open the document given in variable path
1018	#
1019	# PARAMETERS: path -> Document to be opened
1020	#
1021	#///////////////////////////////////////////////////////////////////////////
1022	$self configure -state normal
1023	$self _DeleteRows 0 [$self cget -rows]
1024	$self _DeleteCols 0 [$self cget -cols]
1025
1026	if { ![catch {set fd [open $path r] } msgerr] } {
1027	set txt [read -nonewline $fd]
1028	#Saved previous row and column separator
1029	set rsep [$self cget -rowseparator]
1030	set csep [$self cget -colseparator]
1031	#Set them to \n and ;
1032	$self configure -rowseparator "\n" -colseparator ";"
1033	# Call to table's paste handler with the opened file
1034	$self _PasteHandler 0,0 $txt
1035	$self configure -rowseparator $rsep -colseparator $csep
1036	#TOL files have last column separator after the last col,
1037	#that's why last column is deleted.
1038	set typecol [expr [$self cget -cols]-1]
1039	set data(types) [lreplace $data(types) $typecol $typecol]
1040	set data(formats) [lreplace $data(formats) $typecol $typecol]
1041	$self configure -cols [expr [$self cget -cols] -1]
1042
1043	close $fd
1044	$self _InitState open
1045	return 1
1046	}
1047	error $msgerr
1048	}
1049
1050	#///////////////////////////////////////////////////////////////////////////
1051	method _Sort { start end col args } {
1052	#
1053	# PURPOSE: Sort table. Modification of tk::table::Sort process.
1054	# PARAMETERS: start -> selection's top-left cell
1055	# end -> selection's bottom-right cell
1056	# col -> selection's index (simple selection)
1057	# args -> extra sort arguments
1058	#
1059	#///////////////////////////////////////////////////////////////////////////
1060	#Start row and column
1061	scan $start %d,%d sr sc
1062	#End row and column
1063	scan $end %d,%d er ec
1064
1065	if {($col < $sc) \|\| ($col > $ec)} {
1066	return -code error "$col is not within sort range $sc to $ec"
1067	}
1068
1069	set col [expr {$col - $sc}]
1070
1071	set row {}
1072	upvar \#0 [varname matrix] matrix
1073	set selected {}
1074	for {set i $sr} {$i <= $er} {incr i} {
1075	for {set j $sc} {$j <= $ec} {incr j} {
1076	if { [info exists matrix($i,$j)] } {
1077	lappend row $matrix($i,$j)
1078	} else {
1079	lappend row {}
1080	}
1081	}
1082	lappend selected $row
1083	set row {}
1084	}
1085
1086	if { $col == 0 && $args == "advorder" } {
1087	set i $sr
1088	foreach row [eval [list lsort -command [list $self _Compare] $selected]] {
1089	$self set row $i,$sc $row
1090	incr i
1091	}
1092	} else {
1093	set i $sr
1094	foreach row [eval [list lsort -index $col] $args [list $selected]] {
1095	$self set row $i,$sc $row
1096	incr i
1097	}
1098	}
1099	}
1100
1101	#///////////////////////////////////////////////////////////////////////////
1102	method _Compare { a b {order ""}} {
1103	#
1104	# PURPOSE: Compare two rows and decide how to order them.
1105	#
1106	# PARAMETERS: a -> First row to be compared
1107	# b -> Second row to be compared
1108	# order -> List that shows how to compare rows.
1109	# Example: { {1 inc} {3 dec} {2 inc} }
1110	# will order first by the first column increasingly,
1111	# then by the thrird decreasingly
1112	# and finally by the second increasingly
1113	#
1114	# RETURN: -1 if a should go first
1115	# 1 if b should go first
1116	#
1117	#///////////////////////////////////////////////////////////////////////////
1118	if {$order == ""} {
1119	set order $data(advorder)
1120	} else {
1121	set order $order
1122	}
1123	#the first order method is got
1124	set firstorder [lindex $order 0]
1125
1126	#Col and way are got
1127	set col [lindex $firstorder 0]
1128
1129	set func [lindex $firstorder 2]
1130
1131	set a0 [lindex $a $col]
1132	set b0 [lindex $b $col]
1133
1134	#The elements are compared
1135	if { ($a0 < $b0) && ($func == "inc") } {
1136	return -1
1137	} elseif { ($a0 > $b0) && ($func == "inc") } {
1138	return 1
1139	} elseif { ($a0 < $b0) && ($func == "dec") } {
1140	return 1
1141	} elseif { ($a0 > $b0) && ($func == "dec") } {
1142	return -1
1143	#If they are the same we should try with the next order method recursively
1144	} else {
1145	set neworder [lrange $order 1 end]
1146	if {[llength $neworder] > 0} {
1147	return [$self _Compare $a $b $neworder]
1148	#If there are the same.. the order doesnt matter
1149	} else {
1150	return -1
1151	}
1152	}
1153	}
1154
1155	#///////////////////////////////////////////////////////////////////////////
1156	method _Active { W S s } {
1157	#
1158	# PURPOSE: The method is triggered when the active cell changes.
1159	# Changes the active cell and recalculates function applied to
1160	# selected cells.
1161	# PARAMETERS: W -> Pathname to the window for which the command was
1162	# generated.
1163	# S -> The index of the new active cell.
1164	# s -> Is the index of the last active cell.
1165	#
1166	#///////////////////////////////////////////////////////////////////////////
1167	#Updates information of the current row,col
1168	set row [lindex [split $S ,] 0]
1169	set col [lindex [split $S ,] 1]
1170	$widget(sb,lPosi) configure -text "[mc Row]: $row, [mc Col]: $col"
1171
1172	#if only one file is selected the selection is updated, otherwise function
1173	#would be calculated with the previous selected cell.
1174	if {[llength [$self curselection]] == 1 } {
1175	$self selection clear all
1176	$self selection set active
1177	}
1178
1179	#call to function calculation
1180	if { [$self cget -function] == "None" } {
1181	$widget(sb,lFunc) configure -text "[mc None]"
1182	} else {
1183	$self _UpdateFunc
1184	}
1185	}
1186
1187	#///////////////////////////////////////////////////////////////////////////
1188	method _InsertCols { side index count typ } {
1189	#
1190	# PURPOSE: Inserts columns and manages types when inserting
1191	# PARAMETERS: side -> side where the columns will be inserted.
1192	# index -> Index from which the columns will be inserted.
1193	# count -> Number of columns to be inserted.
1194	# typ -> Type of the columns to be inserted.
1195	#
1196	#///////////////////////////////////////////////////////////////////////////
1197	#Types and formats are stored in temporaly variables.
1198	set temptype $data(types)
1199	set tempformat $data(formats)
1200
1201	#Columns with the type date and real are changed temporaly to text.
1202	set dates [lsearch -all $data(types) date]
1203	set reals [lsearch -all $data(types) real]
1204	foreach i $dates {
1205	$self setType $i text
1206	}
1207	foreach i $reals {
1208	$self setType $i text
1209	}
1210	#Types for the new columns are inserted
1211	for { set i 0 } { $i < $count } { incr i } {
1212	set data(types) [linsert $data(types) end text]
1213	set data(formats) [linsert $data(formats) end {}]
1214	}
1215	#Then the columns are inserted
1216	if { $side == "left" } {
1217	$self insert cols $index -$count
1218	for { set i 0 } { $i < $count } { incr i } {
1219	set temptype [linsert $temptype $index $typ]
1220	set tempformat [linsert $tempformat $index {}]
1221	}
1222	} else {
1223	$self insert cols $index $count
1224	for { set i 0 } { $i < $count } { incr i } {
1225	set temptype [linsert $temptype [expr $index+1] $typ]
1226	set tempformat [linsert $tempformat [expr $index+1] {}]
1227	}
1228	}
1229	#Previous types are restored + the new types.
1230	set data(types) $temptype
1231	set data(formats) $tempformat
1232	$self _IsSaved 0
1233	}
1234
1235	#///////////////////////////////////////////////////////////////////////////
1236	method _InsertRows { side index count } {
1237	#
1238	# PURPOSE: Inserts rows
1239	# PARAMETERS: side -> side where the rows will be inserted.
1240	# index -> Index from which the rows will be inserted.
1241	# count -> Number of rows to be inserted.
1242	#
1243	#///////////////////////////////////////////////////////////////////////////
1244	if { $side == "up" } {
1245	$self insert rows $index -$count
1246	} else {
1247	$self insert rows $index $count
1248	}
1249	$self _UpdateInfoRows
1250	$self _IsSaved 0
1251	}
1252
1253	#///////////////////////////////////////////////////////////////////////////
1254	method _DeleteCols { colIni cols } {
1255	#
1256	# PURPOSE: Deletes columns and manages types when deleting
1257	# PARAMETERS: colIni -> Initial column to be deleted
1258	# cols -> Number of columns to be deleted
1259	#
1260	#///////////////////////////////////////////////////////////////////////////
1261	#Types and formats are stored in temporaly variables.
1262	set temptype $data(types)
1263	set tempformat $data(formats)
1264
1265	#Columns with the type date and real are changed temporaly to text.
1266	set dates [lsearch -all $data(types) date]
1267	set reals [lsearch -all $data(types) real]
1268	foreach i $dates {
1269	$self setType $i text
1270	}
1271	foreach i $reals {
1272	$self setType $i text
1273	}
1274	#The columns are deleted
1275	$self delete cols $colIni $cols
1276	#The types too
1277	set temptype [lreplace $temptype $colIni [expr $colIni+$cols-1]]
1278	set tempformat [lreplace $tempformat $colIni [expr $colIni+$cols-1]]
1279	#whole table cant be deleted, there is always at least one cell left
1280	#so if the user selects to delete all colums the text type and empty
1281	#format are added
1282	if { $temptype == "" } {
1283	set temptype [linsert $temptype end text]
1284	set tempformat [linsert $tempformat end {}]
1285	}
1286
1287	#types are restored
1288	set data(types) $temptype
1289	set data(formats) $tempformat
1290
1291	$self _IsSaved 0
1292	}
1293
1294	#///////////////////////////////////////////////////////////////////////////
1295	method _DeleteRows { rowIni rows } {
1296	#
1297	# PURPOSE: Deletes rows.
1298	# PARAMETERS: rowIni -> Initial row to be deleted
1299	# rows -> Number of rows to be deleted
1300	#
1301	#///////////////////////////////////////////////////////////////////////////
1302	set lista [$self _GetSelectedRow]
1303
1304	if {[llength $lista]} {
1305	set aux 0
1306	foreach idx $lista {
1307	if {$aux == 0} {
1308	$self delete rows $idx 1
1309	} else {
1310	$self delete rows [expr $idx - $aux] 1
1311	}
1312	incr aux
1313	}
1314
1315	$self _UpdateInfoRows
1316	$self _IsSaved 0
1317	}
1318	}
1319
1320	#/////////////////////////////////////////////////////////////////////////////
1321	method _GetSelectedRow { args } {
1322	#
1323	# PURPOSE: Crear la leyenda de colores
1324	#
1325	#/////////////////////////////////////////////////////////////////////////////
1326	variable widget
1327	variable data
1328
1329	set selRowAux [$self getSelectedRows]
1330	set lst {}
1331
1332	if {[llength $selRowAux]} {
1333	foreach it $selRowAux {
1334	if {[llength $lst]} {
1335	if {([lindex [split [lindex $it 0] ,] 0]) != ([lindex $lst [expr [llength $lst] - 1]])} {
1336	lappend lst [lindex [split [lindex $it 0] ,] 0]
1337	}
1338	} else {
1339	lappend lst [lindex [split [lindex $it 0] ,] 0]
1340	}
1341	}
1342	}
1343
1344	return $lst
1345	}
1346
1347	#///////////////////////////////////////////////////////////////////////////
1348	method _Command { set cell val } {
1349	#
1350	# PURPOSE: Returns the value that will be shown for the cell in case of get
1351	# or the value that will be saved in the matrix in case of set.
1352	# PARAMETERS: set -> Flag that shows the function applied to the cell (get/set)
1353	# cell -> The cell
1354	# val -> The value (in case of set)
1355	#
1356	#///////////////////////////////////////////////////////////////////////////
1357	upvar \#0 [varname matrix] matrix
1358	#The column and type are gotten
1359	set col [lindex [split $cell ,] 1]
1360	set type [lindex $data(types) $col]
1361	#SET
1362	if {$set} {
1363	switch $type {
1364	text {
1365	set matrix($cell) $val
1366	}
1367	date {
1368	$self _InsertDate $col $cell $val
1369	}
1370	real {
1371	$self _InsertReal $col $cell $val
1372	}
1373	}
1374	#GET
1375	} else {
1376	if {[info exists matrix($cell)]} {
1377	switch $type {
1378	text {
1379	return $matrix($cell)
1380	}
1381	date {
1382	return [$self _ShowDate $col $cell]
1383	}
1384	real {
1385	return [$self _ShowReal $col $cell]
1386	}
1387	}
1388	} else {
1389	return
1390	}
1391	}
1392	}
1393
1394	#///////////////////////////////////////////////////////////////////////////
1395	method _InsertReal { col cell val } {
1396	#
1397	# PURPOSE: Inserts a real
1398	#
1399	# PARAMETERS: col -> Column in which the real will be inserted
1400	# cell -> The cell
1401	# val -> The value
1402	#
1403	#///////////////////////////////////////////////////////////////////////////
1404	upvar \#0 [varname matrix] matrix
1405	#When value is empty or ? nothing is inserted
1406	if { ($val == "") \|\| ($val == "?") } {
1407	set matrix($cell) $val
1408	#In case of title cells
1409	} elseif { [$self tag includes title $cell] } {
1410	set matrix($cell) $val
1411	#In case of double
1412	} elseif { [string is double $val] } {
1413	set matrix($cell) $val
1414	#In other case the type must be changed to text or the value wont be
1415	#inserted
1416	} else {
1417	set rq [tk_messageBox -type "yesno" -icon warning \
1418	-title [mc "Warning"] -parent $self\
1419	-message "[mc CellNotReal].\n\
1420	[mc LikeChangeTypeText]"]
1421	switch -exact $rq {
1422	yes {
1423	$self setType $col text
1424	set matrix($cell) $val
1425	}
1426	default {
1427	return
1428	}
1429	}
1430	}
1431	}
1432
1433	#///////////////////////////////////////////////////////////////////////////
1434	method _InsertDate { col cell val } {
1435	#
1436	# PURPOSE: Inserts a date
1437	#
1438	# PARAMETERS: col -> Column in which the date will be inserted
1439	# cell -> The cell
1440	# val -> The value
1441	#
1442	#///////////////////////////////////////////////////////////////////////////
1443	upvar \#0 [varname matrix] matrix
1444	#When value is empty nothing is inserted
1445	if { ($val == "") } {
1446	set matrix($cell) $val
1447	#In case of title cell
1448	} elseif { [$self tag includes title $cell] } {
1449	set matrix($cell) $val
1450	#if the val validates regular expresion is a date
1451	} elseif { [regexp {(^([0-9]{4})(/(0[1-9]\|1[0-2])(/(0[1-9]\|[12][0-9]\|3[01])(:([0-1][0-9]\|2[0-3])(:([0-5][0-9])(:([0-5][0-9])(\.[0-9]{0,3})?)?)?)?)?)?$)\|(^(y[0-9]{4})(m(0[1-9]\|1[0-2])(d(0[1-9]\|[12][0-9]\|3[01])(h([0-1][0-9]\|2[0-3])(i([0-5][0-9])(s([0-5][0-9])(\.[0-9]{0,3})?)?)?)?)?)?$)\|(^([0-9]{4})(-(0[1-9]\|1[0-2])(-(0[1-9]\|[12][0-9]\|3[01])( ([0-1][0-9]\|2[0-3])(:([0-5][0-9])(:([0-5][0-9])(\.[0-9]{0,3})?)?)?)?)?)?$)} \
1452	$val] } {
1453	set matrix($cell) $val
1454	#In other case the type must be changed to text or the value wont be
1455	#inserted
1456	} else {
1457	set rq [tk_messageBox -type "yesno" -icon warning \
1458	-title [mc "Warning"] -parent $self\
1459	-message "[mc CellNotDate].\n\
1460	[mc LikeChangeTypeText]"]
1461	switch -exact $rq {
1462	yes {
1463	$self setType $col text
1464	set matrix($cell) $val
1465	}
1466	default {
1467	return
1468	}
1469	}
1470	}
1471	}
1472
1473	#///////////////////////////////////////////////////////////////////////////
1474	method _ShowReal { col cell } {
1475	#
1476	# PURPOSE: Shows a real in the column format
1477	#
1478	# PARAMETERS: col -> Column in which the date will be shown
1479	# cell -> The cell
1480	#
1481	#///////////////////////////////////////////////////////////////////////////
1482	upvar \#0 [varname matrix] matrix
1483	#When the cell is empty or contains ? nothing is returned
1484	if { ($matrix($cell) == "") \|\| ($matrix($cell) == "?") } {
1485	return
1486	#In case the cell is a title
1487	} elseif { [$self tag includes title $cell] } {
1488	return $matrix($cell)
1489	#In case the cell is double
1490	} elseif { [string is double $matrix($cell)] } {
1491
1492	set format [lindex $data(formats) $col]
1493	#The format is applied
1494	if {$format == ""} {
1495	return $matrix($cell)
1496	} else {
1497	return [format $format $matrix($cell)]
1498	}
1499	#In other case the type is changed to text
1500	} else {
1501	$self setType $col text
1502	if { 0 } {
1503	set rq [tk_messageBox -type "ok" -icon warning \
1504	-title [mc "Warning"] -parent $widget(tab)\
1505	-message "[mc SomeCellNotReal].\n\
1506	[mc TypeSetText]"]
1507	}
1508	return $matrix($cell)
1509	}
1510	}
1511
1512	#///////////////////////////////////////////////////////////////////////////
1513	method _ShowDate { col cell } {
1514	#
1515	# PURPOSE: Shows a date in the column format
1516	#
1517	# PARAMETERS: col -> Column in which the date will be shown
1518	# cell -> The cell
1519	#
1520	#///////////////////////////////////////////////////////////////////////////
1521	upvar \#0 [varname matrix] matrix
1522	#When the cell is empty or contains ? nothing is returned
1523	if { ($matrix($cell) == "") } {
1524	return
1525	#In case the cell is a title
1526	} elseif { [$self tag includes title $cell] } {
1527	return $matrix($cell)
1528	#In case the cell is a date
1529	} elseif { [regexp {(^([0-9]{4})(/(0[1-9]\|1[0-2])(/(0[1-9]\|[12][0-9]\|3[01])(:([0-1][0-9]\|2[0-3])(:([0-5][0-9])(:([0-5][0-9])(\.[0-9]{0,3})?)?)?)?)?)?$)\|(^(y[0-9]{4})(m(0[1-9]\|1[0-2])(d(0[1-9]\|[12][0-9]\|3[01])(h([0-1][0-9]\|2[0-3])(i([0-5][0-9])(s([0-5][0-9])(\.[0-9]{0,3})?)?)?)?)?)?$)\|(^([0-9]{4})(-(0[1-9]\|1[0-2])(-(0[1-9]\|[12][0-9]\|3[01])( ([0-1][0-9]\|2[0-3])(:([0-5][0-9])(:([0-5][0-9])(\.[0-9]{0,3})?)?)?)?)?)?$)} \
1530	$matrix($cell)] } {
1531	#Is converted to iso8601
1532	regsub {[:h ]} $matrix($cell) "T" dateT
1533	regsub {\.(.){0,3}$} $dateT "" withoutMS
1534	regsub -all {[/\.ymdis\-]} $withoutMS "" iso8601
1535
1536	set mask 00000101T00:00:00
1537	set addmask [string range $mask [string length $iso8601] end]
1538
1539	set res [join "$iso8601 $addmask" ""]
1540	#The format is applied
1541	set format [lindex $data(formats) $col]
1542
1543	if {$format == ""} {
1544	return $matrix($cell)
1545	} else {
1546	return [clock format [clock scan $res] -format $format]
1547	}
1548	#In other case the type is changed to text
1549	} else {
1550	$self setType $col text
1551	if { 0 } {
1552	set rq [tk_messageBox -type "ok" -icon warning \
1553	-title [mc "Warning"] -parent $self\
1554	-message "[mc SomeCellNotDate].\n\
1555	[mc TypeSetText]"]
1556	}
1557	return $matrix($cell)
1558	}
1559	}
1560
1561	#///////////////////////////////////////////////////////////////////////////
1562	method _UpdateFunc { } {
1563	#
1564	# PURPOSE: Updates the result of the function applied to the selected cells
1565	#
1566	#///////////////////////////////////////////////////////////////////////////
1567	if {[llength [$self curselection]] > 0 } {
1568	#Row and col separator are temporaly changed
1569	set rsep [$self cget -rowseparator]
1570	set csep [$self cget -colseparator]
1571	$self configure -rowseparator " " -colseparator " "
1572
1573	if {[catch {set sel [::tk::table::GetSelection $self]} err]} {
1574	set total 0
1575	$widget(sb,lFunc) configure -text "[mc [$self cget -function]]: $total"
1576	$self configure -rowseparator $rsep -colseparator $csep
1577	return
1578	}
1579
1580	switch [$self cget -function] {
1581	Sum { $self _Sum $sel }
1582	Avg { $self _Avg $sel }
1583	Count { $self _Count $sel }
1584	Countn { $self _Countn $sel }
1585	Max { $self _Max $sel }
1586	Min { $self _Min $sel }
1587	}
1588	#Row and col separator are restored
1589	$self configure -rowseparator $rsep -colseparator $csep
1590	}
1591	}
1592
1593	#///////////////////////////////////////////////////////////////////////////
1594	method _Sum { sel } {
1595	#
1596	# PURPOSE: Applies sumatory function to the selection
1597	#
1598	# PARAMETERS: sel -> The selection
1599	#
1600	#///////////////////////////////////////////////////////////////////////////
1601	set total 0
1602
1603	foreach ele $sel {
1604	if { [string is double $ele] && [string length $ele] > 0 } {
1605	set total [expr ($total + $ele)]
1606	}
1607	}
1608	$widget(sb,lFunc) configure -text "[mc Sum]=$total"
1609	}
1610
1611	#///////////////////////////////////////////////////////////////////////////
1612	method _Avg { sel } {
1613	#
1614	# PURPOSE: Applies average function to the selection
1615	#
1616	# PARAMETERS: sel -> The selection
1617	#
1618	#///////////////////////////////////////////////////////////////////////////
1619	set total 0
1620	set i 0
1621
1622	foreach ele $sel {
1623	if { [string is double $ele] && [string length $ele] > 0 } {
1624	set i [expr ($i + 1)]
1625	set total [expr ($total + $ele)]
1626	}
1627	}
1628	if { $i != 0 } {
1629	set total [expr ($total / $i)]
1630	}
1631	$widget(sb,lFunc) configure -text "[mc Avg]=$total"
1632	}
1633
1634	#///////////////////////////////////////////////////////////////////////////
1635	method _Count { sel } {
1636	#
1637	# PURPOSE: Applies count function to the selection
1638	#
1639	# PARAMETERS: sel -> The selection
1640	#
1641	#///////////////////////////////////////////////////////////////////////////
1642	set total 0
1643
1644	foreach ele $sel {
1645	if {[string length $ele] > 0 } {
1646	set total [expr ($total + 1)]
1647	}
1648	}
1649	$widget(sb,lFunc) configure -text "[mc Count]=$total"
1650	}
1651
1652	#///////////////////////////////////////////////////////////////////////////
1653	method _Countn { sel } {
1654	#
1655	# PURPOSE: Applies count numbers function to the selection
1656	#
1657	# PARAMETERS: sel -> The selection
1658	#
1659	#///////////////////////////////////////////////////////////////////////////
1660	set total 0
1661
1662	foreach ele $sel {
1663	if { [string is double $ele] && [string length $ele] > 0 } {
1664	set total [expr ($total + 1)]
1665	}
1666	}
1667	$widget(sb,lFunc) configure -text "[mc Countn]=$total"
1668	}
1669
1670	#///////////////////////////////////////////////////////////////////////////
1671	method _Max { sel } {
1672	#
1673	# PURPOSE: Applies maximum function to the selection
1674	#
1675	# PARAMETERS: sel -> The selection
1676	#
1677	#///////////////////////////////////////////////////////////////////////////
1678	set total 0
1679	set i 0
1680
1681	foreach ele $sel {
1682	if { [string length $ele] > 0 } {
1683	if { $i == 0 } {
1684	set total $ele
1685	set i 1
1686	} else {
1687	if { $ele > $total } {
1688	set total $ele
1689	}
1690	}
1691	}
1692	}
1693	$widget(sb,lFunc) configure -text "[mc Max]=$total"
1694	}
1695
1696	#///////////////////////////////////////////////////////////////////////////
1697	method _Min { sel } {
1698	#
1699	# PURPOSE: Applies minimum function to the selection
1700	#
1701	# PARAMETERS: sel -> The selection
1702	#
1703	#///////////////////////////////////////////////////////////////////////////
1704	set total 0
1705	set i 0
1706
1707	foreach ele $sel {
1708	if { [string length $ele] > 0 } {
1709	if { $i == 0 } {
1710	set total $ele
1711	set i 1
1712	} else {
1713	if { $ele < $total } {
1714	set total $ele
1715	}
1716	}
1717	}
1718	}
1719	$widget(sb,lFunc) configure -text "[mc Min]=$total"
1720	}
1721
1722	#///////////////////////////////////////////////////////////////////////////
1723	method _UpdateInfoRows { } {
1724	#
1725	# PURPOSE: Rows info is updated.
1726	#
1727	#///////////////////////////////////////////////////////////////////////////
1728	set dataRows [$self cget -rows]
1729	set titleRows [$self cget -titlerows]
1730	set text "$dataRows [mc rows] ($titleRows [mc title])"
1731	$widget(sb,lRows) configure -text $text
1732	}
1733
1734	#///////////////////////////////////////////////////////////////////////////
1735	method _UpdateTypes { {from ""} } {
1736	#
1737	# PURPOSE: Sets default types depending on the type of the varible
1738	# Pre-defined types are:
1739	# serie: First column date the other real
1740	# matrix: all columns real
1741	# default: all columns text
1742	#
1743	# PARAMETERS: from -> type of the table that is being configured
1744	#
1745	#///////////////////////////////////////////////////////////////////////////
1746	set data(types) ""
1747	set data(formats) ""
1748
1749	switch $from {
1750	serie {
1751	#First column date
1752	set data(types) [linsert $data(types) 0 date]
1753	set data(formats) [linsert $data(formats) 0 {}]
1754	#The others real
1755	for {set i 1} {$i < [$self cget -cols]} {incr i} {
1756	set data(types) [linsert $data(types) $i real]
1757	set data(formats) [linsert $data(formats) $i {}]
1758	}
1759	}
1760	matrix {
1761	#All columns real
1762	for {set i 0} {$i < [$self cget -cols]} {incr i} {
1763	set data(types) [linsert $data(types) $i real]
1764	set data(formats) [linsert $data(formats) $i {}]
1765	}
1766	}
1767	default {
1768	#All columns text
1769	for {set i 0} {$i < [$self cget -cols]} {incr i} {
1770	set data(types) [linsert $data(types) $i text]
1771	set data(formats) [linsert $data(formats) $i {}]
1772	}
1773	}
1774	}
1775	}
1776
1777	#///////////////////////////////////////////////////////////////////////////
1778	method _OnDblClickHeader { } {
1779	#
1780	# PURPOSE: Adjusts column width when header is double-clicked
1781	#
1782	#///////////////////////////////////////////////////////////////////////////
1783	#Selected cell
1784	if { ![catch {set cell [$self index active]} msgerr] } {
1785	set row [lindex [split $cell ,] 0]
1786	set col [lindex [split $cell ,] 1]
1787	#Check if the header was clicked
1788	if {$row == 0} {
1789	$self _AdjustColumn $col
1790	}
1791	}
1792	}
1793
1794	#///////////////////////////////////////////////////////////////////////////
1795	method _AdjustTable { {spans ""} } {
1796	#
1797	# PURPOSE: Ajusts all columns width with or without spans, depending on the
1798	# parameter.
1799	# PARAMETERS: spans -> "spans" in case spans is required
1800	# "" if no spans and is required
1801	#
1802	#///////////////////////////////////////////////////////////////////////////
1803	if { $spans == "spans"} {
1804	for {set i [$self cget -colorigin]} {$i < [$self cget -cols]} {incr i} {
1805	$self _AdjustColumnSpans $i
1806	}
1807	} else {
1808	for {set i [$self cget -colorigin]} {$i < [$self cget -cols]} {incr i} {
1809	$self _AdjustColumn $i
1810	}
1811	}
1812	}
1813
1814	#///////////////////////////////////////////////////////////////////////////
1815	method _AdjustColumn { column {first 50} {last 200} } {
1816	#
1817	# PURPOSE: Adjusts column width for the previous and next rows given in
1818	# parameters
1819	#
1820	# PARAMETERS: column -> The column to be adjusted
1821	# first -> Number of previous rows to adjust
1822	# last -> Number of next rows to adjust
1823	#///////////////////////////////////////////////////////////////////////////
1824	set maxLenFin 1
1825
1826	set topleft [$self index topleft]
1827	set topleftrow [lindex [split $topleft ,] 0]
1828
1829	set firstrow [expr $topleftrow - $first]
1830	set lastrow [expr $topleftrow + $last]
1831
1832	if {$firstrow < 0} {
1833	set firstrow [$self cget -roworigin]
1834	}
1835	if {$lastrow > [$self cget -rows]} {
1836	set lastrow [$self cget -rows]
1837	}
1838	for {set i $firstrow} {$i <= $lastrow} {incr i} {
1839	set maxLen [string length [$self get $i,$column]]
1840	# check if the cell is horizontally expanded
1841	if {$maxLen > $maxLenFin} {
1842	set maxLenFin $maxLen
1843	}
1844	}
1845	# Spans control
1846	$self width $column [expr $maxLenFin + 1]
1847	}
1848
1849	#///////////////////////////////////////////////////////////////////////////
1850	method _AdjustColumnSpans { column } {
1851	#
1852	# PURPOSE: Adjusts column width for whole table
1853	#
1854	# PARAMETERS: column -> The column to be adjusted
1855	#
1856	#///////////////////////////////////////////////////////////////////////////
1857	# Spans control
1858	set find 0
1859	set lstSpan [$self spans]
1860	if { [llength $lstSpan] } {
1861	set find 1
1862	set lstInd ""
1863	set ok 1
1864	# list with the index
1865	for {set x 0} {$x < [expr [llength $lstSpan] -1]} {incr x 2} {
1866	lappend lstInd [lindex $lstSpan $x]
1867	}
1868	}
1869	# Search of the column width
1870	set maxLenFin 1
1871	for {set i [$self cget -roworigin]} {$i <= [$self cget -rows]} {incr i} {
1872	set maxLen [string length [$self get $i,$column]]
1873	# check if the cell is horizontally expanded
1874	if { $find } {
1875	set posi [lsearch $lstInd $i,$column]
1876	if [expr $posi > -1] {
1877	set fc [lindex $lstSpan [expr $posi * 2 + 1]]
1878	set nc [string range $fc [expr [string first , $fc] + 1] end]
1879	set maxLen [expr $maxLen / ($nc+1) + 3]
1880	}
1881	}
1882	if {$maxLen > $maxLenFin} {
1883	set maxLenFin $maxLen
1884	}
1885	}
1886	# Spans control
1887	$self width $column [expr $maxLenFin + 1]
1888	}
1889
1890	#///////////////////////////////////////////////////////////////////////////
1891	method _Validate { val } {
1892	#
1893	# PURPOSE: Validates each keystroke when typing in a cell
1894	#
1895	# PARAMETERS: val -> The value to be validated
1896	#
1897	#///////////////////////////////////////////////////////////////////////////
1898	if [regexp {^[^(\n\|\r)]*(\n\|\r)$} $val] {
1899	return 0
1900	} else {
1901	$self _IsSaved 0
1902	return 1
1903	}
1904	}
1905
1906	#///////////////////////////////////////////////////////////////////////////
1907	method _CmdOnB3 { m w x y X Y } {
1908	#
1909	# PURPOSE: Shows contextual menu when right mouse button is clicked
1910	#
1911	# PARAMETERS: m -> The menu
1912	# w -> The parent
1913	# x -> The absolute position
1914	# y -> The absolute postion
1915	# X -> The relative position
1916	# Y -> The relative position
1917	#
1918	#///////////////////////////////////////////////////////////////////////////
1919	if ![llength [$self border mark $x $y]] {
1920	set cell [$self index @$x,$y]
1921	#Last row and col where right button was pressed is saved
1922	set data(lastrow) [lindex [split $cell ,] 0]
1923	set data(lastcol) [lindex [split $cell ,] 1]
1924	#The type is retrieved
1925	set type [lindex $data(types) $data(lastcol)]
1926	$widget(menu) entryconfigure 0 \
1927	-label [mc "[string toupper $type]"]
1928	if { $type == "text" } {
1929	$widget(menu) entryconfigure 2 -state disabled
1930	} else {
1931	$widget(menu) entryconfigure 2 -state normal
1932	}
1933
1934	set sel [$self curselection]
1935	#Column of the first cell in selection
1936	set firstcol [lindex [split [lindex $sel 0] ,] 1]
1937	#Column of the last cell in selection
1938	set lastcol [lindex [split [lindex $sel end] ,] 1]
1939	#if more than one column is selected or selection is empty functions
1940	#are disabled
1941	if { [TclInfoExists Set GuiFunctionTablePrj] } {
1942	if { ($sel == "") } {
1943	$widget(menu) entryconfigure 11 -state disabled
1944	} else {
1945	$widget(menu) entryconfigure 11 -state normal
1946	$self _UpdateMenuFunc
1947	}
1948	}
1949	tk_popup $m $X $Y
1950	}
1951	}
1952
1953	#///////////////////////////////////////////////////////////////////////////
1954	method _UpdateMenuFunc { } {
1955	#
1956	# PURPOSE: Updates menu function
1957	#
1958	#///////////////////////////////////////////////////////////////////////////
1959	#Primero destruye los menus previos en caso de que existan
1960	if { [winfo exist $widget(menu).func] } {
1961	foreach child [winfo children $widget(menu).func] {
1962	destroy $child
1963	}
1964	destroy $widget(menu).func
1965	}
1966	#Crea el menu de las funciones
1967	set mc [menu $widget(menu).func -tearoff 0]
1968
1969	#obtiene el tipo de la columna
1970	set type [lindex $data(types) $data(lastcol)]
1971
1972	#objeto tol con las funciones del usuario
1973	set obj GuiFunctionTablePrj
1974
1975	set lstDef [GetGlobalUniqueName __lstDef]
1976	set tolCmd "Text $lstDef = TolSet2TclLst($obj);"
1977	TclTolEval $tolCmd
1978	eval "set lstUserDef [TclGetVar Text $lstDef]"
1979	::tol::console stack release $lstDef
1980
1981	foreach func $lstUserDef {
1982	set nameFun [lindex $func 0]
1983	set nameGui [lindex $func 1]
1984	set typeIn [lindex $func 2]
1985	set typeOut [lindex $func 3]
1986
1987	if {[string tolower $typeIn] == [string tolower $type]} {
1988	set m [menu $widget(menu).func.[string tolower $nameFun] -tearoff 0]
1989	$widget(menu).func add cascade -label $nameGui -menu $m
1990	$m add command -label [mc "Graph"] \
1991	-command [list $self _CompileMenuFunc $typeOut $nameFun $typeIn $nameGui chart]
1992	$m add command -label [mc "Table"] \
1993	-command [list $self _CompileMenuFunc $typeOut $nameFun $typeIn $nameGui table]
1994	$m add command -label [mc "Compile"] \
1995	-command [list $self _CompileMenuFunc $typeOut $nameFun $typeIn $nameGui]
1996	}
1997	if {[string tolower $typeIn] == "set"} {
1998	$widget(menu).func add command -label $nameGui \
1999	-command [list $self _CompileMenuFunc $typeOut $nameFun $typeIn $nameGui]
2000	}
2001	}
2002	}
2003
2004	#///////////////////////////////////////////////////////////////////////////
2005	method _CompileMenuFunc { typeOut nameFun typeIn nameGui {func ""} } {
2006	#
2007	# PURPOSE: Creates TOL object with the given parameters.
2008	# It can also tabulate and show charts
2009	# PARAMETERS: typeOut -> Type that returns TOL object
2010	# nameFun -> Name that will have the object
2011	# typeIn -> Type of the parameter
2012	# nameGui -> Name used in the GUI
2013	# func -> "chart" creates a graph
2014	# "table" creates a table
2015	# "" just compiles
2016	#
2017	#///////////////////////////////////////////////////////////////////////////
2018	#if the typeOut is SetOf* is changed to Set
2019	if { [regexp {^SetOf} $typeOut] } {
2020	set typeOutRes "Set"
2021	} else {
2022	set typeOutRes $typeOut
2023	}
2024
2025	if { $typeIn == "Set" } {
2026	set paramHeaders "[string trim [$self get 0,0 0,[expr [$self cget -cols] -1]]]"
2027	set paramHeadersAux {}
2028	foreach it $paramHeaders {
2029	lappend paramHeadersAux "\"$it\""
2030	}
2031
2032	set sSetHeader {}
2033	if {[llength $paramHeadersAux]} {
2034	set sSetHeader "SetOfText([join $paramHeadersAux ,])"
2035	set par1 [$self _CreateSetForFunction]
2036	set lstAux {}
2037	lappend lstAux $sSetHeader
2038	lappend lstAux $par1
2039	set param "SetOfSet([join $lstAux ,])"
2040	} else {
2041	set param [$self _CreateSet]
2042	}
2043
2044	set function [GetGlobalUniqueName $nameFun]
2045	set tolCmd "$typeOutRes $function = ${nameFun}($param)"
2046
2047	TclTolEval $tolCmd
2048
2049	::TolInspector::UpdateConsoleObj
2050
2051	::TolConsole::RaiseInspector
2052	} else {
2053	#Selection, type of the column and format are got
2054	set sel [$self curselection]
2055	set type [lindex $data(types) $data(lastcol)]
2056	set saveformat [lindex $data(formats) $data(lastcol)]
2057
2058	#If is a date the format is changed temporaly to TOL format
2059	if { $type == "date" } {
2060	$self setType $data(lastcol) date y%Ym%md%dh%Hi%Ms%S.000
2061	}
2062
2063	#The value of each cell is got
2064	foreach cell $sel {
2065	lappend lst [$self get $cell]
2066	}
2067
2068	#Format is restored
2069	if { $type == "date" } {
2070	$self setType $data(lastcol) date $saveformat
2071	}
2072
2073	#The parameters of the object are built with typeIn
2074	set param [TclLst2TolSet $lst -level 1 \
2075	-grammar [string totitle [string tolower $typeIn]]]
2076
2077	set function [GetGlobalUniqueName $nameFun]
2078	set tolCmd "$typeOutRes $function = ${nameFun}($param)"
2079
2080	TclTolEval $tolCmd
2081
2082	::TolInspector::UpdateConsoleObj
2083
2084	if { $func != "" } {
2085	if { $typeOut == "Serie" } {
2086	set tolCmd "Text SaddVisuConceptView(SetOfSerie($function),\"$nameGui\",\
2087	GCFFile,DefFirst,DefLast,\
2088	\"$func\",\"$typeOut\");"
2089	} else {
2090	set tolCmd "Text SaddVisuConceptView($function,\"$nameGui\",\
2091	GCFFile,DefFirst,DefLast,\
2092	\"$func\",\"$typeOut\");"
2093	}
2094	TclTolEval $tolCmd
2095
2096	} else {
2097	::TolConsole::RaiseInspector
2098	}
2099	}
2100	}
2101
2102	#///////////////////////////////////////////////////////////////////////////
2103	method _CreateSet { } {
2104	#
2105	# PURPOSE: Returns the syntax to create TOL object.
2106	# PARAMETERS:
2107	#
2108	#///////////////////////////////////////////////////////////////////////////
2109	#Gets current selection
2110	set cells [$self curselection]
2111	#Inicialize lists
2112	set rows {}
2113	set sSet {}
2114
2115	#The content of the selected rows are added to rowsres
2116	foreach cell $cells {
2117	set row [lindex [split $cell ,] 0]
2118	if { [lsearch $rows $row] == -1 } {
2119	lappend rows $row
2120	set sAny {}
2121	for { set i 0 } { $i <= [$self cget -cols] } { incr i } {
2122	set type [lindex $data(types) $i]
2123	if { $type == "text" } {
2124	lappend sAny "\"[string trim [$self get $row,$i] \"]\""
2125	} elseif { $type == "date" } {
2126	set saveformat [lindex $data(formats) $i]
2127	$self setType $i date y%Ym%md%dh%Hi%Ms%S.000
2128	lappend sAny [$self get $row,$i]
2129	$self setType $i date $saveformat
2130	} elseif { $type == "real" } {
2131	lappend sAny [$self get $row,$i]
2132	}
2133	}
2134	lappend sSet "SetOfAnything([join $sAny ,])"
2135	}
2136	}
2137	set code "SetOfSet([join $sSet ,])"
2138
2139	return $code
2140	}
2141
2142	#///////////////////////////////////////////////////////////////////////////
2143	method _CreateSetForFunction { } {
2144	#
2145	# PURPOSE: Returns the syntax to create TOL object.
2146	# PARAMETERS:
2147	#
2148	#///////////////////////////////////////////////////////////////////////////
2149	#Gets current selection
2150	set cells [$self curselection]
2151	#Inicialize lists
2152	set rows {}
2153	set sSet {}
2154
2155	#The content of the selected rows are added to rowsres
2156	foreach cell $cells {
2157	set row [lindex [split $cell ,] 0]
2158	if { [lsearch $rows $row] == -1 } {
2159	lappend rows $row
2160	set sAny {}
2161	for { set i 0 } { $i <= [$self cget -cols] } { incr i } {
2162	set type [lindex $data(types) $i]
2163	if { $type == "text" } {
2164	lappend sAny "\"[string trim [$self get $row,$i] \"]\""
2165	} elseif { $type == "date" } {
2166	set saveformat [lindex $data(formats) $i]
2167	$self setType $i date y%Ym%md%dh%Hi%Ms%S.000
2168	lappend sAny [$self get $row,$i]
2169	$self setType $i date $saveformat
2170	} elseif { $type == "real" } {
2171	lappend sAny [$self get $row,$i]
2172	}
2173	}
2174	lappend sSet "SetOfAnything([join $sAny ,])"
2175	}
2176	}
2177
2178	set sSetReturn "[join $sSet ,]"
2179
2180	#return $sSet
2181	return $sSetReturn
2182	}
2183
2184	#///////////////////////////////////////////////////////////////////////////
2185	method _CmdOnB3Func { m w x y X Y} {
2186	#
2187	# PURPOSE: Shows contextual function menu when right mouse button is clicked
2188	#
2189	# PARAMETERS: m -> The menu
2190	# w -> The parent
2191	# x -> The absolute position
2192	# y -> The absolute postion
2193	# X -> The relative position
2194	# Y -> The relative position
2195	#
2196	#///////////////////////////////////////////////////////////////////////////
2197	if ![llength [$self border mark $x $y]] {
2198	tk_popup $m $X $Y
2199	}
2200	}
2201
2202	#///////////////////////////////////////////////////////////////////////////
2203	method _CmdFirst { } {
2204	#
2205	# PURPOSE: Shows the beginning of the table
2206	#
2207	#///////////////////////////////////////////////////////////////////////////
2208	$self see origin
2209	}
2210
2211	#///////////////////////////////////////////////////////////////////////////
2212	method _CmdBack { } {
2213	#
2214	# PURPOSE: Moves active cell one cell up
2215	#
2216	#///////////////////////////////////////////////////////////////////////////
2217	::tk::table::MoveCell $self -1 0
2218	}
2219
2220	#///////////////////////////////////////////////////////////////////////////
2221	method _CmdNext { } {
2222	#
2223	# PURPOSE: Moves active cell one cell down
2224	#
2225	#///////////////////////////////////////////////////////////////////////////
2226	if { ![catch {$self index active}] } {
2227	if { [$self index active row] < [expr {[$self cget -rows] -1}] } {
2228	::tk::table::MoveCell $self 1 0
2229	} else {
2230	$self insert rows end
2231	::tk::table::MoveCell $self 1 0
2232	$self _UpdateInfoRows
2233	$self _IsSaved 0
2234	}
2235	}
2236	}
2237
2238	#///////////////////////////////////////////////////////////////////////////
2239	method _CmdLast { } {
2240	#
2241	# PURPOSE: Shows the end of the table
2242	#
2243	#///////////////////////////////////////////////////////////////////////////
2244	$self see end
2245	}
2246
2247	#///////////////////////////////////////////////////////////////////////////
2248	method _CmdSelectAll { } {
2249	#
2250	# PURPOSE: Select all the table
2251	#
2252	#///////////////////////////////////////////////////////////////////////////
2253	::tk::table::SelectAll $self
2254	}
2255
2256	#///////////////////////////////////////////////////////////////////////////
2257	method _CmdDelete { } {
2258	#
2259	# PURPOSE: Deletes current selection
2260	#
2261	#///////////////////////////////////////////////////////////////////////////
2262	if {[llength [$self curselection]] > 1 } {
2263	$self curselection {}
2264	$self selection clear all
2265	}
2266	$self _IsSaved 0
2267	}
2268
2269
2270	#///////////////////////////////////////////////////////////////////////////
2271	method _CmdCopy { } {
2272	#
2273	# PURPOSE: Copy to clipboard current selection
2274	#
2275	#///////////////////////////////////////////////////////////////////////////
2276	# before delete clipboard
2277	clipboard clear
2278	tk_tableCopy $widget(tab)
2279	}
2280
2281	#///////////////////////////////////////////////////////////////////////////
2282	method _CmdSpecialCopy { arg } {
2283	#
2284	# PURPOSE: Copies headers or whole table depending on parameter.
2285	# PARAMETERS: arg -> headers -> copy headers
2286	# table -> copy table
2287	#
2288	#///////////////////////////////////////////////////////////////////////////
2289	#The current selection is saved
2290	set sel [$self curselection]
2291	set selfirst [lindex $sel 0]
2292	set sellast [lindex $sel end]
2293	#Current state of selecttitles is saved
2294	set temptit [$self cget -selecttitles]
2295	#Selecttitles is temporally set to 1
2296	$self configure -selecttitles 1
2297	#The headers are selected
2298	$self selection clear all
2299	if { $arg == "headers" } {
2300	$self selection set 0,0 0,[expr [$self cget -cols] -1]
2301	} else {
2302	$self selection set 0,0 end
2303	}
2304	# before delete clipboard
2305	clipboard clear
2306	#copy
2307	tk_tableCopy $widget(tab)
2308	#the selection and selecttitles state are restored
2309	$self selection clear all
2310	$self configure -selecttitles $temptit
2311	$self selection set $selfirst $sellast
2312	}
2313
2314	#///////////////////////////////////////////////////////////////////////////
2315	method _CmdCut { } {
2316	#
2317	# PURPOSE: Cuts to clipboard current selection
2318	#
2319	#///////////////////////////////////////////////////////////////////////////
2320	# before delete clipboard
2321	clipboard clear
2322	tk_tableCut $widget(tab)
2323	$self _IsSaved 0
2324	}
2325
2326	#/////////////////////////////////////////////////////////////////////////////
2327	method _CmdPaste { } {
2328	#
2329	# PURPOSE: Paste information saved in clipboard
2330	#
2331	#/////////////////////////////////////////////////////////////////////////////
2332	set txt [clipboard get]
2333	set p [$self index active]
2334	if {![string length $p]} {
2335	set p 0,0
2336	}
2337
2338	#set rowIni [lindex [split $p ","] 0]
2339	#set colIni [lindex [split $p ","] 1]
2340	#set rsep [$widget(tab) cget -rowseparator]
2341	#set csep [$widget(tab) cget -colseparator]
2342	#
2343	#if {[string comp {} $rsep]} { set drows [split $txt $rsep] }
2344	#set numRows [llength $drows]
2345	#if [string equal [lindex $drows end] {}] {
2346	# set numRows [incr numRows -1]
2347	#}
2348	#set numCols 0
2349	#foreach line $drows {
2350	# if [expr [llength [split $line $csep]] > $numCols] {
2351	# set numCols [llength [split $line $csep]]
2352	# }
2353	#}
2354	#set colsold [$widget(tab) cget -cols]
2355	#for {set i $colsold} {$i < [expr $colIni+$numCols]} {incr i} {
2356	# set data(types) [linsert $data(types) $i text]
2357	#}
2358
2359	$self _PasteHandler $p $txt
2360	}
2361
2362	#/////////////////////////////////////////////////////////////////////////////
2363	method _CmdNew { } {
2364	#
2365	# PURPOSE: Cleans table editor to edit a new white table
2366	#
2367	#/////////////////////////////////////////////////////////////////////////////
2368	if [string equal [$self _CheckSaved] "cancel"] return
2369	$self configure -path ""
2370	}
2371
2372
2373	#/////////////////////////////////////////////////////////////////////////////
2374	method cmdOpen { } {
2375	#
2376	# PURPOSE: Opens selected file
2377	#
2378	#/////////////////////////////////////////////////////////////////////////////
2379	if [string equal [$self _CheckSaved] "cancel"] return
2380
2381	set path [tk_getOpenFile -title [mc "Open"] \
2382	-parent $self \
2383	-initialdir [$self cget -defopenpath] \
2384	-defaultextension [$self cget -defext] \
2385	-filetypes [$self cget -typelist]]
2386	if {$path != ""} {
2387	set pathfolder [file dirname $path]
2388	$self configure -defopenpath $pathfolder
2389	$self configure -path $path
2390	}
2391	}
2392
2393	#/////////////////////////////////////////////////////////////////////////////
2394	method _CmdSave { } {
2395	#
2396	# PURPOSE: Saves the current table to a file.
2397	# RETURN: Returns 1 if file has been saved correctly or 0 if not.
2398	#
2399	#/////////////////////////////////////////////////////////////////////////////
2400	set nameFile [$self cget -path]
2401
2402	if {$nameFile == ""} {
2403	set ok [$self _CmdSaveAs]
2404	} else {
2405	set ok [$self _FileSave $nameFile]
2406	}
2407	return $ok
2408	}
2409
2410	#/////////////////////////////////////////////////////////////////////////////
2411	method _CmdClose { } {
2412	#
2413	# PURPOSE: Closes the table
2414	# RETURN: Returns 1 if the table has been closed 0 if not.
2415	#
2416	#/////////////////////////////////////////////////////////////////////////////
2417	if { [string equal [$self _CheckSaved] "cancel"] } {
2418	return 0
2419	}
2420	#Ini file is written
2421	$self _WriteIni
2422	#if closecmd is defined, is executed
2423	set cmd [$self cget -closecmd]
2424	if {[string length $cmd]} {
2425	eval $cmd
2426	}
2427
2428	destroy [$self cget -parent]
2429	return 1
2430	}
2431
2432	#/////////////////////////////////////////////////////////////////////////////
2433	method _CmdSaveAs {{nf ""}} {
2434	#
2435	# PURPOSE: Saves table data actually opened in table editor asking for the
2436	# user to select a file to save it.
2437	#
2438	# PARAMETERS:
2439	# nf -> name of file proposed
2440	#
2441	# RETURN: Returns 1 if file has been saved correctly or 0 if not.
2442	#
2443	#/////////////////////////////////////////////////////////////////////////////
2444	if {$nf == ""} {
2445	set dir [$self cget -defsavepath]
2446	set fil ""
2447	} else {
2448	set dir "[file dirname $nf]"
2449	set fil "[file tail $nf]"
2450	}
2451	set path [tk_getSaveFile -title [mc "Save as"] -initialdir $dir \
2452	-initialfile $fil -parent $self \
2453	-defaultextension [$self cget -defext] \
2454	-filetypes [$self cget -typelist]]
2455	if {![string equal $path ""] } {
2456	set pathfolder [file dirname $path]
2457	$self configure -defsavepath $pathfolder
2458	set ok [$self _FileSave $path]
2459	set options(-path) $path
2460	} else {
2461	set ok 0
2462	}
2463	return $ok
2464	}
2465
2466
2467	#//////////////////////////////////////////////////////////////////////////
2468	method _PostOrderCommand { } {
2469	#
2470	# PURPOSE: Execute postordercommand
2471	#
2472	#///////////////////////////////////////////////////////////////////////////
2473	set cmd [$self cget -postordercmd]
2474	if {[string length $cmd]} {
2475	eval $cmd
2476	}
2477	}
2478
2479	#/////////////////////////////////////////////////////////////////////////////
2480	method _CmdOrdAsc { } {
2481	#
2482	# PURPOSE: Orders the selected cell increasingly using the left most column as
2483	# index
2484	#
2485	#/////////////////////////////////////////////////////////////////////////////
2486	if { [llength [$self curselection]] } {
2487	set start [lindex [$self curselection] 0]
2488	set end [lindex [$self curselection] end]
2489	set col [lindex [split $start ,] 1]
2490	set args "-increasing"
2491	$self _Sort $start $end $col $args
2492	$self _IsSaved 0
2493
2494	$self _PostOrderCommand
2495	}
2496	}
2497
2498	#/////////////////////////////////////////////////////////////////////////////
2499	method _CmdOrdDes { } {
2500	#
2501	# PURPOSE: Orders the selected cell decreasingly using the left most column as
2502	# index
2503	#
2504	#/////////////////////////////////////////////////////////////////////////////
2505	if { [llength [$self curselection]] } {
2506	set start [lindex [$self curselection] 0]
2507	set end [lindex [$self curselection] end]
2508	set col [lindex [split $start ,] 1]
2509	set args "-decreasing"
2510	$self _Sort $start $end $col $args
2511	$self _IsSaved 0
2512
2513	$self _PostOrderCommand
2514	}
2515	}
2516
2517	#/////////////////////////////////////////////////////////////////////////////
2518	method _CmdCloseOrdAdv { w { onlyexit 0 } } {
2519	#
2520	# PURPOSE: Closes advanced order dialog
2521	#
2522	# PARAMETERS:
2523	# w -> the dialog
2524	# onlyexit -> flag that specifies if the table should be ordered before
2525	# closing or not.
2526	#
2527	#/////////////////////////////////////////////////////////////////////////////
2528	if { $onlyexit } {
2529	$w enddialog ""
2530	} else {
2531	set f [$w getframe]
2532	set data(advorder) [$f.bms get selected]
2533	if { $data(advorder) != "" } {
2534	set trows [expr [$self cget -rows]-1]
2535	set tcols [expr [$self cget -cols]-1]
2536	$self _Sort 1,0 $trows,$tcols 0 advorder
2537	$self _IsSaved 0
2538	}
2539	$self _PostOrderCommand
2540
2541	$w enddialog $data(advorder)
2542	}
2543	}
2544
2545	#/////////////////////////////////////////////////////////////////////////////
2546	method _CmdOrdAdv { } {
2547	#
2548	# PURPOSE: Creates advanced order dialog
2549	#
2550	#/////////////////////////////////////////////////////////////////////////////
2551	if {![winfo exists $self.d]} {
2552	set dialog [Dialog $self.d -title [mc "Advanced selector of order"] \
2553	-modal local -parent $self]
2554	set dialogframe [$dialog getframe]
2555	wm protocol $dialog WM_DELETE_WINDOW [list $self _CmdCloseOrdAdv $dialog]
2556
2557	#The name of the column is set with the header, if there is no header, a
2558	#default column name will be set.
2559	#For each column to lines are added, one to order incrementally and the
2560	#other decrementally.
2561	set select ""
2562	for {set i 0} {$i < [$self cget -cols]} {incr i} {
2563	if {[$self get 0,$i] == ""} {
2564	lappend select "$i {[mc column] $i} inc"
2565	lappend select "$i {[mc column] $i} dec"
2566	} else {
2567	lappend select "$i {[mc [$self get 0,$i]]} inc"
2568	lappend select "$i {[mc [$self get 0,$i]]} dec"
2569	}
2570	}
2571
2572	bmultiselect $dialogframe.bms \
2573	-cols "[mc "index"] [mc "name"] [mc "order"]" \
2574	-hiddencols [mc "index"] -unsel $select \
2575	-labelunsel [mc "Not selected"] -labelsel [mc "Selected"]
2576
2577	set dialogframe_bbox \
2578	[ButtonBox $dialogframe.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
2579	-homogeneous false]
2580	$dialogframe_bbox add -text [mc "Accept"] -relief link \
2581	-helptext [mc "Accept selection"] \
2582	-image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
2583	-command [list $self _CmdCloseOrdAdv $dialog]
2584	$dialogframe_bbox add -text [mc "Cancel"] -relief link \
2585	-helptext [mc "Cancel selection"] \
2586	-image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
2587	-command [list $self _CmdCloseOrdAdv $dialog 1]
2588
2589	pack $dialogframe_bbox -side bottom -expand no -fill x
2590	pack $dialogframe.bms -fill both -expand true
2591	}
2592	#wm resizable $dialog 0 0
2593	$self.d draw
2594	}
2595
2596	#/////////////////////////////////////////////////////////////////////////////
2597	method _CmdSetType { typ } {
2598	#
2599	# PURPOSE: Sets the type of the last right clicked column
2600	#
2601	# PARAMETERS:
2602	# typ -> the type
2603	#
2604	#/////////////////////////////////////////////////////////////////////////////
2605	$self setType $data(lastcol) $typ
2606	}
2607
2608	#/////////////////////////////////////////////////////////////////////////////
2609	method setType { col typ {format {}}} {
2610	#
2611	# PURPOSE: Sets the type of the column.Empty format is also set.
2612	#
2613	# PARAMETERS:
2614	# col -> the column
2615	# typ -> the type
2616	#
2617	#/////////////////////////////////////////////////////////////////////////////
2618	set data(types) [lreplace $data(types) $col $col $typ]
2619	set data(formats) [lreplace $data(formats) $col $col $format]
2620	$self configure -padx [$self cget -padx]
2621	}
2622
2623	#/////////////////////////////////////////////////////////////////////////////
2624	method _CmdSetFormat { } {
2625	#
2626	# PURPOSE: Sets the format of the last right clicked column
2627	#
2628	#/////////////////////////////////////////////////////////////////////////////
2629	set type [lindex $data(types) $data(lastcol)]
2630	if { $type == "date" } {
2631	$self _CmdSetFormatDate
2632	} else {
2633	$self _CmdSetFormatReal
2634	}
2635	}
2636
2637	#/////////////////////////////////////////////////////////////////////////////
2638	method _CmdSetFormatDate { } {
2639	#
2640	# PURPOSE: Creates format dialog for date type
2641	#
2642	#/////////////////////////////////////////////////////////////////////////////
2643	set dialog [Dialog $self.fd -title [mc "Date format"]\
2644	-default 0 -modal none -parent $self]
2645	set w [$dialog getframe]
2646	wm resizable $dialog 0 0
2647	#Some default formats are included
2648	set data(dateformat,formats) [list \
2649	[mc "TOL Long Format"] "y%Ym%md%dh%Hi%Ms%S.000" \
2650	[mc "TOL Short Format"] "y%Ym%md%d" \
2651	"Completo YYYY/MM/dd" "%Y/%m/%d" \
2652	"Completo dd/MM/YYYY" "%d/%m/%Y" \
2653	"Fecha larga" "%d de %B de %Y" \
2654	"Completo dd/Month/YYYY" "%d/%h/%Y" \
2655	[mc "User Defined"]]
2656	foreach {cad for} $data(dateformat,formats) {
2657	lappend lstCad $cad
2658	}
2659
2660	label $w.lFormat -text [mc Format]:
2661	set widget(dateformat,date) [ComboBox $w.cbFormat \
2662	-width 30 -height 6 -editable false -values $lstCad \
2663	-textvariable [varname data(dateformat,date)] \
2664	-modifycmd [list $self _CheckFormatDate]]
2665	label $w.lString -text [mc String]:
2666	set widget(dateformat,datestring) [Entry $w.eString \
2667	-width 45 -state disabled\
2668	-textvariable [varname data(dateformat,datestring)]]
2669
2670	bind $w.eString <KeyRelease> [list $self _CheckDateString]
2671	label $w.lView -text [mc Sample]:
2672	set widget(dateformat,dateview) [Entry $w.eView -width 45 -state disabled\
2673	-textvariable [varname data(dateformat,dateview)]]
2674	Button $w.bHelp -text [mc "Format Specifiers"] \
2675	-command [list $self _ShowFormatSpecifiers $w "date"] \
2676	-helptext [mc "Format Specifiers"]
2677	Button $w.ok -text [mc "Ok"] -width 16 \
2678	-command [list $self _DateFormatApply $dialog] \
2679	-helptext [mc "Ok"]
2680	Button $w.cancel -text [mc "Cancel"] -width 16 \
2681	-command [list destroy $dialog] \
2682	-helptext [mc "Cancel"]
2683
2684	grid $w.lFormat $w.cbFormat -sticky nw -padx 2 -pady 2
2685	grid $w.lString $w.eString -sticky nw -padx 2 -pady 2
2686	grid $w.lView $w.eView -sticky nw -padx 2 -pady 2
2687	grid $w.bHelp - -sticky nw -pady 2 -pady 2
2688	grid $w.ok $w.cancel -sticky nw -pady 2 -pady 2
2689
2690	wm geometry $dialog 360x90
2691	$dialog draw
2692	update
2693
2694	}
2695
2696	#/////////////////////////////////////////////////////////////////////////////
2697	method _CheckFormatDate { } {
2698	#
2699	# PURPOSE: Enables entry to configure the format when User Defined is
2700	# selected in other case shows system date with selected format
2701	#
2702	#/////////////////////////////////////////////////////////////////////////////
2703	if [string equal $data(dateformat,date) [mc "User Defined"]] {
2704	$widget(dateformat,datestring) configure -state normal
2705	} else {
2706	$widget(dateformat,datestring) configure -state disabled
2707	set idx [lsearch -exact $data(dateformat,formats) $data(dateformat,date)]
2708	set data(dateformat,datestring) [lindex $data(dateformat,formats) [expr $idx+1]]
2709	#Shows system date with selected format
2710	set data(dateformat,dateview) \
2711	[clock format [clock scan now] -format $data(dateformat,datestring)]
2712	}
2713	}
2714
2715	#/////////////////////////////////////////////////////////////////////////////
2716	method _CheckDateString { } {
2717	#
2718	# PURPOSE: Shows system date with typed format
2719	#
2720	#/////////////////////////////////////////////////////////////////////////////
2721	if {[set idx [lsearch -exact $data(dateformat,formats) \
2722	$data(dateformat,datestring)]] != -1} {
2723	set data(dateformat,date) [lindex $data(dateformat,formats) [expr $idx-1]]
2724	} else {
2725	set data(dateformat,date) [lindex $data(dateformat,formats) end]
2726	$widget(dateformat,datestring) configure -state normal
2727	}
2728	set data(dateformat,dateview) \
2729	[clock format [clock scan now] -format $data(dateformat,datestring)]
2730	}
2731
2732	#/////////////////////////////////////////////////////////////////////////////
2733	method _DateFormatApply { dialog } {
2734	#
2735	# PURPOSE: Applies format to the column
2736	#
2737	#/////////////////////////////////////////////////////////////////////////////
2738	set data(formats) [lreplace $data(formats) $data(lastcol) $data(lastcol) \
2739	$data(dateformat,datestring)]
2740	destroy $dialog
2741	$self configure -padx [$self cget -padx]
2742	}
2743
2744	#/////////////////////////////////////////////////////////////////////////////
2745	method _CmdSetFormatReal { } {
2746	#
2747	# PURPOSE: Creates format dialog for real type
2748	#
2749	#/////////////////////////////////////////////////////////////////////////////
2750	set dialog [Dialog $self.fre -title [mc "Real format"]\
2751	-default 0 -modal none -parent $self]
2752	set w [$dialog getframe]
2753	wm resizable $dialog 0 0
2754
2755	set data(realformat,real) 12345.67890
2756
2757
2758	label $w.lReal -text [mc "Number"]:
2759	set widget(realformat,real) [Entry $w.eReal -width 20 \
2760	-textvariable [varname data(realformat,real)]]
2761
2762	label $w.lFormat -text [mc "Format"]:
2763	set widget(realformat,realstring) [Entry $w.eFormat -width 20 \
2764	-textvariable [varname data(realformat,realformat)]]
2765
2766	bind $w.eReal <KeyRelease> [list $self _CheckReal]
2767	bind $w.eFormat <KeyRelease> [list $self _CheckReal]
2768
2769	label $w.lView -text [mc Sample]:
2770	set widget(realformat,realview) [Entry $w.eView -width 20 \
2771	-state disabled \
2772	-textvariable [varname data(realformat,realview)]]
2773
2774	Button $w.bHelp -text [mc "Format Specifiers"] \
2775	-command [list $self _ShowFormatSpecifiers $w "real"] \
2776	-helptext [mc "Format Specifiers"]
2777	Button $w.ok -text [mc "Ok"] -width 16 \
2778	-command [list $self _RealFormatApply $dialog] \
2779	-helptext [mc "Ok"]
2780	Button $w.cancel -text [mc "Cancel"] -width 16 \
2781	-command [list destroy $dialog] \
2782	-helptext [mc "Cancel"]
2783
2784	grid $w.lReal $w.eReal -sticky nw -padx 2 -pady 2
2785	grid $w.lFormat $w.eFormat -sticky nw -padx 2 -pady 2
2786	grid $w.lView $w.eView -sticky nw -padx 2 -pady 2
2787	grid $w.bHelp - -sticky nw -pady 2 -pady 2
2788	grid $w.ok $w.cancel -sticky nw -pady 2 -pady 2
2789
2790	wm geometry $dialog 360x90
2791	$dialog draw
2792	update
2793	}
2794
2795	#/////////////////////////////////////////////////////////////////////////////
2796	method _CheckReal { } {
2797	#
2798	# PURPOSE: Shows the result of appliying the format to the number
2799	#
2800	#/////////////////////////////////////////////////////////////////////////////
2801	if { ![catch {set data(realformat,realview) \
2802	[format $data(realformat,realformat) $data(realformat,real)]} msgerr] } {
2803	} else {
2804	set data(realformat,realview) [mc "Format not valid"]
2805	}
2806	}
2807
2808	#/////////////////////////////////////////////////////////////////////////////
2809	method _RealFormatApply { dialog } {
2810	#
2811	# PURPOSE: Applies format to the column
2812	#
2813	#/////////////////////////////////////////////////////////////////////////////
2814	set data(formats) [lreplace $data(formats) $data(lastcol) $data(lastcol) \
2815	$data(realformat,realformat)]
2816	destroy $dialog
2817	$self configure -padx [$self cget -padx]
2818	}
2819
2820	#/////////////////////////////////////////////////////////////////////////////
2821	method _ShowFormatSpecifiers { w typ } {
2822	#
2823	# PURPOSE: Shows help for the format specifiers
2824	#
2825	#/////////////////////////////////////////////////////////////////////////////
2826	if [winfo exist $w.t] {
2827	raise $w.t
2828	return
2829	}
2830	set dialog [Dialog $w.t -title [mc "Format Specifiers"]\
2831	-default 0 -parent $w -modal none -separator true]
2832
2833	set w [$dialog getframe]
2834
2835	set txt [text $w.txt -state normal -yscrollcommand "$w.scroll set"]
2836	set scroll [scrollbar $w.scroll -command "$txt yview"]
2837
2838	$txt tag configure label -font {Arial 9} -foreground red
2839	$txt tag configure desc -font {Arial 9} -foreground black -lmargin1 "20" \
2840	-lmargin2 "20"
2841
2842	if { $typ == "real" } {
2843	set chars [list \
2844	% c d e f g i o s u x]
2845	} else {
2846	set chars [list \
2847	% a A b B c C d D e h H I j K l m M n p r R s S t T u U V w W x X y Y Z]
2848	}
2849
2850	foreach char $chars {
2851	$txt insert end %$char {label}
2852	$txt insert end \n
2853	$txt insert end "[mc desc$typ%$char]" {desc}
2854	$txt insert end \n
2855	}
2856
2857	$txt configure -state disabled
2858
2859	pack $scroll -side right -fill y
2860	pack $txt -side bottom -expand yes -fill both
2861
2862	$dialog draw
2863	}
2864
2865
2866	#/////////////////////////////////////////////////////////////////////////////
2867	method _CmdInsertCols { } {
2868	#
2869	# PURPOSE: Creates dialog to insert columns
2870	#
2871	#/////////////////////////////////////////////////////////////////////////////
2872	#default data
2873	set data(insertcols,side) left
2874	set data(insertcols,type) text
2875
2876
2877	set dialog [Dialog $self.ic -title [mc "Insert Columns"]\
2878	-default 0 -modal none -parent $self]
2879	set w [$dialog getframe]
2880	wm resizable $dialog 0 0
2881
2882	wm protocol $dialog WM_DELETE_WINDOW [list $self _InsertColsClose $dialog]
2883
2884	label $w.lNum -text [mc "Columns"]
2885	SpinBox $w.sNum -range {1 99} -width 2 -justify right -editable true \
2886	-textvariable [varname data(insertcols,num)]
2887	TitleFrame $w.side -bd 2 -relief groove -text [mc "Side"]
2888	set f [$w.side getframe]
2889	radiobutton $f.left -text [mc "Left"] -value left \
2890	-variable [varname data(insertcols,side)] \
2891	-highlightthickness 0 -pady 0
2892	radiobutton $f.right -text [mc "Right"] -value right \
2893	-variable [varname data(insertcols,side)] \
2894	-highlightthickness 0 -pady 0
2895	TitleFrame $w.type -bd 2 -relief groove -text [mc "Type"]
2896	set f1 [$w.type getframe]
2897	radiobutton $f1.text -text [mc "Text"] -value text \
2898	-variable [varname data(insertcols,type)] \
2899	-highlightthickness 0 -pady 0
2900	radiobutton $f1.real -text [mc "Real"] -value real \
2901	-variable [varname data(insertcols,type)] \
2902	-highlightthickness 0 -pady 0
2903	radiobutton $f1.date -text [mc "Date"] -value date \
2904	-variable [varname data(insertcols,type)] \
2905	-highlightthickness 0 -pady 0
2906	Button $w.ok -text [mc "Ok"] -width 8 \
2907	-command [list $self _InsertColsOk $dialog] \
2908	-helptext [mc "Insert Columns"]
2909	Button $w.cancelar -text [mc "Cancel"] -width 8 \
2910	-helptext "" -command [list $self _InsertColsClose $dialog]
2911
2912	bind $dialog <Escape> [list $self _InsertColsClose $dialog]
2913
2914	grid $f.left
2915	grid $f.right
2916
2917	grid $f1.text
2918	grid $f1.real
2919	grid $f1.date
2920
2921	grid $w.lNum $w.sNum -sticky nw -padx 5
2922	grid $w.type $w.side -sticky nw -padx 5
2923	grid $w.ok $w.cancelar -sticky nw -padx 5
2924
2925	wm geometry $dialog 360x90
2926	$dialog draw
2927	update
2928	}
2929
2930	#/////////////////////////////////////////////////////////////////////////////
2931	method _InsertColsOk { dialog } {
2932	#
2933	# PURPOSE: Inserts column with the options set in the dialog and after
2934	# destroys the dialog
2935	# PARAMETERS:
2936	# dialog -> the dialog
2937	#
2938	#/////////////////////////////////////////////////////////////////////////////
2939	$self _InsertCols $data(insertcols,side) \
2940	$data(lastcol) \
2941	$data(insertcols,num) \
2942	$data(insertcols,type)
2943	destroy $dialog
2944	}
2945
2946	#/////////////////////////////////////////////////////////////////////////////
2947	method _InsertColsClose { dialog } {
2948	#
2949	# PURPOSE: Destroys the dialog
2950	# PARAMETERS:
2951	# dialog -> the dialog
2952	#
2953	#/////////////////////////////////////////////////////////////////////////////
2954	destroy $dialog
2955	}
2956
2957
2958	#/////////////////////////////////////////////////////////////////////////////
2959	method _CmdInsertRows { } {
2960	#
2961	# PURPOSE: Creates dialog to insert rows
2962	#
2963	#/////////////////////////////////////////////////////////////////////////////
2964	#default data
2965	set data(insertrows,side) up
2966
2967	set dialog [Dialog $self.ir -title [mc "Insert Rows"]\
2968	-default 0 -modal none -parent $self]
2969	set w [$dialog getframe]
2970	wm resizable $dialog 0 0
2971
2972	wm protocol $dialog WM_DELETE_WINDOW [list $self _InsertRowsClose $dialog]
2973
2974	label $w.lNum -text [mc "Rows"]
2975	SpinBox $w.sNum -range {1 99} -width 2 -justify right -editable true \
2976	-textvariable [varname data(insertrows,num)]
2977	TitleFrame $w.side -bd 2 -relief groove -text [mc "Side"]
2978	set f [$w.side getframe]
2979	radiobutton $f.up -text [mc "Up"] -value up \
2980	-variable [varname data(insertrows,side)] \
2981	-highlightthickness 0 -pady 0
2982	radiobutton $f.down -text [mc "Down"] -value down \
2983	-variable [varname data(insertrows,side)] \
2984	-highlightthickness 0 -pady 0
2985
2986	Button $w.ok -text [mc "Ok"] -width 8 \
2987	-command [list $self _InsertRowsOk $dialog] \
2988	-helptext [mc "Insert Rows"]
2989	Button $w.cancelar -text [mc "Cancel"] -width 8 \
2990	-helptext "" -command [list $self _InsertRowsClose $dialog]
2991
2992	bind $dialog <Escape> [list $self _InsertRowsClose $dialog]
2993
2994	grid $f.up $f.down
2995
2996	grid $w.lNum $w.sNum -sticky nw -padx 5
2997	grid $w.side - -sticky nw -padx 5
2998	grid $w.ok $w.cancelar -sticky nw -padx 5
2999
3000	wm geometry $dialog 360x90
3001	$dialog draw
3002	update
3003	}
3004
3005	#/////////////////////////////////////////////////////////////////////////////
3006	method _InsertRowsOk { dialog } {
3007	#
3008	# PURPOSE: Inserts column with the options set in the dialog and after
3009	# destroys the dialog
3010	# PARAMETERS:
3011	# dialog -> the dialog
3012	#
3013	#/////////////////////////////////////////////////////////////////////////////
3014	$self _InsertRows $data(insertrows,side) \
3015	$data(lastrow) \
3016	$data(insertrows,num)
3017	destroy $dialog
3018	}
3019
3020	#/////////////////////////////////////////////////////////////////////////////
3021	method _InsertRowsClose { dialog } {
3022	#
3023	# PURPOSE: Destroys the dialog
3024	# PARAMETERS:
3025	# dialog -> the dialog
3026	#
3027	#/////////////////////////////////////////////////////////////////////////////
3028	destroy $dialog
3029	}
3030
3031	#/////////////////////////////////////////////////////////////////////////////
3032	method _CmdDeleteCols { } {
3033	#
3034	# PURPOSE: Deletes selected columns
3035	#
3036	#/////////////////////////////////////////////////////////////////////////////
3037	set cells [$self curselection]
3038	if ![llength $cells] {
3039	set cells {0,0}
3040	}
3041	set colIni [lindex [split [lindex $cells 0] ","] 1]
3042	set colEnd [lindex [split [lindex $cells end] ","] 1]
3043	set cols [expr $colEnd-$colIni+1]
3044
3045	$self _DeleteCols $colIni $cols
3046	}
3047
3048	#/////////////////////////////////////////////////////////////////////////////
3049	method _CmdDeleteRows { } {
3050	#
3051	# PURPOSE: Deletes selected rows
3052	#
3053	#/////////////////////////////////////////////////////////////////////////////
3054	set cells [$self curselection]
3055	if ![llength $cells] {
3056	set cells {0,0}
3057	}
3058
3059	set rowIni [lindex [split [lindex $cells 0] ","] 0]
3060	set rowEnd [lindex [split [lindex $cells end] ","] 0]
3061	set rows [expr $rowEnd-$rowIni+1]
3062
3063	$self _DeleteRows $rowIni $rows
3064	}
3065
3066	#/////////////////////////////////////////////////////////////////////////////
3067	method _CmdFind { } {
3068	#
3069	# PURPOSE: Set default parameters for the Find dialog
3070	#
3071	#/////////////////////////////////////////////////////////////////////////////
3072	set data(find,text) ""
3073	set data(find,next) 0
3074	$self _FindCreate
3075	}
3076
3077	#/////////////////////////////////////////////////////////////////////////////
3078	method _FindCreate { } {
3079	#
3080	# PURPOSE: Creates a Find Dialog
3081	#
3082	#/////////////////////////////////////////////////////////////////////////////
3083	set dialog [Dialog $self.df -title [mc "Find"]\
3084	-default 0 -modal none -parent $self]
3085	set w [$dialog getframe]
3086	wm resizable $dialog 0 0
3087
3088	wm protocol $dialog WM_DELETE_WINDOW [list $self _FindClose $dialog]
3089
3090	set data(find,cad) [LabelEntry $w.eTxt -label "[mc "Find"]: " \
3091	-textvariable [varname data(find,text)] -labelwidth 12]
3092	checkbutton $w.full -text [mc "Full word"] \
3093	-variable [varname data(find,full)] -pady 0
3094	checkbutton $w.case -text [mc "Case sensitive"] \
3095	-variable [varname data(find,case)] -pady 0
3096	TitleFrame $w.dir -bd 2 -relief groove -text [mc "Direction"]
3097	set f [$w.dir getframe]
3098	radiobutton $f.forward -text [mc "Forward"] -value forward \
3099	-variable [varname data(find,dir)] \
3100	-highlightthickness 0 -pady 0
3101	radiobutton $f.backward -text [mc "Backward"] -value backward \
3102	-variable [varname data(find,dir)] \
3103	-highlightthickness 0 -pady 0
3104	Button $w.findNext -text [mc "Find next"] -width 16 \
3105	-command [list $self _FindNext 1] \
3106	-helptext [mc "Find next"]
3107	Button $w.mark -text [mc "Mark all"] -width 16 \
3108	-command [list $self _MarkAll] \
3109	-helptext [mc "Mark "]
3110	Button $w.cancelar -text [mc "Cancel"] -width 16 \
3111	-helptext "" -command [list $self _FindClose $dialog]
3112
3113	bind $dialog <Return> [list $self _FindNext 1]
3114	bind $dialog <F3> [list $self _FindNext 1]
3115	bind $dialog <Escape> [list $self _FindClose $dialog]
3116
3117	grid $f.forward $f.backward -sticky nw
3118
3119	grid $w.eTxt - -sticky news -padx 5 -pady 5
3120	grid $w.full $w.findNext -sticky nw -padx 5
3121	grid $w.case $w.mark -sticky nw -padx 5
3122	grid $w.dir $w.cancelar -sticky nw -padx 5
3123	wm geometry $dialog 360x90
3124	$dialog draw
3125	update
3126	focus $data(find,cad)
3127	}
3128
3129	#/////////////////////////////////////////////////////////////////////////////
3130	method _FindClose { dialog } {
3131	#
3132	# PURPOSE: Closes find dialog and deletes possibly marked cells
3133	# PARAMETERS:
3134	# dialog -> Find dialog
3135	#
3136	#/////////////////////////////////////////////////////////////////////////////
3137	set foundcells [$self tag celltag found]
3138	foreach cell $foundcells {
3139	$self tag celltag "" $cell
3140	}
3141	destroy $dialog
3142	}
3143
3144	#/////////////////////////////////////////////////////////////////////////////
3145	method _FindNext { ask {key find} } {
3146	#
3147	# PURPOSE: Finds next cell that matches the searched text.
3148	#
3149	# PARAMETERS:
3150	# ask -> asks to continue from the beginning when the end of the table is
3151	# reached
3152	# key -> type of search. Default value find. Domain [find \| replace]
3153	#
3154	#/////////////////////////////////////////////////////////////////////////////
3155	set pos [$self _FindText $key]
3156
3157	if { $pos != "" } {
3158	set data($key,next) 1
3159	set p "[lindex $pos 0],[lindex $pos 1]"
3160	$self selection clear all
3161	$self see $p
3162	if { [$self cget -state] == "normal" } {
3163	$self activate $p
3164	} else {
3165	$self activate $p
3166	$self selection set $p
3167	}
3168	} elseif { $ask == 0} {
3169	set data($key,next) 0
3170	} else {
3171	set data($key,next) 0
3172	if [string equal $data($key,dir) "forward"] {
3173	set msg "[mc SearchUpEndDoc].\n[mc FindFromBegin]"
3174	} else {
3175	set msg "[mc SearchUpBeginDoc].\n[mc FindFromEnd]"
3176	}
3177	set rq [tk_messageBox -type okcancel -icon info -parent $self\
3178	-title [mc "Table"] -message $msg]
3179	if {$rq == "ok"} {
3180	if [string equal $data($key,dir) "forward"] {
3181	set ro [$self cget -roworigin]
3182	set co [$self cget -colorigin]
3183	$self activate "$ro,$co"
3184	} else {
3185	$self activate end
3186	}
3187	$self _FindNext $ask $key
3188	}
3189	}
3190	return $pos
3191	}
3192
3193	#/////////////////////////////////////////////////////////////////////////////
3194	method _MarkAll { } {
3195	#
3196	# PURPOSE: Marks all cells that match with the searched text
3197	#
3198	#/////////////////////////////////////////////////////////////////////////////
3199	# save value
3200	set tpmfinddir $data(find,dir)
3201	set data(find,dir) forward
3202	set ro [$self cget -roworigin]
3203	set co [$self cget -colorigin]
3204	$self activate "$ro,$co"
3205
3206	set pos [$self _FindText]
3207
3208	while { $pos != "" } {
3209	set data(find,next) 1
3210	set p "[lindex $pos 0],[lindex $pos 1]"
3211	$self selection clear all
3212	$self see $p
3213	$self activate $p
3214
3215	$self tag celltag found $p
3216
3217	set pos [$self _FindText]
3218	}
3219	$self activate "$ro,$co"
3220	# retore value
3221	set data(find,dir) $tpmfinddir
3222	}
3223
3224	#/////////////////////////////////////////////////////////////////////////////
3225	method _FindText { {key find} } {
3226	#
3227	# PURPOSE: Find the text in the table
3228	# PARAMETERS:
3229	# key -> type of search. Default value find. Domain [find \| replace]
3230	# RETURN:
3231	#
3232	#/////////////////////////////////////////////////////////////////////////////
3233	#values are initialized
3234	set ok 0
3235	set rc ""
3236	#number of columns and rows
3237	set r [$self cget -rows]
3238	set c [$self cget -cols]
3239	set ro [$self cget -roworigin]
3240	set co [$self cget -colorigin]
3241	#active cell
3242	if { ![catch {set pos [$self index active]} msgerr] } {
3243	if {$pos eq "" } {
3244	set rp $ro
3245	set cp $co
3246	} else {
3247	set pc [string first , $pos]
3248	set rp [string range $pos 0 [expr $pc - 1]]
3249	set cp [string range $pos [incr pc] end]
3250	}
3251	} else {
3252	set rp $ro
3253	set cp $co
3254	}
3255	#search direction is set
3256	if [string equal $data($key,dir) "forward"] {
3257	set dir 1
3258	} else {
3259	set dir -1
3260	}
3261	#case sensitive
3262	if $data($key,case) {
3263	set nc ""
3264	} else {
3265	set nc -nocase
3266	}
3267	set sw $data($key,next)
3268
3269	upvar \#0 [varname matrix] matrix
3270
3271	#search
3272	if {![string equal $data($key,text) ""]} {
3273	while {[expr ($ok == 0) && ($cp >= $co) && ($cp < $c)]} {
3274	while {[expr ($ok == 0) && ($rp >= $ro) && ($rp < $r)]} {
3275	if { [info exists matrix($rp,$cp)] } {
3276	set txt $matrix($rp,$cp)
3277	if { $data($key,full) == 0 } {
3278	set comp [eval string match $nc [list $data($key,text)] [list $txt]]
3279	} else {
3280	set comp [eval string match $nc [list $data($key,text)] [list $txt]]
3281	}
3282	if { $comp } {
3283	if {($sw eq "0") \|\| ($pos ne "$rp,$cp")} {
3284	set ok 1
3285	set rc "$rp $cp"
3286	}
3287	set sw 0
3288	}
3289	}
3290	incr rp $dir
3291	}
3292	if {[expr ($dir == 1)]} {
3293	set rp $ro
3294	} else {
3295	set rp [expr $r - 1]
3296	}
3297	incr cp $dir
3298	}
3299	}
3300	return $rc
3301	}
3302
3303	#/////////////////////////////////////////////////////////////////////////////
3304	method _CmdReplace { } {
3305	#
3306	# PURPOSE: Set default parameters for the Replace dialog
3307	#
3308	#/////////////////////////////////////////////////////////////////////////////
3309	set data(replace,text) ""
3310	set data(replace,newtext) ""
3311	set data(replace,next) 0
3312	$self _ReplaceCreate
3313	}
3314
3315	#/////////////////////////////////////////////////////////////////////////////
3316	method _ReplaceCreate { } {
3317	#
3318	# PURPOSE: Creates a Replace Dialog
3319	#
3320	#/////////////////////////////////////////////////////////////////////////////
3321	set dialog [Dialog $self.dr -title [mc "Replace"]\
3322	-default 0 -modal none -parent $self]
3323	set w [$dialog getframe]
3324	wm resizable $dialog 0 0
3325
3326	set data(replace,find) [LabelEntry $w.eTxtF \
3327	-label "[mc "Find"]: " \
3328	-labelwidth 12 \
3329	-textvariable [varname data(replace,text)]]
3330	set data(replace,rep) [LabelEntry $w.eTxtR \
3331	-label "[mc "Replace"]: " \
3332	-labelwidth 12 \
3333	-textvariable [varname data(replace,newtext)]]
3334	checkbutton $w.full -text [mc "Full word"] \
3335	-variable [varname data(replace,full)] -pady 0
3336	checkbutton $w.case -text [mc "Case sensitive"] \
3337	-variable [varname data(replace,case)] -pady 0
3338	TitleFrame $w.dir -bd 2 -relief groove -text [mc "Direction"]
3339	set f [$w.dir getframe]
3340	radiobutton $f.forward -text [mc "Forward"] -value forward \
3341	-variable [varname data(replace,dir)] \
3342	-highlightthickness 0 -pady 0
3343	radiobutton $f.backward -text [mc "Backward"] -value backward \
3344	-variable [varname data(replace,dir)] \
3345	-highlightthickness 0 -pady 0
3346	Button $w.findNext -text [mc "Find next"] -width 16 \
3347	-command [list $self _FindNext 1 replace] \
3348	-helptext [mc "Find next"]
3349	Button $w.rep -text [mc "Replace"] -width 16 \
3350	-command [list $self _Replace] \
3351	-helptext [mc "Replace"]
3352	Button $w.repAll -text [mc "Replace all"] -width 16 \
3353	-command [list $self _ReplaceAll] \
3354	-helptext [mc "Mark "]
3355	Button $w.cancel -text [mc "Cancel"] -width 16 \
3356	-helptext "" -command "destroy $dialog"
3357	frame $w.fr
3358
3359	bind $dialog <Return> [list $self _Replace]
3360	bind $dialog <F3> [list $self _Replace]
3361	bind $dialog <Escape> [list destroy $dialog]
3362
3363	# Hemos añadido un tag para la selección, hay que quitarle como el tag sel
3364	#bind $ <ButtonPress> +[list $data(tabla) tag delete found]
3365	grid $f.forward $f.backward -sticky nw
3366
3367	grid $w.eTxtF - -sticky news -padx 5
3368	grid $w.eTxtR - -sticky news -padx 5 -pady 5
3369	grid $w.full $w.findNext -sticky nw -padx 5
3370	grid $w.case $w.rep -sticky nw -padx 5
3371	grid $w.dir $w.repAll -sticky nw -padx 5
3372	grid ^ $w.cancel -sticky nw -padx 5
3373	wm geometry $dialog 360x90
3374	$dialog draw
3375	update
3376	focus $data(replace,find)
3377	}
3378
3379	#/////////////////////////////////////////////////////////////////////////////
3380	method _Replace { { ask 1 } } {
3381	#
3382	# PURPOSE: Replaces text in the table
3383	#
3384	# PARAMETERS:
3385	# ask -> asks to continue from the beginning when the end of the table is
3386	# reached
3387	#
3388	#/////////////////////////////////////////////////////////////////////////////
3389	upvar \#0 [varname matrix] matrix
3390
3391	if { ![catch {set cell [$self index active]} msgerr] } {
3392	if $data(replace,case) {
3393	set nc ""
3394	} else {
3395	set nc -nocase
3396	}
3397	if { [info exists matrix($cell)] && $matrix($cell) != ""} {
3398	if { $data(replace,newtext) != "" } {
3399	eval regsub $nc $data(replace,text) $matrix($cell) \
3400	$data(replace,newtext) matrix($cell)
3401	} else {
3402	set newvalue "[regsub $nc $data(replace,text) $matrix($cell) {}]"
3403	set matrix($cell) $newvalue
3404	}
3405	$self _IsSaved 0
3406	}
3407	}
3408	return [$self _FindNext $ask replace]
3409	}
3410
3411	#/////////////////////////////////////////////////////////////////////////////
3412	method _ReplaceAll { } {
3413	#
3414	# PURPOSE: Replaces all cells with the text in the table
3415	#
3416	#/////////////////////////////////////////////////////////////////////////////
3417	# save value
3418	set tmpreplacedir $data(replace,dir)
3419	set data(replace,dir) forward
3420	set ro [$self cget -roworigin]
3421	set co [$self cget -colorigin]
3422	$self activate "$ro,$co"
3423
3424	set pos [$self _Replace 0]
3425
3426	while { $pos != "" } {
3427	set pos [$self _Replace 0]
3428	}
3429	$self activate "$ro,$co"
3430	# restore value
3431	set data(replace,dir) $tmpreplacedir
3432	}
3433
3434	# #/////////////////////////////////////////////////////////////////////////////
3435	# method _CmdFilter { } {
3436	# #
3437	# # PURPOSE: Filters data in the table
3438	# #
3439	# #/////////////////////////////////////////////////////////////////////////////
3440	# set dialog [Dialog $self.f -title [mc "Filter"] -modal local \
3441	# -parent $self -default 0 -cancel 1]
3442
3443	# set f [$dialog getframe]
3444
3445	# set values {}
3446	# for {set i 0} {$i < [$self cget -cols]} {incr i} {
3447	# set col [$self get 0,$i]
3448	# set type [string totitle [lindex $data(types) $i]]
3449	# if { $col != "" } {
3450	# lappend values [list $i $type {} {} $col]
3451	# } else {
3452	# lappend values [list $i $type {} {} [mc column]$i]
3453	# }
3454	# }
3455	# puts $values
3456	# set filter [bfilter $f.bf -values $values -language "TOL" \
3457	# -showbuttons 1 \
3458	# -okcommand [list puts ok] \
3459	# -cancelcommand [list puts cancel]]
3460
3461	# puts $filter
3462	# pack $filter -expand true -fill both
3463	# $dialog draw
3464	# }
3465
3466	#/////////////////////////////////////////////////////////////////////////////
3467	method _OptionsGet { } {
3468	#
3469	# PURPOSE: Gets the current options for the options dialog
3470	#
3471	#/////////////////////////////////////////////////////////////////////////////
3472	set colsep [$self cget -colseparator]
3473	set rowsep [$self cget -rowseparator]
3474
3475	if { $colsep == "\t" } {
3476	set data(options,colseptype) TAB
3477	} elseif { $colsep == "\n" } {
3478	set data(options,colseptype) RET
3479	} else {
3480	set data(options,colseptype) OTHER
3481	set data(options,colseparator) $colsep
3482	}
3483
3484	if { $rowsep == "\t" } {
3485	set data(options,rowseptype) TAB
3486	} elseif { $rowsep == "\n" } {
3487	set data(options,rowseptype) RET
3488	} else {
3489	set data(options,rowseptype) OTHER
3490	set data(options,rowseparator) $rowsep
3491	}
3492
3493	set data(options,font) [$self cget -font]
3494	set data(options,bg) [$self cget -bg]
3495	set data(options,cbalt) [$self cget -bgalt]
3496	set data(options,bgalt1) [$self cget -bgalt1]
3497	set data(options,bgalt2) [$self cget -bgalt2]
3498	set data(options,whole) [$self cget -checkcolumn]
3499	set data(options,inter) [$self cget -internalvalues]
3500	}
3501
3502	#/////////////////////////////////////////////////////////////////////////////
3503	method _OptionsSet { } {
3504	#
3505	# PURPOSE: Sets the options selected in the options dialog
3506	#
3507	#/////////////////////////////////////////////////////////////////////////////
3508	if { $data(options,rowseptype) == "TAB" } {
3509	$self configure -rowseparator \t
3510	} elseif { $data(options,rowseptype) == "RET" } {
3511	$self configure -rowseparator \n
3512	} else {
3513	$self configure -rowseparator $data(options,rowseparator)
3514	}
3515
3516	if { $data(options,colseptype) == "TAB" } {
3517	$self configure -colseparator \t
3518	} elseif { $data(options,colseptype) == "RET" } {
3519	$self configure -colseparator \n
3520	} else {
3521	$self configure -colseparator $data(options,colseparator)
3522	}
3523
3524	$self configure -font $data(options,font)
3525	$self configure -bg $data(options,bg)
3526	$self configure -bgalt $data(options,cbalt)
3527	$self configure -bgalt1 $data(options,bgalt1)
3528	$self configure -bgalt2 $data(options,bgalt2)
3529	$self configure -checkcolumn $data(options,whole)
3530	$self configure -internalvalues $data(options,inter)
3531	}
3532
3533	#/////////////////////////////////////////////////////////////////////////////
3534	method _CmdOptions { } {
3535	#
3536	# PURPOSE: Creates an options Dialog
3537	#
3538	#/////////////////////////////////////////////////////////////////////////////
3539	set dialog [Dialog $self.t -title [mc "Table Options"] -modal local \
3540	-parent $self -default 0 -cancel 1]
3541
3542	wm protocol $dialog WM_DELETE_WINDOW [list $self _OptionsDestroy $dialog]
3543
3544	set w [$dialog getframe]
3545	wm resizable $dialog 0 0
3546
3547	set w_tabset [NoteBook $w.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
3548
3549	#insertar tabset
3550	set num_i 0
3551	foreach lab_i [list Export Style Behaviour] {
3552	$w_tabset insert $num_i $lab_i -text " [mc $lab_i] " -background \#d9d9d9
3553	set tab_i [$w_tabset getframe $lab_i]
3554	$tab_i configure -borderwidth 2 -background \#d9d9d9
3555	incr num_i
3556	set f$num_i [frame $tab_i.f]
3557	pack $tab_i.f -fill both -expand yes
3558	}
3559	$w_tabset raise [$w_tabset pages 0]
3560
3561	$self _OptionsGet
3562	$self _OptionsCreateExport $f1
3563	$self _OptionsCreateStyle $f2
3564	$self _OptionsCreateBehaviour $f3
3565
3566	set w_bbox \
3567	[ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
3568	-homogeneous false]
3569	$w_bbox add -text [mc "Accept"] -relief link \
3570	-helptext [mc "Make the changes and leave the dialog"] \
3571	-image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
3572	-command [list $self _OptionsOk $dialog]
3573	$w_bbox add -text [mc "Cancel"] -relief link \
3574	-helptext [mc "Leave the dialog without apply any change"] \
3575	-image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
3576	-command [list $self _OptionsDestroy $dialog]
3577	$w_bbox add -text [mc "Apply"] -relief link \
3578	-helptext [mc "Make the changes without leave the dialog"] \
3579	-image [::Bitmap::get apply] -compound left -padx 5 -pady 1 \
3580	-command [list $self _OptionsSet]
3581
3582	$w_tabset compute_size
3583	grid $w_tabset -sticky news
3584	grid $w_bbox -sticky news
3585
3586	grid rowconfigure $w 0 -weight 1
3587	grid rowconfigure $w 1 -weight 0
3588	grid columnconfigure $w 0 -weight 1
3589
3590	$dialog draw
3591	}
3592
3593	#/////////////////////////////////////////////////////////////////////////////
3594	method _OptionsCreateExport { w } {
3595	#
3596	# PURPOSE: Creates export options tab
3597	#
3598	# PARAMETERS:
3599	# w -> the frame in which the options widgets will be created
3600	#
3601	#/////////////////////////////////////////////////////////////////////////////
3602	TitleFrame $w.tf1 -text [mc "Columns separator"]
3603	set f1 [$w.tf1 getframe]
3604	set widget(options,rbColSep1) [radiobutton $f1.rbColSep1 -text [mc Tab] \
3605	-value TAB -highlightthickness 0 -pady 0 \
3606	-variable [varname data(options,colseptype)] \
3607	-command [list $self _OptionsCheckColSepType]]
3608	set widget(options,rbColSep2) [radiobutton $f1.rbColSep2 -text [mc Return] \
3609	-value RET -highlightthickness 0 -pady 0 \
3610	-variable [varname data(options,colseptype)] \
3611	-command [list $self _OptionsCheckColSepType]]
3612	set widget(options,rbColSepN) [radiobutton $f1.rbColSepN -text [mc Other]: \
3613	-value OTHER -highlightthickness 0 -pady 0 \
3614	-variable [varname data(options,colseptype)] \
3615	-command [list $self _OptionsCheckColSepType]]
3616	set widget(options,eColSep) [Entry $f1.eColSep \
3617	-width 5 -justify right -textvariable [varname data(options,colseparator)]]
3618	frame $f1.f -width 25
3619
3620	grid $f1.f $widget(options,rbColSep1) $widget(options,rbColSep2) $widget(options,rbColSepN) $widget(options,eColSep) -sticky w -padx 2 -pady 0
3621	grid rowconfigure $f1 1 -weight 1
3622	grid columnconfigure $f1 4 -weight 1
3623
3624
3625	TitleFrame $w.tf2 -text [mc "Rows separator"]
3626	set f2 [$w.tf2 getframe]
3627	set widget(options,rbRowSep1) [radiobutton $f2.rbRowSep1 -text [mc Return] \
3628	-value RET -highlightthickness 0 -pady 0 \
3629	-variable [varname data(options,rowseptype)] \
3630	-command [list $self _OptionsCheckRowSepType]]
3631	set widget(options,rbRowSep2) [radiobutton $f2.rbRowSep2 -text [mc Tab] \
3632	-value TAB -highlightthickness 0 -pady 0 \
3633	-variable [varname data(options,rowseptype)] \
3634	-command [list $self _OptionsCheckRowSepType]]
3635	set widget(options,rbRowSepN) [radiobutton $f2.rbRowSepN -text [mc Other]: \
3636	-value OTHER -highlightthickness 0 -pady 0 \
3637	-variable [varname data(options,rowseptype)] \
3638	-command [list $self _OptionsCheckRowSepType]]
3639	set widget(options,eRowSep) [Entry $f2.eRowSep \
3640	-width 5 -justify right -textvariable [varname data(options,rowseparator)]]
3641
3642	frame $f2.f -width 25
3643
3644	grid $f2.f $widget(options,rbRowSep1) $widget(options,rbRowSep2) $widget(options,rbRowSepN) $widget(options,eRowSep) -sticky w -padx 2 -pady 0
3645	grid rowconfigure $f2 1 -weight 1
3646	grid columnconfigure $f2 4 -weight 1
3647
3648	grid $w.tf1 -sticky news -padx 2
3649	grid $w.tf2 -sticky news -padx 2
3650	grid rowconfigure $w 0 -weight 1
3651	grid rowconfigure $w 1 -weight 3
3652	grid columnconfigure $w 0 -weight 1
3653	}
3654
3655	#/////////////////////////////////////////////////////////////////////////////
3656	method _OptionsCreateStyle { w } {
3657	#
3658	# PURPOSE: Creates style options tab
3659	#
3660	# PARAMETERS:
3661	# w -> the frame in which the options widgets will be created
3662	#
3663	#/////////////////////////////////////////////////////////////////////////////
3664	TitleFrame $w.tf1 -text [mc "Style"]
3665	set f1 [$w.tf1 getframe]
3666	set widget(options,font) [bfont $f1.bFont \
3667	-variable [varname data(options,font)] -showlabel 1 -label [mc "Font"]:]
3668
3669	set widget(options,bg) [bcolor $f1.bColor \
3670	-variable [varname data(options,bg)] -showlabel 1 -label [mc "Color"]:]
3671
3672	set widget(options,cbalt) [checkbutton $f1.cbalt \
3673	-text [mc "Alternate row colors"] \
3674	-variable [varname data(options,cbalt)] -pady 0]
3675
3676	set widget(options,bgalt1) [bcolor $f1.bColorAlt1 \
3677	-variable [varname data(options,bgalt1)] -showlabel 1 -label [mc "Color "]1:]
3678
3679	set widget(options,bgalt2) [bcolor $f1.bColorAlt2 \
3680	-variable [varname data(options,bgalt2)] -showlabel 1 -label [mc "Color "]2:]
3681
3682	grid $widget(options,font) $widget(options,bg) -padx 10
3683	grid $widget(options,cbalt) $widget(options,bgalt1) $widget(options,bgalt2) -padx 10
3684
3685	grid $w.tf1 -sticky news -padx 2
3686	grid rowconfigure $w 0 -weight 1
3687	grid columnconfigure $w 0 -weight 1
3688	}
3689
3690	#/////////////////////////////////////////////////////////////////////////////
3691	method _OptionsCreateBehaviour { w } {
3692	#
3693	# PURPOSE: Creates behaviour options tab
3694	#
3695	# PARAMETERS:
3696	# w -> the frame in which the options widgets will be created
3697	#
3698	#/////////////////////////////////////////////////////////////////////////////
3699	TitleFrame $w.tf1 -text [mc "Behaviour"]
3700	set f1 [$w.tf1 getframe]
3701
3702	checkbutton $f1.whole -text [mc "Check whole table when changing types"] \
3703	-variable [varname data(options,whole)] -pady 0 -state disabled
3704	checkbutton $f1.inter -text [mc "Works with internal data"] \
3705	-variable [varname data(options,inter)] -pady 0 -state disabled
3706
3707	grid $f1.whole -sticky w -padx 2 -pady 1
3708	grid $f1.inter -sticky w -padx 2 -pady 1
3709
3710	grid $w.tf1 -sticky news -padx 2
3711	grid rowconfigure $w 0 -weight 1
3712	grid columnconfigure $w 0 -weight 1
3713	}
3714
3715
3716	#/////////////////////////////////////////////////////////////////////////////
3717	method _OptionsCheckColSepType { } {
3718	#
3719	# PURPOSE: Manages behaviour of column separator widgets
3720	#
3721	#/////////////////////////////////////////////////////////////////////////////
3722	switch $data(options,colseptype) {
3723	TAB {
3724	focus $widget(options,rbColSep1)
3725	$widget(options,eColSep) configure -state disabled
3726	}
3727	RET {
3728	focus $widget(options,rbColSep2)
3729	$widget(options,eColSep) configure -state disabled
3730	}
3731	OTHER { $widget(options,eColSep) configure -state normal }
3732	}
3733	}
3734
3735	#/////////////////////////////////////////////////////////////////////////////
3736	method _OptionsCheckRowSepType { } {
3737	#
3738	# PURPOSE: Manages behaviour of row separator widgets
3739	#
3740	#/////////////////////////////////////////////////////////////////////////////
3741	switch $data(options,rowseptype) {
3742	RET {
3743	focus $widget(options,rbRowSep1)
3744	$widget(options,eRowSep) configure -state disabled
3745	}
3746	TAB {
3747	focus $widget(options,rbRowSep2)
3748	$widget(options,eRowSep) configure -state disabled
3749	}
3750	OTHER { $widget(options,eRowSep) configure -state normal }
3751	}
3752	}
3753
3754	#/////////////////////////////////////////////////////////////////////////////
3755	method _OptionsOk { dialog } {
3756	#
3757	# PURPOSE: Sets selected options and destroys the options window
3758	#
3759	# PARAMETERS:
3760	# dialog -> options window
3761	#
3762	#/////////////////////////////////////////////////////////////////////////////
3763	$self _OptionsSet
3764	$self _OptionsDestroy $dialog
3765	}
3766
3767	#/////////////////////////////////////////////////////////////////////////////
3768	method _OptionsDestroy { dialog } {
3769	#
3770	# PURPOSE: Destroys the options window
3771	#
3772	# PARAMETERS:
3773	# dialog -> options window
3774	#
3775	#/////////////////////////////////////////////////////////////////////////////
3776	destroy $dialog
3777	}
3778
3779	#/////////////////////////////////////////////////////////////////////////////
3780	method _RowTag { number } {
3781	#
3782	# PURPOSE: Returns tag that will be used in the given row number
3783	#
3784	# PARAMETERS:
3785	# number -> row's number
3786	#
3787	#/////////////////////////////////////////////////////////////////////////////
3788	if { ![$self cget -bgalt] } {
3789	return ""
3790	} else {
3791	if { [expr $number % 2] } {
3792	return bgalt1
3793	} else {
3794	return bgalt2
3795	}
3796	}
3797	}
3798
3799	#/////////////////////////////////////////////////////////////////////////////
3800	method _CheckSaved { } {
3801	#
3802	# PURPOSE: Checks if a file has changed and asks for saving.
3803	#
3804	# RETURN: Returns ok if file has been saved correctly or cancel if not.
3805	#
3806	#/////////////////////////////////////////////////////////////////////////////
3807
3808	set nameFile [$self cget -path]
3809	set isSaved $data(isSaved)
3810	# checks if the file is saved
3811	if {!$isSaved} {
3812	if {$nameFile != ""} {
3813	set name $nameFile
3814	} else {
3815	set name "untitled.bst"
3816	}
3817
3818	set rq [tk_messageBox -type "yesnocancel" -icon warning \
3819	-title [mc "Warning"] -parent $self \
3820	-message "[mc "Table %1\$s has changed!" $name].\n\
3821	[mc "Do you want to save changes?"]"]
3822	switch -exact $rq {
3823	yes {
3824	if {$nameFile != "" } {
3825	$self _FileSave $nameFile
3826	} else {
3827	$self _CmdSaveAs $nameFile
3828	}
3829	}
3830	cancel {return cancel}
3831	default {return ok}
3832	}
3833	}
3834	return ok
3835	}
3836
3837	#/////////////////////////////////////////////////////////////////////////////
3838	method _FileSave { path {replace 0}} {
3839	#
3840	# PURPOSE: Saves table data actually opened in table editor in a text file.
3841	#
3842	# PARAMETERS:
3843	# path -> name of file
3844	# replace -> replaces ? with ""
3845	#
3846	# RETURN: Returns 1 if file has been saved correctly or 0 if not.
3847	#
3848	#/////////////////////////////////////////////////////////////////////////////
3849	if { ![ catch { set fd [open $path w] } msgerr] } {
3850	set numCols [$self cget -cols]
3851	set list [$self get @0,0 end]
3852	if $replace {
3853	set list [ListReplace $list {} "?"]
3854	}
3855	set struct "{$numCols {\n} {} { ; }} {1 { ; } {} {}}"
3856	set txt [ListToStrStruct $list $struct]
3857	puts $fd $txt
3858	close $fd
3859	$self _IsSaved 1
3860	return 1
3861	}
3862	error $msgerr
3863	}
3864
3865
3866
3867	#/////////////////////////////////////////////////////////////////////////////
3868	method _CmdExcel { } {
3869	#
3870	# PURPOSE: Opens Microsoft Excel with data of the table
3871	#
3872	#/////////////////////////////////////////////////////////////////////////////
3873	global tcl_platform
3874	global env
3875
3876	if { [string equal $tcl_platform(platform) "windows"] } {
3877	if { [$self cget -cols] < 256 && [$self cget -rows] < 65536 } {
3878	set tempcolsep [$self cget -colseparator]
3879	set temprowsep [$self cget -rowseparator]
3880
3881	$self configure -colseparator "\t"
3882	$self configure -rowseparator "\n"
3883
3884	exec $env(COMSPEC) /c start excel.exe &
3885
3886	$self _CmdSpecialCopy table
3887	::cwind::waitwind {Microsoft Excel*} 10
3888	::cwind::send \|CTRL+\| v \|CTRL-\|
3889	$self configure -colseparator $tempcolsep
3890	$self configure -rowseparator $temprowsep
3891	} else {
3892	set rq [tk_messageBox -type "ok" -icon warning \
3893	-title [mc "Warning"] -parent $self\
3894	-message [mc "excellimit"]]
3895	}
3896	} else {
3897	set rq [tk_messageBox -type "ok" -icon warning \
3898	-title [mc "Warning"] -parent $self\
3899	-message [mc "onlywin"]]
3900	}
3901	}
3902
3903	#/////////////////////////////////////////////////////////////////////////////
3904	method fillSerie { sergrp {format {} } } {
3905	#
3906	# PURPOSE: Procedure to fill data elements of the table. Gets data from a
3907	# group of series and sets them to the table.
3908	#
3909	# PARAMETERS:
3910	# sergrp -> tol series group (created by toltcl ::tol::create command)
3911	#
3912	#/////////////////////////////////////////////////////////////////////////////
3913	upvar \#0 [varname matrix] matrix
3914
3915	$self configure -state normal
3916	$self _DeleteRows 0 [$self cget -rows]
3917	$self _DeleteCols 0 [$self cget -cols]
3918
3919	# insert the series into the table
3920	set numCols [$sergrp serie size]
3921	set numRows [$sergrp dating size]
3922	set matrix(0,0) [$sergrp dating name]
3923
3924	for {set i 0} {$i < $numRows} {incr i} {
3925	set matrix([expr $i+1],0) [$self _GetTickLabel $sergrp $i]
3926	}
3927	for {set j 0} {$j < $numCols} {incr j} {
3928	set matrix(0,[expr $j+1]) [$sergrp serie $j name]
3929	foreach vec_data [$sergrp serie $j data] {
3930	set x [lindex $vec_data 0]
3931	set y [lindex $vec_data 1]
3932	for {set i 0} {$i < [llength $x]} {incr i} {
3933	set matrix([expr round([lindex $x $i])+1],[expr $j+1]) [lindex $y $i]
3934	}
3935	}
3936	}
3937	$self configure -rows [expr $numRows+1] -cols [expr $numCols+1]
3938	$self _InitState serie
3939	$self setType 0 date $format
3940	}
3941
3942	#/////////////////////////////////////////////////////////////////////////////
3943	method _GetTickLabel { group tick } {
3944	#
3945	# PURPOSE: Gets ticks label
3946	#
3947	# PARAMETERS:
3948	# group -> group
3949	# tick -> tick
3950	#
3951	#/////////////////////////////////////////////////////////////////////////////
3952	set str ""
3953	catch {
3954	set str [$group dating $tick]
3955	}
3956	return $str
3957	}
3958
3959	#/////////////////////////////////////////////////////////////////////////////
3960	method fillSet { tableset } {
3961	#
3962	# PURPOSE: Procedure to fill data elements of the table. Gets data from a
3963	# tableset and sets them to the table.
3964	#
3965	# PARAMETERS:
3966	# tableset -> tol tableset
3967	#
3968	#/////////////////////////////////////////////////////////////////////////////
3969	upvar \#0 [varname matrix] matrix
3970
3971	$self configure -state normal
3972	$self _DeleteRows 0 [$self cget -rows]
3973	$self _DeleteCols 0 [$self cget -cols]
3974
3975	set numRows [$tableset info datarows]
3976	set numCols [llength [$tableset info columns]]
3977
3978	set i_ini 0
3979	set infHea [$tableset info header]
3980	set infCol [$tableset info columns]
3981	#insert the set into the table
3982	if {[string equal [lindex $infHea 0] "row"]} {
3983	set i_ini 1
3984	set j 1
3985	set colsF [expr [llength $infCol] - [lindex $infHea 1] -1]
3986	foreach lstInfo [lrange $infCol 0 $colsF] {
3987	set matrix($i_ini,$j) [lindex $lstInfo 1]
3988	#$self setType $j [string tolower [lindex $lstInfo 3]]
3989	incr j
3990	}
3991	} elseif {[string equal $infHea "struct"] \|\| \
3992	[string equal $infHea "generic"]} {
3993	set j 1
3994	foreach lstInfo $infCol {
3995	set matrix($i_ini,$j) [lindex $lstInfo 1]
3996	#$self setType $j [string tolower [lindex $lstInfo 3]]
3997	incr j
3998	}
3999	}
4000	set i 1
4001	foreach name [$tableset info rowsnames] {
4002	set matrix($i,0) $name
4003	incr i
4004	}
4005	$tableset data apply all [list $self _FillCell [expr $i_ini+1]]
4006
4007	$self configure -rows [expr $numRows+$i_ini+1] -cols [expr $numCols+1]
4008
4009	$self _InitState set
4010	set j 1
4011	set colsF [expr [llength $infCol] - [lindex $infHea 1] -1]
4012	foreach lstInfo [lrange $infCol 0 $colsF] {
4013	$self setType $j [string tolower [lindex $lstInfo 3]]
4014	incr j
4015	}
4016	}
4017
4018	#/////////////////////////////////////////////////////////////////////////////
4019	method _FillCell { i_ini i j value } {
4020	#
4021	# PURPOSE: Fill each cell of the table.Only used by fillSet method
4022	#
4023	# PARAMETERS:
4024	# i_ini -> initial row
4025	# i -> row
4026	# j -> column
4027	# value -> the value
4028	#
4029	#/////////////////////////////////////////////////////////////////////////////
4030	upvar \#0 [varname matrix] matrix
4031	set matrix([expr $i_ini+$i],[expr $j+1]) $value
4032	}
4033
4034	#/////////////////////////////////////////////////////////////////////////////
4035	method fillMatrix { refMatrix } {
4036	#
4037	# PURPOSE: Procedure to fill data elements of the table. Gets data from a
4038	# matrix and sets them to the table.
4039	#
4040	# PARAMETERS:
4041	# refMatrix -> tol matrix
4042	#
4043	#/////////////////////////////////////////////////////////////////////////////
4044	upvar \#0 [varname matrix] matrix
4045
4046	$self configure -state normal
4047	$self _DeleteRows 0 [$self cget -rows]
4048	$self _DeleteCols 0 [$self cget -cols]
4049
4050	# insert the matrix into the table
4051	set numCols [lindex $refMatrix 2]
4052	set numRows [lindex $refMatrix 1]
4053
4054	set matrix(0,0) [lindex $refMatrix 0]
4055	for {set j 0} {$j < $numCols} {incr j} {
4056	set matrix(0,[expr $j+1]) [expr $j+1]
4057	}
4058	set lst [lindex $refMatrix 3]
4059	for {set i 0} {$i < $numRows} {incr i} {
4060	set matrix([expr $i+1],0) [expr $i+1]
4061	for {set j 0} {$j < $numCols} {incr j} {
4062	set matrix([expr $i+1],[expr $j+1]) [lindex $lst [expr $numCols*$i+$j]]
4063	}
4064	}
4065
4066	$self configure -rows [expr $numRows+1] -cols [expr $numCols+1]
4067
4068	$self _InitState matrix
4069	}
4070
4071	#///////////////////////////////////////////////////////////////////////////
4072	method fillSQL { stmt } {
4073	#
4074	# PURPOSE: Procedure to fill data elements of the table. Gets data from a
4075	# tolodbc statement and sets them to the table.
4076	#
4077	# PARAMETERS:
4078	# stmt -> tolodbc statement
4079	#
4080	#///////////////////////////////////////////////////////////////////////////
4081	upvar \#0 [varname matrix] matrix
4082
4083	$self configure -state normal
4084	$self _DeleteRows 0 [$self cget -rows]
4085	$self _DeleteCols 0 [$self cget -cols]
4086
4087	$stmt execute
4088
4089
4090
4091	set rowCount [$stmt rowcount]
4092	set colsname [$stmt columns]
4093	set types [$stmt columns type]
4094	set colCount [llength $types]
4095
4096
4097	if {$rowCount == -1} {
4098
4099	$widget(sb,lFunc) configure -text [mc "Query executed successfully"]
4100
4101	} else {
4102
4103	$widget(sb,lFunc) configure -text [mc "Process completed. $rowCount rows affected"]
4104
4105	}
4106
4107
4108	set j 0
4109	foreach colname $colsname {
4110	set matrix(0,$j) $colname
4111	incr j
4112	}
4113
4114	set i 1
4115	while {[set row [$stmt fetch]] != {}} {
4116	set j 0
4117	foreach cell $row {
4118	set matrix($i,$j) $cell
4119	incr j
4120	}
4121	incr i
4122	}
4123
4124	$self configure -rows $i -cols $colCount
4125
4126	for {set i 0} {$i < [$self cget -cols]} {incr i} {
4127	set typecol [string tolower [NumSql2Tol [lindex $types $i]]]
4128	set data(types) [linsert $data(types) $i $typecol]
4129	set data(formats) [linsert $data(formats) $i {}]
4130	}
4131
4132	$self _InitState sql
4133	}
4134
4135	#/////////////////////////////////////////////////////////////////////////////
4136	method fillStatistics { sergrp } {
4137	#
4138	# PURPOSE: Procedure to fill data elements of the statistics table.
4139	# Gets data from a group of series and sets them to the table.
4140	#
4141	# PARAMETERS:
4142	# sergrp -> tol series group
4143	#
4144	#/////////////////////////////////////////////////////////////////////////////
4145	upvar \#0 [varname matrix] matrix
4146
4147	$self configure -state normal
4148	$self _DeleteRows 0 [$self cget -rows]
4149	$self _DeleteCols 0 [$self cget -cols]
4150
4151	Tolcon_Trace "SERGRP de fillStatistics method --> $sergrp"
4152
4153	# insert the series into the table
4154	set stats0 [ $sergrp serie 0 stats ]
4155	set numRows [ llength $stats0 ]
4156	set numCols [ $sergrp serie size ]
4157
4158	set row 1
4159	foreach {name value} $stats0 {
4160	set matrix($row,0) [ mc $name ]
4161	incr row
4162	}
4163
4164	for { set j 0 } { $j < $numCols } { incr j } {
4165	set col [ expr { $j + 1 } ]
4166	set matrix(0,$col) [ $sergrp serie $j name ]
4167	set row 1
4168	foreach { s v } [ $sergrp serie $j stats ] {
4169	set matrix($row,$col) $v
4170	incr row
4171	}
4172	}
4173
4174	$self configure -rows [expr $numRows+1] -cols [expr $numCols+1]
4175
4176	$self _InitState statistics
4177	}
4178
4179	#/////////////////////////////////////////////////////////////////////////////
4180	method fillAutocor { serie nLag } {
4181	#
4182	# PURPOSE: Procedure to fill data elements of the autocorrelation table.
4183	# Gets data from a group of series and sets them to the table.
4184	#
4185	# PARAMETERS:
4186	# sergrp -> tol series group
4187	#
4188	#/////////////////////////////////////////////////////////////////////////////
4189	upvar \#0 [varname matrix] matrix
4190
4191	$self configure -state normal
4192	$self _DeleteRows 0 [$self cget -rows]
4193	$self _DeleteCols 0 [$self cget -cols]
4194
4195	set typecor {ACF PACF IACF IPACF}
4196
4197	set numCols [llength $typecor]
4198	if {$nLag == ""} {
4199	set numRows [lindex [::tol::autocor [lindex $typecor 0] $serie] 1]
4200	} else {
4201	set numRows $nLag
4202	}
4203
4204	for {set i 0} {$i < $numRows} {incr i} {
4205	set matrix([expr $i+1],0) [expr $i+1]
4206	}
4207	for {set j 0} {$j < $numCols} {incr j} {
4208	set matrix(0,[expr $j+1]) [lindex $typecor $j]
4209	set values [eval ::tol::autocor [lindex $typecor $j] {$serie} $nLag]
4210	for {set i 0} {$i < $numRows} {incr i} {
4211	set matrix([expr $i+1],[expr $j+1]) \
4212	[lindex [lindex $values 3] $i]
4213	}
4214	}
4215
4216	$self configure -rows [expr $numRows+1] -cols [expr $numCols+1]
4217
4218	$self _InitState autocor
4219	}
4220
4221	#///////////////////////////////////////////////////////////////////////////
4222	method _PasteHandler {cell txt} {
4223	#
4224	# PURPOSE: Pastes txt from the cell given (ini cell)
4225	# PARAMETERS: cell -> initial cell
4226	# txt -> data to be pasted
4227	#
4228	#///////////////////////////////////////////////////////////////////////////
4229	# The needed rows and columns are calculated
4230	set rowIni [lindex [split $cell ","] 0]
4231	set colIni [lindex [split $cell ","] 1]
4232	set rsep [$self cget -rowseparator]
4233	set csep [$self cget -colseparator]
4234
4235	if {[string comp {} $rsep]} { set drows [split $txt $rsep] }
4236	set numRows [llength $drows]
4237	if [string equal [lindex $drows end] {}] {
4238	set numRows [incr numRows -1]
4239	}
4240	set numCols 0
4241	foreach line $drows {
4242	if [expr [llength [split $line $csep]] > $numCols] {
4243	set numCols [llength [split $line $csep]]
4244	}
4245	}
4246
4247	#If more rows are necessary they are created
4248	if [expr $rowIni+$numRows > [$self cget -rows]] {
4249	$self configure -rows [expr $rowIni+$numRows]
4250	$self _UpdateInfoRows
4251	}
4252	#If more columns are necessary they are created
4253	set colsold [$self cget -cols]
4254
4255	if [expr $colIni+$numCols > [$self cget -cols]] {
4256	$self configure -cols [expr $colIni+$numCols]
4257	}
4258
4259	if { $created == 1 } {
4260	for {set i $colsold} {$i < [expr $colIni+$numCols]} {incr i} {
4261	set data(types) [linsert $data(types) $i text]
4262	set data(formats) [linsert $data(formats) $i {}]
4263	}
4264	} else {
4265	$self _UpdateTypes
4266	}
4267
4268	# In version 2.8 of tktable is not possible to paste in title cells
4269	# so a cheat is necessary
4270	set titlerows [$self cget -titlerows]
4271	set titlecols [$self cget -titlecols]
4272	$self configure -titlerows 0 -titlecols 0
4273
4274	$self _TablePasteHandler $self $cell $txt
4275	$self configure -titlerows $titlerows -titlecols $titlecols
4276	}
4277
4278	#///////////////////////////////////////////////////////////////////////////
4279	method _TablePasteHandler {w cell data2} {
4280	#
4281	# PURPOSE: Modification of tk::table::tk_tablePasteHandler. Trim when
4282	# setting the data in the cell is added
4283	# PARAMETERS: w -> self
4284	# cell -> the cell
4285	# data2 -> the data to paste
4286	#
4287	#///////////////////////////////////////////////////////////////////////////
4288	upvar \#0 [varname matrix] matrix
4289	#
4290	# Don't allow pasting into the title cells
4291	#
4292	if {[$w tag includes title $cell]} {
4293	return
4294	}
4295
4296	set rows [expr {[$w cget -rows]-[$w cget -roworigin]}]
4297	set cols [expr {[$w cget -cols]-[$w cget -colorigin]}]
4298	set r [$w index $cell row]
4299	set c [$w index $cell col]
4300	set rsep [$w cget -rowseparator]
4301	set csep [$w cget -colseparator]
4302	## Assume separate rows are split by row separator if specified
4303	## If you were to want multi-character row separators, you would need:
4304	# regsub -all $rsep $data <newline> data
4305	# set data [join $data <newline>]
4306	if {[string compare {} $rsep]} { set data2 [split $data2 $rsep] }
4307	set row $r
4308	foreach line $data2 {
4309	if {$row > $rows} break
4310	set col $c
4311	## Assume separate cols are split by col separator if specified
4312	## Unless a -separator was specified
4313	if {[string compare {} $csep]} { set line [split $line $csep] }
4314	## If you were to want multi-character col separators, you would need:
4315	# regsub -all $csep $line <newline> line
4316	# set line [join $line <newline>]
4317	foreach item $line {
4318	if {$col > $cols} break
4319	#Trim is added to tk::table::tk_tablePasteHandler code
4320	set matrix($row,$col) [string trim $item " "]
4321	incr col
4322	}
4323	incr row
4324	}
4325	}
4326
4327	# delegation of methods and options
4328	delegate method * to tab
4329	delegate option * to tab
4330	}
4331
4332	package provide btable 1.0
4333
4334	# ------- TEST CODE ----
4335
4336	#/////////////////////////////////////////////////////////////////////////////
4337	proc test_btable {} {
4338	#
4339	# PURPOSE: Test function btable
4340	#
4341	#/////////////////////////////////////////////////////////////////////////////
4342
4343	destroy .top
4344	toplevel .top
4345	set tab [btable .top.tbl -parent .top -iniconfig btable]
4346
4347	pack $tab -fill both -expand true
4348	}

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: tol/tolbase/lib/byswidget/btable/btable.tcl @ 20907d9

Download in other formats: