Context Navigation

btable.tcl @ 23399d1

1941-docker-image-to-testdevel

Last change on this file since 23399d1 was 6d788c2, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933
Continúa [7342]

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

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

Context Navigation

source: tol/tolbase/lib/byswidget/btable/btable.tcl @ 23399d1

Download in other formats: