source: tol/tolbaseBLT/lib/toltk/tolbase.tcl @ 56ade3b

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

fixes #1932, se ha creado la rama trunk/tolbaseBLT copia de trunk/tolbase

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7330 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 84.9 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  # tol platform selection
1322  array set tol_platform [lindex [toltcl::eval {PlatformInfo(?)} -named 1] 1]
1323  if {$tol_platform(CompilerID) eq "GNU"} {
1324    set imgfile [file join $toltk_library toltk images splash-gnu.gif]
1325  } elseif {$tol_platform(CompilerID) eq "MSVC"} {
1326    set imgfile [file join $toltk_library toltk images splash-msvc.gif]
1327  } else {
1328    set imgfile [file join $toltk_library toltk images splash.gif]
1329  }
1330  set img [image create photo -file $imgfile]
1331  toplevel $w
1332  wm title $w "[mc About] TOLBase"
1333  wm withdraw $w
1334  wm transient $w .
1335  wm iconbitmap $w [wm iconbitmap .]
1336  wm resizable $w 0 0
1337  label $w.lsplash -image $img -relief ridge -bd 2
1338  array set TolVersionInfo [::tol::info version]
1339  label $w.lversion -bg black -fg white -text \
1340      "[mc {TOL Version}]: [ lindex [ toltcl::eval {Text Version} ] 0 ]"
1341  label $w.laddress -bg black -fg white -text {
1342    Bayes Forecast: dynamic modelling of operations and markets
1343    Voice: (+34) 91.5327440; Fax: (+34) 91.5322636
1344    e-Mail: request@bayesinf.com; URL: http://www.tol-project.org
1345  }
1346 
1347  button $w.bc -text [mc Close] -command [list destroy $w]
1348  grid $w.lsplash
1349  grid $w.lversion -sticky "ew"
1350  grid $w.laddress -sticky "ew"
1351  grid $w.bc -padx 2 -pady 5 -sticky ns
1352  update
1353  # Aqui deberiamos invocar a un proc CenterWindow
1354  wm geometry $w +[expr ([winfo vrootw .]-[winfo reqwidth $w])/2]+[expr ([winfo vrooth .]-[winfo reqheight $w])/2]
1355  update
1356  wm withdraw $w
1357  wm deiconify $w
1358  update
1359}
1360
1361#/////////////////////////////////////////////////////////////////////////////     
1362proc ::TolConsole::IncludeCmd {{path ""} } {
1363# 
1364#/////////////////////////////////////////////////////////////////////////////       
1365  variable data
1366  set types {
1367    {{Tol Files}  {.tol .bst .bsi .bst .bdt .oza}}
1368    {{Text Files}  {.txt}}
1369    {{All Files}  *}
1370  }
1371
1372  if {$path == ""} {
1373    if { [catch {tk_getOpenFile -filetypes $types \
1374                   -initialdir $data(path) \
1375                   -title "Source File"} fn] || [string match {} $fn] } {
1376      return
1377    }   
1378  } else  {
1379    set fn $path
1380  }
1381  UpdateListIncluded $fn
1382  Include $fn
1383   
1384
1385}
1386
1387#/////////////////////////////////////////////////////////////////////////////     
1388proc ::TolConsole::UpdateListIncluded {path} {
1389# 
1390#/////////////////////////////////////////////////////////////////////////////       
1391  variable data
1392  # guardamos el ultimo directorio abierto
1393  set data(path) [file dirname $path]
1394  if { [set idx [lsearch $data(included) $path]] == -1 } {
1395    set data(included) [linsert $data(included) 0 $path]
1396  } else {
1397    set ll ""
1398    lappend ll $path
1399    set i 0
1400    foreach f $data(included) {
1401      if  {$i != $idx} {
1402        lappend ll $f
1403      }
1404      incr i
1405    }
1406    set data(included) $ll
1407  }
1408  set data(included) [lrange $data(included) 0 [expr $data(numRecent)-1]]
1409}
1410
1411#/////////////////////////////////////////////////////////////////////////////
1412proc ::TolConsole::Exit { w } {
1413#
1414#/////////////////////////////////////////////////////////////////////////////
1415  variable data
1416  variable widgets
1417
1418  if {$w eq "."} {
1419    ProcessPendingTasks
1420   
1421    # Options project
1422    if {[info exists data(proc,OnOptionDestroy)] && \
1423            [string length $data(proc,OnOptionDestroy)]} {
1424      foreach f $data(proc,OnOptionDestroy) {
1425        $f
1426      }
1427    }
1428    WriteIni
1429  }
1430}
1431
1432#/////////////////////////////////////////////////////////////////////////////
1433proc ::TolConsole::BeforeExit { } {
1434#
1435#/////////////////////////////////////////////////////////////////////////////
1436  variable data
1437  variable widgets
1438
1439  # check all ...
1440  set okEdi ok
1441  set okETr ok
1442  set okTPr ok
1443  catch {set okEdi [::Editor::CheckAll]}
1444  catch {set okETa [::EditTable::CheckAll]}
1445  catch {set okTPr [::TolProject::CheckAll]}
1446
1447  if {[string eq $okEdi cancel] || [string eq $okETa cancel] || \
1448      [string eq $okTPr cancel]} {
1449    return cancel
1450  }
1451  # exit
1452  if { [info exists widgets(inspector)] } {
1453    foreach a {x y width height} {
1454      set data(geometry,$a) [winfo $a $widgets(inspector)]
1455    }
1456    set data(geometry,wtop) [winfo height $widgets(panes,top)]
1457    set data(geometry,wbottom) [winfo height $widgets(panes,bottom)]
1458    set data(geometry,wleft) [::TolInspector::GetWeight left]
1459    set data(geometry,wright) [::TolInspector::GetWeight right]
1460    set data(font,eval) [$widgets(eval) cget -font]
1461    set data(font,output) [$widgets(output) cget -font]
1462    set data(font,info) [$widgets(info) cget -font]
1463  }
1464  return "ok"
1465}
1466
1467#/////////////////////////////////////////////////////////////////////////////
1468proc ::TolConsole::ProcessPendingTasks {} {
1469#
1470#/////////////////////////////////////////////////////////////////////////////
1471  # para que este procedimiento?
1472  return
1473  foreach id [after info] {
1474    set aft_info [after info $id]
1475    after cancel $id
1476    eval [lindex $aft_info 0]
1477  }
1478}
1479
1480#///////////////////////////////////////////////////////////////////////////// 
1481proc ::TolConsole::OptionsCreate { {tabinit ""} } {
1482#
1483# PURPOSE: Create the dialog of options of TolBase
1484#
1485# PARAMETERS:
1486#   tabinit -> Tab where is focused the dialog when it's displayed (Optional).
1487#
1488#///////////////////////////////////////////////////////////////////////////// 
1489  variable widgets
1490  variable data
1491
1492  set path $widgets(inspector)
1493
1494  set dialog [Dialog $path.t -title [mc "TOLBase Options"]\
1495              -parent $path -default 0 -cancel 1 -modal local] 
1496  wm protocol $dialog WM_DELETE_WINDOW \
1497    [list ::TolConsole::OptionsDestroy $dialog]
1498  set w [$dialog getframe]
1499 
1500  wm resizable $dialog 0 0
1501  # TabSet TolBase
1502  set w_ts [::blt::tabset $w.ts -relief flat -highlightthickness 0 -bd 0 \
1503    -outerpad 0 -tier 2 -slant both -textside right -side left -rotate 90 ]
1504  #insertar tabset
1505  $w_ts insert end TolBase
1506  set f0 [frame $w_ts.f0] 
1507  $w_ts tab configure "TolBase" -text "TolBase" \
1508    -window $f0 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75 
1509 
1510  # TabSet Options
1511  set w_tabset [::blt::tabset $f0.ts -relief flat -highlightthickness 0\
1512    -bd 0 -outerpad 0 -tier 2 -slant right -textside right ]
1513 
1514  $w_tabset insert end TOL Output Precision Paths Others
1515  set f1 [frame $w_tabset.f1]
1516  set f2 [frame $w_tabset.f2]
1517  set f3 [frame $w_tabset.f3]
1518  set f4 [frame $w_tabset.f4]
1519  set f5 [frame $w_tabset.f5]
1520
1521  $w_tabset tab configure "TOL" -text [mc "TOL"] -window $f1\
1522       -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1523  $w_tabset tab configure "Output" -text [mc "Output"] -window $f2\
1524       -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1525  $w_tabset tab configure "Precision" -text [mc "Precision"] -window $f3\
1526       -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1527  $w_tabset tab configure "Paths" -text [mc "Paths"] -window $f5\
1528       -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1529  $w_tabset tab configure "Others" -text [mc "Others"] -window $f4\
1530       -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
1531
1532  OptionsGet
1533  OptionsCreateTOL        $f1
1534  OptionsCreateOutput     $f2
1535  OptionsCreatePrecision  $f3
1536  OptionsCreatePaths      $f5
1537  OptionsCreateOthers     $f4
1538 
1539  # Options project
1540  if {[info exists data(proc,OnOptionCreate)] && \
1541      [string length $data(proc,OnOptionCreate)]} {
1542    foreach f $data(proc,OnOptionCreate) {
1543      $f $w_ts
1544    }
1545  }
1546
1547  OptionsCheck
1548
1549  set w_bbox \
1550          [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1551          -homogeneous false]
1552  $w_bbox add -text [mc "Accept"] -relief link \
1553          -helptext [mc "Make the changes and leave the dialog"] \
1554          -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1555          -command [list ::TolConsole::OptionsOK $dialog]
1556  $w_bbox add -text [mc "Cancel"] -relief link \
1557          -helptext [mc "Leave the dialog without apply any change"] \
1558          -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1559          -command [list ::TolConsole::OptionsDestroy $dialog]
1560  $w_bbox add -text [mc "Apply"] -relief link \
1561          -helptext [mc "Make the changes without leave the dialog"] \
1562          -image [::Bitmap::get apply] -compound left -padx 5 -pady 1 \
1563          -command ::TolConsole::OptionsApply
1564
1565  pack $w_bbox   -side bottom -expand no  -fill x
1566  pack $w_tabset -side top    -expand yes -fill both
1567  pack $w_ts -expand yes -fill both ;#-sticky news
1568 
1569  if {!($tabinit eq "")} {
1570    switch -exact $tabinit  {
1571      "TOL" {
1572        $w_tabset select 0
1573      }
1574      "Output" {
1575        $w_tabset select 1
1576      }
1577      "Precision" {
1578        $w_tabset select 2
1579      }
1580      "Paths" {
1581        $w_tabset select 3
1582      }
1583      "Others" {
1584        $w_tabset select 4
1585      }     
1586    }
1587  }
1588  bind $dialog <F1> "ShowHelp Tb4Opc"
1589  $dialog draw
1590}
1591
1592
1593#///////////////////////////////////////////////////////////////////////////// 
1594proc ::TolConsole::OptionsCreateTOL {w} {
1595#
1596#///////////////////////////////////////////////////////////////////////////// 
1597  variable tmpOpt
1598
1599  #TitleFrame $w.tf1 -text [mc "--"]
1600  #set f1 [$w.tf1 getframe]
1601
1602  TitleFrame $w.tf2 -text [mc "Default dates"]
1603  set f2 [$w.tf2 getframe]
1604
1605  label $f2.lFirstDate -text [mc "First date"]:
1606  ::Objects::ChooseDateCreate ::TolConsole::tmpOpt(var,DefFirst) $f2.cFD
1607
1608  label $f2.lLastDate -text [mc "Last date"]:
1609  ::Objects::ChooseDateCreate ::TolConsole::tmpOpt(var,DefLast) $f2.cLD
1610
1611  frame $f2.f -width 25
1612
1613  grid $f2.f $f2.lFirstDate $f2.cFD $f2.lLastDate $f2.cLD -sticky nw -padx 2
1614  grid rowconfigure    $f2 0 -weight 1
1615  grid columnconfigure $f2 4 -weight 1
1616  grid columnconfigure $f2 2 -pad 10
1617 
1618
1619  #grid $w.tf1 -sticky news -padx 2
1620  grid $w.tf2 -sticky news -padx 2
1621     
1622  grid rowconfigure    $w 0 -weight 1
1623  grid rowconfigure    $w 1 -weight 3
1624  grid columnconfigure $w 0 -weight 1
1625
1626}
1627
1628#/////////////////////////////////////////////////////////////////////////////   
1629proc ::TolConsole::OptionsCreateOutput {w} {
1630# 
1631#/////////////////////////////////////////////////////////////////////////////   
1632  global toltk_options
1633  variable tmpOpt
1634
1635  TitleFrame $w.tf1 -text [mc "Write"]
1636  set f1 [$w.tf1 getframe]
1637
1638  checkbutton $f1.chWrite -text [mc "Write messages in output window"]\
1639      -variable ::TolConsole::tmpOpt(var,chWrite)
1640  label $f1.lColorErr -text [mc "Errors color"]:
1641  bcolor $f1.fColorErr -variable ::TolConsole::tmpOpt(var,colorErr)
1642  #::Objects::ColorCreate ::TolConsole::tmpOpt(var,colorErr) $f1.fColorErr
1643  label $f1.lColorWar -text [mc "Warnings color"]:
1644  ::Objects::ColorCreate ::TolConsole::tmpOpt(var,colorWar) $f1.fColorWar
1645
1646  frame $f1.f  -width 20
1647  grid $f1.f $f1.chWrite   -             -             -             -sticky nw -padx 2
1648  grid ^     $f1.lColorErr $f1.fColorErr $f1.lColorWar $f1.fColorWar -sticky nw -padx 2
1649
1650  grid rowconfigure    $f1 1 -weight 1
1651  grid columnconfigure $f1 4 -weight 1
1652  grid columnconfigure $f1 2 -pad 20
1653
1654
1655  TitleFrame $w.tf2 -text [mc "Update"]
1656  set f2 [$w.tf2 getframe]
1657
1658  label $f2.lUpdateType -text [mc "Update options"]:
1659  frame $f2.f1 -width 15
1660  radiobutton $f2.rbAlways -text [mc "Update always"]\
1661     -value always -highlightthickness 0 -pady 0\
1662     -variable ::TolConsole::tmpOpt(var,updateType)\
1663     -command ::TolConsole::OptionsCheckUpdateType
1664  radiobutton $f2.rbEach   -text [mc "Update each"]\
1665     -value each   -highlightthickness 0 -pady 0\
1666     -variable ::TolConsole::tmpOpt(var,updateType)\
1667     -command ::TolConsole::OptionsCheckUpdateType
1668  radiobutton $f2.rbNever -text [mc "Don't update until the end"]\
1669     -value never  -highlightthickness 0 -pady 0\
1670     -variable ::TolConsole::tmpOpt(var,updateType)\
1671     -command ::TolConsole::OptionsCheckUpdateType
1672  set tmpOpt(widget,updateSec) [SpinBox $f2.sbSeconds -justify right -width 4 \
1673      -editable 0 -range {0 2000 20} \
1674      -textvariable ::TolConsole::tmpOpt(var,updateSec)]
1675  label $f2.lSeconds -text [mc milliseconds]
1676
1677  frame $f2.f -width 20
1678  grid $f2.f $f2.lUpdateType -     -             -             -sticky nw -padx 2
1679  grid ^     $f2.f1  $f2.rbAlways  -             -             -sticky nw -padx 2
1680  grid ^     ^       $f2.rbEach    $f2.sbSeconds $f2.lSeconds  -sticky nw -padx 2
1681  grid ^     ^       $f2.rbNever   -             -             -sticky nw -padx 2
1682
1683  grid rowconfigure    $f2 3 -weight 1
1684  grid columnconfigure $f2 4 -weight 1
1685 
1686  grid $w.tf1 -sticky news -padx 2
1687  grid $w.tf2 -sticky news -padx 2
1688  grid rowconfigure    $w 1 -weight 1
1689  grid columnconfigure $w 0 -weight 1
1690}
1691
1692#/////////////////////////////////////////////////////////////////////////////     
1693proc ::TolConsole::OptionsCreatePrecision {w} {
1694# 
1695#/////////////////////////////////////////////////////////////////////////////     
1696  variable tmpOpt
1697
1698  TitleFrame $w.tf1 -text [mc "Precision"]
1699  set f1 [$w.tf1 getframe]
1700
1701  checkbutton $f1.chDecimals -text [mc "Reduce decimal digits to"]\
1702      -variable ::TolConsole::tmpOpt(var,chDecimals)\
1703      -command ::TolConsole::OptionsCheckDecimals
1704  set tmpOpt(widget,decimals) [SpinBox $f1.sbDecimals -justify right -width 4 \
1705      -editable 0 -range {0 10} \
1706      -textvariable ::TolConsole::tmpOpt(var,numDecimals)]
1707  label $f1.lDecimals -text [mc digits]
1708   
1709  checkbutton $f1.chExponential \
1710      -text [mc "Use exponential notation when number has more than"]\
1711      -variable ::TolConsole::tmpOpt(var,chExponential)\
1712      -command ::TolConsole::OptionsCheckExponential
1713  set tmpOpt(widget,exponential) [SpinBox $f1.sbExponential -justify right -width 4 \
1714      -editable 0 -range {0 10} \
1715      -textvariable ::TolConsole::tmpOpt(var,numExponential)]
1716  label $f1.lExponential -text [mc digits]
1717
1718  frame $f1.f -width 25
1719
1720  grid $f1.f $f1.chDecimals    $f1.sbDecimals    $f1.lDecimals    -sticky nw -padx 2
1721  grid ^     $f1.chExponential $f1.sbExponential $f1.lExponential -sticky nw -padx 2
1722  grid rowconfigure    $f1 1 -weight 1
1723  grid columnconfigure $f1 3 -weight 1     
1724 
1725  grid $w.tf1 -sticky news -padx 2
1726  #grid $w.tf2 -sticky news -padx 2
1727     
1728  grid rowconfigure    $w 0 -weight 1
1729  #grid rowconfigure    $w 1 -weight 2
1730  grid columnconfigure $w 0 -weight 1
1731}
1732
1733#/////////////////////////////////////////////////////////////////////////////     
1734proc ::TolConsole::OptionsCreatePaths {w} {
1735#
1736#/////////////////////////////////////////////////////////////////////////////       
1737  variable tmpOpt
1738
1739  TitleFrame $w.tf -text [mc "Paths"]
1740  set f [$w.tf getframe]
1741
1742  label $f.lPathBrowser   -text [mc "Browser path"]
1743  label $f.lPathPDFViewer -text [mc "PDF viewer path"]
1744  label $f.lPathHelp      -text [mc "Help path"]
1745  Entry $f.ePathBrowser   -state normal -width 30 \
1746    -textvariable ::TolConsole::tmpOpt(var,pathBrowser) \
1747    -helptext [mc pathexplanation]
1748  Entry $f.ePathPDFViewer -state normal -width 30 \
1749    -textvariable ::TolConsole::tmpOpt(var,pathPDFViewer)  \
1750    -helptext [mc pathexplanation]
1751  Entry $f.ePathHelp -state normal -width 30 \
1752    -textvariable ::TolConsole::tmpOpt(var,pathHelp) 
1753  Button $f.bPathBrowser -compound left -padx 10 \
1754    -height 16 -relief link \
1755    -helptext [mc "Search the program path"] \
1756    -image [Bitmap::get bopen] \
1757    -command {::TolConsole::OptionsCreatePath "Browser"}
1758  Button $f.bPathPDFViewer -compound left -padx 10 \
1759    -height 16 -relief link \
1760    -helptext [mc "Search the program path"] \
1761    -image [Bitmap::get bopen] \
1762    -command {::TolConsole::OptionsCreatePath "PDFViewer"}
1763  Button $f.bPathHelp -compound left -padx 10 \
1764    -height 16 -relief link \
1765    -helptext [mc "Search the folder"] \
1766    -image [Bitmap::get bopen] \
1767    -command  {set tmp [tk_chooseDirectory -initialdir $::TolConsole::tmpOpt(var,pathHelp) -mustexist 1]
1768               if {!($tmp eq "")} {
1769                 set ::TolConsole::tmpOpt(var,pathHelp) $tmp
1770               } }
1771
1772  grid $f.lPathBrowser   -row 0 -column 0 -sticky nw  -padx 5 -pady 5
1773  grid $f.lPathPDFViewer -row 1 -column 0 -sticky nw  -padx 5 -pady 5
1774  grid $f.lPathHelp      -row 2 -column 0 -sticky nw  -padx 5 -pady 5
1775  grid $f.ePathBrowser   -row 0 -column 1 -sticky new -padx 5 -pady 5
1776  grid $f.ePathPDFViewer -row 1 -column 1 -sticky new -padx 5 -pady 5
1777  grid $f.ePathHelp      -row 2 -column 1 -sticky new -padx 5 -pady 5
1778  grid $f.bPathBrowser   -row 0 -column 2 -sticky e   -padx 5 -pady 5
1779  grid $f.bPathPDFViewer -row 1 -column 2 -sticky e   -padx 5 -pady 5
1780  grid $f.bPathHelp      -row 2 -column 2 -sticky e   -padx 5 -pady 5
1781
1782  grid columnconfigure $f 1  -weight 1
1783  grid rowconfigure    $f 10 -weight 1
1784 
1785  grid $w.tf -sticky news
1786 
1787  grid columnconfigure $w 0 -weight 1
1788  grid rowconfigure    $w 0 -weight 1
1789}
1790
1791#/////////////////////////////////////////////////////////////////////////////     
1792proc ::TolConsole::OptionsCreatePath { type } {
1793#
1794# PURPOSE: Executes the command associated to the create path buttons:
1795#          Shows a dialog OpenFile with the directory and the appropriate
1796#          file type according to the operating system
1797#
1798# PARAMETERS: Type of path. Allowed values "Browser" "PDFViewer"
1799#
1800# TODO: For linux, to verify that the file is executable
1801#
1802#/////////////////////////////////////////////////////////////////////////////         
1803  variable tmpOpt
1804 
1805  if { $::tcl_platform(platform) == "windows" } {
1806    # get the "Program Files" directory
1807    set dirProgramFiles [registry get \
1808      {HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Session Manager\SFC} \
1809      ProgramFilesDir]
1810    set txtExecFileType "\{\{\{[mc {Executable files} ]\} .exe\}\}"
1811    set commandFile "tk_getOpenFile \
1812      -initialdir [list $dirProgramFiles] -f $txtExecFileType"
1813  } else {  ;# linux
1814    set commandFile "tk_getOpenFile -initialdir \\"
1815  }
1816 
1817  #set ::TolConsole::tmpOpt(var,path$type) [eval $commandFile]
1818  set tmp [eval $commandFile]
1819  if { !($tmp eq "") } {
1820     set ::TolConsole::tmpOpt(var,path$type) $tmp
1821  } 
1822}
1823 
1824#/////////////////////////////////////////////////////////////////////////////     
1825proc ::TolConsole::OptionsCreateOthers {w} {
1826# 
1827#/////////////////////////////////////////////////////////////////////////////       
1828  variable tmpOpt
1829  variable languages
1830
1831  TitleFrame $w.tf1 -text [mc "General Options"]
1832  set f1 [$w.tf1 getframe]
1833
1834  label $f1.lRecent -text [mc "Number of last edited files"]
1835
1836  set tmpOpt(widget,recent) [SpinBox $f1.sbRecent -justify right -width 4 \
1837      -editable 0 -range {0 10} \
1838      -textvariable ::TolConsole::tmpOpt(var,numRecent)]
1839  label $f1.lFiles -text [mc files]
1840
1841  radiobutton $f1.rbOrdDate -text [mc "Order by date"]\
1842     -value date -highlightthickness 0 -pady 0\
1843     -variable ::TolConsole::tmpOpt(var,ordRecent)
1844  radiobutton $f1.rbOrdAsc   -text [mc "Order alphabetically"]\
1845     -value asc   -highlightthickness 0 -pady 0\
1846     -variable ::TolConsole::tmpOpt(var,ordRecent)
1847  radiobutton $f1.rbOrdDesc -text [mc "Order reverse alphabetically"]\
1848     -value desc  -highlightthickness 0 -pady 0\
1849     -variable ::TolConsole::tmpOpt(var,ordRecent)
1850   
1851  frame $f1.f -width 25
1852
1853  grid $f1.f $f1.lRecent   $f1.sbRecent $f1.lFiles -sticky nw -padx 2
1854  grid ^     $f1.rbOrdDate -            -          -sticky nw -padx 2
1855  grid ^     $f1.rbOrdAsc  -            -          -sticky nw -padx 2
1856  grid ^     $f1.rbOrdDesc -            -          -sticky nw -padx 2
1857
1858  grid rowconfigure    $f1 0 -weight 1
1859  grid rowconfigure    $f1 1 -weight 1
1860 
1861  grid rowconfigure    $f1 2 -weight 1
1862 
1863  grid columnconfigure $f1 3 -weight 1
1864  grid columnconfigure $f1 4 -weight 1
1865 
1866  TitleFrame $w.tf2 -text [mc "Language"]
1867  set f2 [$w.tf2 getframe]
1868
1869  label $f2.lLanguage -text [mc "Choose language"]:
1870  foreach {key value} $languages {
1871    lappend values [mc $value]
1872  }
1873
1874  ComboBox $f2.cbLanguages -width 12 -height 5 -editable false -justify right -values $values\
1875   -modifycmd   [list ::Objects::ComboUnTranslateDbl $f2.cbLanguages $languages\
1876       ::TolConsole::tmpOpt(var,language)]
1877  ::Objects::ComboSetIniDbl $f2.cbLanguages $languages ::TolConsole::tmpOpt(var,language)
1878 
1879
1880  label $f2.lLangExp -text ([mc "Language is set when you restart interface"])
1881  frame $f2.f -width 25
1882  grid $f2.f $f2.lLanguage $f2.cbLanguages -sticky nw -padx 2
1883  grid ^     $f2.lLangExp  -               -sticky nw -padx 2
1884  grid rowconfigure    $f2 1 -weight 1
1885  grid columnconfigure $f2 2 -weight 1
1886 
1887  TitleFrame $w.tf3 -text [mc "Object Inspector"]
1888  set f3 [$w.tf3 getframe]
1889  checkbutton $f3.chObjIns -text [mc "Show Object Inspector"]\
1890      -variable ::TolConsole::tmpOpt(var,chObjIns)
1891 
1892  label $f3.lObjIns -text ([mc "Object Inspector visualization is set when you restart interface"])
1893 
1894  grid $f3.chObjIns -sticky nw -padx 2
1895  grid $f3.lObjIns  -sticky nw -padx 2
1896  grid rowconfigure    $f3 1 -weight 1
1897  grid columnconfigure $f3 2 -weight 1
1898 
1899 
1900  grid $w.tf1 -sticky news -padx 2
1901  grid $w.tf2 -sticky news -padx 2
1902  grid $w.tf3 -sticky news -padx 2
1903     
1904  grid rowconfigure    $w 0 -weight 1
1905  grid rowconfigure    $w 1 -weight 1
1906  grid rowconfigure    $w 2 -weight 1
1907  grid columnconfigure $w 0 -weight 1
1908}
1909
1910#/////////////////////////////////////////////////////////////////////////////     
1911proc ::TolConsole::OptionsGet {} {
1912# 
1913#/////////////////////////////////////////////////////////////////////////////       
1914  variable data
1915  variable tmpOpt
1916  set tmpOpt(var,numRecent)      $data(numRecent)
1917  set tmpOpt(var,ordRecent)      $data(ordRecent)
1918  set tmpOpt(var,language)       $data(language)
1919  set tmpOpt(var,chDecimals)     $data(chDecimals)
1920  set tmpOpt(var,numDecimals)    $data(numDecimals)
1921  set tmpOpt(var,chExponential)  $data(chExponential)
1922  set tmpOpt(var,numExponential) $data(numExponential)
1923  set tmpOpt(var,DefFirst)       $data(DefFirst)
1924  set tmpOpt(var,DefLast)        $data(DefLast)
1925  set tmpOpt(var,colorErr)       $data(colorErr)
1926  set tmpOpt(var,colorWar)       $data(colorWar)
1927  set tmpOpt(var,chWrite)        $data(chWrite)
1928  set tmpOpt(var,updateType)     $data(updateType)
1929  set tmpOpt(var,updateSec)      $data(updateSec)
1930  set tmpOpt(var,showODBC)       $data(showODBC)
1931  set tmpOpt(var,pathBrowser)    $data(pathBrowser)
1932  set tmpOpt(var,pathPDFViewer)  $data(pathPDFViewer)
1933  set tmpOpt(var,pathHelp)       $data(pathHelp)
1934  set tmpOpt(var,chObjIns)       $data(chObjIns)
1935 
1936 
1937}
1938
1939#/////////////////////////////////////////////////////////////////////////////     
1940proc ::TolConsole::OptionsSet {} {
1941# 
1942#/////////////////////////////////////////////////////////////////////////////       
1943  variable data
1944  variable tmpOpt
1945   
1946  regsub -all var, [array names ::TolConsole::tmpOpt var,*] "" optNames
1947   
1948  foreach it $optNames {
1949    set data($it) $tmpOpt(var,$it)
1950  }
1951}
1952
1953#/////////////////////////////////////////////////////////////////////////////     
1954proc ::TolConsole::OptionsCheck {} {
1955# 
1956#/////////////////////////////////////////////////////////////////////////////       
1957  OptionsCheckUpdateType
1958  OptionsCheckDecimals
1959  OptionsCheckExponential
1960}
1961
1962#/////////////////////////////////////////////////////////////////////////////     
1963proc ::TolConsole::OptionsCheckDecimals {} {
1964# 
1965#/////////////////////////////////////////////////////////////////////////////       
1966  variable tmpOpt
1967  if {!$tmpOpt(var,chDecimals)} {
1968    $tmpOpt(widget,decimals) configure -state disabled
1969  } else  {
1970    $tmpOpt(widget,decimals) configure -state normal
1971  }
1972}
1973
1974#/////////////////////////////////////////////////////////////////////////////     
1975proc ::TolConsole::OptionsCheckExponential {} {
1976# 
1977#/////////////////////////////////////////////////////////////////////////////       
1978  variable tmpOpt
1979  if {!$tmpOpt(var,chExponential)} {
1980    $tmpOpt(widget,exponential) configure -state disabled
1981  } else  {
1982    $tmpOpt(widget,exponential) configure -state normal
1983  }
1984}
1985
1986#/////////////////////////////////////////////////////////////////////////////     
1987proc ::TolConsole::OptionsCheckUpdateType {} {
1988# 
1989#/////////////////////////////////////////////////////////////////////////////       
1990  variable tmpOpt
1991
1992  switch $tmpOpt(var,updateType) {
1993    always {
1994      $tmpOpt(widget,updateSec) configure -state disabled
1995    }
1996    each {
1997      $tmpOpt(widget,updateSec) configure -state normal
1998    }
1999    never {
2000      $tmpOpt(widget,updateSec) configure -state disabled
2001    }
2002  }
2003}
2004
2005#/////////////////////////////////////////////////////////////////////////////     
2006proc ::TolConsole::OptionsDestroy {dialog} {
2007# 
2008#/////////////////////////////////////////////////////////////////////////////       
2009  #variable data
2010  variable tmpOpt
2011
2012  array unset tmpOpt
2013  destroy $dialog
2014}
2015
2016#/////////////////////////////////////////////////////////////////////////////     
2017proc ::TolConsole::OptionsApply {} {
2018# 
2019#/////////////////////////////////////////////////////////////////////////////
2020  variable data
2021  # Apply
2022  OptionsSet
2023  OptionsApplyLanguage
2024  OptionsApplyDefDates
2025  OptionsApplyColors
2026  # Options project Apply
2027  if {[info exists data(proc,OnOptionApply)] && \
2028      [string length $data(proc,OnOptionApply)]} {
2029    foreach f $data(proc,OnOptionApply) {
2030      $f
2031    }
2032  }
2033  # Write INI
2034  WriteIni
2035}
2036
2037#/////////////////////////////////////////////////////////////////////////////     
2038proc ::TolConsole::OptionsApplyLanguage {} {
2039# 
2040#/////////////////////////////////////////////////////////////////////////////       
2041  global toltk_script_path
2042  variable data
2043
2044  ::tol::language $data(language)
2045  ::msgcat::mclocale $data(language)
2046  ::msgcat::mcload [file join $toltk_script_path msgs]
2047  # sincroniza con tolconfig
2048  if { $data(language) eq "es" } {
2049    set tl "CASTELLANO"
2050  } else {
2051    set tl "ENGLISH"
2052  }
2053  set script [ string map [ list %L $tl ] {
2054    Text TolConfigManager::Config::Various::Language := "%L";
2055    Real TolConfigManager::Save(?)
2056  } ]
2057  toltcl::eval $script
2058}
2059
2060#/////////////////////////////////////////////////////////////////////////////     
2061proc ::TolConsole::OptionsApplyDefDates {} {
2062# 
2063#/////////////////////////////////////////////////////////////////////////////       
2064  variable data
2065  set expr "Date PutDefaultDates([DateTol $data(DefFirst)],[DateTol $data(DefLast)]);"
2066  #Tolcon_Trace "$expr"
2067  ::tol::console eval $expr
2068}
2069
2070#/////////////////////////////////////////////////////////////////////////////     
2071proc ::TolConsole::OptionsApplyColors {} {
2072# 
2073#/////////////////////////////////////////////////////////////////////////////       
2074  variable data
2075  variable widgets
2076
2077  $widgets(output) tag configure errorTag   -foreground $data(colorErr)
2078  $widgets(output) tag configure warningTag -foreground $data(colorWar)
2079}
2080
2081#/////////////////////////////////////////////////////////////////////////////     
2082proc ::TolConsole::OptionsOK {dialog} {
2083# 
2084#/////////////////////////////////////////////////////////////////////////////       
2085  OptionsApply
2086  OptionsDestroy $dialog
2087}
2088
2089#/////////////////////////////////////////////////////////////////////////////
2090  proc ::TolConsole::ReadIni {} {
2091#
2092# PURPOSE: Reads general TolBase options from .ini file.
2093#
2094#/////////////////////////////////////////////////////////////////////////////
2095  global toltk_script_path
2096  global toltk_options
2097  variable data
2098  set rini ::iniFile::Read
2099 
2100  #inicializo variable necesaria para las toolbars
2101  set data(tolbase,lsttoolbars) [$rini TolConsole listtoolbars]
2102  if {![llength $data(tolbase,lsttoolbars)]} {
2103    set data(tolbase,lsttoolbars) {}
2104  }
2105   
2106  set data(path)           [$rini TolConsole path       $toltk_script_path]
2107  set data(included)       [$rini TolConsole recent     {}]
2108  set data(chIncluded)     [$rini TolConsole saveRecent 1]
2109  set data(numRecent)      [$rini TolConsole numRecent  8]
2110  set data(ordRecent)      [$rini TolConsole ordRecent  "date"]
2111  set data(tabRecent)      [$rini TolConsole tabRecent  {}]
2112  set data(prjRecent)      [$rini TolConsole prjRecent  {}]
2113  set data(incRecent)      [$rini TolConsole incRecent  {}]
2114  set data(ediRecent)      [$rini TolConsole ediRecent  {}] 
2115  set data(font,eval)      [$rini TolConsole evalFont   \
2116    $toltk_options(fonts,Fixed)]
2117  set data(font,output)    [$rini TolConsole outputFont \
2118    $toltk_options(fonts,Fixed)]
2119  set data(font,info)      [$rini TolConsole infoFont   \
2120    $toltk_options(fonts,Fixed)]
2121  set data(language)       [$rini TolConsole language   es]
2122  set data(chDecimals)     [$rini TolConsole redDecimals    0]
2123  set data(numDecimals)    [$rini TolConsole numDecimals    4]
2124  set data(chExponential)  [$rini TolConsole useExponential 0]
2125  set data(numExponential) [$rini TolConsole numExponential 8]
2126  set data(DefFirst)       [$rini TolConsole DefFirst [::tol::date first]]
2127  set data(DefLast)        [$rini TolConsole DefLast  [::tol::date last ]]
2128  set data(colorWar)       [$rini TolConsole colorWar blue]
2129  set data(colorErr)       [$rini TolConsole colorErr red]
2130  set data(chWrite)        [$rini TolConsole writeOutput 1]
2131  set data(updateType)     [$rini TolConsole updateType always]
2132  set data(updateSec)      [$rini TolConsole updateSec 200]
2133  set data(showODBC)       [$rini TolConsole ShowODBCDialog 0]
2134 
2135  # program paths
2136  set data(pathBrowser)   [$rini TolConsole pathBrowser {}]
2137  set data(pathPDFViewer) [$rini TolConsole pathPDFViewer {}]
2138  set data(pathHelp)      [$rini TolConsole pathHelp {}]
2139 
2140  # Object Inspector visualization
2141  set data(chObjIns)      [$rini TolConsole chObjIns {}]
2142 
2143  # geometry
2144
2145#  set data(geometry,x) [$rini TolConsole geometry:x -1]
2146#  set data(geometry,y) [$rini TolConsole geometry:y -1]
2147#  set data(geometry,width) [$rini TolConsole geometry:width -1]
2148#  set data(geometry,height) [$rini TolConsole geometry:height -1]
2149  set data(geometry,wtop)    [$rini TolConsole geometry:wtop 5]
2150  set data(geometry,wbottom) [$rini TolConsole geometry:wbottom 1]
2151  set data(geometry,wleft)   [$rini TolConsole geometry:wleft 3]
2152  set data(geometry,wright)  [$rini TolConsole geometry:wright 7]
2153  set data(viewmode)         [$rini TolConsole viewmode middle]
2154 
2155  #cargamos los parametros de las toolbars
2156  set data(toolbars,side) [$rini ToolBars side top]
2157  set data(toolbars,fill) [$rini ToolBars fill x]
2158  set data(toolbars,buttonbar,side) [$rini ToolBars buttonbar:side left]
2159  set data(toolbars,buttonbar,fill) [$rini ToolBars buttonbar:fill y]
2160 
2161  set data(tolbase,ini) 0
2162  set data(tolbase,original) 0
2163}
2164
2165#/////////////////////////////////////////////////////////////////////////////
2166proc ::TolConsole::WriteIni {} {
2167#
2168# PURPOSE: Writes general TolBase options to .ini file.
2169#
2170#/////////////////////////////////////////////////////////////////////////////
2171  variable data
2172  variable widgets
2173
2174  set wini ::iniFile::Write
2175  $wini TolConsole path           $data(path)
2176  $wini TolConsole recent         $data(included)
2177  $wini TolConsole saveRecent     $data(chIncluded)
2178  $wini TolConsole numRecent      $data(numRecent)
2179  $wini TolConsole ordRecent      $data(ordRecent)
2180  $wini TolConsole evalFont       $data(font,eval)
2181  $wini TolConsole outputFont     $data(font,output)
2182  $wini TolConsole infoFont       $data(font,info)
2183  $wini TolConsole language       $data(language)
2184  $wini TolConsole redDecimals    $data(chDecimals)
2185  $wini TolConsole numDecimals    $data(numDecimals)
2186  $wini TolConsole useExponential $data(chExponential)
2187  $wini TolConsole numExponential $data(numExponential)
2188  $wini TolConsole DefFirst       $data(DefFirst)
2189  $wini TolConsole DefLast        $data(DefLast)
2190  $wini TolConsole colorWar       $data(colorWar)
2191  $wini TolConsole colorErr       $data(colorErr)
2192  $wini TolConsole writeOutput    $data(chWrite)
2193  $wini TolConsole updateType     $data(updateType)
2194  $wini TolConsole updateSec      $data(updateSec)
2195  $wini TolConsole ShowODBCDialog $data(showODBC)
2196  $wini TolConsole tabRecent      $data(tabRecent)
2197  $wini TolConsole prjRecent      $data(prjRecent)
2198  $wini TolConsole incRecent      $data(incRecent)
2199  $wini TolConsole ediRecent      $data(ediRecent)
2200
2201  # program paths
2202  $wini TolConsole pathBrowser    $data(pathBrowser)
2203  $wini TolConsole pathPDFViewer  $data(pathPDFViewer)
2204  $wini TolConsole pathHelp       $data(pathHelp)
2205 
2206  # Object Inspector visualization
2207  $wini TolConsole chObjIns       $data(chObjIns)
2208 
2209  # geometry configuration
2210  #  $wini TolConsole geometry:x $data(geometry,x)
2211  #  $wini TolConsole geometry:y $data(geometry,y)
2212  #  $wini TolConsole geometry:width $data(geometry,width)
2213  #  $wini TolConsole geometry:height $data(geometry,height)
2214  $wini TolConsole geometry:wtop    $data(geometry,wtop)
2215  $wini TolConsole geometry:wbottom $data(geometry,wbottom)
2216  $wini TolConsole geometry:wleft   $data(geometry,wleft)
2217  $wini TolConsole geometry:wright  $data(geometry,wright)
2218  $wini TolConsole viewmode         $data(viewmode)
2219  #::iniFile::Flush
2220 
2221  # escribimos las opciones para las barra de botones
2222  if { [winfo exists ${::project::widgets(mainframe)}.toolbarFrame]} {
2223    set packopts [pack info ${::project::widgets(mainframe)}.toolbarFrame]
2224    array set packoptsarray $packopts
2225    $wini ToolBars side $packoptsarray(-side)
2226        $wini ToolBars fill $packoptsarray(-fill)
2227    #set packopts [pack info ${::project::widgets(mainframe)}.toolbarFrame.tb1]
2228    #array set packoptsarray $packopts
2229    #$wini ToolBars buttonbar:side $packoptsarray(-side)
2230        #$wini ToolBars buttonbar:fill $packoptsarray(-fill)
2231  }
2232 
2233  # escribimos las opciones de los documentos abiertos
2234  $::project::widgets(mainmdi) writeDocsIni
2235 
2236  # escribilos las barras de botones que tenemos creadas
2237  # clear the bars created by code
2238  if {[info exists widgets(tbCustom,path)]} {
2239    set lsttollbarsaux {}
2240    foreach ltb $data(tolbase,lsttoolbars) {
2241      if {![string eq $widgets(tbCustom,path) [lindex $ltb 0]]} {
2242        lappend lsttollbarsaux $ltb
2243      } 
2244    }
2245    $wini TolConsole listtoolbars  $lsttollbarsaux
2246  }
2247}
2248
2249#/////////////////////////////////////////////////////////////////////////////
2250  proc ::TolConsole::ODBCShow {} {
2251#
2252# PURPOSE: Show the connection ODBC dialog
2253#
2254#/////////////////////////////////////////////////////////////////////////////
2255  variable data
2256  if {$data(showODBC)} {
2257    set values [::ODBCDialog::ReadIni] 
2258    ::ODBCDialog::Create $::project::widgets(mainframe) \
2259      [lindex $values 0] [lindex $values 1] "" \
2260      ::TolConsole::OnConnect ::TolConsole::OnDisconnect
2261  }
2262}
2263
2264#/////////////////////////////////////////////////////////////////////////////
2265  proc ::TolConsole::ObjectInspectorShow {} {
2266#
2267# PURPOSE: Show Object inspector
2268#
2269#/////////////////////////////////////////////////////////////////////////////
2270  variable data
2271  if {$data(chObjIns) ne "" &&
2272      [string is boolean $data(chObjIns)] && !$data(chObjIns)} {
2273    $::TolConsole::widgets(inspector) withdraw
2274  }
2275}
2276
2277#/////////////////////////////////////////////////////////////////////////////
2278  proc ::TolConsole::GetGCFFile {} {
2279#
2280# PURPOSE: Obtain the GCFFile file of .ini and showed to message in the
2281#          window output
2282#
2283#/////////////////////////////////////////////////////////////////////////////
2284  # GCFFile
2285  set gcfFile [::iniFile::Read SeriesGraph GCFFile {}]
2286  if {[string length $gcfFile]} {
2287    ::tol::console eval "Text (GCFFile := \"$gcfFile\");"
2288    ::TolConsole::HciWriter "Text GCFFile = \"$gcfFile\"\n"
2289  }
2290}
2291
2292
2293#/////////////////////////////////////////////////////////////////////////////
2294  proc ::TolConsole::MenuMDI { } {
2295#
2296# PURPOSE: Crea un menu para mdi
2297#
2298#/////////////////////////////////////////////////////////////////////////////
2299  #cargo la lista de formularios
2300  set ::toolbar::data(toolbar,tolbase,lstcmd) {}
2301 
2302  set md [.mainmenu cget -definition]
2303  set hook $::project::data(menuhook)
2304  set hookhelp $::project::data(menuhookhelp)
2305
2306  set id [$md insert $hook cascade -label [mc &File]]
2307
2308  set cid [$md add $id cascade -label [mc &New] ]
2309  $md add $cid command -label [mc "TOL &file"] \
2310      -command "::Editor::New"
2311  $md add $cid command -label [mc "&Table"] \
2312      -command "::TolConsole::TableNew"
2313  $md add $cid command -label [mc "&Project"] \
2314      -command "::TolProject::New"
2315 
2316  set cid [$md add $id cascade -label [mc &Open] ]
2317  $md add $cid command -label [mc "TOL &file"] \
2318      -command "::Editor::Open"
2319  $md add $cid command -label [mc "&Table"] \
2320      -command "::TolConsole::TableOpen"
2321  $md add $cid command -label [mc "&Project"] \
2322      -command "::TolProject::Open"
2323 
2324  $md add $id command -label [mc &Include] -command "::TolConsole::IncludeCmd"
2325 
2326  $md add $id separator
2327 
2328  set cid [$md add $id cascade -label [mc "&Recent files"] ]
2329  $md add $cid cascade -label [mc "TOL &files"] \
2330      -postcommand "::Editor::postEdited %W"
2331  $md add $cid cascade -label [mc "&Tables"] \
2332      -postcommand "::TolConsole::TableRecent %W"
2333  $md add $cid cascade -label [mc "&Projects"] \
2334      -postcommand "::TolProject::postEdited %W"
2335  $md add $cid cascade -label [mc "&Included"] \
2336      -postcommand "::TolConsole::postIncluded %W"
2337
2338  $md add $id separator
2339 
2340  #$md add $id command -label [mc E&xit] -command "::project::Exit"
2341  #$md add $id command -label [mc E&xit] -command "::TolConsole::Exit"
2342  $md add $id command -label [mc E&xit] -command "::project::OnDelete"
2343
2344 
2345  set id [$md insert $hook cascade -label [mc &Tools]]
2346  set ::project::data(menu,tools) $id
2347   
2348  set cid [$md add $id cascade -label [mc "TOL &Editor"]]
2349  $md add $cid cascade -label [mc "&Recent files"] \
2350      -postcommand "::Editor::postEdited %W"
2351  $md add $cid command -label [mc "&New TOL file"] \
2352      -command "::Editor::New"
2353  $md add $cid command -label [mc "&Open TOL file"] \
2354      -command "::Editor::Open"
2355 
2356  set cid [$md add $id cascade -label [mc "TOL &Table Editor"]]
2357  $md add $cid cascade -label [mc "&Recent files"] \
2358      -postcommand "::TolConsole::TableRecent %W"
2359  $md add $cid command -label [mc "&New Table"] \
2360      -command "::TolConsole::TableNew"
2361  $md add $cid command -label [mc "&Open Table"] \
2362      -command "::TolConsole::TableOpen"
2363 
2364  set cid [$md add $id cascade -label [mc "TOL &Project Editor"]]
2365  $md add $cid cascade -label [mc "&Recent files"] \
2366      -postcommand "::TolProject::postEdited %W"
2367  $md add $cid command -label [mc "&New Project"] \
2368      -command "::TolProject::New"
2369  $md add $cid command -label [mc "&Open Project"] \
2370      -command "::TolProject::Open"
2371 
2372  $md add $id separator
2373  $md add $id command -label "[mc {Manage Packages}]..." \
2374      -command ::TolPkgGUI::Show
2375  set cid [$md add $id cascade -label [mc "Analysis Tools"]]
2376  set cid2 [$md add $cid cascade -label [mc "ARIMA"]]
2377  $md add $cid2 command -label [mc "Draw ACF and PACF of ARIMA Models"] \
2378      -command "::drawArima::Show"
2379  $md add $id separator
2380 
2381  $md add $id command -label [mc "TOL Inspector"] \
2382    -command "$::project::widgets(mainmdi).slave1 restore; $::project::widgets(mainmdi).slave1 raise"
2383  $md add $id command -label [mc "&Functions Search"] \
2384      -command "::funcSearch::Show"
2385  $md add $id command -label [mc "&Calendar Expert"] \
2386      -command "::CalendarTms::ViewTimeSet"
2387  $md add $id command -label [mc "&Bayes SQL"] \
2388      -command "::SQLTable::TableBayesSQL"
2389 
2390  $md add $id separator
2391 
2392  $md add $id command -label [mc "C&onnection to database"] \
2393      -command "$::project::data(bodbc) showdialog"
2394
2395  $md add $id command -label [mc "&Options"] \
2396      -command "::TolConsole::OptionsCreate"
2397
2398  return $md
2399}
2400
2401#/////////////////////////////////////////////////////////////////////////////
2402  proc ::TolConsole::TableNew { } {
2403#
2404# PURPOSE: Creates a new table
2405#
2406#/////////////////////////////////////////////////////////////////////////////
2407  set tl [::project::CreateForm -type Tables \
2408            -width 400 -height 180 \
2409            -iniconfig Tables -helpkey "Tb4Edt"]
2410  set tlf [$tl getframe]
2411  # configuration
2412  btable $tlf.t -parent $tl \
2413                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
2414                -iniconfig btable
2415  pack $tlf.t -fill both -expand yes
2416  $tl bind <Control-F4> [list $tl kill]
2417  #pedro
2418 
2419}
2420
2421#/////////////////////////////////////////////////////////////////////////////
2422  proc ::TolConsole::TableOpen { {path ""} } {
2423#
2424# PURPOSE: Opens a table
2425# PARAMETERS:
2426#   path   -> path of the file to be opened, if no file is given an Openfile
2427#             dialogs is shown
2428#
2429#/////////////////////////////////////////////////////////////////////////////
2430  set tl [::project::CreateForm -type Tables \
2431            -width 400 -height 180 \
2432            -iniconfig Tables -helpkey "Tb4Edt"]
2433  set tlf [$tl getframe]
2434  $tl configure -state withdrawn
2435  # configuration
2436  btable $tlf.t -parent $tl \
2437                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
2438                -iniconfig btable
2439  if { $path == "" } {
2440    $tlf.t cmdOpen
2441    $tl configure -state normal
2442    if { [$tlf.t cget -path] == "" } {
2443      $tl kill
2444    } else {
2445      pack $tlf.t -fill both -expand yes
2446      $tl bind <Control-F4> [list $tl kill]
2447    }
2448  } else {
2449    $tlf.t configure -path $path
2450    $tl configure -state normal
2451    pack $tlf.t -fill both -expand yes
2452    $tl bind <Control-F4> [list $tl kill] 
2453  }
2454}
2455
2456#/////////////////////////////////////////////////////////////////////////////
2457  proc ::TolConsole::TableRecentUpdate { w args } {
2458#
2459# PURPOSE: Updates the last edited files when a table is closed
2460#
2461# PARAMETERS:
2462#   m   -> menu's path that will have the list of last table edited files
2463#   ord -> flag that indicates if files must be shown sorted
2464#
2465#/////////////////////////////////////////////////////////////////////////////
2466  variable data
2467
2468  set newfile [$w cget -path]
2469  set pos [lsearch $data(tabRecent) $newfile]
2470
2471  if { $pos == -1 } {
2472    set data(tabRecent) [linsert $data(tabRecent) 0 $newfile]
2473  } else {
2474    set data(tabRecent) [lreplace $data(tabRecent) $pos $pos]
2475    set data(tabRecent) [linsert $data(tabRecent) 0 $newfile]   
2476  }
2477  if { $data(numRecent) <= [llength $data(tabRecent)] } {
2478    set data(tabRecent) [lreplace $data(tabRecent) $data(numRecent) end]   
2479  }
2480}
2481
2482#/////////////////////////////////////////////////////////////////////////////
2483  proc ::TolConsole::TableRecent { m } {
2484#
2485# PURPOSE: Fills a menu with the last table edited files, according to the
2486#          information of 'options' variable.
2487#
2488# PARAMETERS:
2489#   m   -> menu's path that will have the list of last table edited files
2490#   ord -> flag that indicates if files must be shown sorted
2491#
2492#/////////////////////////////////////////////////////////////////////////////
2493  variable data
2494 
2495  set data(tabRecent) [lrange $data(tabRecent) 0 [expr $data(numRecent)-1]]
2496 
2497  $m delete 0 end
2498  if { $data(ordRecent) == "asc" } {
2499    set lst [lsort -ascii $data(tabRecent)]
2500  } elseif { $data(ordRecent) == "desc" } {
2501    set lst [lsort -ascii -decreasing $data(tabRecent)]
2502  } else {
2503    set lst $data(tabRecent)
2504  }
2505  foreach w $lst {
2506    $m add command -label $w -command [list ::TolConsole::TableOpen $w]
2507  }
2508  if [llength $lst] {
2509    $m add separator
2510    $m add command -label [mc "Clear"]\
2511          -command [list ::TolConsole::TableRecentClear]
2512  }
2513}
2514
2515#/////////////////////////////////////////////////////////////////////////////
2516  proc ::TolConsole::TableRecentClear { } {
2517#
2518# PURPOSE: Clears the list of last edited files
2519#
2520#/////////////////////////////////////////////////////////////////////////////
2521  variable data
2522  set data(tabRecent) ""
2523}
Note: See TracBrowser for help on using the repository browser.