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

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

refs #740, se hace un chequeo más robusto del contenido generado desde tol como definición de la clase.

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