Context Navigation

tolbase.tcl

devel

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

Refs #1938
Se generaliza la versión en los archivos de recursos .rc.
Se crean variables en tcl con las versiones de tolsh y tolbase.
Se simplifica el icono de tolbase en el caso GNU.
Se modifica el título de la aplicación para indicar versión y si es de 32-bits o de 64-bits.

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

Property mode set to 100644

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

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

Context Navigation

source: tol/tolbase/lib/toltk/tolbase.tcl

Download in other formats: