source: tol/tolbase/lib/toltk/tolbase.tcl @ 9bb96e0b

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

refs #1396, se utiliza la fuente normal configurada en tolbase, pendiente de sincronizar cambios y habilitar opciones de menu contextual

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