Context Navigation

tolbase.tcl @ 09d414b

1941-docker-image-to-testdevel

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

fixes #1168, ctrl-i control-u se habilitan en la la ventana eval, también se corrige un error en el término ident, debe ser indent.

git-svn-id: https://www.tol-project.org/svn/tolp/trunk@4131 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
560	if { $grammar eq "Anything" } {
561	if { [ regexp {/+\sClass\s} $content ] } {
562	ActivateInfoWidget "text"
563	$widgets(tabset,info) setwidget $widgets(info,hltext)
564	$widgets(info,hltext) insert end $content
565	$widgets(info,hltext) configure -state disabled
566	return
567	}
568	}
569	MarkupHelper::Init
570	set fmtInfo [ MarkupHelper::BuildTolbaseInfo \
571	$icon $grammar $name $content $path $desc -objref $objRef ]
572	$data(notebookdb) set "info" $fmtInfo
573
574	$widgets(info,markupviewer) showpage "info"
575	ActivateInfoWidget "markup"
576	}
577	}
578	}
579
580	#/////////////////////////////////////////////////////////////////////////////
581	proc ::TolConsole::Include {file} {
582	#
583	#/////////////////////////////////////////////////////////////////////////////
584	#::LoadStatus::Show $file
585
586	::TolInspector::Busy
587	update
588	::tol::include $file
589	::TolInspector::UpdateFileRoot
590	::TolInspector::NotBusy
591	#::LoadStatus::Hide
592	}
593
594
595	#/////////////////////////////////////////////////////////////////////////////
596	proc ::TolConsole::Compile { } {
597	#
598	# PURPOSE: Compiles text of eval window. If any text is selected, then only
599	# selection is compiled, else all text is compiled.
600	#
601	#/////////////////////////////////////////////////////////////////////////////
602	variable widgets
603	set w_eval $widgets(eval)
604
605	set tolexpr [::BayesText::GetSelectionOrAll $w_eval]
606	EvalExpr $tolexpr
607	}
608
609	#/////////////////////////////////////////////////////////////////////////////
610	proc ::TolConsole::EvalExpr {tolexpr} {
611	#
612	# PURPOSE: Compiles a TOL expresion in TOL console
613	#
614	#/////////////////////////////////////////////////////////////////////////////
615	::TolInspector::Busy
616	Tolcon_Trace "tolexpr = $tolexpr"
617	if { [string length $tolexpr] } {
618	::tol::console eval $tolexpr
619	SaveEval $tolexpr
620	}
621	::TolInspector::UpdateConsoleObj
622	::TolInspector::NotBusy
623	}
624
625	#/////////////////////////////////////////////////////////////////////////////
626	proc ::TolConsole::SaveEval {txt} {
627	#
628	#/////////////////////////////////////////////////////////////////////////////
629	global home_path
630	set evalFile [file join $home_path "eval.tol"]
631
632	set texto ""
633	if { [file exists $evalFile] } {
634	set fd [open $evalFile r]
635	set texto [read -nonewline $fd]
636	close $fd
637	}
638	set fd [open $evalFile w]
639	set txt "// [::tol::date now {%W, %Y/%m/%d %h:%i:%s}]\n$txt\n\n"
640	puts -nonewline $fd $txt
641	puts -nonewline $fd $texto
642	close $fd
643	}
644
645	#/////////////////////////////////////////////////////////////////////////////
646	proc ::TolConsole::OpenEval {} {
647	#
648	#/////////////////////////////////////////////////////////////////////////////
649	global home_path
650	set evalFile [file join $home_path "eval.tol"]
651	if { ![file exists $evalFile] } {
652	set fd [open $evalFile w]
653	close $fd
654	}
655	::Editor::Open $evalFile
656	}
657
658	#/////////////////////////////////////////////////////////////////////////////
659	proc ::TolConsole::OnConnect {alias user pass datasource} {
660	#
661	#/////////////////////////////////////////////////////////////////////////////
662	set name [GetUniqueName Real]
663	::tol::console eval "Real $name = DBOpen(\"$alias\",\"$user\",\"$pass\");"
664	::tol::console stack release $name
665	}
666
667	#/////////////////////////////////////////////////////////////////////////////
668	proc ::TolConsole::OnDisconnect {alias user pass datasource} {
669	#
670	#/////////////////////////////////////////////////////////////////////////////
671	set name [GetUniqueName Real]
672	::tol::console eval "Real $name = DBClose(\"$alias\");"
673	::tol::console stack release $name
674	}
675
676	#/////////////////////////////////////////////////////////////////////////////
677	proc ::TolConsole::DBConnect {} {
678	#
679	#/////////////////////////////////////////////////////////////////////////////
680	::ODBCDialog::Create $::project::widgets(mainframe) "" "" "" \
681	::TolConsole::OnConnect ::TolConsole::OnDisconnect
682	}
683
684	#/////////////////////////////////////////////////////////////////////////////
685	proc ::TolConsole::ClearConsole { } {
686	#
687	#/////////////////////////////////////////////////////////////////////////////
688	::TolInspector::ClearConsoleObj
689	::TolInspector::UpdateConsoleObj
690	}
691
692	#/////////////////////////////////////////////////////////////////////////////
693	proc ::TolConsole::OnBusy { state } {
694	#
695	#/////////////////////////////////////////////////////////////////////////////
696	variable widgets
697
698	if { $state } {
699	$widgets(eval) configure -cursor watch
700	$widgets(tabset) configure -cursor watch
701	# ::blt::busy hold .
702	} else {
703	$widgets(eval) configure -cursor xterm
704	$widgets(tabset) configure -cursor ""
705	# ::blt::busy release .
706	}
707	}
708
709
710	#/////////////////////////////////////////////////////////////////////////////
711	proc ::TolConsole::ToEvalWindow { message } {
712	#
713	# PURPOSE: Writes a message in eval window and selects this tab (eval window)
714	#
715	# PARAMETERS:
716	# message -> Message to write in eval window
717	#
718	#/////////////////////////////////////////////////////////////////////////////
719	upvar \#0 ::TolConsole::widgets(tabset) w_tabset
720	upvar \#0 ::TolConsole::widgets(eval) w_eval
721
722	$w_eval insert end "$message\n"
723	$w_tabset select 0
724	$w_eval see end
725	}
726
727	#/////////////////////////////////////////////////////////////////////////////
728	proc ::TolConsole::HciWriter { message } {
729	#
730	#/////////////////////////////////////////////////////////////////////////////
731	variable widgets
732	variable data
733	variable time
734
735	upvar \#0 ::TolConsole::widgets(tabset) w_tabset
736	upvar \#0 ::TolConsole::widgets(output) w_output
737	if $data(chWrite) {
738	$w_output configure -state normal
739	set tr_message [string trim $message]
740	# {<([^>]+)>([^<]+)</([^>]+)>}
741	if { [regexp -- {^<([^>]+)>(.+)</(.+)>} $tr_message -> start content end] } {
742	if {($start ne $end) \|\| (($start ne "E") && ($start ne "W"))} {
743	$w_output insert end "$message"
744	} else {
745	set idx_start [$w_output index "end -1 char"]
746	$w_output insert end "$content\n"
747	set idx_end [$w_output index "end -1 char"]
748	$w_output tag add $data(output,TAG,$start) $idx_start $idx_end
749	}
750	} else {
751	$w_output insert end "$message"
752	}
753	$w_output configure -state disabled
754	}
755
756	switch $data(updateType) {
757	always {
758	if $data(chWrite) {
759	$w_tabset select 1
760	$w_output see end
761	}
762	update
763	}
764	each {
765	set time_now [clock clicks -milliseconds]
766	set dif [expr $time_now - $time]
767	if { $dif >= $data(updateSec) } {
768	set time $time_now
769	if $data(chWrite) {
770	$w_tabset select 1
771	$w_output see end
772	}
773	update
774	}
775	}
776	never { }
777	}
778	}
779
780	#/////////////////////////////////////////////////////////////////////////////
781	proc ::Tol_HciWriter { message } {
782	#
783	#/////////////////////////////////////////////////////////////////////////////
784	::TolConsole::HciWriter $message
785	}
786
787	#/////////////////////////////////////////////////////////////////////////////
788	proc ::TolConsole::Recover {editor} {
789	#
790	#/////////////////////////////////////////////////////////////////////////////
791	set state [$editor cget -state]
792	$editor configure -state normal
793	$editor delete 1.0 end
794
795	set cmd "Text $nRes = PutDumpFile(\"\");"
796	::tol::console eval $cmd
797	array set inf [TclInfoVar Text $nRes]
798	eval "set file $inf(CONTENT)"
799	::tol::console stack release $nRes
800
801	if { ![catch {set fd [open $file r] } msgerr] } {
802	$editor insert 1.0 [read -nonewline $fd]
803	#HciWriter [read -nonewline $fd]
804	close $fd
805	}
806	tk::TextSetCursor $editor end
807	$editor configure -state $state
808	}
809
810	#/////////////////////////////////////////////////////////////////////////////
811	proc ::TolConsole::MainFrame { w {tolcon 1} } {
812	#
813	#/////////////////////////////////////////////////////////////////////////////
814	variable widgets
815	variable data
816
817	#bind ::project::widgets(mainframe) <Destroy> +[list ::TolConsole::Exit]
818	bind . <Destroy> +[list ::TolConsole::Exit %W]
819
820	# Aqui deberiamos llamar a la inicializacion tcl del proyecto.
821	# solo si el proyecto ha puesto menus poner el de tolcon.
822	project::OnExit ::TolConsole::BeforeExit
823
824	#Creamos StatusBar antes de ButtonBar
825	set sb [::TolConsole::CreateStatusBar]
826	#Creamos ButtonBar
827	set bb [::TolConsole::CreateButtonBar $tolcon]
828	#Empacamos ButtonBar
829	#if { [lsearch {left right} $data(toolbars,side)] ne -1 } {
830	# ::toolbar::SetOrientation $bb V
831	#}
832	if { $tolcon } {
833	#Creamos inspector+Ventanas
834	set widgets(inspector) [Create $w]
835	bind $widgets(inspector) <F6> "::TolConsole::ApplyViewMode ; break"
836	Tolcon_Trace "widgets(inspector): $widgets(inspector)"
837	} else {
838	# ::TolConsole::OptionsApplyDefDates
839	}
840
841	# VISUALIZAMOS O NO EL INSPECTOR DE OBJETOS
842	::TolConsole::ObjectInspectorShow
843
844	project::raiseSplash
845	return $w
846	}
847
848
849	#/////////////////////////////////////////////////////////////////////////////
850	proc ::TolConsole::RaiseInspector {} {
851	#/////////////////////////////////////////////////////////////////////////////
852	$::project::widgets(mainmdi).slave1 restore
853	$::project::widgets(mainmdi).slave1 raise
854	}
855
856
857	#pedro-start
858	#/////////////////////////////////////////////////////////////////////////////
859	proc ::TolConsole::NewToolFrame { name { first 1 }} {
860	# Crea una nueva ToolFrame para Toolbars
861	#/////////////////////////////////////////////////////////////////////////////
862	variable widgets
863	variable data
864
865	switch $first {
866	1 {
867	set commandAux "toolbarFrame_${name}"
868	set newTFname $commandAux
869	}
870	2 {
871	set commandAux $name
872	set newTFname $name
873	}
874	default {
875	set newTFname "toolbarFrame_${name}"
876	set commandAux $::project::widgets(mainframe).${newTFname}
877	}
878	}
879	# create a toolframe new
880	Tolcon_Trace "ToolFrame sale-----> $commandAux"
881	set TF [::toolbar::ToolbarFrame $commandAux]
882	#Añadimos como objetivo de Drop (tkdnd)
883	dnd bindtarget $TF text/plain <Drop> "::TolConsole::TMotion %W %D $newTFname"
884	#empacamos
885	#pack $TF -side top -fill y
886	pack $TF -side $data(toolbars,side) \
887	-before $::project::widgets(mainmdi) \
888	-anchor nw -fill $data(toolbars,fill)
889	#añadimos Botones por defecto
890	#if { $first } {
891	#::TolConsole::NewToolBarB $TF $name
892	#}
893	switch $first {
894	1 {
895	::TolConsole::NewToolBarB $commandAux $name
896	}
897	2 {
898	#
899	}
900	default {
901	::TolConsole::NewToolBarB $TF $name
902	}
903	}
904	return $TF
905	}
906
907
908	#/////////////////////////////////////////////////////////////////////////////
909	proc ::TolConsole::NewToolBarB { parentTF name { jump 0 } {Child 0} {ini 0}} {
910	# Crea una nueva toolbar para botones dentro del frame parentTF
911	# parentTF : Frame papa
912	# jump : Opcion utilizada en caso de adopcion. (cambio de frame padre).
913	# loopyPath: Contiene los parametros de creacion de TODOS los botones
914	# de un toolbar, se recorre cuando jump es 1.
915	#/////////////////////////////////////////////////////////////////////////////
916	variable widgets
917	variable data
918
919	switch $ini {
920	1 {
921	set data(tolbase,original) 0
922	set newName $name
923	set largo [string length $newName]
924	set newName [string range $newName 0 [expr $largo - 2]]
925	set newTb [::toolbar::create "$parentTF.$newName"]
926	}
927	2 {
928	set newName [lindex [split $Child .] 3]
929	set largo [string length $newName]
930	set newName [string range $newName 0 [expr $largo - 1]]
931	if {[winfo exists $parentTF.$newName]} {
932	set data(tolbase,original) 1
933	} else {
934	set data(tolbase,original) 0
935	set newTb [::toolbar::create "$parentTF.$newName"]
936	}
937	}
938	default {
939	set data(tolbase,original) 0
940	set newName "tb_${name}"
941	set newTb [::toolbar::create "$parentTF.$newName"]
942	}
943	}
944
945	#if { $ini } {
946	# set newName $name
947	# Tolcon_Trace "newName -> $newName"
948	# set largo [string length $newName]
949	# set newName [string range $newName 0 [expr $largo - 2]]
950	# set newTb [::toolbar::create "$parentTF.$newName"]
951	#} else {
952	# set newName "tb_${name}"
953	# Tolcon_Trace "newName -> $newName"
954	# set newTb [::toolbar::create "$parentTF.$newName"]
955	#}
956
957	if { $jump } {
958	set test "\{"
959	foreach path $widgets(createScript,$Child) {
960	set Apic [lindex $path 1]
961	set Ahelp [lindex $path 2]
962	set Acmd [lindex $path 3]
963	if { [string index $Acmd 0] == $test } {
964	set largo [string length $Acmd]
965	set newCmd [string range $Acmd 1 [expr $largo - 2]]
966	} else {
967	set newCmd $Acmd
968	}
969	#creamos botones exactamente iguales y en el mismo orden sobre nuevo
970	#parent
971	if {$data(tolbase,original) == 0} {
972	::TolConsole::NewButtonB $newTb $Apic $Ahelp $newCmd $parentTF
973	}
974
975	}
976	Tolcon_Trace "/n COMPLETE DUMP ---> $widgets(createScript,$Child)"
977	}
978
979
980	#empacamos
981	if {$data(tolbase,original)} {
982	dnd bindsource $parentTF.$newName text/plain "return $parentTF.$newName"
983	pack $parentTF.$newName -side left -anchor w \
984	-fill x
985	return $parentTF.$newName
986	} else {
987	#Drag-n-Drop para mover a diferentes toolframes
988	dnd bindsource $newTb text/plain "return $newTb"
989	pack $newTb -side left -anchor w \
990	-fill x -in $parentTF
991	return $newTb
992	}
993	}
994
995
996	#/////////////////////////////////////////////////////////////////////////////
997	proc ::TolConsole::NewButtonB { Tb pic help cmd parentTF} {
998	# --- Crea un nuevo boton en la toolbar parametro ---
999	#
1000	# pathToolbar : Ruta completa al toolbar padre que tendra el boton
1001	# pic : Imagen del Boton
1002	# prueba : Introducir boton de prueba (llevar a 0 para no empacar
1003	# dos botones por llamada.
1004	# help : Ayuda del Boton Custom
1005	# cmd :comando a ejecutar por el boton
1006	#/////////////////////////////////////////////////////////////////////////////
1007	variable widgets
1008	variable data
1009
1010	# imagen ?
1011	if { $pic == "" } {
1012	set pic index
1013	}
1014	# exists imagen ?
1015	if {[catch {::Bitmap::get $pic}]} {
1016	# no exists
1017	Tolcon_Trace "La imagen asociada al comando no existe. \
1018	No se mostrara el botón: imagen: $pic - comando: $help"
1019	} else {
1020	# exists
1021	set but [::toolbar::addbutton $Tb -image [::Bitmap::get $pic] \
1022	-tooltip [mc $help] -command $cmd]
1023	#event add <<TMotion_1>> <Button1-Motion>
1024	bind $but <<TMotion_1>> "dnd drag $Tb"
1025	bind $but <ButtonPress-2> "::toolbar::ButtonMenu"
1026	dnd bindsource $Tb text/plain "return $Tb"
1027	#guardamos parametros del create del boton, si es el primer boton,
1028	#iniciamos la matriz.
1029	if { [info exists widgets(createScript,$Tb)] } {
1030	lappend widgets(createScript,$Tb) "$Tb $pic [list $help] [list $cmd] $parentTF"
1031	} else {
1032	set widgets(createScript,$Tb) "{$Tb $pic [list $help] [list $cmd] $parentTF}"
1033	}
1034	if { ![regexp "$Tb $pic [list $help] [list $cmd] $parentTF" "$data(tolbase,lsttoolbars)" ] } {
1035	lappend data(tolbase,lsttoolbars) "$Tb $pic [list $help] [list $cmd] $parentTF"
1036	}
1037	}
1038	return
1039	}
1040
1041
1042	#/////////////////////////////////////////////////////////////////////////////
1043	proc ::TolConsole::TMotion { targetTF newChild name} {
1044	# Mueve Toolbar de un Frame a otro cuando ocurre un DND
1045	#/////////////////////////////////////////////////////////////////////////////
1046	variable widgets
1047	variable data
1048	set test [winfo parent $newChild]
1049
1050	if { $targetTF != $test } {
1051	pack forget $newChild
1052
1053	set data(tolbase,lsttoolbars) \
1054	[lsub $data(tolbase,lsttoolbars) $widgets(createScript,$newChild)]
1055
1056	if {$data(tolbase,ini)} {
1057	::TolConsole::NewToolBarB $targetTF $name 1 $newChild 2
1058	} else {
1059	::TolConsole::NewToolBarB $targetTF $name 1 $newChild 2
1060	}
1061	} else {
1062	pack $newChild -in $targetTF -side left -anchor w \
1063	-fill x
1064	}
1065	return
1066	}
1067
1068
1069	#/////////////////////////////////////////////////////////////////////////////
1070	proc ::TolConsole::CreateButtonBar { {tolcon 1} } {
1071	#
1072	#/////////////////////////////////////////////////////////////////////////////
1073	variable widgets
1074	variable data
1075
1076	set TF {}
1077	if {![llength $data(tolbase,lsttoolbars)]} {
1078	#Creamos ToolFrame Principal para botones por defecto.
1079	set TF [set widgets(toolbar,main) [::TolConsole::NewToolFrame 0 0]]
1080
1081	# 2) Separamos Botones en diferentes Toolframes
1082	#Grupo Botones Inspector
1083	set tb1 [::TolConsole::NewToolBarB $TF "tb1"]
1084	#Show Inspector Window
1085	::TolConsole::NewButtonB $tb1 insobj [mc "TOL Inspector"] \
1086	"$::project::widgets(mainmdi).slave1 restore; $::project::widgets(mainmdi).slave1 raise" $TF
1087	#Show Eval Window
1088	::TolConsole::NewButtonB $tb1 evalwin [mc "Show Eval Window"] \
1089	[list ::TolConsole::ShowWindow "eval"] $TF
1090	#Show Output Window
1091	::TolConsole::NewButtonB $tb1 outputwin [mc "Show Output Window"] \
1092	[list ::TolConsole::ShowWindow "output"] $TF
1093	#Show Info
1094	::TolConsole::NewButtonB $tb1 infowin [mc "Show Info Window"] \
1095	[list ::TolConsole::ShowWindow info] $TF
1096	#Show ViewMode
1097	::TolConsole::NewButtonB $tb1 changeview [mc "Change View Mode"] \
1098	[list ::TolConsole::ApplyViewMode] $TF
1099
1100	#Grupo Botones para Mostrar Acciones
1101	set tbExe [::TolConsole::NewToolBarB $TF "tbExe"]
1102	#New Editor Dialog
1103	::TolConsole::NewButtonB $tbExe newfile [mc "New TOL file"] \
1104	[list ::Editor::New] $TF
1105	#Open TOL File
1106	::TolConsole::NewButtonB $tbExe openfile [mc "Open TOL file"] \
1107	[list ::Editor::Open] $TF
1108	#New Table Dialog
1109	::TolConsole::NewButtonB $tbExe newtable [mc "New Table"] \
1110	[list ::TolConsole::TableNew] $TF
1111	#Open Table Dialog
1112	::TolConsole::NewButtonB $tbExe opentable [mc "Open Table"] \
1113	[list ::TolConsole::TableOpen] $TF
1114
1115	#New Project
1116	::TolConsole::NewButtonB $tbExe newproject [mc "New Project"] \
1117	[list ::TolProject::New] $TF
1118	#Open Project
1119	::TolConsole::NewButtonB $tbExe openprj [mc "Open Project"] \
1120	[list ::TolProject::Open] $TF
1121
1122	#Grupo Botones para Herramientas
1123	set tbTool [::TolConsole::NewToolBarB $TF "tbTool"]
1124	#DB Connection
1125	::TolConsole::NewButtonB $tbTool db [mc "Connection to database"] \
1126	[list $::project::data(bodbc) showdialog] $TF
1127	#Function Search
1128	::TolConsole::NewButtonB $tbTool funsearch [mc "Functions Search"] \
1129	[list ::funcSearch::Show] $TF
1130	#SQL
1131	::TolConsole::NewButtonB $tbTool bysSql [mc "Bayes SQL"] \
1132	[list ::SQLTable::TableBayesSQL] $TF
1133	#Calendar
1134	::TolConsole::NewButtonB $tbTool TimeSet [mc "Calendar Expert"] \
1135	[list ::CalendarTms::ViewTimeSet] $TF
1136	#Calendar
1137	::TolConsole::NewButtonB $tbTool tools [mc Options] \
1138	[list ::TolConsole::OptionsCreate] $TF
1139
1140	#Grupo Botones para Distribucion de Ventanas y Ayuda Visual
1141	set tbHelp [::TolConsole::NewToolBarB $TF "tbHelp"]
1142	#Cascade
1143	::TolConsole::NewButtonB $tbHelp cascade [mc "Cascade"] \
1144	[list $::project::widgets(mainmdi) arrange cascade] $TF
1145	#Horizontal
1146	::TolConsole::NewButtonB $tbHelp tilehor [mc "Tile Horizontal"] \
1147	[list $::project::widgets(mainmdi) arrange hor] $TF
1148	#Vertical
1149	::TolConsole::NewButtonB $tbHelp tilever [mc "Tile Vertical"] \
1150	[list $::project::widgets(mainmdi) arrange ver] $TF
1151	#About
1152	::TolConsole::NewButtonB $tbHelp about [mc "About"] \
1153	[list ::TolConsole::AboutShow] $TF
1154	set widgets(tb1,path) $tb1
1155	set widgets(tbExe,path) $tbExe
1156	set widgets(tbTool,path) $tbTool
1157	set widgets(tbHelp,path) $tbHelp
1158	set widgets(toolbar,frame) $TF
1159	} else {
1160	#aqui creamos las barras de botones que hemos recuperado del INI
1161	set tfgitb [::TolConsole::GlobalIniToolbarsButtons]
1162	set TF [set widgets(toolbar,main) [lindex $tfgitb 0]]
1163	}
1164	# toolbar by default, in order to add bellboys from the outside
1165	if {![string length $TF]} {
1166	# if not exists, create new
1167	set TF [::TolConsole::NewToolFrame 0 0]
1168	}
1169	set widgets(tbCustom,path) [::TolConsole::NewToolBarB $TF "tbCustom"]
1170	return
1171	}
1172
1173
1174	#/////////////////////////////////////////////////////////////////////////////
1175	proc ::TolConsole::GlobalIniToolbarsButtons {} {
1176	#
1177	#/////////////////////////////////////////////////////////////////////////////
1178	variable widgets
1179	variable data
1180
1181	set data(tolbase,ini) 1
1182	set lstToolFrames {}
1183	set lstFrames {}
1184	set lstFrameBut {}
1185	set i 1
1186	foreach item $data(tolbase,lsttoolbars) {
1187	lappend lstFrameBut $item
1188	lappend lstToolFrames [lindex $item 4]
1189	lappend lstFrames [list [lindex $item 0] [lindex $item 4]]
1190	incr i
1191	}
1192	set lstFrames [lsort -unique $lstFrames]
1193	set lstFrameBut [lsort -unique $lstFrameBut]
1194	set lstToolFramesAux {}
1195	foreach it $lstToolFrames {
1196	puts $it
1197	if {!([lsearch -exact $lstToolFramesAux $it ] >= 0)} {
1198	lappend lstToolFramesAux $it
1199	}
1200	}
1201	set tfaux {}
1202	foreach toolFrame $lstToolFramesAux {
1203	set tfaux [::TolConsole::NewToolFrame "$toolFrame" 2]
1204	}
1205	set lstFramesAux {}
1206	foreach it $lstFrames {
1207	puts $it
1208	if {!([lsearch -exact $lstFramesAux $it ] >= 0)} {
1209	lappend lstFramesAux $it
1210	}
1211	}
1212	foreach toolBar $lstFrames {
1213	::TolConsole::NewToolBarB [lindex $toolBar 1] [lindex [split $toolBar .] 3] 0 0 1
1214	}
1215	foreach but $lstFrameBut {
1216	::TolConsole::NewButtonB [lindex $but 0] [lindex $but 1] \
1217	[lindex $but 2] [lindex $but 3] [lindex $but 4]
1218	}
1219	return $tfaux
1220	}
1221
1222
1223	#/////////////////////////////////////////////////////////////////////////////
1224	proc ::TolConsole::CreateStatusBar {} {
1225	#
1226	#/////////////////////////////////////////////////////////////////////////////
1227	variable widgets
1228
1229	set widgets(sb,path) [statusbar .sbar]
1230	.sbar add statTime -image [::Bitmap::get tinyclock]
1231	::TolConsole::UpdateTime
1232	if {0} {
1233	variable widgets
1234	# frame y label para barra de estado
1235	set widgets(sb,path) [set sf [frame $w.sb]]
1236	set widgets(sb,lInfo) [label $sf.info -anchor w -relief sunken]
1237	set widgets(sb,lTime) [label $sf.cursor -anchor w -relief sunken]
1238	# empaquetamos los label de la barra de estado
1239	grid $w.sb.info -row 0 -column 0 -sticky ew -padx 2
1240	grid $w.sb.cursor -row 0 -column 1 -sticky w -padx 2
1241	grid columnconfigure $sf 0 -weight 1
1242	UpdateTime
1243	return $w.sb
1244	}
1245	}
1246
1247	#/////////////////////////////////////////////////////////////////////////////
1248	proc ::TolConsole::UpdateTime {} {
1249	#
1250	# PURPOSE: Updates time in status bar
1251	#
1252	#/////////////////////////////////////////////////////////////////////////////
1253	variable widgets
1254	$widgets(sb,path) itemconf statTime \
1255	-text [clock format [clock seconds] -format {%H:%M:%S }]
1256	after 1000 ::TolConsole::UpdateTime
1257	if {0} {
1258	variable widgets
1259	$widgets(sb,lTime) configure\
1260	-text [clock format [clock seconds] -format {%H:%M:%S }]
1261	after 1000 ::TolConsole::UpdateTime
1262	}
1263	}
1264
1265
1266	#/////////////////////////////////////////////////////////////////////////////
1267	proc ::TolConsole::ApplyViewMode {{change 1}} {
1268	#
1269	# PURPOSE: Changes heights of inspector and eval/output/info windows
1270	#
1271	#/////////////////////////////////////////////////////////////////////////////
1272	variable data
1273	variable widgets
1274
1275	set state $data(viewmode)
1276	set states [list middle max min middle]
1277	if {$change} {
1278	set idx [lsearch -exact $states $state]
1279	set state [lindex $states [expr $idx+1]]
1280	}
1281	::PanedWindow::MoveSash $widgets(pw) 1 y $state
1282	set data(viewmode) $state
1283	}
1284
1285
1286	#/////////////////////////////////////////////////////////////////////////////
1287	proc ::TolConsole::AboutShow {} {
1288	#
1289	# PURPOSE: Shows the function search dialog
1290	#
1291	#/////////////////////////////////////////////////////////////////////////////
1292	set path .__about
1293
1294	if ![winfo exist $path] {
1295	::TolConsole::About $path
1296	}
1297	wm state $path normal
1298	}
1299
1300	#/////////////////////////////////////////////////////////////////////////////
1301	proc ::TolConsole::TolBaseHelp {} {
1302	#
1303	# PURPOSE: Shows the home page of help of Tolbase
1304	#
1305	#/////////////////////////////////////////////////////////////////////////////
1306	ShowHelp "Tb4Mai"
1307	}
1308
1309
1310	#/////////////////////////////////////////////////////////////////////////////
1311	proc ::TolConsole::About { w } {
1312	#
1313	# PURPOSE: Shows a dialog that shows information about TolBase and Bayes.
1314	#
1315	#/////////////////////////////////////////////////////////////////////////////
1316	global toltk_library
1317	global GuiVersionInfo
1318
1319	set imgfile [file join $toltk_library toltk images splash.gif]
1320	set img [image create photo -file $imgfile]
1321	toplevel $w
1322	wm title $w "[mc About] TOLBase"
1323	wm withdraw $w
1324	wm transient $w .
1325	wm iconbitmap $w [wm iconbitmap .]
1326	wm resizable $w 0 0
1327	label $w.lsplash -image $img -relief ridge -bd 2
1328	array set TolVersionInfo [::tol::info version]
1329	label $w.lversion -bg black -fg white -text \
1330	"[mc {TOL Version}]: [ lindex [ toltcl::eval {Text Version} ] 0 ]"
1331	label $w.laddress -bg black -fg white -text {
1332	Bayes Forecast: dynamic modelling of operations and markets
1333	Voice: (+34) 91.5327440; Fax: (+34) 91.5322636
1334	e-Mail: request@bayesinf.com; URL: http://www.tol-project.org
1335	}
1336
1337	button $w.bc -text [mc Close] -command [list destroy $w]
1338	grid $w.lsplash
1339	grid $w.lversion -sticky "ew"
1340	grid $w.laddress -sticky "ew"
1341	grid $w.bc -padx 2 -pady 5 -sticky ns
1342	update
1343	# Aqui deberiamos invocar a un proc CenterWindow
1344	wm geometry $w +[expr ([winfo vrootw .]-[winfo reqwidth $w])/2]+[expr ([winfo vrooth .]-[winfo reqheight $w])/2]
1345	update
1346	wm withdraw $w
1347	wm deiconify $w
1348	update
1349	}
1350
1351	#/////////////////////////////////////////////////////////////////////////////
1352	proc ::TolConsole::IncludeCmd {{path ""} } {
1353	#
1354	#/////////////////////////////////////////////////////////////////////////////
1355	variable data
1356	set types {
1357	{{Tol Files} {.tol .bst .bsi .bst .bdt}}
1358	{{Text Files} {.txt}}
1359	{{All Files} *}
1360	}
1361
1362	if {$path == ""} {
1363	if { [catch {tk_getOpenFile -filetypes $types \
1364	-initialdir $data(path) \
1365	-title "Source File"} fn] \|\| [string match {} $fn] } {
1366	return
1367	}
1368	} else {
1369	set fn $path
1370	}
1371	UpdateListIncluded $fn
1372	Include $fn
1373
1374
1375	}
1376
1377	#/////////////////////////////////////////////////////////////////////////////
1378	proc ::TolConsole::UpdateListIncluded {path} {
1379	#
1380	#/////////////////////////////////////////////////////////////////////////////
1381	variable data
1382	# guardamos el ultimo directorio abierto
1383	set data(path) [file dirname $path]
1384	if { [set idx [lsearch $data(included) $path]] == -1 } {
1385	set data(included) [linsert $data(included) 0 $path]
1386	} else {
1387	set ll ""
1388	lappend ll $path
1389	set i 0
1390	foreach f $data(included) {
1391	if {$i != $idx} {
1392	lappend ll $f
1393	}
1394	incr i
1395	}
1396	set data(included) $ll
1397	}
1398	set data(included) [lrange $data(included) 0 [expr $data(numRecent)-1]]
1399	}
1400
1401	#/////////////////////////////////////////////////////////////////////////////
1402	proc ::TolConsole::Exit { w } {
1403	#
1404	#/////////////////////////////////////////////////////////////////////////////
1405	variable data
1406	variable widgets
1407
1408	if {$w eq "."} {
1409	ProcessPendingTasks
1410
1411	# Options project
1412	if {[info exists data(proc,OnOptionDestroy)] && \
1413	[string length $data(proc,OnOptionDestroy)]} {
1414	foreach f $data(proc,OnOptionDestroy) {
1415	$f
1416	}
1417	}
1418	WriteIni
1419	}
1420	}
1421
1422	#/////////////////////////////////////////////////////////////////////////////
1423	proc ::TolConsole::BeforeExit { } {
1424	#
1425	#/////////////////////////////////////////////////////////////////////////////
1426	variable data
1427	variable widgets
1428
1429	# check all ...
1430	set okEdi ok
1431	set okETr ok
1432	set okTPr ok
1433	catch {set okEdi [::Editor::CheckAll]}
1434	catch {set okETa [::EditTable::CheckAll]}
1435	catch {set okTPr [::TolProject::CheckAll]}
1436
1437	if {[string eq $okEdi cancel] \|\| [string eq $okETa cancel] \|\| \
1438	[string eq $okTPr cancel]} {
1439	return cancel
1440	}
1441	# exit
1442	if { [info exists widgets(inspector)] } {
1443	foreach a {x y width height} {
1444	set data(geometry,$a) [winfo $a $widgets(inspector)]
1445	}
1446	set data(geometry,wtop) [winfo height $widgets(panes,top)]
1447	set data(geometry,wbottom) [winfo height $widgets(panes,bottom)]
1448	set data(geometry,wleft) [::TolInspector::GetWeight left]
1449	set data(geometry,wright) [::TolInspector::GetWeight right]
1450	set data(font,eval) [$widgets(eval) cget -font]
1451	set data(font,output) [$widgets(output) cget -font]
1452	set data(font,info) [$widgets(info) cget -font]
1453	}
1454	return "ok"
1455	}
1456
1457	#/////////////////////////////////////////////////////////////////////////////
1458	proc ::TolConsole::ProcessPendingTasks {} {
1459	#
1460	#/////////////////////////////////////////////////////////////////////////////
1461	# para que este procedimiento?
1462	return
1463	foreach id [after info] {
1464	set aft_info [after info $id]
1465	after cancel $id
1466	eval [lindex $aft_info 0]
1467	}
1468	}
1469
1470	#/////////////////////////////////////////////////////////////////////////////
1471	proc ::TolConsole::OptionsCreate { {tabinit ""} } {
1472	#
1473	# PURPOSE: Create the dialog of options of TolBase
1474	#
1475	# PARAMETERS:
1476	# tabinit -> Tab where is focused the dialog when it's displayed (Optional).
1477	#
1478	#/////////////////////////////////////////////////////////////////////////////
1479	variable widgets
1480	variable data
1481
1482	set path $widgets(inspector)
1483
1484	set dialog [Dialog $path.t -title [mc "TOLBase Options"]\
1485	-parent $path -default 0 -cancel 1 -modal local]
1486	wm protocol $dialog WM_DELETE_WINDOW \
1487	[list ::TolConsole::OptionsDestroy $dialog]
1488	set w [$dialog getframe]
1489
1490	wm resizable $dialog 0 0
1491	# TabSet TolBase
1492	set w_ts [::blt::tabset $w.ts -relief flat -highlightthickness 0 -bd 0 \
1493	-outerpad 0 -tier 2 -slant both -textside right -side left -rotate 90 ]
1494	#insertar tabset
1495	$w_ts insert end TolBase
1496	set f0 [frame $w_ts.f0]
1497	$w_ts tab configure "TolBase" -text "TolBase" \
1498	-window $f0 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1499
1500	# TabSet Options
1501	set w_tabset [::blt::tabset $f0.ts -relief flat -highlightthickness 0\
1502	-bd 0 -outerpad 0 -tier 2 -slant right -textside right ]
1503
1504	$w_tabset insert end TOL Output Precision Paths Others
1505	set f1 [frame $w_tabset.f1]
1506	set f2 [frame $w_tabset.f2]
1507	set f3 [frame $w_tabset.f3]
1508	set f4 [frame $w_tabset.f4]
1509	set f5 [frame $w_tabset.f5]
1510
1511	$w_tabset tab configure "TOL" -text [mc "TOL"] -window $f1\
1512	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1513	$w_tabset tab configure "Output" -text [mc "Output"] -window $f2\
1514	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1515	$w_tabset tab configure "Precision" -text [mc "Precision"] -window $f3\
1516	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1517	$w_tabset tab configure "Paths" -text [mc "Paths"] -window $f5\
1518	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1519	$w_tabset tab configure "Others" -text [mc "Others"] -window $f4\
1520	-fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1521
1522	OptionsGet
1523	OptionsCreateTOL $f1
1524	OptionsCreateOutput $f2
1525	OptionsCreatePrecision $f3
1526	OptionsCreatePaths $f5
1527	OptionsCreateOthers $f4
1528
1529	# Options project
1530	if {[info exists data(proc,OnOptionCreate)] && \
1531	[string length $data(proc,OnOptionCreate)]} {
1532	foreach f $data(proc,OnOptionCreate) {
1533	$f $w_ts
1534	}
1535	}
1536
1537	OptionsCheck
1538
1539	set w_bbox \
1540	[ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1541	-homogeneous false]
1542	$w_bbox add -text [mc "Accept"] -relief link \
1543	-helptext [mc "Make the changes and leave the dialog"] \
1544	-image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1545	-command [list ::TolConsole::OptionsOK $dialog]
1546	$w_bbox add -text [mc "Cancel"] -relief link \
1547	-helptext [mc "Leave the dialog without apply any change"] \
1548	-image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1549	-command [list ::TolConsole::OptionsDestroy $dialog]
1550	$w_bbox add -text [mc "Apply"] -relief link \
1551	-helptext [mc "Make the changes without leave the dialog"] \
1552	-image [::Bitmap::get apply] -compound left -padx 5 -pady 1 \
1553	-command ::TolConsole::OptionsApply
1554
1555	pack $w_bbox -side bottom -expand no -fill x
1556	pack $w_tabset -side top -expand yes -fill both
1557	pack $w_ts -expand yes -fill both ;#-sticky news
1558
1559	if {!($tabinit eq "")} {
1560	switch -exact $tabinit {
1561	"TOL" {
1562	$w_tabset select 0
1563	}
1564	"Output" {
1565	$w_tabset select 1
1566	}
1567	"Precision" {
1568	$w_tabset select 2
1569	}
1570	"Paths" {
1571	$w_tabset select 3
1572	}
1573	"Others" {
1574	$w_tabset select 4
1575	}
1576	}
1577	}
1578	bind $dialog <F1> "ShowHelp Tb4Opc"
1579	$dialog draw
1580	}
1581
1582
1583	#/////////////////////////////////////////////////////////////////////////////
1584	proc ::TolConsole::OptionsCreateTOL {w} {
1585	#
1586	#/////////////////////////////////////////////////////////////////////////////
1587	variable tmpOpt
1588
1589	#TitleFrame $w.tf1 -text [mc "--"]
1590	#set f1 [$w.tf1 getframe]
1591
1592	TitleFrame $w.tf2 -text [mc "Default dates"]
1593	set f2 [$w.tf2 getframe]
1594
1595	label $f2.lFirstDate -text [mc "First date"]:
1596	::Objects::ChooseDateCreate ::TolConsole::tmpOpt(var,DefFirst) $f2.cFD
1597
1598	label $f2.lLastDate -text [mc "Last date"]:
1599	::Objects::ChooseDateCreate ::TolConsole::tmpOpt(var,DefLast) $f2.cLD
1600
1601	frame $f2.f -width 25
1602
1603	grid $f2.f $f2.lFirstDate $f2.cFD $f2.lLastDate $f2.cLD -sticky nw -padx 2
1604	grid rowconfigure $f2 0 -weight 1
1605	grid columnconfigure $f2 4 -weight 1
1606	grid columnconfigure $f2 2 -pad 10
1607
1608
1609	#grid $w.tf1 -sticky news -padx 2
1610	grid $w.tf2 -sticky news -padx 2
1611
1612	grid rowconfigure $w 0 -weight 1
1613	grid rowconfigure $w 1 -weight 3
1614	grid columnconfigure $w 0 -weight 1
1615
1616	}
1617
1618	#/////////////////////////////////////////////////////////////////////////////
1619	proc ::TolConsole::OptionsCreateOutput {w} {
1620	#
1621	#/////////////////////////////////////////////////////////////////////////////
1622	global toltk_options
1623	variable tmpOpt
1624
1625	TitleFrame $w.tf1 -text [mc "Write"]
1626	set f1 [$w.tf1 getframe]
1627
1628	checkbutton $f1.chWrite -text [mc "Write messages in output window"]\
1629	-variable ::TolConsole::tmpOpt(var,chWrite)
1630	label $f1.lColorErr -text [mc "Errors color"]:
1631	bcolor $f1.fColorErr -variable ::TolConsole::tmpOpt(var,colorErr)
1632	#::Objects::ColorCreate ::TolConsole::tmpOpt(var,colorErr) $f1.fColorErr
1633	label $f1.lColorWar -text [mc "Warnings color"]:
1634	::Objects::ColorCreate ::TolConsole::tmpOpt(var,colorWar) $f1.fColorWar
1635
1636	frame $f1.f -width 20
1637	grid $f1.f $f1.chWrite - - - -sticky nw -padx 2
1638	grid ^ $f1.lColorErr $f1.fColorErr $f1.lColorWar $f1.fColorWar -sticky nw -padx 2
1639
1640	grid rowconfigure $f1 1 -weight 1
1641	grid columnconfigure $f1 4 -weight 1
1642	grid columnconfigure $f1 2 -pad 20
1643
1644
1645	TitleFrame $w.tf2 -text [mc "Update"]
1646	set f2 [$w.tf2 getframe]
1647
1648	label $f2.lUpdateType -text [mc "Update options"]:
1649	frame $f2.f1 -width 15
1650	radiobutton $f2.rbAlways -text [mc "Update always"]\
1651	-value always -highlightthickness 0 -pady 0\
1652	-variable ::TolConsole::tmpOpt(var,updateType)\
1653	-command ::TolConsole::OptionsCheckUpdateType
1654	radiobutton $f2.rbEach -text [mc "Update each"]\
1655	-value each -highlightthickness 0 -pady 0\
1656	-variable ::TolConsole::tmpOpt(var,updateType)\
1657	-command ::TolConsole::OptionsCheckUpdateType
1658	radiobutton $f2.rbNever -text [mc "Don't update until the end"]\
1659	-value never -highlightthickness 0 -pady 0\
1660	-variable ::TolConsole::tmpOpt(var,updateType)\
1661	-command ::TolConsole::OptionsCheckUpdateType
1662	set tmpOpt(widget,updateSec) [SpinBox $f2.sbSeconds -justify right -width 4 \
1663	-editable 0 -range {0 2000 20} \
1664	-textvariable ::TolConsole::tmpOpt(var,updateSec)]
1665	label $f2.lSeconds -text [mc milliseconds]
1666
1667	frame $f2.f -width 20
1668	grid $f2.f $f2.lUpdateType - - - -sticky nw -padx 2
1669	grid ^ $f2.f1 $f2.rbAlways - - -sticky nw -padx 2
1670	grid ^ ^ $f2.rbEach $f2.sbSeconds $f2.lSeconds -sticky nw -padx 2
1671	grid ^ ^ $f2.rbNever - - -sticky nw -padx 2
1672
1673	grid rowconfigure $f2 3 -weight 1
1674	grid columnconfigure $f2 4 -weight 1
1675
1676	grid $w.tf1 -sticky news -padx 2
1677	grid $w.tf2 -sticky news -padx 2
1678	grid rowconfigure $w 1 -weight 1
1679	grid columnconfigure $w 0 -weight 1
1680	}
1681
1682	#/////////////////////////////////////////////////////////////////////////////
1683	proc ::TolConsole::OptionsCreatePrecision {w} {
1684	#
1685	#/////////////////////////////////////////////////////////////////////////////
1686	variable tmpOpt
1687
1688	TitleFrame $w.tf1 -text [mc "Precision"]
1689	set f1 [$w.tf1 getframe]
1690
1691	checkbutton $f1.chDecimals -text [mc "Reduce decimal digits to"]\
1692	-variable ::TolConsole::tmpOpt(var,chDecimals)\
1693	-command ::TolConsole::OptionsCheckDecimals
1694	set tmpOpt(widget,decimals) [SpinBox $f1.sbDecimals -justify right -width 4 \
1695	-editable 0 -range {0 10} \
1696	-textvariable ::TolConsole::tmpOpt(var,numDecimals)]
1697	label $f1.lDecimals -text [mc digits]
1698
1699	checkbutton $f1.chExponential \
1700	-text [mc "Use exponential notation when number has more than"]\
1701	-variable ::TolConsole::tmpOpt(var,chExponential)\
1702	-command ::TolConsole::OptionsCheckExponential
1703	set tmpOpt(widget,exponential) [SpinBox $f1.sbExponential -justify right -width 4 \
1704	-editable 0 -range {0 10} \
1705	-textvariable ::TolConsole::tmpOpt(var,numExponential)]
1706	label $f1.lExponential -text [mc digits]
1707
1708	frame $f1.f -width 25
1709
1710	grid $f1.f $f1.chDecimals $f1.sbDecimals $f1.lDecimals -sticky nw -padx 2
1711	grid ^ $f1.chExponential $f1.sbExponential $f1.lExponential -sticky nw -padx 2
1712	grid rowconfigure $f1 1 -weight 1
1713	grid columnconfigure $f1 3 -weight 1
1714
1715	grid $w.tf1 -sticky news -padx 2
1716	#grid $w.tf2 -sticky news -padx 2
1717
1718	grid rowconfigure $w 0 -weight 1
1719	#grid rowconfigure $w 1 -weight 2
1720	grid columnconfigure $w 0 -weight 1
1721	}
1722
1723	#/////////////////////////////////////////////////////////////////////////////
1724	proc ::TolConsole::OptionsCreatePaths {w} {
1725	#
1726	#/////////////////////////////////////////////////////////////////////////////
1727	variable tmpOpt
1728
1729	TitleFrame $w.tf -text [mc "Paths"]
1730	set f [$w.tf getframe]
1731
1732	label $f.lPathBrowser -text [mc "Browser path"]
1733	label $f.lPathPDFViewer -text [mc "PDF viewer path"]
1734	label $f.lPathHelp -text [mc "Help path"]
1735	Entry $f.ePathBrowser -state normal -width 30 \
1736	-textvariable ::TolConsole::tmpOpt(var,pathBrowser) \
1737	-helptext [mc pathexplanation]
1738	Entry $f.ePathPDFViewer -state normal -width 30 \
1739	-textvariable ::TolConsole::tmpOpt(var,pathPDFViewer) \
1740	-helptext [mc pathexplanation]
1741	Entry $f.ePathHelp -state normal -width 30 \
1742	-textvariable ::TolConsole::tmpOpt(var,pathHelp)
1743	Button $f.bPathBrowser -compound left -padx 10 \
1744	-height 16 -relief link \
1745	-helptext [mc "Search the program path"] \
1746	-image [Bitmap::get bopen] \
1747	-command {::TolConsole::OptionsCreatePath "Browser"}
1748	Button $f.bPathPDFViewer -compound left -padx 10 \
1749	-height 16 -relief link \
1750	-helptext [mc "Search the program path"] \
1751	-image [Bitmap::get bopen] \
1752	-command {::TolConsole::OptionsCreatePath "PDFViewer"}
1753	Button $f.bPathHelp -compound left -padx 10 \
1754	-height 16 -relief link \
1755	-helptext [mc "Search the folder"] \
1756	-image [Bitmap::get bopen] \
1757	-command {set tmp [tk_chooseDirectory -initialdir $::TolConsole::tmpOpt(var,pathHelp) -mustexist 1]
1758	if {!($tmp eq "")} {
1759	set ::TolConsole::tmpOpt(var,pathHelp) $tmp
1760	} }
1761
1762	grid $f.lPathBrowser -row 0 -column 0 -sticky nw -padx 5 -pady 5
1763	grid $f.lPathPDFViewer -row 1 -column 0 -sticky nw -padx 5 -pady 5
1764	grid $f.lPathHelp -row 2 -column 0 -sticky nw -padx 5 -pady 5
1765	grid $f.ePathBrowser -row 0 -column 1 -sticky new -padx 5 -pady 5
1766	grid $f.ePathPDFViewer -row 1 -column 1 -sticky new -padx 5 -pady 5
1767	grid $f.ePathHelp -row 2 -column 1 -sticky new -padx 5 -pady 5
1768	grid $f.bPathBrowser -row 0 -column 2 -sticky e -padx 5 -pady 5
1769	grid $f.bPathPDFViewer -row 1 -column 2 -sticky e -padx 5 -pady 5
1770	grid $f.bPathHelp -row 2 -column 2 -sticky e -padx 5 -pady 5
1771
1772	grid columnconfigure $f 1 -weight 1
1773	grid rowconfigure $f 10 -weight 1
1774
1775	grid $w.tf -sticky news
1776
1777	grid columnconfigure $w 0 -weight 1
1778	grid rowconfigure $w 0 -weight 1
1779	}
1780
1781	#/////////////////////////////////////////////////////////////////////////////
1782	proc ::TolConsole::OptionsCreatePath { type } {
1783	#
1784	# PURPOSE: Executes the command associated to the create path buttons:
1785	# Shows a dialog OpenFile with the directory and the appropriate
1786	# file type according to the operating system
1787	#
1788	# PARAMETERS: Type of path. Allowed values "Browser" "PDFViewer"
1789	#
1790	# TODO: For linux, to verify that the file is executable
1791	#
1792	#/////////////////////////////////////////////////////////////////////////////
1793	variable tmpOpt
1794
1795	if { $::tcl_platform(platform) == "windows" } {
1796	# get the "Program Files" directory
1797	set dirProgramFiles [registry get \
1798	{HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Session Manager\SFC} \
1799	ProgramFilesDir]
1800	set txtExecFileType "\{\{\{[mc {Executable files} ]\} .exe\}\}"
1801	set commandFile "tk_getOpenFile \
1802	-initialdir [list $dirProgramFiles] -f $txtExecFileType"
1803	} else { ;# linux
1804	set commandFile "tk_getOpenFile -initialdir \\"
1805	}
1806
1807	#set ::TolConsole::tmpOpt(var,path$type) [eval $commandFile]
1808	set tmp [eval $commandFile]
1809	if { !($tmp eq "") } {
1810	set ::TolConsole::tmpOpt(var,path$type) $tmp
1811	}
1812	}
1813
1814	#/////////////////////////////////////////////////////////////////////////////
1815	proc ::TolConsole::OptionsCreateOthers {w} {
1816	#
1817	#/////////////////////////////////////////////////////////////////////////////
1818	variable tmpOpt
1819	variable languages
1820
1821	TitleFrame $w.tf1 -text [mc "General Options"]
1822	set f1 [$w.tf1 getframe]
1823
1824	label $f1.lRecent -text [mc "Number of last edited files"]
1825
1826	set tmpOpt(widget,recent) [SpinBox $f1.sbRecent -justify right -width 4 \
1827	-editable 0 -range {0 10} \
1828	-textvariable ::TolConsole::tmpOpt(var,numRecent)]
1829	label $f1.lFiles -text [mc files]
1830
1831	radiobutton $f1.rbOrdDate -text [mc "Order by date"]\
1832	-value date -highlightthickness 0 -pady 0\
1833	-variable ::TolConsole::tmpOpt(var,ordRecent)
1834	radiobutton $f1.rbOrdAsc -text [mc "Order alphabetically"]\
1835	-value asc -highlightthickness 0 -pady 0\
1836	-variable ::TolConsole::tmpOpt(var,ordRecent)
1837	radiobutton $f1.rbOrdDesc -text [mc "Order reverse alphabetically"]\
1838	-value desc -highlightthickness 0 -pady 0\
1839	-variable ::TolConsole::tmpOpt(var,ordRecent)
1840
1841	frame $f1.f -width 25
1842
1843	grid $f1.f $f1.lRecent $f1.sbRecent $f1.lFiles -sticky nw -padx 2
1844	grid ^ $f1.rbOrdDate - - -sticky nw -padx 2
1845	grid ^ $f1.rbOrdAsc - - -sticky nw -padx 2
1846	grid ^ $f1.rbOrdDesc - - -sticky nw -padx 2
1847
1848	grid rowconfigure $f1 0 -weight 1
1849	grid rowconfigure $f1 1 -weight 1
1850
1851	grid rowconfigure $f1 2 -weight 1
1852
1853	grid columnconfigure $f1 3 -weight 1
1854	grid columnconfigure $f1 4 -weight 1
1855
1856	TitleFrame $w.tf2 -text [mc "Language"]
1857	set f2 [$w.tf2 getframe]
1858
1859	label $f2.lLanguage -text [mc "Choose language"]:
1860	foreach {key value} $languages {
1861	lappend values [mc $value]
1862	}
1863
1864	ComboBox $f2.cbLanguages -width 12 -height 5 -editable false -justify right -values $values\
1865	-modifycmd [list ::Objects::ComboUnTranslateDbl $f2.cbLanguages $languages\
1866	::TolConsole::tmpOpt(var,language)]
1867	::Objects::ComboSetIniDbl $f2.cbLanguages $languages ::TolConsole::tmpOpt(var,language)
1868
1869
1870	label $f2.lLangExp -text ([mc "Language is set when you restart interface"])
1871	frame $f2.f -width 25
1872	grid $f2.f $f2.lLanguage $f2.cbLanguages -sticky nw -padx 2
1873	grid ^ $f2.lLangExp - -sticky nw -padx 2
1874	grid rowconfigure $f2 1 -weight 1
1875	grid columnconfigure $f2 2 -weight 1
1876
1877	TitleFrame $w.tf3 -text [mc "Object Inspector"]
1878	set f3 [$w.tf3 getframe]
1879	checkbutton $f3.chObjIns -text [mc "Show Object Inspector"]\
1880	-variable ::TolConsole::tmpOpt(var,chObjIns)
1881
1882	label $f3.lObjIns -text ([mc "Object Inspector visualization is set when you restart interface"])
1883
1884	grid $f3.chObjIns -sticky nw -padx 2
1885	grid $f3.lObjIns -sticky nw -padx 2
1886	grid rowconfigure $f3 1 -weight 1
1887	grid columnconfigure $f3 2 -weight 1
1888
1889
1890	grid $w.tf1 -sticky news -padx 2
1891	grid $w.tf2 -sticky news -padx 2
1892	grid $w.tf3 -sticky news -padx 2
1893
1894	grid rowconfigure $w 0 -weight 1
1895	grid rowconfigure $w 1 -weight 1
1896	grid rowconfigure $w 2 -weight 1
1897	grid columnconfigure $w 0 -weight 1
1898	}
1899
1900	#/////////////////////////////////////////////////////////////////////////////
1901	proc ::TolConsole::OptionsGet {} {
1902	#
1903	#/////////////////////////////////////////////////////////////////////////////
1904	variable data
1905	variable tmpOpt
1906	set tmpOpt(var,numRecent) $data(numRecent)
1907	set tmpOpt(var,ordRecent) $data(ordRecent)
1908	set tmpOpt(var,language) $data(language)
1909	set tmpOpt(var,chDecimals) $data(chDecimals)
1910	set tmpOpt(var,numDecimals) $data(numDecimals)
1911	set tmpOpt(var,chExponential) $data(chExponential)
1912	set tmpOpt(var,numExponential) $data(numExponential)
1913	set tmpOpt(var,DefFirst) $data(DefFirst)
1914	set tmpOpt(var,DefLast) $data(DefLast)
1915	set tmpOpt(var,colorErr) $data(colorErr)
1916	set tmpOpt(var,colorWar) $data(colorWar)
1917	set tmpOpt(var,chWrite) $data(chWrite)
1918	set tmpOpt(var,updateType) $data(updateType)
1919	set tmpOpt(var,updateSec) $data(updateSec)
1920	set tmpOpt(var,showODBC) $data(showODBC)
1921	set tmpOpt(var,pathBrowser) $data(pathBrowser)
1922	set tmpOpt(var,pathPDFViewer) $data(pathPDFViewer)
1923	set tmpOpt(var,pathHelp) $data(pathHelp)
1924	set tmpOpt(var,chObjIns) $data(chObjIns)
1925
1926
1927	}
1928
1929	#/////////////////////////////////////////////////////////////////////////////
1930	proc ::TolConsole::OptionsSet {} {
1931	#
1932	#/////////////////////////////////////////////////////////////////////////////
1933	variable data
1934	variable tmpOpt
1935
1936	regsub -all var, [array names ::TolConsole::tmpOpt var,*] "" optNames
1937
1938	foreach it $optNames {
1939	set data($it) $tmpOpt(var,$it)
1940	}
1941	}
1942
1943	#/////////////////////////////////////////////////////////////////////////////
1944	proc ::TolConsole::OptionsCheck {} {
1945	#
1946	#/////////////////////////////////////////////////////////////////////////////
1947	OptionsCheckUpdateType
1948	OptionsCheckDecimals
1949	OptionsCheckExponential
1950	}
1951
1952	#/////////////////////////////////////////////////////////////////////////////
1953	proc ::TolConsole::OptionsCheckDecimals {} {
1954	#
1955	#/////////////////////////////////////////////////////////////////////////////
1956	variable tmpOpt
1957	if {!$tmpOpt(var,chDecimals)} {
1958	$tmpOpt(widget,decimals) configure -state disabled
1959	} else {
1960	$tmpOpt(widget,decimals) configure -state normal
1961	}
1962	}
1963
1964	#/////////////////////////////////////////////////////////////////////////////
1965	proc ::TolConsole::OptionsCheckExponential {} {
1966	#
1967	#/////////////////////////////////////////////////////////////////////////////
1968	variable tmpOpt
1969	if {!$tmpOpt(var,chExponential)} {
1970	$tmpOpt(widget,exponential) configure -state disabled
1971	} else {
1972	$tmpOpt(widget,exponential) configure -state normal
1973	}
1974	}
1975
1976	#/////////////////////////////////////////////////////////////////////////////
1977	proc ::TolConsole::OptionsCheckUpdateType {} {
1978	#
1979	#/////////////////////////////////////////////////////////////////////////////
1980	variable tmpOpt
1981
1982	switch $tmpOpt(var,updateType) {
1983	always {
1984	$tmpOpt(widget,updateSec) configure -state disabled
1985	}
1986	each {
1987	$tmpOpt(widget,updateSec) configure -state normal
1988	}
1989	never {
1990	$tmpOpt(widget,updateSec) configure -state disabled
1991	}
1992	}
1993	}
1994
1995	#/////////////////////////////////////////////////////////////////////////////
1996	proc ::TolConsole::OptionsDestroy {dialog} {
1997	#
1998	#/////////////////////////////////////////////////////////////////////////////
1999	#variable data
2000	variable tmpOpt
2001
2002	array unset tmpOpt
2003	destroy $dialog
2004	}
2005
2006	#/////////////////////////////////////////////////////////////////////////////
2007	proc ::TolConsole::OptionsApply {} {
2008	#
2009	#/////////////////////////////////////////////////////////////////////////////
2010	variable data
2011	# Apply
2012	OptionsSet
2013	OptionsApplyLanguage
2014	OptionsApplyDefDates
2015	OptionsApplyColors
2016	# Options project Apply
2017	if {[info exists data(proc,OnOptionApply)] && \
2018	[string length $data(proc,OnOptionApply)]} {
2019	foreach f $data(proc,OnOptionApply) {
2020	$f
2021	}
2022	}
2023	# Write INI
2024	WriteIni
2025	}
2026
2027	#/////////////////////////////////////////////////////////////////////////////
2028	proc ::TolConsole::OptionsApplyLanguage {} {
2029	#
2030	#/////////////////////////////////////////////////////////////////////////////
2031	global toltk_script_path
2032	variable data
2033
2034	::tol::language $data(language)
2035	::msgcat::mclocale $data(language)
2036	::msgcat::mcload [file join $toltk_script_path msgs]
2037	}
2038
2039	#/////////////////////////////////////////////////////////////////////////////
2040	proc ::TolConsole::OptionsApplyDefDates {} {
2041	#
2042	#/////////////////////////////////////////////////////////////////////////////
2043	variable data
2044	set expr "Date PutDefaultDates([DateTol $data(DefFirst)],[DateTol $data(DefLast)]);"
2045	#Tolcon_Trace "$expr"
2046	::tol::console eval $expr
2047	}
2048
2049	#/////////////////////////////////////////////////////////////////////////////
2050	proc ::TolConsole::OptionsApplyColors {} {
2051	#
2052	#/////////////////////////////////////////////////////////////////////////////
2053	variable data
2054	variable widgets
2055
2056	$widgets(output) tag configure errorTag -foreground $data(colorErr)
2057	$widgets(output) tag configure warningTag -foreground $data(colorWar)
2058	}
2059
2060	#/////////////////////////////////////////////////////////////////////////////
2061	proc ::TolConsole::OptionsOK {dialog} {
2062	#
2063	#/////////////////////////////////////////////////////////////////////////////
2064	OptionsApply
2065	OptionsDestroy $dialog
2066	}
2067
2068	#/////////////////////////////////////////////////////////////////////////////
2069	proc ::TolConsole::ReadIni {} {
2070	#
2071	# PURPOSE: Reads general TolBase options from .ini file.
2072	#
2073	#/////////////////////////////////////////////////////////////////////////////
2074	global toltk_script_path
2075	global toltk_options
2076	variable data
2077	set rini ::iniFile::Read
2078
2079	#inicializo variable necesaria para las toolbars
2080	set data(tolbase,lsttoolbars) [$rini TolConsole listtoolbars]
2081	if {![llength $data(tolbase,lsttoolbars)]} {
2082	set data(tolbase,lsttoolbars) {}
2083	}
2084
2085	set data(path) [$rini TolConsole path $toltk_script_path]
2086	set data(included) [$rini TolConsole recent {}]
2087	set data(chIncluded) [$rini TolConsole saveRecent 1]
2088	set data(numRecent) [$rini TolConsole numRecent 8]
2089	set data(ordRecent) [$rini TolConsole ordRecent "date"]
2090	set data(tabRecent) [$rini TolConsole tabRecent {}]
2091	set data(prjRecent) [$rini TolConsole prjRecent {}]
2092	set data(incRecent) [$rini TolConsole incRecent {}]
2093	set data(ediRecent) [$rini TolConsole ediRecent {}]
2094	set data(font,eval) [$rini TolConsole evalFont \
2095	$toltk_options(fonts,Fixed)]
2096	set data(font,output) [$rini TolConsole outputFont \
2097	$toltk_options(fonts,Fixed)]
2098	set data(font,info) [$rini TolConsole infoFont \
2099	$toltk_options(fonts,Fixed)]
2100	set data(language) [$rini TolConsole language es]
2101	set data(chDecimals) [$rini TolConsole redDecimals 0]
2102	set data(numDecimals) [$rini TolConsole numDecimals 4]
2103	set data(chExponential) [$rini TolConsole useExponential 0]
2104	set data(numExponential) [$rini TolConsole numExponential 8]
2105	set data(DefFirst) [$rini TolConsole DefFirst [::tol::date first]]
2106	set data(DefLast) [$rini TolConsole DefLast [::tol::date last ]]
2107	set data(colorWar) [$rini TolConsole colorWar blue]
2108	set data(colorErr) [$rini TolConsole colorErr red]
2109	set data(chWrite) [$rini TolConsole writeOutput 1]
2110	set data(updateType) [$rini TolConsole updateType always]
2111	set data(updateSec) [$rini TolConsole updateSec 200]
2112	set data(showODBC) [$rini TolConsole ShowODBCDialog 0]
2113
2114	# program paths
2115	set data(pathBrowser) [$rini TolConsole pathBrowser {}]
2116	set data(pathPDFViewer) [$rini TolConsole pathPDFViewer {}]
2117	set data(pathHelp) [$rini TolConsole pathHelp {}]
2118
2119	# Object Inspector visualization
2120	set data(chObjIns) [$rini TolConsole chObjIns {}]
2121
2122	# geometry
2123
2124	# set data(geometry,x) [$rini TolConsole geometry:x -1]
2125	# set data(geometry,y) [$rini TolConsole geometry:y -1]
2126	# set data(geometry,width) [$rini TolConsole geometry:width -1]
2127	# set data(geometry,height) [$rini TolConsole geometry:height -1]
2128	set data(geometry,wtop) [$rini TolConsole geometry:wtop 5]
2129	set data(geometry,wbottom) [$rini TolConsole geometry:wbottom 1]
2130	set data(geometry,wleft) [$rini TolConsole geometry:wleft 3]
2131	set data(geometry,wright) [$rini TolConsole geometry:wright 7]
2132	set data(viewmode) [$rini TolConsole viewmode middle]
2133
2134	#cargamos los parametros de las toolbars
2135	set data(toolbars,side) [$rini ToolBars side top]
2136	set data(toolbars,fill) [$rini ToolBars fill x]
2137	set data(toolbars,buttonbar,side) [$rini ToolBars buttonbar:side left]
2138	set data(toolbars,buttonbar,fill) [$rini ToolBars buttonbar:fill y]
2139
2140	set data(tolbase,ini) 0
2141	set data(tolbase,original) 0
2142	}
2143
2144	#/////////////////////////////////////////////////////////////////////////////
2145	proc ::TolConsole::WriteIni {} {
2146	#
2147	# PURPOSE: Writes general TolBase options to .ini file.
2148	#
2149	#/////////////////////////////////////////////////////////////////////////////
2150	variable data
2151	variable widgets
2152
2153	set wini ::iniFile::Write
2154	$wini TolConsole path $data(path)
2155	$wini TolConsole recent $data(included)
2156	$wini TolConsole saveRecent $data(chIncluded)
2157	$wini TolConsole numRecent $data(numRecent)
2158	$wini TolConsole ordRecent $data(ordRecent)
2159	$wini TolConsole evalFont $data(font,eval)
2160	$wini TolConsole outputFont $data(font,output)
2161	$wini TolConsole infoFont $data(font,info)
2162	$wini TolConsole language $data(language)
2163	$wini TolConsole redDecimals $data(chDecimals)
2164	$wini TolConsole numDecimals $data(numDecimals)
2165	$wini TolConsole useExponential $data(chExponential)
2166	$wini TolConsole numExponential $data(numExponential)
2167	$wini TolConsole DefFirst $data(DefFirst)
2168	$wini TolConsole DefLast $data(DefLast)
2169	$wini TolConsole colorWar $data(colorWar)
2170	$wini TolConsole colorErr $data(colorErr)
2171	$wini TolConsole writeOutput $data(chWrite)
2172	$wini TolConsole updateType $data(updateType)
2173	$wini TolConsole updateSec $data(updateSec)
2174	$wini TolConsole ShowODBCDialog $data(showODBC)
2175	$wini TolConsole tabRecent $data(tabRecent)
2176	$wini TolConsole prjRecent $data(prjRecent)
2177	$wini TolConsole incRecent $data(incRecent)
2178	$wini TolConsole ediRecent $data(ediRecent)
2179
2180	# program paths
2181	$wini TolConsole pathBrowser $data(pathBrowser)
2182	$wini TolConsole pathPDFViewer $data(pathPDFViewer)
2183	$wini TolConsole pathHelp $data(pathHelp)
2184
2185	# Object Inspector visualization
2186	$wini TolConsole chObjIns $data(chObjIns)
2187
2188	# geometry configuration
2189	# $wini TolConsole geometry:x $data(geometry,x)
2190	# $wini TolConsole geometry:y $data(geometry,y)
2191	# $wini TolConsole geometry:width $data(geometry,width)
2192	# $wini TolConsole geometry:height $data(geometry,height)
2193	$wini TolConsole geometry:wtop $data(geometry,wtop)
2194	$wini TolConsole geometry:wbottom $data(geometry,wbottom)
2195	$wini TolConsole geometry:wleft $data(geometry,wleft)
2196	$wini TolConsole geometry:wright $data(geometry,wright)
2197	$wini TolConsole viewmode $data(viewmode)
2198	#::iniFile::Flush
2199
2200	# escribimos las opciones para las barra de botones
2201	if { [winfo exists ${::project::widgets(mainframe)}.toolbarFrame]} {
2202	set packopts [pack info ${::project::widgets(mainframe)}.toolbarFrame]
2203	array set packoptsarray $packopts
2204	$wini ToolBars side $packoptsarray(-side)
2205	$wini ToolBars fill $packoptsarray(-fill)
2206	#set packopts [pack info ${::project::widgets(mainframe)}.toolbarFrame.tb1]
2207	#array set packoptsarray $packopts
2208	#$wini ToolBars buttonbar:side $packoptsarray(-side)
2209	#$wini ToolBars buttonbar:fill $packoptsarray(-fill)
2210	}
2211
2212	# escribimos las opciones de los documentos abiertos
2213	$::project::widgets(mainmdi) writeDocsIni
2214
2215	# escribilos las barras de botones que tenemos creadas
2216	# clear the bars created by code
2217	if {[info exists widgets(tbCustom,path)]} {
2218	set lsttollbarsaux {}
2219	foreach ltb $data(tolbase,lsttoolbars) {
2220	if {![string eq $widgets(tbCustom,path) [lindex $ltb 0]]} {
2221	lappend lsttollbarsaux $ltb
2222	}
2223	}
2224	$wini TolConsole listtoolbars $lsttollbarsaux
2225	}
2226	}
2227
2228	#/////////////////////////////////////////////////////////////////////////////
2229	proc ::TolConsole::ODBCShow {} {
2230	#
2231	# PURPOSE: Show the connection ODBC dialog
2232	#
2233	#/////////////////////////////////////////////////////////////////////////////
2234	variable data
2235	if {$data(showODBC)} {
2236	set values [::ODBCDialog::ReadIni]
2237	::ODBCDialog::Create $::project::widgets(mainframe) \
2238	[lindex $values 0] [lindex $values 1] "" \
2239	::TolConsole::OnConnect ::TolConsole::OnDisconnect
2240	}
2241	}
2242
2243	#/////////////////////////////////////////////////////////////////////////////
2244	proc ::TolConsole::ObjectInspectorShow {} {
2245	#
2246	# PURPOSE: Show Object inspector
2247	#
2248	#/////////////////////////////////////////////////////////////////////////////
2249	variable data
2250	if {$data(chObjIns) ne "" &&
2251	[string is boolean $data(chObjIns)] && !$data(chObjIns)} {
2252	$::TolConsole::widgets(inspector) withdraw
2253	}
2254	}
2255
2256	#/////////////////////////////////////////////////////////////////////////////
2257	proc ::TolConsole::GetGCFFile {} {
2258	#
2259	# PURPOSE: Obtain the GCFFile file of .ini and showed to message in the
2260	# window output
2261	#
2262	#/////////////////////////////////////////////////////////////////////////////
2263	# GCFFile
2264	set gcfFile [::iniFile::Read SeriesGraph GCFFile {}]
2265	if {[string length $gcfFile]} {
2266	::tol::console eval "Text (GCFFile := \"$gcfFile\");"
2267	::TolConsole::HciWriter "Text GCFFile = \"$gcfFile\"\n"
2268	}
2269	}
2270
2271
2272	#/////////////////////////////////////////////////////////////////////////////
2273	proc ::TolConsole::MenuMDI { } {
2274	#
2275	# PURPOSE: Crea un menu para mdi
2276	#
2277	#/////////////////////////////////////////////////////////////////////////////
2278	#cargo la lista de formularios
2279	set ::toolbar::data(toolbar,tolbase,lstcmd) {}
2280
2281	set md [.mainmenu cget -definition]
2282	set hook $::project::data(menuhook)
2283	set hookhelp $::project::data(menuhookhelp)
2284
2285	set id [$md insert $hook cascade -label [mc &File]]
2286
2287	set cid [$md add $id cascade -label [mc &New] ]
2288	$md add $cid command -label [mc "TOL &file"] \
2289	-command "::Editor::New"
2290	$md add $cid command -label [mc "&Table"] \
2291	-command "::TolConsole::TableNew"
2292	$md add $cid command -label [mc "&Project"] \
2293	-command "::TolProject::New"
2294
2295	set cid [$md add $id cascade -label [mc &Open] ]
2296	$md add $cid command -label [mc "TOL &file"] \
2297	-command "::Editor::Open"
2298	$md add $cid command -label [mc "&Table"] \
2299	-command "::TolConsole::TableOpen"
2300	$md add $cid command -label [mc "&Project"] \
2301	-command "::TolProject::Open"
2302
2303	$md add $id command -label [mc &Include] -command "::TolConsole::IncludeCmd"
2304
2305	$md add $id separator
2306
2307	set cid [$md add $id cascade -label [mc "&Recent files"] ]
2308	$md add $cid cascade -label [mc "TOL &files"] \
2309	-postcommand "::Editor::postEdited %W"
2310	$md add $cid cascade -label [mc "&Tables"] \
2311	-postcommand "::TolConsole::TableRecent %W"
2312	$md add $cid cascade -label [mc "&Projects"] \
2313	-postcommand "::TolProject::postEdited %W"
2314	$md add $cid cascade -label [mc "&Included"] \
2315	-postcommand "::TolConsole::postIncluded %W"
2316
2317	$md add $id separator
2318
2319	#$md add $id command -label [mc E&xit] -command "::project::Exit"
2320	#$md add $id command -label [mc E&xit] -command "::TolConsole::Exit"
2321	$md add $id command -label [mc E&xit] -command "::project::OnDelete"
2322
2323
2324	set id [$md insert $hook cascade -label [mc &Tools]]
2325	set ::project::data(menu,tools) $id
2326
2327	set cid [$md add $id cascade -label [mc "TOL &Editor"]]
2328	$md add $cid cascade -label [mc "&Recent files"] \
2329	-postcommand "::Editor::postEdited %W"
2330	$md add $cid command -label [mc "&New TOL file"] \
2331	-command "::Editor::New"
2332	$md add $cid command -label [mc "&Open TOL file"] \
2333	-command "::Editor::Open"
2334
2335	set cid [$md add $id cascade -label [mc "TOL &Table Editor"]]
2336	$md add $cid cascade -label [mc "&Recent files"] \
2337	-postcommand "::TolConsole::TableRecent %W"
2338	$md add $cid command -label [mc "&New Table"] \
2339	-command "::TolConsole::TableNew"
2340	$md add $cid command -label [mc "&Open Table"] \
2341	-command "::TolConsole::TableOpen"
2342
2343	set cid [$md add $id cascade -label [mc "TOL &Project Editor"]]
2344	$md add $cid cascade -label [mc "&Recent files"] \
2345	-postcommand "::TolProject::postEdited %W"
2346	$md add $cid command -label [mc "&New Project"] \
2347	-command "::TolProject::New"
2348	$md add $cid command -label [mc "&Open Project"] \
2349	-command "::TolProject::Open"
2350
2351	$md add $id separator
2352	$md add $id command -label "[mc {Manage Packages}]..." \
2353	-command ::TolPkgGUI::Show
2354	set cid [$md add $id cascade -label [mc "Analysis Tools"]]
2355	set cid2 [$md add $cid cascade -label [mc "ARIMA"]]
2356	$md add $cid2 command -label [mc "Draw ACF and PACF of ARIMA Models"] \
2357	-command "::drawArima::Show"
2358	$md add $id separator
2359
2360	$md add $id command -label [mc "TOL Inspector"] \
2361	-command "$::project::widgets(mainmdi).slave1 restore; $::project::widgets(mainmdi).slave1 raise"
2362	$md add $id command -label [mc "&Functions Search"] \
2363	-command "::funcSearch::Show"
2364	$md add $id command -label [mc "&Calendar Expert"] \
2365	-command "::CalendarTms::ViewTimeSet"
2366	$md add $id command -label [mc "&Bayes SQL"] \
2367	-command "::SQLTable::TableBayesSQL"
2368
2369	$md add $id separator
2370
2371	$md add $id command -label [mc "C&onnection to database"] \
2372	-command "$::project::data(bodbc) showdialog"
2373
2374	$md add $id command -label [mc "&Options"] \
2375	-command "::TolConsole::OptionsCreate"
2376
2377	return $md
2378	}
2379
2380	#/////////////////////////////////////////////////////////////////////////////
2381	proc ::TolConsole::TableNew { } {
2382	#
2383	# PURPOSE: Creates a new table
2384	#
2385	#/////////////////////////////////////////////////////////////////////////////
2386	set tl [::project::CreateForm -type Tables \
2387	-width 400 -height 180 \
2388	-iniconfig Tables -helpkey "Tb4Edt"]
2389	set tlf [$tl getframe]
2390	# configuration
2391	btable $tlf.t -parent $tl \
2392	-posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
2393	-iniconfig btable
2394	pack $tlf.t -fill both -expand yes
2395	$tl bind <Control-F4> [list $tl kill]
2396	#pedro
2397
2398	}
2399
2400	#/////////////////////////////////////////////////////////////////////////////
2401	proc ::TolConsole::TableOpen { {path ""} } {
2402	#
2403	# PURPOSE: Opens a table
2404	# PARAMETERS:
2405	# path -> path of the file to be opened, if no file is given an Openfile
2406	# dialogs is shown
2407	#
2408	#/////////////////////////////////////////////////////////////////////////////
2409	set tl [::project::CreateForm -type Tables \
2410	-width 400 -height 180 \
2411	-iniconfig Tables -helpkey "Tb4Edt"]
2412	set tlf [$tl getframe]
2413	$tl configure -state withdrawn
2414	# configuration
2415	btable $tlf.t -parent $tl \
2416	-posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
2417	-iniconfig btable
2418	if { $path == "" } {
2419	$tlf.t cmdOpen
2420	$tl configure -state normal
2421	if { [$tlf.t cget -path] == "" } {
2422	$tl kill
2423	} else {
2424	pack $tlf.t -fill both -expand yes
2425	$tl bind <Control-F4> [list $tl kill]
2426	}
2427	} else {
2428	$tlf.t configure -path $path
2429	$tl configure -state normal
2430	pack $tlf.t -fill both -expand yes
2431	$tl bind <Control-F4> [list $tl kill]
2432	}
2433	}
2434
2435	#/////////////////////////////////////////////////////////////////////////////
2436	proc ::TolConsole::TableRecentUpdate { w args } {
2437	#
2438	# PURPOSE: Updates the last edited files when a table is closed
2439	#
2440	# PARAMETERS:
2441	# m -> menu's path that will have the list of last table edited files
2442	# ord -> flag that indicates if files must be shown sorted
2443	#
2444	#/////////////////////////////////////////////////////////////////////////////
2445	variable data
2446
2447	set newfile [$w cget -path]
2448	set pos [lsearch $data(tabRecent) $newfile]
2449
2450	if { $pos == -1 } {
2451	set data(tabRecent) [linsert $data(tabRecent) 0 $newfile]
2452	} else {
2453	set data(tabRecent) [lreplace $data(tabRecent) $pos $pos]
2454	set data(tabRecent) [linsert $data(tabRecent) 0 $newfile]
2455	}
2456	if { $data(numRecent) <= [llength $data(tabRecent)] } {
2457	set data(tabRecent) [lreplace $data(tabRecent) $data(numRecent) end]
2458	}
2459	}
2460
2461	#/////////////////////////////////////////////////////////////////////////////
2462	proc ::TolConsole::TableRecent { m } {
2463	#
2464	# PURPOSE: Fills a menu with the last table edited files, according to the
2465	# information of 'options' variable.
2466	#
2467	# PARAMETERS:
2468	# m -> menu's path that will have the list of last table edited files
2469	# ord -> flag that indicates if files must be shown sorted
2470	#
2471	#/////////////////////////////////////////////////////////////////////////////
2472	variable data
2473
2474	set data(tabRecent) [lrange $data(tabRecent) 0 [expr $data(numRecent)-1]]
2475
2476	$m delete 0 end
2477	if { $data(ordRecent) == "asc" } {
2478	set lst [lsort -ascii $data(tabRecent)]
2479	} elseif { $data(ordRecent) == "desc" } {
2480	set lst [lsort -ascii -decreasing $data(tabRecent)]
2481	} else {
2482	set lst $data(tabRecent)
2483	}
2484	foreach w $lst {
2485	$m add command -label $w -command [list ::TolConsole::TableOpen $w]
2486	}
2487	if [llength $lst] {
2488	$m add separator
2489	$m add command -label [mc "Clear"]\
2490	-command [list ::TolConsole::TableRecentClear]
2491	}
2492	}
2493
2494	#/////////////////////////////////////////////////////////////////////////////
2495	proc ::TolConsole::TableRecentClear { } {
2496	#
2497	# PURPOSE: Clears the list of last edited files
2498	#
2499	#/////////////////////////////////////////////////////////////////////////////
2500	variable data
2501	set data(tabRecent) ""
2502	}

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

Context Navigation

source: tol/tolbase/lib/toltk/tolbase.tcl @ 09d414b

Download in other formats: