source: tol/tolbase/lib/toltk/tolbase.tcl @ 6b3f93a

1941-docker-image-to-testdevel
Last change on this file since 6b3f93a was 6b3f93a, checked in by Pedro Gea <pgea@…>, 16 years ago

Se introducen los siguientes cambios:
En la información en columnas del inspector:

  • Se oculta la columna con la referencia-tcl del objeto.
  • Se modifica el contenido de la columna "content" para las instancias.

En la pestaña de información de TOLBase:

  • Se muestran opcionalmente (si no es vacío) tanto el campo "path" como la descripción.
  • Se renombra el campo "Value" a "Content" por coherencia con las columnas del inspector y se utiliza la información de instancia como en las columnas.
  • Se muestra la información específica de las instancias.

Refs #1092

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