Context Navigation

btable.tcl @ 2840b37

1941-docker-image-to-testdevel

Last change on this file since 2840b37 was 2840b37, checked in by Jorge Pérez <josp.jorge@…>, 16 years ago

closes #967, por el momento deshabilitamos estos mensajes, si en algún momento hay que avisar de algún error de conversión no debe darse este celda a celda sino al final de la creación de toda la tabla.

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

Property mode set to 100755

File size: 143.0 KB

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

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

Context Navigation

source: tol/tolbase/lib/byswidget/btable/btable.tcl @ 2840b37

Download in other formats: