source: tol/tolbase/lib/toltk/tolbase.tcl @ 567b369

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

refs #1409, mostramos como version el valor de Text Version

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