source: tol/tolbase/lib/toltk/tolbase.tcl @ 0422d20

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

refs #1347, factoring MarkupHelper in order to use it from MMS (outside tolbase)

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