Context Navigation

tolbase.tcl @ 1efd6f9

1941-docker-image-to-testdevel

Last change on this file since 1efd6f9 was a566515, checked in by Jorge Pérez <josp.jorge@…>, 15 years ago

fixes #1433, cuando el conjunto es estructurado se incluye la definición de la estructura en el panel info

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

Property mode set to 100644

File size: 84.1 KB

Line
1	#/////////////////////////////////////////////////////////////////////////////
2	# FILE : tolbase.tcl
3	# PURPOSE : This file
4	#/////////////////////////////////////////////////////////////////////////////
5
6	#/////////////////////////////////////////////////////////////////////////////
7	if { 0 } {
8	#
9	#/////////////////////////////////////////////////////////////////////////////
10	set toltk_script_path [file dirname [info script]]
11
12	puts $toltk_script_path
13
14	if { [lsearch $auto_path $toltk_library] == -1 } {
15	lappend auto_path $toltk_library
16	}
17	if { ![info exists blt_libPath] } {
18	set blt_libPath [file join $toltk_library blt]
19	}
20	if { ![info exists env(BLT_LIBRARY)] } {
21	set env(BLT_LIBRARY) [file join $toltk_library blt]
22	}
23	package require BWidget
24
25	source [file join $toltk_script_path "prjmenu.tcl"]
26	source [file join $toltk_script_path "tolinspect.tcl"]
27	source [file join $toltk_script_path "toltable.tcl"]
28	source [file join $toltk_script_path "calendar.tcl"]
29	source [file join $toltk_script_path "editSelector.tcl"]
30	source [file join $toltk_script_path "selector.tcl"]
31	source [file join $toltk_script_path "bayesgraph.tcl"]
32	source [file join $toltk_script_path "sergraph.tcl"]
33	source [file join $toltk_script_path "autocorgraph.tcl"]
34	source [file join $toltk_script_path "graph.tcl"]
35	source [file join $toltk_script_path "BfString.tcl"]
36	source [file join $toltk_script_path "BfList.tcl"]
37	source [file join $toltk_script_path "newButtonDiag2.tcl"]
38	source [file join $toltk_script_path "newToolbarDiag.tcl"]
39	} else {
40	if {$::tcl_platform(platform) eq "unix"} {
41	proc ::dnd {args} {}
42	} else {
43	package require tkdnd
44	source [file join $toltk_script_path "newButtonDiag2.tcl"]
45	source [file join $toltk_script_path "newToolbarDiag.tcl"]
46	}
47	}
48
49	package require nbdbmanager
50	package require markupviewer
51
52	global tcl_platform
53	if { [string equal $tcl_platform(platform) "unix"] } {
54	source [file join $toltk_script_path "panedw.tcl"]
55	} else {
56	source [file join $toltk_script_path "panedw.tcl"]
57	}
58
59	source [file join $toltk_script_path "editor.tcl"]
60	source [file join $toltk_script_path "markuphelper.tcl"]
61	source [file join $toltk_script_path "tolpkg.tcl"]
62	source [file join $toltk_script_path "tolpkg_gui.tcl"]
63	source [file join $toltk_script_path "tolconfig.tcl"]
64	source [file join $toltk_script_path "tolconfig_gui.tcl"]
65
66	#source [file join $toltk_script_path "scrollw.tcl"]
67
68	namespace eval ::TolConsole {
69	# widgets -> array with entries:
70	# inspector -> toplevel containing inspector and tabs of info.
71	# tabset -> tabset containing: eval, output & info.
72	# eval -> text for evaluating.
73	# output -> text with the output.
74	# info -> text with info on inspector objects.
75	# data -> array with entries:
76	# (path) -> directory of the last included file
77	# (included) -> last included files
78	# (font,eval)
79	# (font,output)
80	# (font,info)
81	# (viewmode)
82	variable data
83	variable widgets
84	variable time [clock clicks -milliseconds]
85	variable languages [list de German en English es Spanish fr French \
86	it Italian ja Japanese nl Dutch po Portuguese ru Russian sv Swedish \
87	zh Chinese]
88	}
89
90	proc ::TolConsole::CGetFont { font } {
91	if { [lsearch -exact [font names] $font ] != -1 } {
92	set family [ font configure $font -family ]
93	set size [ font configure $font -size ]
94	} else {
95	foreach { family size } $font break
96	}
97	return [ list -family $family -size $size ]
98	}
99
100	proc ::TolConsole::MarkupMenu { w } {
101	set m [ menu $w.m -tearoff 0 ]
102
103	$m add command -label "[mc Find]..." -accelerator CTRL+F \
104	-command [ list ::BayesText::FindShow $w ]
105	$m add command -label [mc "Copy"] -accelerator CTRL+C \
106	-command [list ::BayesText::Copy $w]
107	$m add command -label [mc "Select all"] -accelerator CTRL+E \
108	-command [list ::BayesText::SelectAll $w]
109	$m add command -label "[mc Font]..." -accelerator CTRL+T \
110	-command [list ::BayesText::FontChange $w]
111
112	bind $w <Button-3> "tk_popup $m %X %Y"
113
114
115	}
116
117	#/////////////////////////////////////////////////////////////////////////////
118	proc ::TolConsole::Create { w } {
119	#
120	# PURPOSE: Creates TolBase main windows (tol inspector + eval/output/info
121	# windows)
122	# PARAMTERS:
123	# w: path of father the widget inspector
124	# name: name of widget inspector
125	#
126	# RETURN: path of widget inspector
127	#
128	#/////////////////////////////////////////////////////////////////////////////
129
130	variable widgets
131	variable data
132
133	set data(nbdbmanager) [ nbdbmanagerType create %AUTO% ]
134	set data(notebookdb) [ $data(nbdbmanager) create "__tmp_info__" ]
135
136	# connection BODBC
137	set data(bodbc) [$::project::data(bodbc) connection \
138	-name TolBase \
139	-stdtolcon 1 \
140	-stdtclcon 0 \
141	-iniconfig TolBaseODBC \
142	-savealias 1 \
143	-saveuser 1]
144	Tolcon_Trace "TolConsole.Create : data(bodbc)=$data(bodbc)"
145
146	#Control de modo de visualizacion
147	#Frame
148
149	set path [::project::CreateForm \
150	-iniconfig ObjectInspector \
151	-title [mc {Inspector}] -width 700 -height 400 \
152	-helpkey "Tb4Ins"]
153	$path configure -closecmd "$path minimize; return 0"
154	set pathf [$path getframe]
155
156	set pw1 [PanedWindow $pathf.pw -side right -pad 0 -width 4]
157	set pane1 [$pw1 add -weight $data(geometry,wtop)]
158	set pane2 [$pw1 add -weight $data(geometry,wbottom)]
159
160	# set widgets(pw) $path
161	set widgets(pw) $pw1
162	set widgets(panes,top) $pane1
163	set widgets(panes,bottom) $pane2
164	# object inspector component
165
166	::TolInspector::Create $pane1.ti \
167	-onselcmd ::TolConsole::OnInfo \
168	-wleft $data(geometry,wleft) \
169	-wright $data(geometry,wright)
170
171	::TolInspector::OnBusy ::TolConsole::OnBusy
172
173	# tabset for eval, output & description
174	set widgets(tabset) $pane2.ts
175	set w_tabset [::blt::tabset $widgets(tabset) -side top -relief flat \
176	-bd 0 -outerpad 0 -tearoff 0 -slant right -textside right \
177	-highlightthickness 0 ]
178	set sw2 [ScrolledWindow $w_tabset.sw2 -auto both]
179	set sw3 [ScrolledWindow $w_tabset.sw3 -auto both]
180	set widgets(tabset,info) $sw3
181
182	$w_tabset insert end \
183	Eval -text "[mc Eval] <Ctrl+A>" -selectbackground \#d9d9d9 -bg gray75 -pady 0\
184	Output -text "[mc Output] <Ctrl+O>" -selectbackground \#d9d9d9 -bg gray75 -pady 0\
185	Info -text "[mc Info] <Ctrl+I>" -selectbackground \#d9d9d9 -bg gray75 -pady 0
186
187	# OUTPUT CONSOLE COMPONENT
188	set widgets(output) $sw2.out
189	set w_output [text $widgets(output) -wrap none -cursor ""\
190	-state disabled -font $data(font,output)]
191	$sw2 setwidget $w_output
192
193	# EVAL CONSOLE COMPONENT
194	set feval $w_tabset.f
195	CreateEvalWindow $feval
196
197	# configuro los mensajes del output
198	$w_output tag configure errorTag -foreground $data(colorErr)
199	$w_output tag configure warningTag -foreground $data(colorWar)
200	set data(output,TAG,E) errorTag
201	set data(output,TAG,W) warningTag
202
203	set menu [::BayesText::MenuCreate $w_output]
204	# Añadimos la opción de recuperar la salida
205	$menu insert 0 separator
206	$menu insert 0 command -label [mc "Recover from log"] \
207	-command [list ::TolConsole::Recover $w_output]
208	$menu insert 0 command -label [mc "Delete all"] \
209	-command [list ::BayesText::DeleteAll $w_output]
210
211	# Habilitamos la opción de borrar
212	$menu entryconfigure [mc "Delete"] -state normal
213	bind $w_output <Delete> [list ::BayesText::Delete $w_output]
214
215	# INFO CONSOLE COMPONENT
216	set widgets(info,text) $sw3.info1
217	#(pgea) se elimina -wrap word
218	set w_info [text $widgets(info,text) -cursor ""\
219	-state disabled -font $data(font,info)]
220	$sw3 setwidget $w_info
221	::BayesText::MenuCreate $w_info
222	set widgets(info,hltext) $sw3.info2
223	::BayesText::CreateHLText $widgets(info,hltext) tol -font $data(font,eval) \
224	-state disabled
225	set widgets(info) $widgets(info,text)
226
227	set widgets(info,markupviewer) [ markupviewer $w_tabset.mv \
228	-db $data(notebookdb) -showtitle 0 ]
229
230	MarkupMenu $widgets(info,markupviewer)
231
232	set def_font [$w_info cget -font]
233	if { [lsearch -exact [font names] fnBold] == -1 } {
234	if {[string length [lindex $def_font 1]]} {
235	font create fnBold -family [lindex $def_font 0] \
236	-size [lindex $def_font 1] -weight bold
237	} else {
238	font create fnBold -family [lindex $def_font 0] -size 10 -weight bold
239	}
240	}
241
242	# force renderpane to use the same or similar font
243	if { [lsearch -exact [font names] "ctfnNormal"] != -1 } {
244	array set normalProps [ CGetFont "ctfnNormal" ]
245	} else {
246	array set normalProps [ CGetFont [ $widgets(output) cget -font ] ]
247	}
248	prefs set bodytext [ list $normalProps(-family) $normalProps(-size) ]
249	prefs set monotext [ list Courier $normalProps(-size) ]
250	foreach {f ds p} {header1 4 bold header2 2 bold header3 0 bold title 8 {} small -4 {}} {
251	prefs set ${f}text [ list Helvetica [ expr {$normalProps(-size) + $ds} ] $p ]
252	}
253	prefs NotifyObservers
254
255	# teclas acceso rapido solapas de Informacion
256	$path bind <Control-F4> +[list $path kill]
257
258	bind $path <Control-KeyRelease> \
259	+[list ::TolConsole::OnControlKey %K %k]
260	$w_tabset tab configure Eval -window $feval -fill both -padx 0
261	$w_tabset tab configure Output -window $sw2 -fill both -padx 0
262	$w_tabset tab configure Info -window $sw3 -fill both -padx 0
263	pack $w_tabset -fill both -expand yes
264
265	pack $pw1 -fill both -expand yes
266	Configure
267
268	bind . <Control-Key-k> +::tol::stop
269	bind Text <Control-Key-k> ""
270	bind Text <Shift-Control-slash> {
271	set start [ %W index sel.first ]
272	set end [ %W index sel.last ]
273	set selection [ %W get $start $end ]
274	if { [ regsub -all {\\} $selection {/} changed ] } {
275	%W delete $start $end
276	%W insert $start $changed
277	}
278	break
279	}
280	return $path
281	}
282
283	#/////////////////////////////////////////////////////////////////////////////
284	proc ::TolConsole::CreateEvalWindow {w} {
285	#
286	# PURPOSE: Creates eval window as widget w
287	#
288	#/////////////////////////////////////////////////////////////////////////////
289	variable widgets
290	variable data
291
292	set feval [frame $w]
293	set sw1 [ScrolledWindow $feval.sw1 -auto both]
294	set widgets(eval) $sw1.eval
295
296	# aseguramos que se lean las opciones de Editor que vamos a compartir
297	#Creamos text con resaltado TOL
298	set w_eval [::BayesText::CreateHLText $widgets(eval) tol \
299	-font $data(font,eval)]
300
301	set m [::BayesText::MenuCreate $w_eval]
302	# Añadimos la opcion de refrescar el resaltado en la ventana eval
303	$m insert 0 separator
304	$m insert 0 command -label [mc Refresh] -accelerator F5\
305	-command [list ::BayesText::Refresh $w_eval]
306	$m insert 0 command -label [mc "Syntax Check"] -accelerator F7 \
307	-command [list ::BayesText::TolSyntaxCheck $w_eval]
308	$m insert 0 command -label [mc Decompile] -accelerator F8\
309	-command ::TolConsole::ClearConsole
310	$m insert 0 command -label [mc Compile] -accelerator F9\
311	-command ::TolConsole::Compile
312
313	# Añadimos la opción de limpiar la ventana de eval
314	$m insert 0 separator
315	$m insert 0 command -label [mc "Delete all"] \
316	-command [list ::BayesText::DeleteAll $w_eval]
317	bind $w_eval <F9> "::TolConsole::Compile ; break"
318	bind $w_eval <F8> "::TolConsole::ClearConsole ; break"
319	bind $w_eval <F5> "::BayesText::Refresh $w_eval ; break"
320	bind $w_eval <F7> "::BayesText::TolSyntaxCheck $w_eval ; break"
321	bind $w_eval <F10> "::TolConsole::OpenEval ; break"
322
323	bind $w_eval <Control-Key-i> {
324	::BayesText::Indent %W $::Editor::options(charsIndent)
325	break
326	}
327
328	bind $w_eval <Control-Key-u> {
329	::BayesText::UnIndent %W $::Editor::options(charsIndent)
330	break
331	}
332
333	## 1) Create a horizontal toolbar frame...
334	set TF [::toolbar::ToolbarFrame $feval.toolbarFrame]
335	## 2) Create a toolbar in this toolbar frame...
336	set tb1 [::toolbar::create $TF.tb1]
337	# add compile button
338	::toolbar::addbutton $tb1 -image [::Bitmap::get "eval"] \
339	-statuswidget $widgets(sb,path) -tooltip "[mc Compile] (F9)"\
340	-command [list ::TolConsole::Compile]
341	# add decompile button
342	::toolbar::addbutton $tb1 -image [::Bitmap::get "decom"] \
343	-statuswidget $widgets(sb,path) -tooltip "[mc Decompile] (F8)"\
344	-command [list ::TolConsole::ClearConsole]
345	# add syntax check button
346	::toolbar::addbutton $tb1 -image [::Bitmap::get "syntaxcheck"] \
347	-statuswidget $widgets(sb,path) -tooltip "[mc Syntax Check] (F7)"\
348	-command [list ::BayesText::TolSyntaxCheck $w_eval]
349	#add Refresh button
350	::toolbar::addbutton $tb1 -image [::Bitmap::get "refresh"] \
351	-statuswidget $widgets(sb,path) -tooltip "[mc Refresh] (F5)"\
352	-command [list ::BayesText::Refresh $w_eval]
353	#add History button
354	::toolbar::addbutton $tb1 -image [::Bitmap::get "History"] \
355	-statuswidget $widgets(sb,path) -tooltip "[mc "Show history file"] (F10)"\
356	-command [list ::TolConsole::OpenEval]
357
358	::toolbar::addseparator $tb1
359
360	::toolbar::addbutton $tb1 -image [::Bitmap::get "delete"] \
361	-statuswidget $widgets(sb,path) \
362	-tooltip [mc "Delete all the messages of the window of output"] \
363	-command [list ::BayesText::DeleteAll $widgets(output)]
364
365	## 4) Pack the toolbar inside the toolbar frame...
366	pack $tb1 -side left -fill y
367
368	## 5) Pack the toolbar frame in our window...
369
370	# Si empacabamos la barra de botones debajo del editor de la ventana eval,
371	# cuando la ventana de Eval se hacía pequeña, la barra botones desaparecía
372	# Con la opción -before se evita esto
373
374	pack $sw1 -expand true -fill both -padx 0 -pady 0
375	pack $TF -side top -fill both -padx 0 -pady 0 -before $sw1
376
377	$sw1 setwidget $w_eval
378	}
379
380
381	#/////////////////////////////////////////////////////////////////////////////
382	proc ::TolConsole::OnControlKey {keysym keycode} {
383	#
384	# PURPOSE: Controla es uso de teclas rápidas para le ejecución de funciones
385	#
386	# PARAMETERS: keysym -> The keysym corresponding to the event,
387	# substituted as a textual string
388	# keycode -> The keycode field from the event
389	#
390	#///////////////////////////////////////////////////////////////////////////
391	variable widgets
392	switch [string toupper $keysym] {
393	A { ShowWindow "eval" }
394	O { ShowWindow "output" }
395	I { ShowWindow "info" }
396	}
397	}
398
399	#///////////////////////////////////////////////////////////////////////////
400	proc ::TolConsole::ShowWindow {win} {
401	#///////////////////////////////////////////////////////////////////////////
402	variable widgets
403	#win can have values "eval" "output" "info"
404	switch -exact $win {
405	"eval" {
406	$widgets(tabset) select 0
407	$widgets(eval) mark set anchor insert
408	}
409	"output" {
410	$widgets(tabset) select 1
411	}
412	"info" {
413	$widgets(tabset) select 2
414	}
415	}
416
417	}
418
419	#/////////////////////////////////////////////////////////////////////////////
420	proc ::TolConsole::Configure {} {
421	#
422	#/////////////////////////////////////////////////////////////////////////////
423	OptionsApplyDefDates
424	}
425
426	#/////////////////////////////////////////////////////////////////////////////
427	proc ::TolConsole::postIncluded {m {ord 0}} {
428	#
429	# PURPOSE: Fills a menu with the last included files from TolBase, according
430	# to information of 'data' variable.
431	#
432	# PARAMETERS:
433	# m -> menu's path that will have the list of last included files
434	# ord -> flag that indicates if files must be shown sorted
435	#
436	#/////////////////////////////////////////////////////////////////////////////
437	variable data
438	$m delete 0 end
439	if $data(chIncluded) {
440	set data(included) [lrange $data(included) 0 [expr $data(numRecent)-1]]
441	if $ord {
442	set lst [lsort -ascii $data(included)]
443	} else {
444	set lst $data(included)
445	}
446	foreach w $lst {
447	#set w [lindex $w 0]
448	$m add command -label $w -command [list ::TolConsole::IncludeCmd $w]
449	}
450	if [llength $lst] {
451	$m add separator
452	$m add command -label [mc "Clear"]\
453	-command [list ::TolConsole::clearRecent]
454	}
455	}
456	}
457
458	#/////////////////////////////////////////////////////////////////////////////
459	proc ::TolConsole::clearRecent {} {
460	#
461	# PURPOSE: Clears the list of last Recent files
462	#
463	#/////////////////////////////////////////////////////////////////////////////
464	variable data
465	set data(included) ""
466	::iniFile::Write TolConsole recent data(included)
467	::iniFile::Flush
468	}
469
470
471	#/////////////////////////////////////////////////////////////////////////////
472	proc ::TolConsole::Format {value} {
473	#
474	# PURPOSE: Receives a value and if it's double, formats it according to
475	# the information of 'data' variable.
476	#
477	# PARAMETERS:
478	# value -> value to format
479	#
480	# RETURN: The value formated
481	#
482	#/////////////////////////////////////////////////////////////////////////////
483	variable data
484	set val $value
485	if [string is double -strict $value] {
486	if {$data(chExponential) &&
487	![catch {expr log10($value) >= $data(numExponential)} result]} {
488	if $result {
489	if $data(chDecimals) {
490	set val [format %.$data(chDecimals)e $value]
491	} else {
492	set val [format %e $value]
493	}
494	} else {
495	if $data(chDecimals) {
496	set val [format "%.$data(numDecimals)f" $value]
497	}
498	}
499	} else {
500	if $data(chDecimals) {
501	set val [format "%.$data(numDecimals)f" $value]
502	}
503	}
504	}
505	return $val
506	}
507
508	proc ::TolConsole::ActivateInfoWidget { id } {
509	variable widgets
510
511	if { $id eq "text" } {
512	set w $widgets(tabset,info)
513	} elseif { $id eq "markup" } {
514	set w $widgets(info,markupviewer)
515	} else {
516	error "unknown id '$id' in ::TolConsole::ActivateInfoWidget"
517	}
518	if { [ $widgets(tabset) tab cget Info -window ] ne $w } {
519	$widgets(tabset) tab configure Info -window $w -fill both -padx 0
520	}
521	$widgets(tabset) select 2
522	}
523
524	#/////////////////////////////////////////////////////////////////////////////
525	proc ::TolConsole::OnInfo { args } {
526	#
527	#/////////////////////////////////////////////////////////////////////////////
528	variable data
529	variable widgets
530
531	set w_tabset $widgets(tabset)
532	foreach type { text hltext } {
533	$widgets(info,$type) configure -state normal
534	$widgets(info,$type) delete 1.0 end
535	}
536	set ll [llength $args]
537	switch $ll {
538	0 -
539	1 {
540	if { 0 } {
541	$widgets(tabset,info) setwidget $widgets(info,text)
542	if { $ll == 1 } {
543	#$w_info configure -wrap word
544	$widgets(tabset,info) setwidget $widgets(info,text)
545	$widgets(info,text) insert end [lindex $args 0]
546	$widgets(tabset) select 2
547	}
548	$widgets(info,text) configure -state disabled
549	}
550	if { $ll } {
551	ActivateInfoWidget "markup"
552	$data(notebookdb) set "info" \
553	[ MarkupHelper::Preprocess [ lindex $args 0 ] ]
554	$widgets(info,markupviewer) showpage "info"
555	}
556	}
557	default {
558	foreach {icon grammar name content path desc objRef} $args {}
559	if { $grammar eq "Anything" } {
560	if { [ regexp {/+\sClass\s} $content ] } {
561	ActivateInfoWidget "text"
562	$widgets(tabset,info) setwidget $widgets(info,hltext)
563	$widgets(info,hltext) insert end $content
564	$widgets(info,hltext) configure -state disabled
565	return
566	}
567	}
568	MarkupHelper::Init
569	set fmtInfo [ MarkupHelper::BuildTolbaseInfo \
570	$icon $grammar $name $content $path $desc -objref $objRef ]
571	$data(notebookdb) set "info" $fmtInfo
572
573	$widgets(info,markupviewer) showpage "info"
574	ActivateInfoWidget "markup"
575	}
576	}
577	}
578
579	#/////////////////////////////////////////////////////////////////////////////
580	proc ::TolConsole::Include {file} {
581	#
582	#/////////////////////////////////////////////////////////////////////////////
583	#::LoadStatus::Show $file
584
585	::TolInspector::Busy
586	update
587	::tol::include $file
588	::TolInspector::UpdateFileRoot
589	::TolInspector::NotBusy
590	#::LoadStatus::Hide
591	}
592
593
594	#/////////////////////////////////////////////////////////////////////////////
595	proc ::TolConsole::Compile { } {
596	#
597	# PURPOSE: Compiles text of eval window. If any text is selected, then only
598	# selection is compiled, else all text is compiled.
599	#
600	#/////////////////////////////////////////////////////////////////////////////
601	variable widgets
602	set w_eval $widgets(eval)
603
604	set tolexpr [::BayesText::GetSelectionOrAll $w_eval]
605	EvalExpr $tolexpr
606	}
607
608	#/////////////////////////////////////////////////////////////////////////////
609	proc ::TolConsole::EvalExpr {tolexpr} {
610	#
611	# PURPOSE: Compiles a TOL expresion in TOL console
612	#
613	#/////////////////////////////////////////////////////////////////////////////
614	::TolInspector::Busy
615	Tolcon_Trace "tolexpr = $tolexpr"
616	if { [string length $tolexpr] } {
617	::tol::console eval $tolexpr
618	SaveEval $tolexpr
619	}
620	::TolInspector::UpdateConsoleObj
621	::TolInspector::NotBusy
622	}
623
624	#/////////////////////////////////////////////////////////////////////////////
625	proc ::TolConsole::SaveEval {txt} {
626	#
627	#/////////////////////////////////////////////////////////////////////////////
628	global home_path
629	set evalFile [file join $home_path "eval.tol"]
630
631	set texto ""
632	if { [file exists $evalFile] } {
633	set fd [open $evalFile r]
634	set texto [read -nonewline $fd]
635	close $fd
636	}
637	set fd [open $evalFile w]
638	set txt "// [::tol::date now {%W, %Y/%m/%d %h:%i:%s}]\n$txt\n\n"
639	puts -nonewline $fd $txt
640	puts -nonewline $fd $texto
641	close $fd
642	}
643
644	#/////////////////////////////////////////////////////////////////////////////
645	proc ::TolConsole::OpenEval {} {
646	#
647	#/////////////////////////////////////////////////////////////////////////////
648	global home_path
649	set evalFile [file join $home_path "eval.tol"]
650	if { ![file exists $evalFile] } {
651	set fd [open $evalFile w]
652	close $fd
653	}
654	::Editor::Open $evalFile
655	}
656
657	#/////////////////////////////////////////////////////////////////////////////
658	proc ::TolConsole::OnConnect {alias user pass datasource} {
659	#
660	#/////////////////////////////////////////////////////////////////////////////
661	set name [GetUniqueName Real]
662	::tol::console eval "Real $name = DBOpen(\"$alias\",\"$user\",\"$pass\");"
663	::tol::console stack release $name
664	}
665
666	#/////////////////////////////////////////////////////////////////////////////
667	proc ::TolConsole::OnDisconnect {alias user pass datasource} {
668	#
669	#/////////////////////////////////////////////////////////////////////////////
670	set name [GetUniqueName Real]
671	::tol::console eval "Real $name = DBClose(\"$alias\");"
672	::tol::console stack release $name
673	}
674
675	#/////////////////////////////////////////////////////////////////////////////
676	proc ::TolConsole::DBConnect {} {
677	#
678	#/////////////////////////////////////////////////////////////////////////////
679	::ODBCDialog::Create $::project::widgets(mainframe) "" "" "" \
680	::TolConsole::OnConnect ::TolConsole::OnDisconnect
681	}
682
683	#/////////////////////////////////////////////////////////////////////////////
684	proc ::TolConsole::ClearConsole { } {
685	#
686	#/////////////////////////////////////////////////////////////////////////////
687	::TolInspector::ClearConsoleObj
688	::TolInspector::UpdateConsoleObj
689	}
690
691	#/////////////////////////////////////////////////////////////////////////////
692	proc ::TolConsole::OnBusy { state } {
693	#
694	#/////////////////////////////////////////////////////////////////////////////
695	variable widgets
696
697	if { $state } {
698	$widgets(eval) configure -cursor watch
699	$widgets(tabset) configure -cursor watch
700	# ::blt::busy hold .
701	} else {
702	$widgets(eval) configure -cursor xterm
703	$widgets(tabset) configure -cursor ""
704	# ::blt::busy release .
705	}
706	}
707
708
709	#/////////////////////////////////////////////////////////////////////////////
710	proc ::TolConsole::ToEvalWindow { message } {
711	#
712	# PURPOSE: Writes a message in eval window and selects this tab (eval window)
713	#
714	# PARAMETERS:
715	# message -> Message to write in eval window
716	#
717	#/////////////////////////////////////////////////////////////////////////////
718	upvar \#0 ::TolConsole::widgets(tabset) w_tabset
719	upvar \#0 ::TolConsole::widgets(eval) w_eval
720
721	$w_eval insert end "$message\n"
722	$w_tabset select 0
723	$w_eval see end
724	}
725
726	#/////////////////////////////////////////////////////////////////////////////
727	proc ::TolConsole::HciWriter { message } {
728	#
729	#/////////////////////////////////////////////////////////////////////////////
730	variable widgets
731	variable data
732	variable time
733
734	upvar \#0 ::TolConsole::widgets(tabset) w_tabset
735	upvar \#0 ::TolConsole::widgets(output) w_output
736	if $data(chWrite) {
737	$w_output configure -state normal
738	set tr_message [string trim $message]
739	# {<([^>]+)>([^<]+)</([^>]+)>}
740	if { [regexp -- {^<([^>]+)>(.+)</(.+)>} $tr_message -> start content end] } {
741	if {($start ne $end) \|\| (($start ne "E") && ($start ne "W"))} {
742	$w_output insert end "$message"
743	} else {
744	set idx_start [$w_output index "end -1 char"]
745	$w_output insert end "$content\n"
746	set idx_end [$w_output index "end -1 char"]
747	$w_output tag add $data(output,TAG,$start) $idx_start $idx_end
748	}
749	} else {
750	$w_output insert end "$message"
751	}
752	$w_output configure -state disabled
753	}
754
755	switch $data(updateType) {
756	always {
757	if $data(chWrite) {
758	$w_tabset select 1
759	$w_output see end
760	}
761	update
762	}
763	each {
764	set time_now [clock clicks -milliseconds]
765	set dif [expr $time_now - $time]
766	if { $dif >= $data(updateSec) } {
767	set time $time_now
768	if $data(chWrite) {
769	$w_tabset select 1
770	$w_output see end
771	}
772	update
773	}
774	}
775	never { }
776	}
777	}
778
779	#/////////////////////////////////////////////////////////////////////////////
780	proc ::Tol_HciWriter { message } {
781	#
782	#/////////////////////////////////////////////////////////////////////////////
783	::TolConsole::HciWriter $message
784	}
785
786	#/////////////////////////////////////////////////////////////////////////////
787	proc ::TolConsole::Recover {editor} {
788	#
789	#/////////////////////////////////////////////////////////////////////////////
790	set state [$editor cget -state]
791	$editor configure -state normal
792	$editor delete 1.0 end
793
794	set cmd "Text $nRes = PutDumpFile(\"\");"
795	::tol::console eval $cmd
796	array set inf [TclInfoVar Text $nRes]
797	eval "set file $inf(CONTENT)"
798	::tol::console stack release $nRes
799
800	if { ![catch {set fd [open $file r] } msgerr] } {
801	$editor insert 1.0 [read -nonewline $fd]
802	#HciWriter [read -nonewline $fd]
803	close $fd
804	}
805	tk::TextSetCursor $editor end
806	$editor configure -state $state
807	}
808
809	#/////////////////////////////////////////////////////////////////////////////
810	proc ::TolConsole::MainFrame { w {tolcon 1} } {
811	#
812	#/////////////////////////////////////////////////////////////////////////////
813	variable widgets
814	variable data
815
816	#bind ::project::widgets(mainframe) <Destroy> +[list ::TolConsole::Exit]
817	bind . <Destroy> +[list ::TolConsole::Exit %W]
818
819	# Aqui deberiamos llamar a la inicializacion tcl del proyecto.
820	# solo si el proyecto ha puesto menus poner el de tolcon.
821	project::OnExit ::TolConsole::BeforeExit
822
823	#Creamos StatusBar antes de ButtonBar
824	set sb [::TolConsole::CreateStatusBar]
825	#Creamos ButtonBar
826	set bb [::TolConsole::CreateButtonBar $tolcon]
827	#Empacamos ButtonBar
828	#if { [lsearch {left right} $data(toolbars,side)] ne -1 } {
829	# ::toolbar::SetOrientation $bb V
830	#}
831	if { $tolcon } {
832	#Creamos inspector+Ventanas
833	set widgets(inspector) [Create $w]
834	bind $widgets(inspector) <F6> "::TolConsole::ApplyViewMode ; break"
835	Tolcon_Trace "widgets(inspector): $widgets(inspector)"
836	} else {
837	# ::TolConsole::OptionsApplyDefDates
838	}
839
840	# VISUALIZAMOS O NO EL INSPECTOR DE OBJETOS
841	::TolConsole::ObjectInspectorShow
842
843	project::raiseSplash
844	return $w
845	}
846
847
848	#/////////////////////////////////////////////////////////////////////////////
849	proc ::TolConsole::RaiseInspector {} {
850	#/////////////////////////////////////////////////////////////////////////////
851	$::project::widgets(mainmdi).slave1 restore
852	$::project::widgets(mainmdi).slave1 raise
853	}
854
855
856	#pedro-start
857	#/////////////////////////////////////////////////////////////////////////////
858	proc ::TolConsole::NewToolFrame { name { first 1 }} {
859	# Crea una nueva ToolFrame para Toolbars
860	#/////////////////////////////////////////////////////////////////////////////
861	variable widgets
862	variable data
863
864	switch $first {
865	1 {
866	set commandAux "toolbarFrame_${name}"
867	set newTFname $commandAux
868	}
869	2 {
870	set commandAux $name
871	set newTFname $name
872	}
873	default {
874	set newTFname "toolbarFrame_${name}"
875	set commandAux $::project::widgets(mainframe).${newTFname}
876	}
877	}
878	# create a toolframe new
879	Tolcon_Trace "ToolFrame sale-----> $commandAux"
880	set TF [::toolbar::ToolbarFrame $commandAux]
881	#Añadimos como objetivo de Drop (tkdnd)
882	dnd bindtarget $TF text/plain <Drop> "::TolConsole::TMotion %W %D $newTFname"
883	#empacamos
884	#pack $TF -side top -fill y
885	pack $TF -side $data(toolbars,side) \
886	-before $::project::widgets(mainmdi) \
887	-anchor nw -fill $data(toolbars,fill)
888	#añadimos Botones por defecto
889	#if { $first } {
890	#::TolConsole::NewToolBarB $TF $name
891	#}
892	switch $first {
893	1 {
894	::TolConsole::NewToolBarB $commandAux $name
895	}
896	2 {
897	#
898	}
899	default {
900	::TolConsole::NewToolBarB $TF $name
901	}
902	}
903	return $TF
904	}
905
906
907	#/////////////////////////////////////////////////////////////////////////////
908	proc ::TolConsole::NewToolBarB { parentTF name { jump 0 } {Child 0} {ini 0}} {
909	# Crea una nueva toolbar para botones dentro del frame parentTF
910	# parentTF : Frame papa
911	# jump : Opcion utilizada en caso de adopcion. (cambio de frame padre).
912	# loopyPath: Contiene los parametros de creacion de TODOS los botones
913	# de un toolbar, se recorre cuando jump es 1.
914	#/////////////////////////////////////////////////////////////////////////////
915	variable widgets
916	variable data
917
918	switch $ini {
919	1 {
920	set data(tolbase,original) 0
921	set newName $name
922	set largo [string length $newName]
923	set newName [string range $newName 0 [expr $largo - 2]]
924	set newTb [::toolbar::create "$parentTF.$newName"]
925	}
926	2 {
927	set newName [lindex [split $Child .] 3]
928	set largo [string length $newName]
929	set newName [string range $newName 0 [expr $largo - 1]]
930	if {[winfo exists $parentTF.$newName]} {
931	set data(tolbase,original) 1
932	} else {
933	set data(tolbase,original) 0
934	set newTb [::toolbar::create "$parentTF.$newName"]
935	}
936	}
937	default {
938	set data(tolbase,original) 0
939	set newName "tb_${name}"
940	set newTb [::toolbar::create "$parentTF.$newName"]
941	}
942	}
943
944	#if { $ini } {
945	# set newName $name
946	# Tolcon_Trace "newName -> $newName"
947	# set largo [string length $newName]
948	# set newName [string range $newName 0 [expr $largo - 2]]
949	# set newTb [::toolbar::create "$parentTF.$newName"]
950	#} else {
951	# set newName "tb_${name}"
952	# Tolcon_Trace "newName -> $newName"
953	# set newTb [::toolbar::create "$parentTF.$newName"]
954	#}
955
956	if { $jump } {
957	set test "\{"
958	foreach path $widgets(createScript,$Child) {
959	set Apic [lindex $path 1]
960	set Ahelp [lindex $path 2]
961	set Acmd [lindex $path 3]
962	if { [string index $Acmd 0] == $test } {
963	set largo [string length $Acmd]
964	set newCmd [string range $Acmd 1 [expr $largo - 2]]
965	} else {
966	set newCmd $Acmd
967	}
968	#creamos botones exactamente iguales y en el mismo orden sobre nuevo
969	#parent
970	if {$data(tolbase,original) == 0} {
971	::TolConsole::NewButtonB $newTb $Apic $Ahelp $newCmd $parentTF
972	}
973
974	}
975	Tolcon_Trace "/n COMPLETE DUMP ---> $widgets(createScript,$Child)"
976	}
977
978
979	#empacamos
980	if {$data(tolbase,original)} {
981	dnd bindsource $parentTF.$newName text/plain "return $parentTF.$newName"
982	pack $parentTF.$newName -side left -anchor w \
983	-fill x
984	return $parentTF.$newName
985	} else {
986	#Drag-n-Drop para mover a diferentes toolframes
987	dnd bindsource $newTb text/plain "return $newTb"
988	pack $newTb -side left -anchor w \
989	-fill x -in $parentTF
990	return $newTb
991	}
992	}
993
994
995	#/////////////////////////////////////////////////////////////////////////////
996	proc ::TolConsole::NewButtonB { Tb pic help cmd parentTF} {
997	# --- Crea un nuevo boton en la toolbar parametro ---
998	#
999	# pathToolbar : Ruta completa al toolbar padre que tendra el boton
1000	# pic : Imagen del Boton
1001	# prueba : Introducir boton de prueba (llevar a 0 para no empacar
1002	# dos botones por llamada.
1003	# help : Ayuda del Boton Custom
1004	# cmd :comando a ejecutar por el boton
1005	#/////////////////////////////////////////////////////////////////////////////
1006	variable widgets
1007	variable data
1008
1009	# imagen ?
1010	if { $pic == "" } {
1011	set pic index
1012	}
1013	# exists imagen ?
1014	if {[catch {::Bitmap::get $pic}]} {
1015	# no exists
1016	Tolcon_Trace "La imagen asociada al comando no existe. \
1017	No se mostrara el botón: imagen: $pic - comando: $help"
1018	} else {
1019	# exists
1020	set but [::toolbar::addbutton $Tb -image [::Bitmap::get $pic] \
1021	-tooltip [mc $help] -command $cmd]
1022	#event add <<TMotion_1>> <Button1-Motion>
1023	bind $but <<TMotion_1>> "dnd drag $Tb"
1024	bind $but <ButtonPress-2> "::toolbar::ButtonMenu"
1025	dnd bindsource $Tb text/plain "return $Tb"
1026	#guardamos parametros del create del boton, si es el primer boton,
1027	#iniciamos la matriz.
1028	if { [info exists widgets(createScript,$Tb)] } {
1029	lappend widgets(createScript,$Tb) "$Tb $pic [list $help] [list $cmd] $parentTF"
1030	} else {
1031	set widgets(createScript,$Tb) "{$Tb $pic [list $help] [list $cmd] $parentTF}"
1032	}
1033	if { ![regexp "$Tb $pic [list $help] [list $cmd] $parentTF" "$data(tolbase,lsttoolbars)" ] } {
1034	lappend data(tolbase,lsttoolbars) "$Tb $pic [list $help] [list $cmd] $parentTF"
1035	}
1036	}
1037	return
1038	}
1039
1040
1041	#/////////////////////////////////////////////////////////////////////////////
1042	proc ::TolConsole::TMotion { targetTF newChild name} {
1043	# Mueve Toolbar de un Frame a otro cuando ocurre un DND
1044	#/////////////////////////////////////////////////////////////////////////////
1045	variable widgets
1046	variable data
1047	set test [winfo parent $newChild]
1048
1049	if { $targetTF != $test } {
1050	pack forget $newChild
1051
1052	set data(tolbase,lsttoolbars) \
1053	[lsub $data(tolbase,lsttoolbars) $widgets(createScript,$newChild)]
1054
1055	if {$data(tolbase,ini)} {
1056	::TolConsole::NewToolBarB $targetTF $name 1 $newChild 2
1057	} else {
1058	::TolConsole::NewToolBarB $targetTF $name 1 $newChild 2
1059	}
1060	} else {
1061	pack $newChild -in $targetTF -side left -anchor w \
1062	-fill x
1063	}
1064	return
1065	}
1066
1067
1068	#/////////////////////////////////////////////////////////////////////////////
1069	proc ::TolConsole::CreateButtonBar { {tolcon 1} } {
1070	#
1071	#/////////////////////////////////////////////////////////////////////////////
1072	variable widgets
1073	variable data
1074
1075	set TF {}
1076	if {![llength $data(tolbase,lsttoolbars)]} {
1077	#Creamos ToolFrame Principal para botones por defecto.
1078	set TF [set widgets(toolbar,main) [::TolConsole::NewToolFrame 0 0]]
1079
1080	# 2) Separamos Botones en diferentes Toolframes
1081	#Grupo Botones Inspector
1082	set tb1 [::TolConsole::NewToolBarB $TF "tb1"]
1083	#Show Inspector Window
1084	::TolConsole::NewButtonB $tb1 insobj [mc "TOL Inspector"] \
1085	"$::project::widgets(mainmdi).slave1 restore; $::project::widgets(mainmdi).slave1 raise" $TF
1086	#Show Eval Window
1087	::TolConsole::NewButtonB $tb1 evalwin [mc "Show Eval Window"] \
1088	[list ::TolConsole::ShowWindow "eval"] $TF
1089	#Show Output Window
1090	::TolConsole::NewButtonB $tb1 outputwin [mc "Show Output Window"] \
1091	[list ::TolConsole::ShowWindow "output"] $TF
1092	#Show Info
1093	::TolConsole::NewButtonB $tb1 infowin [mc "Show Info Window"] \
1094	[list ::TolConsole::ShowWindow info] $TF
1095	#Show ViewMode
1096	::TolConsole::NewButtonB $tb1 changeview [mc "Change View Mode"] \
1097	[list ::TolConsole::ApplyViewMode] $TF
1098
1099	#Grupo Botones para Mostrar Acciones
1100	set tbExe [::TolConsole::NewToolBarB $TF "tbExe"]
1101	#New Editor Dialog
1102	::TolConsole::NewButtonB $tbExe newfile [mc "New TOL file"] \
1103	[list ::Editor::New] $TF
1104	#Open TOL File
1105	::TolConsole::NewButtonB $tbExe openfile [mc "Open TOL file"] \
1106	[list ::Editor::Open] $TF
1107	#New Table Dialog
1108	::TolConsole::NewButtonB $tbExe newtable [mc "New Table"] \
1109	[list ::TolConsole::TableNew] $TF
1110	#Open Table Dialog
1111	::TolConsole::NewButtonB $tbExe opentable [mc "Open Table"] \
1112	[list ::TolConsole::TableOpen] $TF
1113
1114	#New Project
1115	::TolConsole::NewButtonB $tbExe newproject [mc "New Project"] \
1116	[list ::TolProject::New] $TF
1117	#Open Project
1118	::TolConsole::NewButtonB $tbExe openprj [mc "Open Project"] \
1119	[list ::TolProject::Open] $TF
1120
1121	#Grupo Botones para Herramientas
1122	set tbTool [::TolConsole::NewToolBarB $TF "tbTool"]
1123	#DB Connection
1124	::TolConsole::NewButtonB $tbTool db [mc "Connection to database"] \
1125	[list $::project::data(bodbc) showdialog] $TF
1126	#Function Search
1127	::TolConsole::NewButtonB $tbTool funsearch [mc "Functions Search"] \
1128	[list ::funcSearch::Show] $TF
1129	#SQL
1130	::TolConsole::NewButtonB $tbTool bysSql [mc "Bayes SQL"] \
1131	[list ::SQLTable::TableBayesSQL] $TF
1132	#Calendar
1133	::TolConsole::NewButtonB $tbTool TimeSet [mc "Calendar Expert"] \
1134	[list ::CalendarTms::ViewTimeSet] $TF
1135	#Calendar
1136	::TolConsole::NewButtonB $tbTool tools [mc Options] \
1137	[list ::TolConsole::OptionsCreate] $TF
1138
1139	#Grupo Botones para Distribucion de Ventanas y Ayuda Visual
1140	set tbHelp [::TolConsole::NewToolBarB $TF "tbHelp"]
1141	#Cascade
1142	::TolConsole::NewButtonB $tbHelp cascade [mc "Cascade"] \
1143	[list $::project::widgets(mainmdi) arrange cascade] $TF
1144	#Horizontal
1145	::TolConsole::NewButtonB $tbHelp tilehor [mc "Tile Horizontal"] \
1146	[list $::project::widgets(mainmdi) arrange hor] $TF
1147	#Vertical
1148	::TolConsole::NewButtonB $tbHelp tilever [mc "Tile Vertical"] \
1149	[list $::project::widgets(mainmdi) arrange ver] $TF
1150	#About
1151	::TolConsole::NewButtonB $tbHelp about [mc "About"] \
1152	[list ::TolConsole::AboutShow] $TF
1153	set widgets(tb1,path) $tb1
1154	set widgets(tbExe,path) $tbExe
1155	set widgets(tbTool,path) $tbTool
1156	set widgets(tbHelp,path) $tbHelp
1157	set widgets(toolbar,frame) $TF
1158	} else {
1159	#aqui creamos las barras de botones que hemos recuperado del INI
1160	set tfgitb [::TolConsole::GlobalIniToolbarsButtons]
1161	set TF [set widgets(toolbar,main) [lindex $tfgitb 0]]
1162	}
1163	# toolbar by default, in order to add bellboys from the outside
1164	if {![string length $TF]} {
1165	# if not exists, create new
1166	set TF [::TolConsole::NewToolFrame 0 0]
1167	}
1168	set widgets(tbCustom,path) [::TolConsole::NewToolBarB $TF "tbCustom"]
1169	return
1170	}
1171
1172
1173	#/////////////////////////////////////////////////////////////////////////////
1174	proc ::TolConsole::GlobalIniToolbarsButtons {} {
1175	#
1176	#/////////////////////////////////////////////////////////////////////////////
1177	variable widgets
1178	variable data
1179
1180	set data(tolbase,ini) 1
1181	set lstToolFrames {}
1182	set lstFrames {}
1183	set lstFrameBut {}
1184	set i 1
1185	foreach item $data(tolbase,lsttoolbars) {
1186	lappend lstFrameBut $item
1187	lappend lstToolFrames [lindex $item 4]
1188	lappend lstFrames [list [lindex $item 0] [lindex $item 4]]
1189	incr i
1190	}
1191	set lstFrames [lsort -unique $lstFrames]
1192	set lstFrameBut [lsort -unique $lstFrameBut]
1193	set lstToolFramesAux {}
1194	foreach it $lstToolFrames {
1195	puts $it
1196	if {!([lsearch -exact $lstToolFramesAux $it ] >= 0)} {
1197	lappend lstToolFramesAux $it
1198	}
1199	}
1200	set tfaux {}
1201	foreach toolFrame $lstToolFramesAux {
1202	set tfaux [::TolConsole::NewToolFrame "$toolFrame" 2]
1203	}
1204	set lstFramesAux {}
1205	foreach it $lstFrames {
1206	puts $it
1207	if {!([lsearch -exact $lstFramesAux $it ] >= 0)} {
1208	lappend lstFramesAux $it
1209	}
1210	}
1211	foreach toolBar $lstFrames {
1212	::TolConsole::NewToolBarB [lindex $toolBar 1] [lindex [split $toolBar .] 3] 0 0 1
1213	}
1214	foreach but $lstFrameBut {
1215	::TolConsole::NewButtonB [lindex $but 0] [lindex $but 1] \
1216	[lindex $but 2] [lindex $but 3] [lindex $but 4]
1217	}
1218	return $tfaux
1219	}
1220
1221
1222	#/////////////////////////////////////////////////////////////////////////////
1223	proc ::TolConsole::CreateStatusBar {} {
1224	#
1225	#/////////////////////////////////////////////////////////////////////////////
1226	variable widgets
1227
1228	set widgets(sb,path) [statusbar .sbar]
1229	.sbar add statTime -image [::Bitmap::get tinyclock]
1230	::TolConsole::UpdateTime
1231	if {0} {
1232	variable widgets
1233	# frame y label para barra de estado
1234	set widgets(sb,path) [set sf [frame $w.sb]]
1235	set widgets(sb,lInfo) [label $sf.info -anchor w -relief sunken]
1236	set widgets(sb,lTime) [label $sf.cursor -anchor w -relief sunken]
1237	# empaquetamos los label de la barra de estado
1238	grid $w.sb.info -row 0 -column 0 -sticky ew -padx 2
1239	grid $w.sb.cursor -row 0 -column 1 -sticky w -padx 2
1240	grid columnconfigure $sf 0 -weight 1
1241	UpdateTime
1242	return $w.sb
1243	}
1244	}
1245
1246	#/////////////////////////////////////////////////////////////////////////////
1247	proc ::TolConsole::UpdateTime {} {
1248	#
1249	# PURPOSE: Updates time in status bar
1250	#
1251	#/////////////////////////////////////////////////////////////////////////////
1252	variable widgets
1253	$widgets(sb,path) itemconf statTime \
1254	-text [clock format [clock seconds] -format {%H:%M:%S }]
1255	after 1000 ::TolConsole::UpdateTime
1256	if {0} {
1257	variable widgets
1258	$widgets(sb,lTime) configure\
1259	-text [clock format [clock seconds] -format {%H:%M:%S }]
1260	after 1000 ::TolConsole::UpdateTime
1261	}
1262	}
1263
1264
1265	#/////////////////////////////////////////////////////////////////////////////
1266	proc ::TolConsole::ApplyViewMode {{change 1}} {
1267	#
1268	# PURPOSE: Changes heights of inspector and eval/output/info windows
1269	#
1270	#/////////////////////////////////////////////////////////////////////////////
1271	variable data
1272	variable widgets
1273
1274	set state $data(viewmode)
1275	set states [list middle max min middle]
1276	if {$change} {
1277	set idx [lsearch -exact $states $state]
1278	set state [lindex $states [expr $idx+1]]
1279	}
1280	::PanedWindow::MoveSash $widgets(pw) 1 y $state
1281	set data(viewmode) $state
1282	}
1283
1284
1285	#/////////////////////////////////////////////////////////////////////////////
1286	proc ::TolConsole::AboutShow {} {
1287	#
1288	# PURPOSE: Shows the function search dialog
1289	#
1290	#/////////////////////////////////////////////////////////////////////////////
1291	set path .__about
1292
1293	if ![winfo exist $path] {
1294	::TolConsole::About $path
1295	}
1296	wm state $path normal
1297	}
1298
1299	#/////////////////////////////////////////////////////////////////////////////
1300	proc ::TolConsole::TolBaseHelp {} {
1301	#
1302	# PURPOSE: Shows the home page of help of Tolbase
1303	#
1304	#/////////////////////////////////////////////////////////////////////////////
1305	ShowHelp "Tb4Mai"
1306	}
1307
1308
1309	#/////////////////////////////////////////////////////////////////////////////
1310	proc ::TolConsole::About { w } {
1311	#
1312	# PURPOSE: Shows a dialog that shows information about TolBase and Bayes.
1313	#
1314	#/////////////////////////////////////////////////////////////////////////////
1315	global toltk_library
1316	global GuiVersionInfo
1317
1318	set imgfile [file join $toltk_library toltk images splash.gif]
1319	set img [image create photo -file $imgfile]
1320	toplevel $w
1321	wm title $w "[mc About] TOLBase"
1322	wm withdraw $w
1323	wm transient $w .
1324	wm iconbitmap $w [wm iconbitmap .]
1325	wm resizable $w 0 0
1326	label $w.lsplash -image $img -relief ridge -bd 2
1327	array set TolVersionInfo [::tol::info version]
1328	label $w.lversion -bg black -fg white -text \
1329	"[mc {TOL Version}]: [ lindex [ toltcl::eval {Text Version} ] 0 ]"
1330	label $w.laddress -bg black -fg white -text {
1331	Bayes Forecast: dynamic modelling of operations and markets
1332	Voice: (+34) 91.5327440; Fax: (+34) 91.5322636
1333	e-Mail: request@bayesinf.com; URL: http://www.tol-project.org
1334	}
1335
1336	button $w.bc -text [mc Close] -command [list destroy $w]
1337	grid $w.lsplash
1338	grid $w.lversion -sticky "ew"
1339	grid $w.laddress -sticky "ew"
1340	grid $w.bc -padx 2 -pady 5 -sticky ns
1341	update
1342	# Aqui deberiamos invocar a un proc CenterWindow
1343	wm geometry $w +[expr ([winfo vrootw .]-[winfo reqwidth $w])/2]+[expr ([winfo vrooth .]-[winfo reqheight $w])/2]
1344	update
1345	wm withdraw $w
1346	wm deiconify $w
1347	update
1348	}
1349
1350	#/////////////////////////////////////////////////////////////////////////////
1351	proc ::TolConsole::IncludeCmd {{path ""} } {
1352	#
1353	#/////////////////////////////////////////////////////////////////////////////
1354	variable data
1355	set types {
1356	{{Tol Files} {.tol .bst .bsi .bst .bdt}}
1357	{{Text Files} {.txt}}
1358	{{All Files} *}
1359	}
1360
1361	if {$path == ""} {
1362	if { [catch {tk_getOpenFile -filetypes $types \
1363	-initialdir $data(path) \
1364	-title "Source File"} fn] \|\| [string match {} $fn] } {
1365	return
1366	}
1367	} else {
1368	set fn $path
1369	}
1370	UpdateListIncluded $fn
1371	Include $fn
1372
1373
1374	}
1375
1376	#/////////////////////////////////////////////////////////////////////////////
1377	proc ::TolConsole::UpdateListIncluded {path} {
1378	#
1379	#/////////////////////////////////////////////////////////////////////////////
1380	variable data
1381	# guardamos el ultimo directorio abierto
1382	set data(path) [file dirname $path]
1383	if { [set idx [lsearch $data(included) $path]] == -1 } {
1384	set data(included) [linsert $data(included) 0 $path]
1385	} else {
1386	set ll ""
1387	lappend ll $path
1388	set i 0
1389	foreach f $data(included) {
1390	if {$i != $idx} {
1391	lappend ll $f
1392	}
1393	incr i
1394	}
1395	set data(included) $ll
1396	}
1397	set data(included) [lrange $data(included) 0 [expr $data(numRecent)-1]]
1398	}
1399
1400	#/////////////////////////////////////////////////////////////////////////////
1401	proc ::TolConsole::Exit { w } {
1402	#
1403	#/////////////////////////////////////////////////////////////////////////////
1404	variable data
1405	variable widgets
1406
1407	if {$w eq "."} {
1408	ProcessPendingTasks
1409
1410	# Options project
1411	if {[info exists data(proc,OnOptionDestroy)] && \
1412	[string length $data(proc,OnOptionDestroy)]} {
1413	foreach f $data(proc,OnOptionDestroy) {
1414	$f
1415	}
1416	}
1417	WriteIni
1418	}
1419	}
1420
1421	#/////////////////////////////////////////////////////////////////////////////
1422	proc ::TolConsole::BeforeExit { } {
1423	#
1424	#/////////////////////////////////////////////////////////////////////////////
1425	variable data
1426	variable widgets
1427
1428	# check all ...
1429	set okEdi ok
1430	set okETr ok
1431	set okTPr ok
1432	catch {set okEdi [::Editor::CheckAll]}
1433	catch {set okETa [::EditTable::CheckAll]}
1434	catch {set okTPr [::TolProject::CheckAll]}
1435
1436	if {[string eq $okEdi cancel] \|\| [string eq $okETa cancel] \|\| \
1437	[string eq $okTPr cancel]} {
1438	return cancel
1439	}
1440	# exit
1441	if { [info exists widgets(inspector)] } {
1442	foreach a {x y width height} {
1443	set data(geometry,$a) [winfo $a $widgets(inspector)]
1444	}
1445	set data(geometry,wtop) [winfo height $widgets(panes,top)]
1446	set data(geometry,wbottom) [winfo height $widgets(panes,bottom)]
1447	set data(geometry,wleft) [::TolInspector::GetWeight left]
1448	set data(geometry,wright) [::TolInspector::GetWeight right]
1449	set data(font,eval) [$widgets(eval) cget -font]
1450	set data(font,output) [$widgets(output) cget -font]
1451	set data(font,info) [$widgets(info) cget -font]
1452	}
1453	return "ok"
1454	}
1455
1456	#/////////////////////////////////////////////////////////////////////////////
1457	proc ::TolConsole::ProcessPendingTasks {} {
1458	#
1459	#/////////////////////////////////////////////////////////////////////////////
1460	# para que este procedimiento?
1461	return
1462	foreach id [after info] {
1463	set aft_info [after info $id]
1464	after cancel $id
1465	eval [lindex $aft_info 0]
1466	}
1467	}
1468
1469	#/////////////////////////////////////////////////////////////////////////////
1470	proc ::TolConsole::OptionsCreate { {tabinit ""} } {
1471	#
1472	# PURPOSE: Create the dialog of options of TolBase
1473	#
1474	# PARAMETERS:
1475	# tabinit -> Tab where is focused the dialog when it's displayed (Optional).
1476	#
1477	#/////////////////////////////////////////////////////////////////////////////
1478	variable widgets
1479	variable data
1480
1481	set path $widgets(inspector)
1482
1483	set dialog [Dialog $path.t -title [mc "TOLBase Options"]\
1484	-parent $path -default 0 -cancel 1 -modal local]
1485	wm protocol $dialog WM_DELETE_WINDOW \
1486	[list ::TolConsole::OptionsDestroy $dialog]
1487	set w [$dialog getframe]
1488
1489	wm resizable $dialog 0 0
1490	# TabSet TolBase
1491	set w_ts [::blt::tabset $w.ts -relief flat -highlightthickness 0 -bd 0 \
1492	-outerpad 0 -tier 2 -slant both -textside right -side left -rotate 90 ]
1493	#insertar tabset
1494	$w_ts insert end TolBase
1495	set f0 [frame $w_ts.f0]
1496	$w_ts tab configure "TolBase" -text "TolBase" \
1497	-window $f0 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1498
1499	# TabSet Options
1500	set w_tabset [::blt::tabset $f0.ts -relief flat -highlightthickness 0\
1501	-bd 0 -outerpad 0 -tier 2 -slant right -textside right ]
1502
1503	$w_tabset insert end TOL Output Precision Paths Others
1504	set f1 [frame $w_tabset.f1]
1505	set f2 [frame $w_tabset.f2]
1506	set f3 [frame $w_tabset.f3]
1507	set f4 [frame $w_tabset.f4]
1508	set f5 [frame $w_tabset.f5]
1509
1510	$w_tabset tab configure "TOL" -text [mc "TOL"] -window $f1\
1511	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1512	$w_tabset tab configure "Output" -text [mc "Output"] -window $f2\
1513	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1514	$w_tabset tab configure "Precision" -text [mc "Precision"] -window $f3\
1515	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1516	$w_tabset tab configure "Paths" -text [mc "Paths"] -window $f5\
1517	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1518	$w_tabset tab configure "Others" -text [mc "Others"] -window $f4\
1519	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1520
1521	OptionsGet
1522	OptionsCreateTOL $f1
1523	OptionsCreateOutput $f2
1524	OptionsCreatePrecision $f3
1525	OptionsCreatePaths $f5
1526	OptionsCreateOthers $f4
1527
1528	# Options project
1529	if {[info exists data(proc,OnOptionCreate)] && \
1530	[string length $data(proc,OnOptionCreate)]} {
1531	foreach f $data(proc,OnOptionCreate) {
1532	$f $w_ts
1533	}
1534	}
1535
1536	OptionsCheck
1537
1538	set w_bbox \
1539	[ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1540	-homogeneous false]
1541	$w_bbox add -text [mc "Accept"] -relief link \
1542	-helptext [mc "Make the changes and leave the dialog"] \
1543	-image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1544	-command [list ::TolConsole::OptionsOK $dialog]
1545	$w_bbox add -text [mc "Cancel"] -relief link \
1546	-helptext [mc "Leave the dialog without apply any change"] \
1547	-image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1548	-command [list ::TolConsole::OptionsDestroy $dialog]
1549	$w_bbox add -text [mc "Apply"] -relief link \
1550	-helptext [mc "Make the changes without leave the dialog"] \
1551	-image [::Bitmap::get apply] -compound left -padx 5 -pady 1 \
1552	-command ::TolConsole::OptionsApply
1553
1554	pack $w_bbox -side bottom -expand no -fill x
1555	pack $w_tabset -side top -expand yes -fill both
1556	pack $w_ts -expand yes -fill both ;#-sticky news
1557
1558	if {!($tabinit eq "")} {
1559	switch -exact $tabinit {
1560	"TOL" {
1561	$w_tabset select 0
1562	}
1563	"Output" {
1564	$w_tabset select 1
1565	}
1566	"Precision" {
1567	$w_tabset select 2
1568	}
1569	"Paths" {
1570	$w_tabset select 3
1571	}
1572	"Others" {
1573	$w_tabset select 4
1574	}
1575	}
1576	}
1577	bind $dialog <F1> "ShowHelp Tb4Opc"
1578	$dialog draw
1579	}
1580
1581
1582	#/////////////////////////////////////////////////////////////////////////////
1583	proc ::TolConsole::OptionsCreateTOL {w} {
1584	#
1585	#/////////////////////////////////////////////////////////////////////////////
1586	variable tmpOpt
1587
1588	#TitleFrame $w.tf1 -text [mc "--"]
1589	#set f1 [$w.tf1 getframe]
1590
1591	TitleFrame $w.tf2 -text [mc "Default dates"]
1592	set f2 [$w.tf2 getframe]
1593
1594	label $f2.lFirstDate -text [mc "First date"]:
1595	::Objects::ChooseDateCreate ::TolConsole::tmpOpt(var,DefFirst) $f2.cFD
1596
1597	label $f2.lLastDate -text [mc "Last date"]:
1598	::Objects::ChooseDateCreate ::TolConsole::tmpOpt(var,DefLast) $f2.cLD
1599
1600	frame $f2.f -width 25
1601
1602	grid $f2.f $f2.lFirstDate $f2.cFD $f2.lLastDate $f2.cLD -sticky nw -padx 2
1603	grid rowconfigure $f2 0 -weight 1
1604	grid columnconfigure $f2 4 -weight 1
1605	grid columnconfigure $f2 2 -pad 10
1606
1607
1608	#grid $w.tf1 -sticky news -padx 2
1609	grid $w.tf2 -sticky news -padx 2
1610
1611	grid rowconfigure $w 0 -weight 1
1612	grid rowconfigure $w 1 -weight 3
1613	grid columnconfigure $w 0 -weight 1
1614
1615	}
1616
1617	#/////////////////////////////////////////////////////////////////////////////
1618	proc ::TolConsole::OptionsCreateOutput {w} {
1619	#
1620	#/////////////////////////////////////////////////////////////////////////////
1621	global toltk_options
1622	variable tmpOpt
1623
1624	TitleFrame $w.tf1 -text [mc "Write"]
1625	set f1 [$w.tf1 getframe]
1626
1627	checkbutton $f1.chWrite -text [mc "Write messages in output window"]\
1628	-variable ::TolConsole::tmpOpt(var,chWrite)
1629	label $f1.lColorErr -text [mc "Errors color"]:
1630	bcolor $f1.fColorErr -variable ::TolConsole::tmpOpt(var,colorErr)
1631	#::Objects::ColorCreate ::TolConsole::tmpOpt(var,colorErr) $f1.fColorErr
1632	label $f1.lColorWar -text [mc "Warnings color"]:
1633	::Objects::ColorCreate ::TolConsole::tmpOpt(var,colorWar) $f1.fColorWar
1634
1635	frame $f1.f -width 20
1636	grid $f1.f $f1.chWrite - - - -sticky nw -padx 2
1637	grid ^ $f1.lColorErr $f1.fColorErr $f1.lColorWar $f1.fColorWar -sticky nw -padx 2
1638
1639	grid rowconfigure $f1 1 -weight 1
1640	grid columnconfigure $f1 4 -weight 1
1641	grid columnconfigure $f1 2 -pad 20
1642
1643
1644	TitleFrame $w.tf2 -text [mc "Update"]
1645	set f2 [$w.tf2 getframe]
1646
1647	label $f2.lUpdateType -text [mc "Update options"]:
1648	frame $f2.f1 -width 15
1649	radiobutton $f2.rbAlways -text [mc "Update always"]\
1650	-value always -highlightthickness 0 -pady 0\
1651	-variable ::TolConsole::tmpOpt(var,updateType)\
1652	-command ::TolConsole::OptionsCheckUpdateType
1653	radiobutton $f2.rbEach -text [mc "Update each"]\
1654	-value each -highlightthickness 0 -pady 0\
1655	-variable ::TolConsole::tmpOpt(var,updateType)\
1656	-command ::TolConsole::OptionsCheckUpdateType
1657	radiobutton $f2.rbNever -text [mc "Don't update until the end"]\
1658	-value never -highlightthickness 0 -pady 0\
1659	-variable ::TolConsole::tmpOpt(var,updateType)\
1660	-command ::TolConsole::OptionsCheckUpdateType
1661	set tmpOpt(widget,updateSec) [SpinBox $f2.sbSeconds -justify right -width 4 \
1662	-editable 0 -range {0 2000 20} \
1663	-textvariable ::TolConsole::tmpOpt(var,updateSec)]
1664	label $f2.lSeconds -text [mc milliseconds]
1665
1666	frame $f2.f -width 20
1667	grid $f2.f $f2.lUpdateType - - - -sticky nw -padx 2
1668	grid ^ $f2.f1 $f2.rbAlways - - -sticky nw -padx 2
1669	grid ^ ^ $f2.rbEach $f2.sbSeconds $f2.lSeconds -sticky nw -padx 2
1670	grid ^ ^ $f2.rbNever - - -sticky nw -padx 2
1671
1672	grid rowconfigure $f2 3 -weight 1
1673	grid columnconfigure $f2 4 -weight 1
1674
1675	grid $w.tf1 -sticky news -padx 2
1676	grid $w.tf2 -sticky news -padx 2
1677	grid rowconfigure $w 1 -weight 1
1678	grid columnconfigure $w 0 -weight 1
1679	}
1680
1681	#/////////////////////////////////////////////////////////////////////////////
1682	proc ::TolConsole::OptionsCreatePrecision {w} {
1683	#
1684	#/////////////////////////////////////////////////////////////////////////////
1685	variable tmpOpt
1686
1687	TitleFrame $w.tf1 -text [mc "Precision"]
1688	set f1 [$w.tf1 getframe]
1689
1690	checkbutton $f1.chDecimals -text [mc "Reduce decimal digits to"]\
1691	-variable ::TolConsole::tmpOpt(var,chDecimals)\
1692	-command ::TolConsole::OptionsCheckDecimals
1693	set tmpOpt(widget,decimals) [SpinBox $f1.sbDecimals -justify right -width 4 \
1694	-editable 0 -range {0 10} \
1695	-textvariable ::TolConsole::tmpOpt(var,numDecimals)]
1696	label $f1.lDecimals -text [mc digits]
1697
1698	checkbutton $f1.chExponential \
1699	-text [mc "Use exponential notation when number has more than"]\
1700	-variable ::TolConsole::tmpOpt(var,chExponential)\
1701	-command ::TolConsole::OptionsCheckExponential
1702	set tmpOpt(widget,exponential) [SpinBox $f1.sbExponential -justify right -width 4 \
1703	-editable 0 -range {0 10} \
1704	-textvariable ::TolConsole::tmpOpt(var,numExponential)]
1705	label $f1.lExponential -text [mc digits]
1706
1707	frame $f1.f -width 25
1708
1709	grid $f1.f $f1.chDecimals $f1.sbDecimals $f1.lDecimals -sticky nw -padx 2
1710	grid ^ $f1.chExponential $f1.sbExponential $f1.lExponential -sticky nw -padx 2
1711	grid rowconfigure $f1 1 -weight 1
1712	grid columnconfigure $f1 3 -weight 1
1713
1714	grid $w.tf1 -sticky news -padx 2
1715	#grid $w.tf2 -sticky news -padx 2
1716
1717	grid rowconfigure $w 0 -weight 1
1718	#grid rowconfigure $w 1 -weight 2
1719	grid columnconfigure $w 0 -weight 1
1720	}
1721
1722	#/////////////////////////////////////////////////////////////////////////////
1723	proc ::TolConsole::OptionsCreatePaths {w} {
1724	#
1725	#/////////////////////////////////////////////////////////////////////////////
1726	variable tmpOpt
1727
1728	TitleFrame $w.tf -text [mc "Paths"]
1729	set f [$w.tf getframe]
1730
1731	label $f.lPathBrowser -text [mc "Browser path"]
1732	label $f.lPathPDFViewer -text [mc "PDF viewer path"]
1733	label $f.lPathHelp -text [mc "Help path"]
1734	Entry $f.ePathBrowser -state normal -width 30 \
1735	-textvariable ::TolConsole::tmpOpt(var,pathBrowser) \
1736	-helptext [mc pathexplanation]
1737	Entry $f.ePathPDFViewer -state normal -width 30 \
1738	-textvariable ::TolConsole::tmpOpt(var,pathPDFViewer) \
1739	-helptext [mc pathexplanation]
1740	Entry $f.ePathHelp -state normal -width 30 \
1741	-textvariable ::TolConsole::tmpOpt(var,pathHelp)
1742	Button $f.bPathBrowser -compound left -padx 10 \
1743	-height 16 -relief link \
1744	-helptext [mc "Search the program path"] \
1745	-image [Bitmap::get bopen] \
1746	-command {::TolConsole::OptionsCreatePath "Browser"}
1747	Button $f.bPathPDFViewer -compound left -padx 10 \
1748	-height 16 -relief link \
1749	-helptext [mc "Search the program path"] \
1750	-image [Bitmap::get bopen] \
1751	-command {::TolConsole::OptionsCreatePath "PDFViewer"}
1752	Button $f.bPathHelp -compound left -padx 10 \
1753	-height 16 -relief link \
1754	-helptext [mc "Search the folder"] \
1755	-image [Bitmap::get bopen] \
1756	-command {set tmp [tk_chooseDirectory -initialdir $::TolConsole::tmpOpt(var,pathHelp) -mustexist 1]
1757	if {!($tmp eq "")} {
1758	set ::TolConsole::tmpOpt(var,pathHelp) $tmp
1759	} }
1760
1761	grid $f.lPathBrowser -row 0 -column 0 -sticky nw -padx 5 -pady 5
1762	grid $f.lPathPDFViewer -row 1 -column 0 -sticky nw -padx 5 -pady 5
1763	grid $f.lPathHelp -row 2 -column 0 -sticky nw -padx 5 -pady 5
1764	grid $f.ePathBrowser -row 0 -column 1 -sticky new -padx 5 -pady 5
1765	grid $f.ePathPDFViewer -row 1 -column 1 -sticky new -padx 5 -pady 5
1766	grid $f.ePathHelp -row 2 -column 1 -sticky new -padx 5 -pady 5
1767	grid $f.bPathBrowser -row 0 -column 2 -sticky e -padx 5 -pady 5
1768	grid $f.bPathPDFViewer -row 1 -column 2 -sticky e -padx 5 -pady 5
1769	grid $f.bPathHelp -row 2 -column 2 -sticky e -padx 5 -pady 5
1770
1771	grid columnconfigure $f 1 -weight 1
1772	grid rowconfigure $f 10 -weight 1
1773
1774	grid $w.tf -sticky news
1775
1776	grid columnconfigure $w 0 -weight 1
1777	grid rowconfigure $w 0 -weight 1
1778	}
1779
1780	#/////////////////////////////////////////////////////////////////////////////
1781	proc ::TolConsole::OptionsCreatePath { type } {
1782	#
1783	# PURPOSE: Executes the command associated to the create path buttons:
1784	# Shows a dialog OpenFile with the directory and the appropriate
1785	# file type according to the operating system
1786	#
1787	# PARAMETERS: Type of path. Allowed values "Browser" "PDFViewer"
1788	#
1789	# TODO: For linux, to verify that the file is executable
1790	#
1791	#/////////////////////////////////////////////////////////////////////////////
1792	variable tmpOpt
1793
1794	if { $::tcl_platform(platform) == "windows" } {
1795	# get the "Program Files" directory
1796	set dirProgramFiles [registry get \
1797	{HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Session Manager\SFC} \
1798	ProgramFilesDir]
1799	set txtExecFileType "\{\{\{[mc {Executable files} ]\} .exe\}\}"
1800	set commandFile "tk_getOpenFile \
1801	-initialdir [list $dirProgramFiles] -f $txtExecFileType"
1802	} else { ;# linux
1803	set commandFile "tk_getOpenFile -initialdir \\"
1804	}
1805
1806	#set ::TolConsole::tmpOpt(var,path$type) [eval $commandFile]
1807	set tmp [eval $commandFile]
1808	if { !($tmp eq "") } {
1809	set ::TolConsole::tmpOpt(var,path$type) $tmp
1810	}
1811	}
1812
1813	#/////////////////////////////////////////////////////////////////////////////
1814	proc ::TolConsole::OptionsCreateOthers {w} {
1815	#
1816	#/////////////////////////////////////////////////////////////////////////////
1817	variable tmpOpt
1818	variable languages
1819
1820	TitleFrame $w.tf1 -text [mc "General Options"]
1821	set f1 [$w.tf1 getframe]
1822
1823	label $f1.lRecent -text [mc "Number of last edited files"]
1824
1825	set tmpOpt(widget,recent) [SpinBox $f1.sbRecent -justify right -width 4 \
1826	-editable 0 -range {0 10} \
1827	-textvariable ::TolConsole::tmpOpt(var,numRecent)]
1828	label $f1.lFiles -text [mc files]
1829
1830	radiobutton $f1.rbOrdDate -text [mc "Order by date"]\
1831	-value date -highlightthickness 0 -pady 0\
1832	-variable ::TolConsole::tmpOpt(var,ordRecent)
1833	radiobutton $f1.rbOrdAsc -text [mc "Order alphabetically"]\
1834	-value asc -highlightthickness 0 -pady 0\
1835	-variable ::TolConsole::tmpOpt(var,ordRecent)
1836	radiobutton $f1.rbOrdDesc -text [mc "Order reverse alphabetically"]\
1837	-value desc -highlightthickness 0 -pady 0\
1838	-variable ::TolConsole::tmpOpt(var,ordRecent)
1839
1840	frame $f1.f -width 25
1841
1842	grid $f1.f $f1.lRecent $f1.sbRecent $f1.lFiles -sticky nw -padx 2
1843	grid ^ $f1.rbOrdDate - - -sticky nw -padx 2
1844	grid ^ $f1.rbOrdAsc - - -sticky nw -padx 2
1845	grid ^ $f1.rbOrdDesc - - -sticky nw -padx 2
1846
1847	grid rowconfigure $f1 0 -weight 1
1848	grid rowconfigure $f1 1 -weight 1
1849
1850	grid rowconfigure $f1 2 -weight 1
1851
1852	grid columnconfigure $f1 3 -weight 1
1853	grid columnconfigure $f1 4 -weight 1
1854
1855	TitleFrame $w.tf2 -text [mc "Language"]
1856	set f2 [$w.tf2 getframe]
1857
1858	label $f2.lLanguage -text [mc "Choose language"]:
1859	foreach {key value} $languages {
1860	lappend values [mc $value]
1861	}
1862
1863	ComboBox $f2.cbLanguages -width 12 -height 5 -editable false -justify right -values $values\
1864	-modifycmd [list ::Objects::ComboUnTranslateDbl $f2.cbLanguages $languages\
1865	::TolConsole::tmpOpt(var,language)]
1866	::Objects::ComboSetIniDbl $f2.cbLanguages $languages ::TolConsole::tmpOpt(var,language)
1867
1868
1869	label $f2.lLangExp -text ([mc "Language is set when you restart interface"])
1870	frame $f2.f -width 25
1871	grid $f2.f $f2.lLanguage $f2.cbLanguages -sticky nw -padx 2
1872	grid ^ $f2.lLangExp - -sticky nw -padx 2
1873	grid rowconfigure $f2 1 -weight 1
1874	grid columnconfigure $f2 2 -weight 1
1875
1876	TitleFrame $w.tf3 -text [mc "Object Inspector"]
1877	set f3 [$w.tf3 getframe]
1878	checkbutton $f3.chObjIns -text [mc "Show Object Inspector"]\
1879	-variable ::TolConsole::tmpOpt(var,chObjIns)
1880
1881	label $f3.lObjIns -text ([mc "Object Inspector visualization is set when you restart interface"])
1882
1883	grid $f3.chObjIns -sticky nw -padx 2
1884	grid $f3.lObjIns -sticky nw -padx 2
1885	grid rowconfigure $f3 1 -weight 1
1886	grid columnconfigure $f3 2 -weight 1
1887
1888
1889	grid $w.tf1 -sticky news -padx 2
1890	grid $w.tf2 -sticky news -padx 2
1891	grid $w.tf3 -sticky news -padx 2
1892
1893	grid rowconfigure $w 0 -weight 1
1894	grid rowconfigure $w 1 -weight 1
1895	grid rowconfigure $w 2 -weight 1
1896	grid columnconfigure $w 0 -weight 1
1897	}
1898
1899	#/////////////////////////////////////////////////////////////////////////////
1900	proc ::TolConsole::OptionsGet {} {
1901	#
1902	#/////////////////////////////////////////////////////////////////////////////
1903	variable data
1904	variable tmpOpt
1905	set tmpOpt(var,numRecent) $data(numRecent)
1906	set tmpOpt(var,ordRecent) $data(ordRecent)
1907	set tmpOpt(var,language) $data(language)
1908	set tmpOpt(var,chDecimals) $data(chDecimals)
1909	set tmpOpt(var,numDecimals) $data(numDecimals)
1910	set tmpOpt(var,chExponential) $data(chExponential)
1911	set tmpOpt(var,numExponential) $data(numExponential)
1912	set tmpOpt(var,DefFirst) $data(DefFirst)
1913	set tmpOpt(var,DefLast) $data(DefLast)
1914	set tmpOpt(var,colorErr) $data(colorErr)
1915	set tmpOpt(var,colorWar) $data(colorWar)
1916	set tmpOpt(var,chWrite) $data(chWrite)
1917	set tmpOpt(var,updateType) $data(updateType)
1918	set tmpOpt(var,updateSec) $data(updateSec)
1919	set tmpOpt(var,showODBC) $data(showODBC)
1920	set tmpOpt(var,pathBrowser) $data(pathBrowser)
1921	set tmpOpt(var,pathPDFViewer) $data(pathPDFViewer)
1922	set tmpOpt(var,pathHelp) $data(pathHelp)
1923	set tmpOpt(var,chObjIns) $data(chObjIns)
1924
1925
1926	}
1927
1928	#/////////////////////////////////////////////////////////////////////////////
1929	proc ::TolConsole::OptionsSet {} {
1930	#
1931	#/////////////////////////////////////////////////////////////////////////////
1932	variable data
1933	variable tmpOpt
1934
1935	regsub -all var, [array names ::TolConsole::tmpOpt var,*] "" optNames
1936
1937	foreach it $optNames {
1938	set data($it) $tmpOpt(var,$it)
1939	}
1940	}
1941
1942	#/////////////////////////////////////////////////////////////////////////////
1943	proc ::TolConsole::OptionsCheck {} {
1944	#
1945	#/////////////////////////////////////////////////////////////////////////////
1946	OptionsCheckUpdateType
1947	OptionsCheckDecimals
1948	OptionsCheckExponential
1949	}
1950
1951	#/////////////////////////////////////////////////////////////////////////////
1952	proc ::TolConsole::OptionsCheckDecimals {} {
1953	#
1954	#/////////////////////////////////////////////////////////////////////////////
1955	variable tmpOpt
1956	if {!$tmpOpt(var,chDecimals)} {
1957	$tmpOpt(widget,decimals) configure -state disabled
1958	} else {
1959	$tmpOpt(widget,decimals) configure -state normal
1960	}
1961	}
1962
1963	#/////////////////////////////////////////////////////////////////////////////
1964	proc ::TolConsole::OptionsCheckExponential {} {
1965	#
1966	#/////////////////////////////////////////////////////////////////////////////
1967	variable tmpOpt
1968	if {!$tmpOpt(var,chExponential)} {
1969	$tmpOpt(widget,exponential) configure -state disabled
1970	} else {
1971	$tmpOpt(widget,exponential) configure -state normal
1972	}
1973	}
1974
1975	#/////////////////////////////////////////////////////////////////////////////
1976	proc ::TolConsole::OptionsCheckUpdateType {} {
1977	#
1978	#/////////////////////////////////////////////////////////////////////////////
1979	variable tmpOpt
1980
1981	switch $tmpOpt(var,updateType) {
1982	always {
1983	$tmpOpt(widget,updateSec) configure -state disabled
1984	}
1985	each {
1986	$tmpOpt(widget,updateSec) configure -state normal
1987	}
1988	never {
1989	$tmpOpt(widget,updateSec) configure -state disabled
1990	}
1991	}
1992	}
1993
1994	#/////////////////////////////////////////////////////////////////////////////
1995	proc ::TolConsole::OptionsDestroy {dialog} {
1996	#
1997	#/////////////////////////////////////////////////////////////////////////////
1998	#variable data
1999	variable tmpOpt
2000
2001	array unset tmpOpt
2002	destroy $dialog
2003	}
2004
2005	#/////////////////////////////////////////////////////////////////////////////
2006	proc ::TolConsole::OptionsApply {} {
2007	#
2008	#/////////////////////////////////////////////////////////////////////////////
2009	variable data
2010	# Apply
2011	OptionsSet
2012	OptionsApplyLanguage
2013	OptionsApplyDefDates
2014	OptionsApplyColors
2015	# Options project Apply
2016	if {[info exists data(proc,OnOptionApply)] && \
2017	[string length $data(proc,OnOptionApply)]} {
2018	foreach f $data(proc,OnOptionApply) {
2019	$f
2020	}
2021	}
2022	# Write INI
2023	WriteIni
2024	}
2025
2026	#/////////////////////////////////////////////////////////////////////////////
2027	proc ::TolConsole::OptionsApplyLanguage {} {
2028	#
2029	#/////////////////////////////////////////////////////////////////////////////
2030	global toltk_script_path
2031	variable data
2032
2033	::tol::language $data(language)
2034	::msgcat::mclocale $data(language)
2035	::msgcat::mcload [file join $toltk_script_path msgs]
2036	}
2037
2038	#/////////////////////////////////////////////////////////////////////////////
2039	proc ::TolConsole::OptionsApplyDefDates {} {
2040	#
2041	#/////////////////////////////////////////////////////////////////////////////
2042	variable data
2043	set expr "Date PutDefaultDates([DateTol $data(DefFirst)],[DateTol $data(DefLast)]);"
2044	#Tolcon_Trace "$expr"
2045	::tol::console eval $expr
2046	}
2047
2048	#/////////////////////////////////////////////////////////////////////////////
2049	proc ::TolConsole::OptionsApplyColors {} {
2050	#
2051	#/////////////////////////////////////////////////////////////////////////////
2052	variable data
2053	variable widgets
2054
2055	$widgets(output) tag configure errorTag -foreground $data(colorErr)
2056	$widgets(output) tag configure warningTag -foreground $data(colorWar)
2057	}
2058
2059	#/////////////////////////////////////////////////////////////////////////////
2060	proc ::TolConsole::OptionsOK {dialog} {
2061	#
2062	#/////////////////////////////////////////////////////////////////////////////
2063	OptionsApply
2064	OptionsDestroy $dialog
2065	}
2066
2067	#/////////////////////////////////////////////////////////////////////////////
2068	proc ::TolConsole::ReadIni {} {
2069	#
2070	# PURPOSE: Reads general TolBase options from .ini file.
2071	#
2072	#/////////////////////////////////////////////////////////////////////////////
2073	global toltk_script_path
2074	global toltk_options
2075	variable data
2076	set rini ::iniFile::Read
2077
2078	#inicializo variable necesaria para las toolbars
2079	set data(tolbase,lsttoolbars) [$rini TolConsole listtoolbars]
2080	if {![llength $data(tolbase,lsttoolbars)]} {
2081	set data(tolbase,lsttoolbars) {}
2082	}
2083
2084	set data(path) [$rini TolConsole path $toltk_script_path]
2085	set data(included) [$rini TolConsole recent {}]
2086	set data(chIncluded) [$rini TolConsole saveRecent 1]
2087	set data(numRecent) [$rini TolConsole numRecent 8]
2088	set data(ordRecent) [$rini TolConsole ordRecent "date"]
2089	set data(tabRecent) [$rini TolConsole tabRecent {}]
2090	set data(prjRecent) [$rini TolConsole prjRecent {}]
2091	set data(incRecent) [$rini TolConsole incRecent {}]
2092	set data(ediRecent) [$rini TolConsole ediRecent {}]
2093	set data(font,eval) [$rini TolConsole evalFont \
2094	$toltk_options(fonts,Fixed)]
2095	set data(font,output) [$rini TolConsole outputFont \
2096	$toltk_options(fonts,Fixed)]
2097	set data(font,info) [$rini TolConsole infoFont \
2098	$toltk_options(fonts,Fixed)]
2099	set data(language) [$rini TolConsole language es]
2100	set data(chDecimals) [$rini TolConsole redDecimals 0]
2101	set data(numDecimals) [$rini TolConsole numDecimals 4]
2102	set data(chExponential) [$rini TolConsole useExponential 0]
2103	set data(numExponential) [$rini TolConsole numExponential 8]
2104	set data(DefFirst) [$rini TolConsole DefFirst [::tol::date first]]
2105	set data(DefLast) [$rini TolConsole DefLast [::tol::date last ]]
2106	set data(colorWar) [$rini TolConsole colorWar blue]
2107	set data(colorErr) [$rini TolConsole colorErr red]
2108	set data(chWrite) [$rini TolConsole writeOutput 1]
2109	set data(updateType) [$rini TolConsole updateType always]
2110	set data(updateSec) [$rini TolConsole updateSec 200]
2111	set data(showODBC) [$rini TolConsole ShowODBCDialog 0]
2112
2113	# program paths
2114	set data(pathBrowser) [$rini TolConsole pathBrowser {}]
2115	set data(pathPDFViewer) [$rini TolConsole pathPDFViewer {}]
2116	set data(pathHelp) [$rini TolConsole pathHelp {}]
2117
2118	# Object Inspector visualization
2119	set data(chObjIns) [$rini TolConsole chObjIns {}]
2120
2121	# geometry
2122
2123	# set data(geometry,x) [$rini TolConsole geometry:x -1]
2124	# set data(geometry,y) [$rini TolConsole geometry:y -1]
2125	# set data(geometry,width) [$rini TolConsole geometry:width -1]
2126	# set data(geometry,height) [$rini TolConsole geometry:height -1]
2127	set data(geometry,wtop) [$rini TolConsole geometry:wtop 5]
2128	set data(geometry,wbottom) [$rini TolConsole geometry:wbottom 1]
2129	set data(geometry,wleft) [$rini TolConsole geometry:wleft 3]
2130	set data(geometry,wright) [$rini TolConsole geometry:wright 7]
2131	set data(viewmode) [$rini TolConsole viewmode middle]
2132
2133	#cargamos los parametros de las toolbars
2134	set data(toolbars,side) [$rini ToolBars side top]
2135	set data(toolbars,fill) [$rini ToolBars fill x]
2136	set data(toolbars,buttonbar,side) [$rini ToolBars buttonbar:side left]
2137	set data(toolbars,buttonbar,fill) [$rini ToolBars buttonbar:fill y]
2138
2139	set data(tolbase,ini) 0
2140	set data(tolbase,original) 0
2141	}
2142
2143	#/////////////////////////////////////////////////////////////////////////////
2144	proc ::TolConsole::WriteIni {} {
2145	#
2146	# PURPOSE: Writes general TolBase options to .ini file.
2147	#
2148	#/////////////////////////////////////////////////////////////////////////////
2149	variable data
2150	variable widgets
2151
2152	set wini ::iniFile::Write
2153	$wini TolConsole path $data(path)
2154	$wini TolConsole recent $data(included)
2155	$wini TolConsole saveRecent $data(chIncluded)
2156	$wini TolConsole numRecent $data(numRecent)
2157	$wini TolConsole ordRecent $data(ordRecent)
2158	$wini TolConsole evalFont $data(font,eval)
2159	$wini TolConsole outputFont $data(font,output)
2160	$wini TolConsole infoFont $data(font,info)
2161	$wini TolConsole language $data(language)
2162	$wini TolConsole redDecimals $data(chDecimals)
2163	$wini TolConsole numDecimals $data(numDecimals)
2164	$wini TolConsole useExponential $data(chExponential)
2165	$wini TolConsole numExponential $data(numExponential)
2166	$wini TolConsole DefFirst $data(DefFirst)
2167	$wini TolConsole DefLast $data(DefLast)
2168	$wini TolConsole colorWar $data(colorWar)
2169	$wini TolConsole colorErr $data(colorErr)
2170	$wini TolConsole writeOutput $data(chWrite)
2171	$wini TolConsole updateType $data(updateType)
2172	$wini TolConsole updateSec $data(updateSec)
2173	$wini TolConsole ShowODBCDialog $data(showODBC)
2174	$wini TolConsole tabRecent $data(tabRecent)
2175	$wini TolConsole prjRecent $data(prjRecent)
2176	$wini TolConsole incRecent $data(incRecent)
2177	$wini TolConsole ediRecent $data(ediRecent)
2178
2179	# program paths
2180	$wini TolConsole pathBrowser $data(pathBrowser)
2181	$wini TolConsole pathPDFViewer $data(pathPDFViewer)
2182	$wini TolConsole pathHelp $data(pathHelp)
2183
2184	# Object Inspector visualization
2185	$wini TolConsole chObjIns $data(chObjIns)
2186
2187	# geometry configuration
2188	# $wini TolConsole geometry:x $data(geometry,x)
2189	# $wini TolConsole geometry:y $data(geometry,y)
2190	# $wini TolConsole geometry:width $data(geometry,width)
2191	# $wini TolConsole geometry:height $data(geometry,height)
2192	$wini TolConsole geometry:wtop $data(geometry,wtop)
2193	$wini TolConsole geometry:wbottom $data(geometry,wbottom)
2194	$wini TolConsole geometry:wleft $data(geometry,wleft)
2195	$wini TolConsole geometry:wright $data(geometry,wright)
2196	$wini TolConsole viewmode $data(viewmode)
2197	#::iniFile::Flush
2198
2199	# escribimos las opciones para las barra de botones
2200	if { [winfo exists ${::project::widgets(mainframe)}.toolbarFrame]} {
2201	set packopts [pack info ${::project::widgets(mainframe)}.toolbarFrame]
2202	array set packoptsarray $packopts
2203	$wini ToolBars side $packoptsarray(-side)
2204	$wini ToolBars fill $packoptsarray(-fill)
2205	#set packopts [pack info ${::project::widgets(mainframe)}.toolbarFrame.tb1]
2206	#array set packoptsarray $packopts
2207	#$wini ToolBars buttonbar:side $packoptsarray(-side)
2208	#$wini ToolBars buttonbar:fill $packoptsarray(-fill)
2209	}
2210
2211	# escribimos las opciones de los documentos abiertos
2212	$::project::widgets(mainmdi) writeDocsIni
2213
2214	# escribilos las barras de botones que tenemos creadas
2215	# clear the bars created by code
2216	if {[info exists widgets(tbCustom,path)]} {
2217	set lsttollbarsaux {}
2218	foreach ltb $data(tolbase,lsttoolbars) {
2219	if {![string eq $widgets(tbCustom,path) [lindex $ltb 0]]} {
2220	lappend lsttollbarsaux $ltb
2221	}
2222	}
2223	$wini TolConsole listtoolbars $lsttollbarsaux
2224	}
2225	}
2226
2227	#/////////////////////////////////////////////////////////////////////////////
2228	proc ::TolConsole::ODBCShow {} {
2229	#
2230	# PURPOSE: Show the connection ODBC dialog
2231	#
2232	#/////////////////////////////////////////////////////////////////////////////
2233	variable data
2234	if {$data(showODBC)} {
2235	set values [::ODBCDialog::ReadIni]
2236	::ODBCDialog::Create $::project::widgets(mainframe) \
2237	[lindex $values 0] [lindex $values 1] "" \
2238	::TolConsole::OnConnect ::TolConsole::OnDisconnect
2239	}
2240	}
2241
2242	#/////////////////////////////////////////////////////////////////////////////
2243	proc ::TolConsole::ObjectInspectorShow {} {
2244	#
2245	# PURPOSE: Show Object inspector
2246	#
2247	#/////////////////////////////////////////////////////////////////////////////
2248	variable data
2249	if {$data(chObjIns) ne "" &&
2250	[string is boolean $data(chObjIns)] && !$data(chObjIns)} {
2251	$::TolConsole::widgets(inspector) withdraw
2252	}
2253	}
2254
2255	#/////////////////////////////////////////////////////////////////////////////
2256	proc ::TolConsole::GetGCFFile {} {
2257	#
2258	# PURPOSE: Obtain the GCFFile file of .ini and showed to message in the
2259	# window output
2260	#
2261	#/////////////////////////////////////////////////////////////////////////////
2262	# GCFFile
2263	set gcfFile [::iniFile::Read SeriesGraph GCFFile {}]
2264	if {[string length $gcfFile]} {
2265	::tol::console eval "Text (GCFFile := \"$gcfFile\");"
2266	::TolConsole::HciWriter "Text GCFFile = \"$gcfFile\"\n"
2267	}
2268	}
2269
2270
2271	#/////////////////////////////////////////////////////////////////////////////
2272	proc ::TolConsole::MenuMDI { } {
2273	#
2274	# PURPOSE: Crea un menu para mdi
2275	#
2276	#/////////////////////////////////////////////////////////////////////////////
2277	#cargo la lista de formularios
2278	set ::toolbar::data(toolbar,tolbase,lstcmd) {}
2279
2280	set md [.mainmenu cget -definition]
2281	set hook $::project::data(menuhook)
2282	set hookhelp $::project::data(menuhookhelp)
2283
2284	set id [$md insert $hook cascade -label [mc &File]]
2285
2286	set cid [$md add $id cascade -label [mc &New] ]
2287	$md add $cid command -label [mc "TOL &file"] \
2288	-command "::Editor::New"
2289	$md add $cid command -label [mc "&Table"] \
2290	-command "::TolConsole::TableNew"
2291	$md add $cid command -label [mc "&Project"] \
2292	-command "::TolProject::New"
2293
2294	set cid [$md add $id cascade -label [mc &Open] ]
2295	$md add $cid command -label [mc "TOL &file"] \
2296	-command "::Editor::Open"
2297	$md add $cid command -label [mc "&Table"] \
2298	-command "::TolConsole::TableOpen"
2299	$md add $cid command -label [mc "&Project"] \
2300	-command "::TolProject::Open"
2301
2302	$md add $id command -label [mc &Include] -command "::TolConsole::IncludeCmd"
2303
2304	$md add $id separator
2305
2306	set cid [$md add $id cascade -label [mc "&Recent files"] ]
2307	$md add $cid cascade -label [mc "TOL &files"] \
2308	-postcommand "::Editor::postEdited %W"
2309	$md add $cid cascade -label [mc "&Tables"] \
2310	-postcommand "::TolConsole::TableRecent %W"
2311	$md add $cid cascade -label [mc "&Projects"] \
2312	-postcommand "::TolProject::postEdited %W"
2313	$md add $cid cascade -label [mc "&Included"] \
2314	-postcommand "::TolConsole::postIncluded %W"
2315
2316	$md add $id separator
2317
2318	#$md add $id command -label [mc E&xit] -command "::project::Exit"
2319	#$md add $id command -label [mc E&xit] -command "::TolConsole::Exit"
2320	$md add $id command -label [mc E&xit] -command "::project::OnDelete"
2321
2322
2323	set id [$md insert $hook cascade -label [mc &Tools]]
2324	set ::project::data(menu,tools) $id
2325
2326	set cid [$md add $id cascade -label [mc "TOL &Editor"]]
2327	$md add $cid cascade -label [mc "&Recent files"] \
2328	-postcommand "::Editor::postEdited %W"
2329	$md add $cid command -label [mc "&New TOL file"] \
2330	-command "::Editor::New"
2331	$md add $cid command -label [mc "&Open TOL file"] \
2332	-command "::Editor::Open"
2333
2334	set cid [$md add $id cascade -label [mc "TOL &Table Editor"]]
2335	$md add $cid cascade -label [mc "&Recent files"] \
2336	-postcommand "::TolConsole::TableRecent %W"
2337	$md add $cid command -label [mc "&New Table"] \
2338	-command "::TolConsole::TableNew"
2339	$md add $cid command -label [mc "&Open Table"] \
2340	-command "::TolConsole::TableOpen"
2341
2342	set cid [$md add $id cascade -label [mc "TOL &Project Editor"]]
2343	$md add $cid cascade -label [mc "&Recent files"] \
2344	-postcommand "::TolProject::postEdited %W"
2345	$md add $cid command -label [mc "&New Project"] \
2346	-command "::TolProject::New"
2347	$md add $cid command -label [mc "&Open Project"] \
2348	-command "::TolProject::Open"
2349
2350	$md add $id separator
2351	$md add $id command -label "[mc {Manage Packages}]..." \
2352	-command ::TolPkgGUI::Show
2353	set cid [$md add $id cascade -label [mc "Analysis Tools"]]
2354	set cid2 [$md add $cid cascade -label [mc "ARIMA"]]
2355	$md add $cid2 command -label [mc "Draw ACF and PACF of ARIMA Models"] \
2356	-command "::drawArima::Show"
2357	$md add $id separator
2358
2359	$md add $id command -label [mc "TOL Inspector"] \
2360	-command "$::project::widgets(mainmdi).slave1 restore; $::project::widgets(mainmdi).slave1 raise"
2361	$md add $id command -label [mc "&Functions Search"] \
2362	-command "::funcSearch::Show"
2363	$md add $id command -label [mc "&Calendar Expert"] \
2364	-command "::CalendarTms::ViewTimeSet"
2365	$md add $id command -label [mc "&Bayes SQL"] \
2366	-command "::SQLTable::TableBayesSQL"
2367
2368	$md add $id separator
2369
2370	$md add $id command -label [mc "C&onnection to database"] \
2371	-command "$::project::data(bodbc) showdialog"
2372
2373	$md add $id command -label [mc "&Options"] \
2374	-command "::TolConsole::OptionsCreate"
2375
2376	return $md
2377	}
2378
2379	#/////////////////////////////////////////////////////////////////////////////
2380	proc ::TolConsole::TableNew { } {
2381	#
2382	# PURPOSE: Creates a new table
2383	#
2384	#/////////////////////////////////////////////////////////////////////////////
2385	set tl [::project::CreateForm -type Tables \
2386	-width 400 -height 180 \
2387	-iniconfig Tables -helpkey "Tb4Edt"]
2388	set tlf [$tl getframe]
2389	# configuration
2390	btable $tlf.t -parent $tl \
2391	-posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
2392	-iniconfig btable
2393	pack $tlf.t -fill both -expand yes
2394	$tl bind <Control-F4> [list $tl kill]
2395	#pedro
2396
2397	}
2398
2399	#/////////////////////////////////////////////////////////////////////////////
2400	proc ::TolConsole::TableOpen { {path ""} } {
2401	#
2402	# PURPOSE: Opens a table
2403	# PARAMETERS:
2404	# path -> path of the file to be opened, if no file is given an Openfile
2405	# dialogs is shown
2406	#
2407	#/////////////////////////////////////////////////////////////////////////////
2408	set tl [::project::CreateForm -type Tables \
2409	-width 400 -height 180 \
2410	-iniconfig Tables -helpkey "Tb4Edt"]
2411	set tlf [$tl getframe]
2412	$tl configure -state withdrawn
2413	# configuration
2414	btable $tlf.t -parent $tl \
2415	-posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
2416	-iniconfig btable
2417	if { $path == "" } {
2418	$tlf.t cmdOpen
2419	$tl configure -state normal
2420	if { [$tlf.t cget -path] == "" } {
2421	$tl kill
2422	} else {
2423	pack $tlf.t -fill both -expand yes
2424	$tl bind <Control-F4> [list $tl kill]
2425	}
2426	} else {
2427	$tlf.t configure -path $path
2428	$tl configure -state normal
2429	pack $tlf.t -fill both -expand yes
2430	$tl bind <Control-F4> [list $tl kill]
2431	}
2432	}
2433
2434	#/////////////////////////////////////////////////////////////////////////////
2435	proc ::TolConsole::TableRecentUpdate { w args } {
2436	#
2437	# PURPOSE: Updates the last edited files when a table is closed
2438	#
2439	# PARAMETERS:
2440	# m -> menu's path that will have the list of last table edited files
2441	# ord -> flag that indicates if files must be shown sorted
2442	#
2443	#/////////////////////////////////////////////////////////////////////////////
2444	variable data
2445
2446	set newfile [$w cget -path]
2447	set pos [lsearch $data(tabRecent) $newfile]
2448
2449	if { $pos == -1 } {
2450	set data(tabRecent) [linsert $data(tabRecent) 0 $newfile]
2451	} else {
2452	set data(tabRecent) [lreplace $data(tabRecent) $pos $pos]
2453	set data(tabRecent) [linsert $data(tabRecent) 0 $newfile]
2454	}
2455	if { $data(numRecent) <= [llength $data(tabRecent)] } {
2456	set data(tabRecent) [lreplace $data(tabRecent) $data(numRecent) end]
2457	}
2458	}
2459
2460	#/////////////////////////////////////////////////////////////////////////////
2461	proc ::TolConsole::TableRecent { m } {
2462	#
2463	# PURPOSE: Fills a menu with the last table edited files, according to the
2464	# information of 'options' variable.
2465	#
2466	# PARAMETERS:
2467	# m -> menu's path that will have the list of last table edited files
2468	# ord -> flag that indicates if files must be shown sorted
2469	#
2470	#/////////////////////////////////////////////////////////////////////////////
2471	variable data
2472
2473	set data(tabRecent) [lrange $data(tabRecent) 0 [expr $data(numRecent)-1]]
2474
2475	$m delete 0 end
2476	if { $data(ordRecent) == "asc" } {
2477	set lst [lsort -ascii $data(tabRecent)]
2478	} elseif { $data(ordRecent) == "desc" } {
2479	set lst [lsort -ascii -decreasing $data(tabRecent)]
2480	} else {
2481	set lst $data(tabRecent)
2482	}
2483	foreach w $lst {
2484	$m add command -label $w -command [list ::TolConsole::TableOpen $w]
2485	}
2486	if [llength $lst] {
2487	$m add separator
2488	$m add command -label [mc "Clear"]\
2489	-command [list ::TolConsole::TableRecentClear]
2490	}
2491	}
2492
2493	#/////////////////////////////////////////////////////////////////////////////
2494	proc ::TolConsole::TableRecentClear { } {
2495	#
2496	# PURPOSE: Clears the list of last edited files
2497	#
2498	#/////////////////////////////////////////////////////////////////////////////
2499	variable data
2500	set data(tabRecent) ""
2501	}

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

Context Navigation

source: tol/tolbase/lib/toltk/tolbase.tcl @ 1efd6f9

Download in other formats: