source: tol/tolbase/lib/toltk/tolbase.tcl @ 543fdce

1941-docker-image-to-testdevel
Last change on this file since 543fdce was 543fdce, checked in by Jorge Pérez <josp.jorge@…>, 15 years ago

refs #919, sourcing tolconfig_gui.tcl

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