source: tol/tolbase/lib/toltk/tolbase.tcl @ 7b8f6fc

1941-docker-image-to-testdevel
Last change on this file since 7b8f6fc was cc64b09, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933
Se revisan los binds respecto a wtree y su treectrl.
Se quitan los métodos específicos para la creación de columnas e inserción de nodos que quedaban en tolinspe.
Se añade un update del nodo de paquetes para que se actualice ante un "require".
Se revisan los métodos de botón derecho para que aparezcan sólo sobre los objetos seleccionados.
Se añade un método a wtree para gestionar el color de todas las columnas de un nodo.
Se añaden las columnas al root de wtree.

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