source: tol/tolbase/lib/toltk/tolprj.tcl @ 6dc91d2

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

Refs #1933
Se incorporan las barras a la ventana de salida del inspector (tolbase.tcl).
Se corrige un bug con el botón derecho sobre el árbol del inspector (tolinspewtree2.tcl).
Se revisan los binds del editor de PRJs (tolprj.tcl) y se hace uso de la nueva opción de wtree: -selectcommand.
Se añade el método focus y dos opciones de configuración (selectcommand y bindtags) al wtree (wtree.tcl).

Se revisa listboxplus:

+ Se añaden algunas opciones auxiliares (para evitar errores)
+ Se suspenden las barras para que no salgan duplicadas (wtree ya las tiene)
+ Se redirigen los mecanismos de ordenación a los de wtree (véase _SortByColumn, por ejemplo).

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7354 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 60.9 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : tolprj.tcl
3# PURPOSE : This file contains a namespace called TolProject with its
4#           functions. It's for managing TOL projects that are groups of TOL
5#           objects (text files, table files, etc.). They are showed as a
6#           hierarchical treeview.
7#/////////////////////////////////////////////////////////////////////////////
8
9package require bfunctions
10
11#/////////////////////////////////////////////////////////////////////////////
12namespace eval TolProject {
13#
14# PURPOSE: The purpose of this namespace is organize code and functions and
15#          manage common options for all tol project editors such as last
16#          edited files, last directory used, etc.
17#          A special namespace is created for each instance of project.
18#
19# VARIABLES:
20#   options -> common options for all project windows:
21#     wm,state  -> initial window project state
22#     geometry  -> initial window project geometry
23#     lastDir   -> last directory used
24#     chEdited  -> boolen for saving last project files path
25#     numEdited -> number of last project files path to save
26#     edited    -> path of last used projects
27#   tmpOpt      -> temporary array used to store the widgets and variables of
28#              the options dialog.
29#   num_Project -> incrementally number to identify each project window
30#   typelist    -> list of type files supported by project editor
31#   defExt      -> default extension for files managed by project editor
32#   num         -> incrementally number to identify each item in the
33#                 [Included TOL Files] section of project file
34#
35#/////////////////////////////////////////////////////////////////////////////
36  variable options
37  variable tmpOpt
38  variable num_Project 0
39  variable typelist {{"Project" {".prj"}}}
40  variable defExt .prj
41}
42
43#/////////////////////////////////////////////////////////////////////////////
44proc ::TolProject::ComputeFullPath {this path} {
45#
46# PURPOSE: Prepends name of project base directory if necessary to a given
47#          path.
48#          This will be necessary in case path is not an absolute path.
49#
50# PARAMETERS:
51#   this  -> instance of tol project
52#   path  -> path to which name of project base directory is to be prepended.
53#
54# RETURN: The path modified or not as necessary.
55#
56#/////////////////////////////////////////////////////////////////////////////
57  upvar \#0 ${this}::data data
58
59  if {[file pathtype $path] == "absolute"} {
60    return $path
61  } else {
62    return [file join $data(baseDir) $path]
63  }
64}
65
66#/////////////////////////////////////////////////////////////////////////////
67proc ::TolProject::New {{path ""}} {
68#
69# PURPOSE: Creates a new project window and an instance of it. This also
70#          initializes the instance and register the window in the project.
71#
72# PARAMETERS:
73#   path  -> path of project to use. If it isn't specified a new white
74#            project is created.
75#
76# RETURN: A instance of TolProject.
77#
78#/////////////////////////////////////////////////////////////////////////////
79  variable num_Project
80  incr num_Project
81
82  set this [Create .proy$num_Project]
83  SetTraces $this
84  InitState $this new
85  update
86  if {$path == ""} {
87    CmdNew $this
88  }
89  return $this
90}
91
92#/////////////////////////////////////////////////////////////////////////////
93proc ::TolProject::Open {{path ""} {run 0}} {
94#
95# PURPOSE: Open a project file in a project window. If file is already opened
96#          it raises its window, else it creates a new tol project window and
97#          an instance of it.
98#
99# PARAMETERS:
100#   path  -> path of file to open. If it isn't specified it ask for it.
101#   run   -> indicates if the project must be compiled.
102#
103# RETURN: A instance of tol project.
104#
105#/////////////////////////////////////////////////////////////////////////////
106  if {$path != ""} {
107    #Comprobar si el archivo ya está abierto y si es así hacer un raise
108    if { ![ catch { set lst [namespace children ::TolProject] } msgerr] } {
109      foreach ins $lst {
110        upvar \#0 ${ins}::data data
111        if {[string equal "$data(baseDir)/$data(nameFile)" $path]} {
112          #wm deiconify $data(f)
113          raise $data(f)
114          return $ins
115        }
116      }
117      update
118    }
119  }
120
121  if {$path == ""} {
122    CmdOpen ""
123  } else  {
124    set this [New $path]
125    GetFromFile $this $path $run
126  } 
127
128  if {[info exists this]} {
129    return $this
130  } else  {
131    return ""
132  }
133}
134
135#/////////////////////////////////////////////////////////////////////////////
136proc ::TolProject::postEdited {m {ord 0}} {
137#
138# PURPOSE: Fills a menu with the last used project files, according to the
139#          information of 'options' variable.
140#
141# PARAMETERS:
142#   m   -> menu's path that will have the list of last used projects
143#   ord -> flag that indicates if files must be shown sorted
144#
145#/////////////////////////////////////////////////////////////////////////////
146  variable options
147  $m delete 0 end
148  if $options(chEdited) {
149    set options(edited) [lrange $options(edited) 0 [expr $options(numEdited)-1]]
150    if $ord {
151      set lst [lsort -ascii $options(edited)]
152    } else {
153      set lst $options(edited)
154    }
155    foreach w $lst {
156      $m add command -label $w -command [list ::TolProject::Open $w]
157    }
158    if [llength $lst] {
159      $m add separator
160      $m add command -label [mc "Clear"]\
161           -command [list ::TolProject::clearEdited]
162    }
163  }
164}
165
166#/////////////////////////////////////////////////////////////////////////////
167proc ::TolProject::clearEdited {} {
168#
169# PURPOSE: Clears the list of last edited files
170#
171#/////////////////////////////////////////////////////////////////////////////
172  variable options
173  set options(edited) ""
174  ::iniFile::Write TolProject recent       $options(edited)
175  ::iniFile::Flush
176}
177
178#/////////////////////////////////////////////////////////////////////////////
179proc ::TolProject::OnDelete {this} {
180#
181# PURPOSE: Procedure to check things before destroying tol project window
182#
183# PARAMETERS:
184#   this  -> Instance of tol project
185#
186#/////////////////////////////////////////////////////////////////////////////
187  upvar \#0 ${this}::data data
188  if {[string equal [CheckOpen $this] "cancel"]} {
189    return 0
190  }
191  destroy $data(f)
192  return 1
193}
194
195#/////////////////////////////////////////////////////////////////////////////
196proc ::TolProject::Destroy {this w} {
197#
198# PURPOSE: Deletes the instance of the tol project. Before this, writes the
199#          ini file.
200#
201# PARAMETERS:
202#   this  -> Instance of tol project
203#
204#/////////////////////////////////////////////////////////////////////////////
205  upvar \#0 ${this}::data data
206  if [string equal $data(f) $w] {
207    WriteIni $this
208    namespace delete $this
209  }
210}
211
212#/////////////////////////////////////////////////////////////////////////////
213proc ::TolProject::InitState {this from} {
214#
215# PURPOSE: Initializes some variables according to the state of the tol
216#          project.
217#
218# PARAMETERS:
219#   this  -> Instance of tol project
220#   from  -> State that defines values for the variables
221#
222#/////////////////////////////////////////////////////////////////////////////
223  upvar \#0 ${this}::data data
224
225  switch $from {
226    new {
227      set data(compiling) 0
228      set data(isSaved) 1
229      set data(nameFile) ""
230      set data(baseDir) ""
231      set data(lastOpenedNodeDir) ""
232    }
233    open {
234      set data(compiling) 0
235      set data(isSaved) 1
236#      set data(nameFile) ""
237    }
238    save {
239      set data(isSaved) 1
240    }
241  }
242}
243
244#/////////////////////////////////////////////////////////////////////////////
245proc ::TolProject::SetTraces {this} {
246#
247# PURPOSE: Sets some traces of variables to control changes in tol project
248#          widget
249#
250# PARAMETERS:
251#   this  -> Instance of tol project
252#
253#/////////////////////////////////////////////////////////////////////////////
254  upvar \#0 ${this}::data data
255
256  trace variable ${this}::data(nameFile) w \
257          [list ::TolProject::TraceNameFile $this]
258  trace variable ${this}::data(isSaved)  w \
259          [list ::TolProject::TraceSaved $this]
260  trace variable ${this}::data(compiling)  w \
261          [list ::TolProject::TraceCompiling $this]
262}
263
264#/////////////////////////////////////////////////////////////////////////////
265proc ::TolProject::TraceNameFile {this name1 name2 op} {
266#
267# PURPOSE: Sets tol project's name each time var nameFile changes.
268#
269# PARAMETERS:
270#   this  -> Instance of tol project
271#   name1, name2, op ->
272#     Name1 and name2 give the name(s) for the variable being accessed: if the
273#     variable is a scalar then name1 gives the variable's name and name2 is
274#     an empty string; if the variable is an array element then name1 gives
275#     the name of the array and name2 gives the index into the array; if an
276#     entire array is being deleted and the trace was registered on the
277#     overall array, rather than a single element, then name1 gives the array
278#     name and name2 is an empty string. Name1 and name2 are not necessarily
279#     the same as the name used in the trace variable command: the upvar
280#     command allows a procedure to reference a variable under a different
281#     name. Op indicates what operation is being performed on the variable,
282#     and is one of r, w, or u.
283#
284#/////////////////////////////////////////////////////////////////////////////
285  upvar \#0 ${this}::data data
286  if {$data(nameFile) != ""} {
287    set data(labelWindow) $data(nameFile)
288  } else  {
289    set data(labelWindow) "untitled.prj"
290  }
291  $data(f) configure -title "[mc Project] $data(labelWindow)"
292  set tv [GetTreeview $this]
293  #@ Antes se usaba $data(nameFile) como FileName y $data(labelWindow) como label   
294  $tv item text root FileName [file tail $data(labelWindow)]
295}
296
297#/////////////////////////////////////////////////////////////////////////////
298proc ::TolProject::TraceSaved {this name1 name2 op} {
299#
300# PURPOSE: Sets saved/not saved info in status bar each time var 'isSaved'
301#          changes.
302#
303# PARAMETERS:
304#   this  -> Instance of tol project
305#   name1, name2, op -> see above
306#
307#/////////////////////////////////////////////////////////////////////////////
308  upvar \#0 ${this}::data data
309
310  if $data(isSaved) {
311    $data(sb,modi) configure -text [mc "Saved"] -relief groove
312  } else  {
313    $data(sb,modi) configure -text [mc "Not Saved"] -relief raised
314  }
315}
316
317#/////////////////////////////////////////////////////////////////////////////
318proc ::TolProject::TraceCompiling {this name1 name2 op} {
319#
320# PURPOSE: Enables/disables compiling options each time var 'compiling'
321#          changes.
322#
323# PARAMETERS:
324#   this  -> Instance of tol project
325#   name1, name2, op -> see above
326#
327#/////////////////////////////////////////////////////////////////////////////
328  upvar \#0 ${this}::data data
329  set menu [GetMenu $this]
330
331  if {$data(compiling) eq 1} {
332    set state disabled
333  } else  {
334    set state normal   
335  }
336  foreach ite [list 4 5 6 7 8] {
337    catch { $menu entryconfigure $ite -state $state }
338  }
339}
340
341#/////////////////////////////////////////////////////////////////////////////
342proc ::TolProject::Create {path} {
343#
344# PURPOSE: Creates a Tol Project instance. Creates and packs the tol projedt
345#          window (toplevel, treeview, toolbar, statusbar, popup menu, ...).
346#
347# PARAMETERS:
348#   path  -> project window's path (toplevel)
349#
350# RETURN: Tol project's instance
351#
352#/////////////////////////////////////////////////////////////////////////////
353  variable options
354  global toltk_options
355  set this ::TolProject::$path
356  if { [lsearch [namespace children ::TolProject] $this] != -1 } {
357    error "$this already exists as a children of ::TolProject"
358  }
359
360  #  A namespace is created for each tol project widget.
361
362  namespace eval $this {
363 
364    # data -> array with information about the instance:
365    #   f          -> toplevel path
366    #   tb,frame   -> toolbar's frame path
367    #   sb,frame   -> statusbar's frame path
368    #   mainMenu
369
370    variable data
371  }
372
373  upvar \#0 ${this}::data data
374  # create
375  set data(f) [set f [::project::CreateForm -width 400 -height 500 \
376                        -type [mc Projects] \
377                        -iniconfig TolProject \
378                        -closecmd [list ::TolProject::OnDelete $this] \
379                        -helpkey "Tb4Edp"]]
380  set f [$f getframe]
381
382  set n_b [list \
383     "bnew"     "CmdNew"      "[mc [list New white project]] (CTRL+N)" \
384     "openprj"  "CmdOpen"     "[mc Open] (CTRL+A)" \
385     "bsave"    "CmdSave"     "[mc Save] (CTRL+S)" \
386     "sep1"     "--"          ""\
387     "tools"    "CmdOptions"  "[mc Options]"]
388  # botonera superior
389  set data(tb,frame) [frame $f.ftop -relief raised -bd 1]
390  foreach {n_img n_proc n_hint} $n_b {
391    if {[string equal $n_proc "--"]} {
392      Separator $f.ftop.$n_img -orient vertical
393    } else {
394      set data(tb,$n_img) [Button $f.ftop.$n_img\
395              -image [::Bitmap::get ${n_img}] -relief link -helptext $n_hint\
396              -bd 2 -command [list ::TolProject::$n_proc $this]]
397    }
398    pack $f.ftop.$n_img -side left -pady 2 -fill y -padx 1
399  }
400
401  # frame y label para barra de estado
402  set data(sb,frame) [frame $f.fop -relief groove -bd 1 -height 7]
403  set data(sb,modi)  [label $f.fop.modi -bd 1 -width 14]
404  set data(sb,desc)  [label $f.fop.desc -relief groove -bd 1 -anchor w]
405
406  # treeview y scroll
407  ScrolledWindow $f.sw
408  set tv [::wtree $f.sw.t -table 0 -filter no \
409    -background white -showroot 1 -selectmode single -showheader 0 \
410    -selectcommand "::TolProject::SelectProc $this" \
411    -highlightbackground gray75 -highlightcolor black \
412    -highlightthickness 0 -font $toltk_options(fonts,Label) \
413    -columns [list \
414      [list {image text} -label FileName -tags FileName] \
415      [list text -label Description -tags Description] \
416      [list text -label Type -tags Type] \
417      [list text -label Exclude -tags Exclude] \
418      [list text -label ExcludeTOL -tags ExcludeTOL] \
419    ] ]
420  set data(treeview) $tv
421  $tv item style set root FileName    [$tv column cget FileName -itemstyle]
422  $tv item style set root Description [$tv column cget Description -itemstyle]
423  $tv item style set root Type        [$tv column cget Type -itemstyle]
424  $tv item style set root Exclude     [$tv column cget Exclude -itemstyle]
425  $tv item style set root ExcludeTOL  [$tv column cget ExcludeTOL -itemstyle]
426  $tv column configure "range 1 end" -visible no
427  $tv column configure first -expand yes -weight 1
428  $tv column configure all -itembackground ""
429 
430  $f.sw setwidget $f.sw.t
431   
432  # empaquetamos los label de estado
433  pack $f.fop.modi -side left
434  pack $f.fop.desc -expand true -fill x
435   
436  grid $f.ftop  -sticky new
437  grid $f.sw    -sticky news 
438  grid $f.fop   -sticky ews
439
440  grid rowconfigure    $f 1 -weight 1
441  grid columnconfigure $f 0 -weight 1
442
443  bind $tv <Control-KeyRelease> [list ::TolProject::OnControlKey $this %K %k]
444  bind $tv <Button-1> "::focus $tv"
445  bind $tv <Button-3> +[list ::TolProject::PostVariable $this %X %Y]
446
447  bind $tv <Double-1> "mdidoc disableglobalraise ; ::TolProject::OpenNodeIfTerminal $this"
448  bind $tv <KeyPress-Return> "::TolProject::OpenNodeIfTerminal $this"
449
450  bind $tv <KeyPress-space>  +[list ::TolProject::NodeActiveAttributes $this]
451  bind $tv <KeyPress-Delete> +[list ::TolProject::DeleteActiveNode     $this]
452  bind $tv <KeyPress-F9>     "::TolProject::CompileActiveNode    $this ; break"
453  bind $tv <KeyPress-F8>     "::TolProject::DecompileActiveNode  $this ; break" 
454 
455  set data(mainMenu) [menu $tv.m -tearoff 0]
456
457  bind $data(f) <Destroy> +[list ::TolProject::Destroy $this %W]
458  $data(f) bind <Control-F4> "$data(f) kill; break"
459  return $this
460}
461
462#///////////////////////////////////////////////////////////////////////////
463proc ::TolProject::OnControlKey {this keysym keycode} {
464#
465# PURPOSE: Control the "Control + Key Press"
466#
467# PARAMETERS: this ->  Instance of project editor
468#             keysym -> The keysym corresponding to the event,
469#                       substituted as a textual string
470#             keycode -> The keycode field from the event
471#
472#///////////////////////////////////////////////////////////////////////////
473  #puts "PLATFORM: $::tcl_platform(platform)"
474  switch [string toupper $keysym] {
475    A { ::TolProject::CmdOpen $this}
476    N { ::TolProject::CmdNew  $this}
477    S { ::TolProject::CmdSave $this}
478  }
479}
480
481#/////////////////////////////////////////////////////////////////////////////
482# File management commands (new, open, save, save as...)
483#/////////////////////////////////////////////////////////////////////////////
484
485#/////////////////////////////////////////////////////////////////////////////
486proc ::TolProject::CmdNew {this} {
487#
488# PURPOSE: Cleans project window to edit a new white project
489#
490# PARAMETERS:
491#   this  -> Instance of Tol project
492#
493#/////////////////////////////////////////////////////////////////////////////
494  upvar \#0 ${this}::data data
495
496  set tv [GetTreeview $this]
497  if [string equal [CheckOpen $this] "cancel"] return
498  $tv item delete all
499  set img [GetImageFromType ROOT]
500  $tv item image root FileName $img
501  $tv item text root FileName "" Description "Root node" \
502    Type "ROOT" Exclude 0 ExcludeTOL 0
503  InitState $this new
504}
505
506#/////////////////////////////////////////////////////////////////////////////
507proc ::TolProject::UpdateListEdited {path} {
508#
509# PURPOSE: Updates list of last edited project files adding a new file path.
510#
511# PARAMETERS:
512#   path  -> path of the last edited project file
513#
514#/////////////////////////////////////////////////////////////////////////////
515  variable options
516  # guardamos el ultimo directorio abierto
517  set options(lastDir) [file dirname $path]
518  if { [set idx [lsearch $options(edited) $path]] == -1 } {
519    set options(edited) [linsert $options(edited) 0 $path]
520  } else {
521    set ll ""
522    lappend ll $path
523    set i 0
524    foreach f $options(edited) {
525      if  {$i != $idx} {
526        lappend ll $f
527      }
528      incr i
529    }
530    set options(edited) $ll
531  }
532  set options(edited) [lrange $options(edited) 0 [expr $options(numEdited)-1]]
533}
534
535#/////////////////////////////////////////////////////////////////////////////
536proc ::TolProject::CmdOpen {{this ""}} {
537#
538# PURPOSE: Asks for a project file path and if it's given opens it into the
539#          project window.
540#
541# PARAMETERS:
542#   this -> Instance of tol project
543#
544#/////////////////////////////////////////////////////////////////////////////
545  variable options
546  variable typelist
547  variable defExt
548 
549  if {$this == ""} {
550    set parent .
551  } else  {
552    set parent [GetTreeview $this]
553    if [string equal [CheckOpen $this] "cancel"] return
554  }
555
556  set path [tk_getOpenFile -title [mc "Open"] \
557          -parent $parent -initialdir $options(lastDir) \
558          -defaultextension $defExt -filetypes $typelist]
559
560  if { $path != "" } {
561    # abrimos solo si no esta ya abierto
562    foreach ins [namespace children ::TolProject::] {
563      upvar \#0 ${ins}::data data
564      if {[string equal "$data(baseDir)/$data(nameFile)" $path]} {
565        $data(f) raise
566            set resp [tk_messageBox -type ok -icon warning \
567             -message [mc "The project is allready opened!"] ]
568        return
569      }
570    }
571    if {$this == ""} {
572      set this [New $path]
573    }
574    GetFromFile $this $path
575  }
576}
577
578#/////////////////////////////////////////////////////////////////////////////
579proc ::TolProject::GetFromFile {this path {run 0}} {
580#
581# PURPOSE: Loads a project into the project window . This converts from the
582#          file especification to the treeview representation.
583#
584# PARAMETERS:
585#   this -> Instance of tol project
586#   path -> project file's path
587#   run  -> if 1 the project will be automatically compiled
588#
589#/////////////////////////////////////////////////////////////////////////////
590  upvar \#0 ${this}::data data
591  set tv [GetTreeview $this]
592  $tv item delete all
593  if {[::TolProject::WtreeFromFile $tv $path ::TolProject::GetImageFromType]} {
594    set data(baseDir) [file dirname $path]
595    set data(lastOpenedNodeDir) $data(baseDir)
596    set data(nameFile) [file tail $path]
597    UpdateListEdited $path
598  } else {
599    set data(nameFile) ""
600  }
601  $data(f) raise
602  InitState $this open
603  if { $run } {
604    CompileNode $this root
605  }
606}
607
608#/////////////////////////////////////////////////////////////////////////////
609proc ::TolProject::CheckAll {} {
610#
611# PURPOSE: Checks for files opened if anyone has changed and asks for saving.
612#
613#/////////////////////////////////////////////////////////////////////////////
614  if { ![ catch { set lst [namespace children ::TolProject] } msgerr] } {
615    foreach ins $lst {
616      if {[CheckOpen $ins] eq "cancel"} {
617        return "cancel"
618      }
619    }
620  }
621  return "ok"
622}
623
624#/////////////////////////////////////////////////////////////////////////////
625proc ::TolProject::CheckOpen {this {type "yesnocancel"}} {
626#
627# PURPOSE: Checks if a file has changed and asks for saving.
628#
629# PARAMETERS:
630#   this -> Instance of Tol project
631#   type -> type of messageBox to ask. (yesnocancel by default)
632#
633# RETURN: Returns user answer for saving.
634#
635#/////////////////////////////////////////////////////////////////////////////
636  upvar \#0 ${this}::data data
637   
638  # comprobamos si necesita ser guardado
639  if { !$data(isSaved)} {
640    if {$data(nameFile) != ""} {
641      set name $data(nameFile)
642    } else  {
643      set name "untitled.prj"
644    }
645    # preguntamos por conformidad
646    set tv [GetTreeview $this]
647    set rq [tk_messageBox -type $type -icon warning -title [mc "Warning"]\
648            -parent $tv -message "[mc "File %1\$s has changed!" $name].\n\
649            [mc "Do you want to save changes?"]"]
650    switch -exact $rq {
651      yes {
652        if {$data(nameFile) != "" } {
653          FileSave $this $data(nameFile)
654        } else {
655          CmdSaveAs $this $data(nameFile)
656        }
657      }
658      cancel {return cancel}
659      default {return ok}
660    }
661  }
662  return ok
663}
664
665#/////////////////////////////////////////////////////////////////////////////
666proc ::TolProject::CmdSave {this} {
667#
668# PURPOSE: Saves project info actually opened in the project editor. If it
669#          doesn't have a name, asks for ti (CmdSaveAs).
670#
671# PARAMETERS:
672#   this -> Instance of Tol project
673#
674# RETURN: Returns 1 if file has been saved correctly or 0 if not.
675#
676#/////////////////////////////////////////////////////////////////////////////
677  upvar \#0 ${this}::data data
678
679  if {$data(nameFile) == ""} {
680    set ok [CmdSaveAs $this]
681  } else {
682    set ok [FileSave $this $data(nameFile)]
683  }
684  return $ok
685}
686
687#/////////////////////////////////////////////////////////////////////////////
688proc ::TolProject::CmdSaveAs {this {nf ""}} {
689#
690# PURPOSE: Saves project actually opened in project editor asking for the
691#          user to select a file to save it.
692#
693# PARAMETERS:
694#   this -> Instance of Tol project
695#   nf   -> name of file proposed
696#
697# RETURN: Returns 1 if file has been saved correctly or 0 if not.
698#
699#/////////////////////////////////////////////////////////////////////////////
700  upvar \#0 ${this}::data data
701  variable options
702  variable typelist
703  variable defExt
704  set tv [GetTreeview $this]
705 
706  if {$nf == ""} {
707    set dir $options(lastDir)
708    set fil ""
709  } else  {
710    set dir "[file dirname $nf]"
711    set fil "[file tail $nf]"
712  }
713  set path [tk_getSaveFile -title [mc "Save as"] -initialdir $dir \
714       -initialfile $fil -parent $tv \
715       -defaultextension $defExt -filetypes $typelist]
716  if {![string equal $path ""] } {
717    set data(baseDir) [file dirname $path]
718    set data(lastOpenedNodeDir) $data(baseDir)
719    set data(nameFile) [file tail $path]
720    set ok [FileSave $this [file tail $path]]
721  } else {
722    set ok 0
723  }
724  return $ok
725}
726
727#/////////////////////////////////////////////////////////////////////////////
728proc ::TolProject::FileSave { this path } {
729#
730# PURPOSE: Saves project actually opened in project editor in a text file.
731#
732# PARAMETERS:
733#   this -> Instance of tol project
734#   path -> name of file
735#
736# RETURN: Returns 1 if file has been saved correctly or 0 if not.
737#
738#/////////////////////////////////////////////////////////////////////////////
739  variable options
740  upvar \#0 ${this}::data data
741
742  #Guardar la transformación de treeview a archivo
743  if {[::TolProject::WtreeToFile [GetTreeview $this] \
744      [::TolProject::ComputeFullPath $this $path]]} {
745    #Añadir al archivo la entrada para que pueda ser llamado desde tol.exe
746    AddEntry $this [::TolProject::ComputeFullPath $this $path]
747    set data(nameFile) $path
748    InitState $this save
749    # guardamos el ultimo directorio utilizado
750    set options(lastDir) $data(baseDir)
751    set ok 1
752  } else  {
753    set ok 0
754  }
755  return $ok
756}
757
758#/////////////////////////////////////////////////////////////////////////////
759proc ::TolProject::AddEntry {this path} {
760#
761# PURPOSE: Adds a special entry in file path for including proyect from TOL.
762#
763# PARAMETERS:
764#   this -> Instance of tol project
765#   path -> name of file
766#
767#/////////////////////////////////////////////////////////////////////////////
768  upvar \#0 ${this}::data data
769  set data(num) 1
770  set fd [iniparse:openfile $path]
771  NodeToFile $this root $fd [file tail [file rootname $path]]
772  iniparse:closefile $fd
773}
774
775#/////////////////////////////////////////////////////////////////////////////
776proc ::TolProject::NodeToFile {this index fd name} {
777#
778# PURPOSE:
779#
780# PARAMETERS:
781#   this -> Instance of tol project
782#   index -> treeview node index
783#   fd    -> channel identifier of text file
784#   name  ->
785#
786#/////////////////////////////////////////////////////////////////////////////
787  upvar \#0 ${this}::data data
788  set key "Included TOL Files"
789
790  set tv [GetTreeview $this]
791  # Guardar data del nodo actual
792  set excludeTOL [$tv item text $index ExcludeTOL]
793  if ![string equal $excludeTOL 1] {
794    if {[IsCompilable $this $index] } {
795      set filename [$tv item text $index FileName]
796      set item "Set $name.$data(num)"
797      set value "Include(\"$filename\");"
798      writeini $fd $key $item $value
799      incr data(num)
800    }
801    # Llamar recursivamente para los hijos
802    foreach child [$tv item children $index] {
803      NodeToFile $this $child $fd $name
804    }
805  }
806}
807
808#/////////////////////////////////////////////////////////////////////////////
809proc ::TolProject::GetTreeview {this} {
810#
811# PURPOSE: Returns treeview's path of a given instance
812#
813# PARAMETERS:
814#   this -> Instance of tol project
815#
816# RETURN: Treeview's path
817#
818#/////////////////////////////////////////////////////////////////////////////
819  upvar \#0 ${this}::data data
820  return $data(treeview)
821}
822
823#/////////////////////////////////////////////////////////////////////////////
824proc ::TolProject::GetMenu {this} {
825#
826# PURPOSE: Returns treeview's menu of a given instance
827#
828# PARAMETERS:
829#   this -> Instance of tol project
830#
831# RETURN: Treeview menu's path
832#
833#/////////////////////////////////////////////////////////////////////////////
834  upvar \#0 ${this}::data data
835  return $data(mainMenu)
836}
837
838#/////////////////////////////////////////////////////////////////////////////
839proc ::TolProject::SelectProc {this} {
840#
841#/////////////////////////////////////////////////////////////////////////////
842  upvar \#0 ${this}::data data
843  set tv [GetTreeview $this]
844  set node [$tv selection get end] ;# anchor
845  if { $node eq "" } return
846  set description [$tv item text $node Description]
847  $data(sb,desc) configure -text "$description"
848}
849
850#/////////////////////////////////////////////////////////////////////////////
851proc ::TolProject::PostVariable {this x y} {
852#
853# PURPOSE: Composes a popup menu and displays it. Its composed depending on
854#          the node clicked by user.
855#
856# PARAMETERS:
857#   x -> x-coordinate where popup menu is drawn
858#   y -> y-coordinate where popup menu is drawn
859#
860#/////////////////////////////////////////////////////////////////////////////
861  upvar \#0 ${this}::data data
862  set tv [GetTreeview $this]
863  set menu [GetMenu $this]
864  $menu delete 0 end
865
866  set state [expr {$data(compiling)? "disabled" : "normal" }]
867
868  set node [$tv selection get end] ;# current
869  if { [string length $node] } {
870    if [IsTerminal $this $node] {
871      $menu add command -label [mc "Open node"] -accelerator Return\
872         -command [list ::TolProject::OpenNode $this $node]
873 
874      # Compute insertion point and prepare menu entry     
875      set nodefocus [$tv selection get end] ;# focus
876      set parent [$tv item parent $nodefocus]   
877      set prev [$tv item prevsibling $nodefocus]
878      if {[string equal $prev ""]} {
879        set prevCount 1
880      } else {
881        set prevCount [expr [lsearch [$tv item children $parent] $node] + 1]
882      }
883      $menu add command -label [mc "Add node"] \
884        -command [list ::TolProject::AddNode $this $parent $prevCount]\
885        -accelerator Ins
886 
887    } else {
888      # This adds to the end of the non-terminal node
889      $menu add command -label [mc "Add node"] -accelerator Ins\
890            -command [list ::TolProject::AddNode $this $node]
891    }
892    $menu add command -label [mc "Attributes"] -accelerator space\
893          -command [list ::TolProject::NodeAttributes $this $node]
894    $menu add command -label [mc "Delete node"] -accelerator Sup\
895          -command [list ::TolProject::DeleteNode $this $node]
896    $menu add separator
897    if [IsTerminal $this $node] {
898      $menu add command -label [mc "Compile node"] -state $state \
899         -command [list ::TolProject::CompileNode $this $node]\
900         -accelerator F9
901      $menu add command -label [mc "Decompile node"]  -state $state \
902         -command [list ::TolProject::DecompileNode $this $node]\
903         -accelerator F8
904    } else {
905      $menu add command -label [mc "Compile node"] -state $state \
906         -command [list ::TolProject::CompileNode $this $node]\
907         -accelerator F9
908      $menu add command -label [mc "Decompile node"]  -state $state \
909         -command [list ::TolProject::DecompileNode $this $node]\
910         -accelerator F8
911    }
912    $menu add command -label [mc "Compile to the end"] -state $state \
913       -command [list ::TolProject::CompileIfBeforeNode $this root $node]
914    $menu add command -label [mc "Compile up to here"] -state $state \
915       -command [list ::TolProject::CompileUpToHereNode $this root $node]   
916    # save as
917    $menu add separator   
918    $menu add command -label "[mc "Save as"] ..." \
919      -command [list ::TolProject::CmdSaveAs $this]   
920    # show menu
921    tk_popup $menu $x $y     
922  }
923}
924
925#/////////////////////////////////////////////////////////////////////////////
926proc ::TolProject::OpenNodeIfTerminal {this} {
927#
928# PURPOSE:
929#
930# PARAMETERS:
931#   this -> Instance of tol project
932#
933#/////////////////////////////////////////////////////////////////////////////
934  upvar \#0 ${this}::data data
935  set tv [GetTreeview $this]
936  set node [$tv selection get end] ;# anchor
937  OpenNode $this $node
938}
939
940#/////////////////////////////////////////////////////////////////////////////
941proc ::TolProject::OpenNode {this node} {
942#
943# PURPOSE: Opens a terminal node of the project. It depends on the node type
944#          what kind of editor use for opening the node (text or table).
945#
946# PARAMETERS:
947#   this -> Instance of tol project
948#   node -> Node active in treeview, which is opened
949#
950#/////////////////////////////////////////////////////////////////////////////
951  upvar \#0 ${this}::data data
952  set tv [GetTreeview $this]
953 
954  set type [$tv item text $node Type]
955  set filename [$tv item text $node FileName]
956  switch $type {
957    TOL { ::Editor::Open \
958          [::TolProject::ComputeFullPath $this $filename] }
959    BDT -
960    BST { ::EditTable::Open \
961          [::TolProject::ComputeFullPath $this $filename] }
962  }
963}
964
965#/////////////////////////////////////////////////////////////////////////////
966proc ::TolProject::AddNode {this node {prev end}} {
967#
968# PURPOSE: Adds a node to the project. First of all, asks for the node type.
969#
970# PARAMETERS:
971#   this -> Instance of tol project
972#   node -> Node active in treeview, in which the new node is added
973#   prev -> where is added, end if nothing is specified
974#
975#/////////////////////////////////////////////////////////////////////////////
976  upvar \#0 ${this}::data data
977  set tv [GetTreeview $this]
978 
979  #si no hay un directorio base establecido mostramos dialogo de guardar proyecto
980  if { $data(baseDir) eq "" } {
981    CmdSave $this
982    return
983  }
984 
985  ClearData $this
986  DialogType $this $tv
987  # si no se ha pulsado cancelar
988  if {$data(type) != -1} {
989    if {!($data(type) eq "Fol") } {
990      set title "[mc Add] [mc {a file of type}] $data(type) "
991    } else {
992      set title "[mc Add] [mc folder]"
993    }
994    DialogAttributes $this $tv $title
995    # si no se ha pulsado cancelar
996    if {![string equal $data(name) ""]} {
997
998      # Path name gets transformed for files
999      switch -exact $data(type) {
1000        TOL -
1001        BDT -
1002        BST {
1003          set data(lastOpenedNodeDir) [file dirname $data(name)]
1004          set data(name) \
1005          [ObtainRelativePath $data(name) $data(baseDir)]
1006        }
1007        default {
1008          # do nothing for folders
1009        }
1010      }
1011     
1012      set img [GetImageFromType $data(type)]                                       
1013      if { $data(type) eq "Fol" } {
1014        set hasbutton 1
1015      } else {
1016        set hasbutton 0
1017      }
1018      if {$prev eq "end"} {
1019        set idx [$tv item create -parent $node -button $hasbutton -open 0]
1020      } else {
1021        set idx [$tv item create -prevsibling $prev -button $hasbutton -open 0]
1022      }
1023      $tv item image $idx FileName $img
1024      $tv item text $idx FileName $data(name) Description $data(desc) \
1025        Type $data(type) Exclude $data(exclude) ExcludeTOL $data(excludeTOL)
1026      set data(isSaved) 0
1027    }
1028  }
1029}
1030
1031#/////////////////////////////////////////////////////////////////////////////
1032proc ::TolProject::NodeActiveAttributes {this args} {
1033#/////////////////////////////////////////////////////////////////////////////
1034  upvar \#0 ${this}::data data
1035  set tv [GetTreeview $this]
1036  set node [$tv selection get end] ;# anchor
1037  NodeAttributes $this $node
1038}
1039
1040#/////////////////////////////////////////////////////////////////////////////
1041proc ::TolProject::NodeAttributes {this node} {
1042#
1043# PURPOSE: Shows the attributes of the selected node.
1044#
1045# PARAMETERS:
1046#   this -> Instance of tol project
1047#   node -> Node active in treeview, whose attributes are shown
1048#
1049#/////////////////////////////////////////////////////////////////////////////
1050  upvar \#0 ${this}::data data
1051  set tv [GetTreeview $this]
1052  GetDataFromNode $this $node
1053  set name_old $data(name)
1054  set desc_old $data(desc)
1055  set excl_old $data(exclude)
1056  set exct_old $data(excludeTOL)
1057  set title "[$tv item text $node FileName] [mc Attributes]"
1058  DialogAttributes $this $tv $title
1059  # si no se ha pulsado cancelar
1060  if {![string equal $data(name) ""]} {
1061    # si se ha cambiado algun dato
1062    if {![string equal $name_old $data(name)] ||
1063        ![string equal $desc_old $data(desc)] ||
1064        ![string equal $excl_old $data(exclude)] ||
1065        ![string equal $exct_old $data(excludeTOL)]} {
1066      $tv item text $node FileName $data(name) Description $data(desc) \
1067        Exclude $data(exclude) ExcludeTOL $data(excludeTOL)                       
1068      set data(isSaved) 0
1069    }
1070  }
1071}
1072
1073#/////////////////////////////////////////////////////////////////////////////
1074proc ::TolProject::DeleteActiveNode {this args} {
1075#/////////////////////////////////////////////////////////////////////////////
1076  upvar \#0 ${this}::data data
1077  set tv [GetTreeview $this]
1078  set node [$tv selection get end] ;# current
1079  DeleteNode $this $node
1080}
1081
1082#/////////////////////////////////////////////////////////////////////////////
1083proc ::TolProject::DeleteNode {this node} {
1084#
1085# PURPOSE: Deletes a node and all its childs from the project.
1086#
1087# PARAMETERS:
1088#   this -> Instance of tol project
1089#   node -> Node active in treeview, which is deleted
1090#
1091#/////////////////////////////////////////////////////////////////////////////
1092  upvar \#0 ${this}::data data
1093
1094  set tv [GetTreeview $this]
1095  set name [$tv item text $node FileName]
1096  set answer [tk_messageBox -title [mc "Question"]\
1097            -parent $tv\
1098            -message [mc "Are you sure you want to delete node %1\$s?" $name] \
1099            -type yesno -icon question]
1100  if { [string compare $answer yes] == 0 } {
1101    $tv item delete $node
1102    set data(isSaved) 0
1103  }
1104}
1105
1106#/////////////////////////////////////////////////////////////////////////////
1107proc ::TolProject::CompileActiveNode {this args} {
1108#/////////////////////////////////////////////////////////////////////////////
1109  upvar \#0 ${this}::data data
1110  set tv [GetTreeview $this]
1111  set node [$tv selection get end] ;# current
1112  CompileNode $this $node
1113}
1114
1115#/////////////////////////////////////////////////////////////////////////////
1116proc ::TolProject::CompileNode {this node } {
1117#
1118# PURPOSE: Compiles a node and all its childs if parameter 'childs' is true.
1119#
1120# PARAMETERS:
1121#   this   -> Instance of tol project
1122#   node   -> Node active in treeview, which is compiled
1123#   childs -> flag that indicates if childs must be compiled too
1124#
1125#/////////////////////////////////////////////////////////////////////////////
1126  upvar \#0 ${this}::data data
1127  set tv [GetTreeview $this]
1128  set exclude [$tv item text $node Exclude]
1129  if ![string equal $exclude 1] { 
1130    if [IsCompilable $this $node] {
1131      #Tolcon_Trace "  Compilo $node"
1132      set data(compiling) 1
1133      set filename [$tv item text $node FileName]   
1134      ::TolConsole::Include \
1135        [::TolProject::ComputeFullPath $this $filename]
1136      set data(compiling) 0
1137    }
1138    foreach child [$tv item children $node] {
1139      CompileNode $this $child
1140    }
1141  }
1142}
1143
1144#/////////////////////////////////////////////////////////////////////////////
1145proc ::TolProject::CompileIfBeforeNode {this node ref} {
1146#
1147# PURPOSE: Compiles a node if it's after a node given as reference
1148#
1149# PARAMETERS:
1150#   this -> Instance of tol project
1151#   node -> Node to check if it's after a given node to compile it
1152#   ref  -> Node given as reference
1153#
1154#/////////////////////////////////////////////////////////////////////////////
1155  set tv [GetTreeview $this]
1156  #Tolcon_Trace "CompileIfBeforeNode. node: $node, ref: $ref"
1157  set isbefore [expr [$tv item order $node] < [$tv item order $ref]] 
1158  if !$isbefore {
1159    CompileNode $this $node
1160  } else  {
1161    foreach child [$tv item children $node] {
1162      CompileIfBeforeNode $this $child $ref
1163    }
1164  }
1165}
1166
1167#/////////////////////////////////////////////////////////////////////////////
1168proc ::TolProject::CompileUpToHereNode {this node ref} {
1169#
1170# PURPOSE: Compiles up to here
1171#
1172# PARAMETERS:
1173#   this -> Instance of tol project
1174#   node -> Node to check if it's after a given node to compile it
1175#   ref  -> Node given as reference
1176#
1177#/////////////////////////////////////////////////////////////////////////////
1178  set tv [GetTreeview $this]
1179  #Tolcon_Trace "CompileUpToHereNode. node: $node, ref: $ref"
1180  set isbefore [expr [$tv item order $node] < [$tv item order $ref]] 
1181  if {((![string eq root $node] && [string eq $node $ref]) ||
1182       (![string eq root $node] && $isbefore))} {
1183    CompileNode $this $node
1184  } else  {
1185    foreach child [$tv item children $node] {
1186      CompileUpToHereNode $this $child $ref
1187    }
1188  }
1189}
1190
1191#/////////////////////////////////////////////////////////////////////////////
1192proc ::TolProject::DecompileActiveNode {this args} {
1193#/////////////////////////////////////////////////////////////////////////////
1194  upvar \#0 ${this}::data data
1195  set tv [GetTreeview $this]
1196  set node [$tv selection get end] ;# current
1197  DecompileNode $this $node
1198}
1199
1200#/////////////////////////////////////////////////////////////////////////////
1201proc ::TolProject::DecompileNode {this node} {
1202#
1203# PURPOSE: Decompiles a node and all its childs.
1204#
1205# PARAMETERS:
1206#   this   -> Instance of tol project
1207#   node   -> Node active in treeview, which is decompiled
1208#
1209#/////////////////////////////////////////////////////////////////////////////
1210  set tv [GetTreeview $this]
1211  set exclude [$tv item text $node Exclude]
1212  if ![string equal $exclude 1] {
1213    if [IsCompilable $this $node] {
1214      set filename [$tv item text $node FileName]   
1215      catch {::TolInspector::DecompileFile \
1216             [::TolProject::ComputeFullPath $this $filename]}
1217      ::TolInspector::UpdateFileRoot
1218    }
1219    foreach child [$tv item children $node] {
1220      DecompileNode $this $child
1221    }
1222  }
1223}
1224
1225#/////////////////////////////////////////////////////////////////////////////
1226proc ::TolProject::ClearData {this} {
1227#
1228# PURPOSE: Clears some variables of data array relatives to attributes of
1229#          active node.
1230#
1231# PARAMETERS:
1232#   this -> Instance of tol project
1233#
1234#/////////////////////////////////////////////////////////////////////////////
1235  upvar \#0 ${this}::data data
1236  set data(name) ""
1237  set data(desc) ""
1238  set data(type) ""
1239  set data(exclude) 0
1240  set data(excludeTOL) 0
1241}
1242
1243#/////////////////////////////////////////////////////////////////////////////
1244proc ::TolProject::GetDataFromNode {this index} {
1245#
1246# PURPOSE: Sets some variables of data array, getting its values from a given
1247#          node.
1248#
1249# PARAMETERS:
1250#   this  -> Instance of tol project
1251#   index -> node index of a treeview to get values
1252#
1253#/////////////////////////////////////////////////////////////////////////////
1254  upvar \#0 ${this}::data data
1255  set tv [GetTreeview $this]
1256  set data(name)       [$tv item text $index FileName]
1257  set data(desc)       [$tv item text $index Description]
1258  set data(type)       [$tv item text $index Type]
1259  set data(exclude)    [$tv item text $index Exclude]
1260  set data(excludeTOL) [$tv item text $index ExcludeTOL]
1261}
1262
1263#/////////////////////////////////////////////////////////////////////////////
1264proc ::TolProject::GetImageFromType {type} {
1265#
1266# PURPOSE: Returns the image's path of a node given its type
1267#
1268# PARAMETERS:
1269#   type -> type of node
1270#
1271# RETURN: Image's path that correspond to type or "" if error
1272#
1273#/////////////////////////////////////////////////////////////////////////////
1274  set path ""
1275  switch -exact $type {
1276    ROOT { set path [Bitmap::get Files] }
1277    Fol  { set path [Bitmap::get DIRFile] }
1278    TOL -
1279    BDT -
1280    BST  { set path [Bitmap::get ${type}File] }
1281  }
1282  return $path
1283}
1284
1285#/////////////////////////////////////////////////////////////////////////////
1286proc ::TolProject::IsTerminal {this node} {
1287#
1288# PURPOSE: Determines if a node is terminal or not
1289#
1290# PARAMETERS:
1291#   this -> Instance of tol project
1292#   node -> node index of a treeview
1293#
1294# RETURN: True if node is terminal and false if not
1295#
1296#/////////////////////////////////////////////////////////////////////////////
1297  set terminal 0
1298  set tv [GetTreeview $this]
1299  set type [$tv item text $node Type]
1300  switch $type {
1301    Fol -
1302    ROOT { set terminal 0 }
1303    TOL -
1304    BDT -
1305    BST { set terminal 1 }
1306  }
1307  return $terminal
1308}
1309
1310#/////////////////////////////////////////////////////////////////////////////
1311proc ::TolProject::IsCompilable {this node} {
1312#
1313# PURPOSE: Determines if a node is compilable or not
1314#
1315# PARAMETERS:
1316#   this -> Instance of tol project
1317#   node -> node index of a treeview
1318#
1319# RETURN: True if node is compilable and false if not
1320#
1321#/////////////////////////////////////////////////////////////////////////////
1322  set compilable 0
1323  set tv [GetTreeview $this]
1324  set type [$tv item text $node Type]
1325  switch $type {
1326    Fol -
1327    ROOT { set compilable 0 }
1328    TOL -
1329    BDT -
1330    BST {
1331        set compilable 1
1332    }
1333  }
1334  return $compilable
1335}
1336
1337#/////////////////////////////////////////////////////////////////////////////
1338proc ::TolProject::DialogType {this path} {
1339#
1340# PURPOSE: Shows a dialog to ask for the type of a node
1341#
1342# PARAMETERS:
1343#   this -> Instance of tol project
1344#   path -> dialog's parent path
1345#
1346#/////////////////////////////////////////////////////////////////////////////
1347  #Type node dialog
1348  set tv [GetTreeview $this]
1349  set dialog [Dialog $tv.dt -title [mc "Select node type"]\
1350          -modal local -parent $tv]
1351  wm resizable $dialog 0 0
1352  wm protocol $dialog WM_DELETE_WINDOW \
1353          [list ::TolProject::OptionsDestroy $this $dialog]
1354  set w [$dialog getframe]
1355 
1356  set ${this}::data(type) TOL
1357  set f [labelframe $w.f -text [mc "Node type"]]
1358  radiobutton $f.rbTOL -text [mc "TOL file"] -value TOL -highlightthickness 0\
1359        -pady 0 -variable ${this}::data(type)
1360  radiobutton $f.rbBDT -text [mc "BDT file"] -value BDT -highlightthickness 0\
1361        -pady 0 -variable ${this}::data(type)
1362  radiobutton $f.rbBST -text [mc "BST file"] -value BST -highlightthickness 0\
1363        -pady 0 -variable ${this}::data(type)
1364  radiobutton $f.rbFol -text [mc "Folder"]   -value Fol -highlightthickness 0\
1365        -pady 0 -variable ${this}::data(type) 
1366
1367  grid $f.rbTOL $f.rbBDT -sticky nw -padx 0
1368  grid $f.rbBST $f.rbFol -sticky nw -padx 0
1369 
1370 
1371 
1372   set w_bbox \
1373          [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1374          -homogeneous false]
1375    $w_bbox add -text [mc "Accept"] -relief link \
1376          -helptext [mc "Continue"] \
1377          -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1378          -command [list ::TolProject::DialogTypeOK $this $dialog]
1379    $w_bbox add -text [mc "Cancel"] -relief link \
1380          -helptext [mc "Cancel"]\
1381          -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1382          -command [list ::TolProject::DialogTypeDestroy $this $dialog]
1383   
1384  pack $w_bbox -expand true -fill x    -side bottom
1385  pack $f      -expand true -fill both
1386
1387  bind $dialog <F1> "ShowHelp Tb4Edp"
1388  $dialog draw
1389}
1390
1391#/////////////////////////////////////////////////////////////////////////////
1392proc ::TolProject::DialogTypeOK {this dialog} {
1393#
1394# PURPOSE:
1395#
1396# PARAMETERS:
1397#   this   -> Instance of tol project
1398#   dialog -> Get type dialog
1399#
1400#/////////////////////////////////////////////////////////////////////////////
1401  upvar \#0 ${this}::data data
1402 
1403  destroy $dialog
1404}
1405
1406#/////////////////////////////////////////////////////////////////////////////
1407proc ::TolProject::DialogTypeDestroy {this dialog} {
1408#
1409# PURPOSE: Destroy get type dialog
1410#
1411# PARAMETERS:
1412#   this   -> Instance of tol project
1413#   dialog -> Get type dialog
1414#
1415#/////////////////////////////////////////////////////////////////////////////
1416  upvar \#0 ${this}::data data
1417  set data(type) -1
1418  destroy $dialog
1419}
1420
1421#/////////////////////////////////////////////////////////////////////////////
1422proc ::TolProject::DialogAttributes {this path title} {
1423#
1424# PURPOSE: Shows a dialog to ask for the attributes of a node
1425#
1426# PARAMETERS:
1427#   this  -> Instance of tol project
1428#   path  -> dialog's parent path
1429#   title ->
1430#
1431#/////////////////////////////////////////////////////////////////////////////
1432  upvar \#0 ${this}::data data
1433  #Attributes node dialog
1434  set tv [GetTreeview $this]
1435  set dialog [Dialog $tv.da -title $title -modal local -parent $tv\
1436     -default 0 -cancel 1]
1437  wm resizable $dialog 0 0
1438  wm protocol $dialog WM_DELETE_WINDOW \
1439          [list ::TolProject::OptionsDestroy $this $dialog]
1440  set w [$dialog getframe]
1441 
1442  set f1 [labelframe $w.f1 -text [mc "File name"]]
1443 
1444  switch -exact $data(type) {
1445    TOL {
1446      set typelist {{"Tol Files" {".tol"}} {"All Files" {"*"}}}
1447      set defExt   .tol
1448    }
1449    BDT {
1450      set typelist {{"Bayes Data Table" {".bdt"}} {"All Files" {"*"}}}
1451      set defExt   .bdt
1452    }
1453    BST {
1454      set typelist {{"Bayes Struct Table" {".bst"}} {"All Files" {"*"}}}
1455      set defExt   .bst
1456    }
1457    default {
1458      set typelist {{"All Files" {"*"}}}
1459      set defExt ""
1460    }
1461  }
1462
1463  # This passes -initialdir to ::Objects::ChooseFileCreate
1464  # which might need further study
1465  entry  $f1.eFile -width 50 -textvariable ${this}::data(name)
1466  ::Objects::ChooseFileCreate ${this}::data(name) $f1.bFile \
1467    -filetypes $typelist -defaultextension $defExt \
1468    -initialdir $data(lastOpenedNodeDir)
1469 
1470  set f2 [labelframe $w.f2 -text [mc "Description"]]
1471  entry $f2.description -width 60 -textvariable ${this}::data(desc)
1472
1473  checkbutton $w.chExclude -text [mc "Exclude in TOLBase"] \
1474            -variable ${this}::data(exclude)
1475
1476  checkbutton $w.chExcludeTOL -text [mc "Exclude in tol.exe"] \
1477        -variable ${this}::data(excludeTOL)
1478
1479  if {[string equal $data(type) "Fol"] ||
1480      [string equal $data(type) "ROOT"] } {
1481    grid $f1.eFile -sticky nw -padx 2 -pady 2
1482  } else  {
1483    grid $f1.eFile $f1.bFile -sticky nw -padx 2 -pady 2
1484  }
1485  grid $f2.description     -sticky nw -padx 2 -pady 2
1486
1487  set w_bbox \
1488    [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1489    -homogeneous false]
1490  $w_bbox add -text [mc "Accept"] -relief link \
1491    -helptext [mc "Continue"] \
1492    -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1493    -command [list ::TolProject::DialogAttributesOK $this $dialog]
1494  $w_bbox add -text [mc "Cancel"] -relief link \
1495    -helptext [mc "Cancel selection"]\
1496    -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1497    -command [list ::TolProject::DialogAttributesDestroy $this $dialog]
1498 
1499  grid $f1 - -sticky news
1500  grid $f2 - -sticky news
1501  grid $w.chExclude $w.chExcludeTOL -sticky nw -pady 2
1502  grid $w_bbox                       -sticky ns -pady 2 -columnspan 2
1503
1504  focus $f1.eFile
1505 
1506  bind $dialog <F1> "ShowHelp Tb4Edp"
1507  $dialog draw
1508
1509}
1510
1511#/////////////////////////////////////////////////////////////////////////////
1512proc ::TolProject::DialogAttributesOK {this dialog} {
1513#
1514# PURPOSE:
1515#
1516# PARAMETERS:
1517#   this   -> Instance of tol project
1518#   dialog -> Get type dialog
1519#
1520#/////////////////////////////////////////////////////////////////////////////
1521  upvar \#0 ${this}::data data
1522   
1523  destroy $dialog
1524}
1525
1526#/////////////////////////////////////////////////////////////////////////////
1527proc ::TolProject::DialogAttributesDestroy {this dialog} {
1528#
1529# PURPOSE: Destroy get type dialog
1530#
1531# PARAMETERS:
1532#   this   -> Instance of tol project
1533#   dialog -> Get type dialog
1534#
1535#/////////////////////////////////////////////////////////////////////////////
1536  upvar \#0 ${this}::data data
1537  set data(name) ""
1538  destroy $dialog
1539}
1540
1541#/////////////////////////////////////////////////////////////////////////////
1542# OPTIONS
1543#/////////////////////////////////////////////////////////////////////////////
1544
1545#/////////////////////////////////////////////////////////////////////////////
1546proc ::TolProject::CmdOptions {this} {
1547#
1548# PURPOSE: Creates a dialog options for Tol Project Editors
1549#
1550# PARAMETERS:
1551#   this -> Instance of tol project
1552#
1553#/////////////////////////////////////////////////////////////////////////////
1554  set path [GetTreeview $this]
1555  set dialog [Dialog $path.d -title [mc "TOL Project Editor Options"]\
1556            -modal local -parent $path]
1557  wm resizable $dialog 0 0
1558  wm protocol $dialog WM_DELETE_WINDOW \
1559        [list ::TolProject::OptionsDestroy $this $dialog]
1560  set w [$dialog getframe]
1561  set w_tabset [NoteBook $w.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
1562  #insertar tabset
1563  set num_i 0
1564  foreach lab_i [list Others] {
1565    $w_tabset insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
1566    set tab_i [$w_tabset getframe $lab_i]
1567    $tab_i configure -borderwidth 2 -background \#d9d9d9
1568    incr num_i   
1569    set f$num_i [frame $tab_i.f]
1570    pack $tab_i.f -fill both -expand yes 
1571  }
1572  $w_tabset raise [$w_tabset pages 0]
1573     
1574  OptionsGet $this
1575  OptionsCreateOthers  $this $f1 
1576  OptionsCheck $this
1577   
1578  set w_bbox \
1579    [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1580    -homogeneous false]
1581  $w_bbox add -text [mc "Accept"] -relief link \
1582    -helptext [mc "Accept"] \
1583    -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1584    -command [list ::TolProject::OptionsOK $this $dialog]
1585  $w_bbox add -text [mc "Cancel"] -relief link \
1586    -helptext [mc "Cancel"]\
1587    -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1588    -command [list ::SetGraphDialog::Cancel $dialog]
1589   
1590  pack $w_bbox   -fill x -expand false -side bottom
1591  $w_tabset compute_size
1592  pack $w_tabset -fill both -expand true
1593
1594  bind $dialog <F1> "ShowHelp Tb4EdpOpc"
1595  $dialog draw
1596}
1597
1598#/////////////////////////////////////////////////////////////////////////////
1599proc ::TolProject::OptionsCreateOthers {this w} {
1600#
1601# PURPOSE: Creates a frame with general options as number of files edited
1602#          recently
1603#
1604# PARAMETERS:
1605#   this -> Instance of tol project
1606#   w    -> widget's path to allocate the frame
1607#
1608#/////////////////////////////////////////////////////////////////////////////
1609  variable tmpOpt
1610   
1611  TitleFrame $w.tf1 -text [mc "General Options"]
1612  set f1 [$w.tf1 getframe]
1613   
1614  checkbutton $f1.chEdited -text [mc "Files edited recently"]\
1615          -variable ::TolProject::tmpOpt(var,chEdited)\
1616          -command [list ::TolProject::OptionsCheckEdited $this]
1617   
1618  set tmpOpt(widget,edited) [SpinBox $f1.sbEdited -justify right -width 4 \
1619          -editable 0 -range {0 10} \
1620          -textvariable ::TolProject::tmpOpt(var,numEdited)]
1621  label $f1.lFiles -text [mc files]
1622 
1623  frame $f1.f -width 25
1624   
1625  grid $f1.f $f1.chEdited     $f1.sbEdited     $f1.lFiles -sticky nw -padx 2
1626  grid rowconfigure    $f1 0 -weight 1
1627  grid columnconfigure $f1 3 -weight 1
1628   
1629  grid $w.tf1 -sticky news -padx 2
1630   
1631  grid rowconfigure    $w 1 -weight 1
1632  grid rowconfigure    $w 2 -weight 2
1633  grid columnconfigure $w 0 -weight 1
1634}
1635
1636#/////////////////////////////////////////////////////////////////////////////
1637proc ::TolProject::OptionsGet {this} {
1638#
1639# PURPOSE: Gets all options variables values from ini file  and copies them
1640#          to the temporary tmpOpt array.
1641#
1642# PARAMETERS:
1643#   this   -> Instance of tol project
1644#
1645#/////////////////////////////////////////////////////////////////////////////
1646  variable options
1647  variable tmpOpt
1648  set tmpOpt(var,chEdited)   $options(chEdited)
1649  set tmpOpt(var,numEdited)  $options(numEdited)
1650}
1651
1652#/////////////////////////////////////////////////////////////////////////////
1653proc ::TolProject::OptionsSet {this} {
1654#
1655# PURPOSE: Copies all .
1656#
1657# PARAMETERS:
1658#   this   -> Instance of tol project
1659#
1660#/////////////////////////////////////////////////////////////////////////////
1661  variable options
1662  variable tmpOpt
1663   
1664  regsub -all var, [array names ::TolProject::tmpOpt var,*] "" optNames
1665  foreach it $optNames {
1666    set options($it) $tmpOpt(var,$it)
1667  } 
1668}
1669
1670#/////////////////////////////////////////////////////////////////////////////
1671proc ::TolProject::OptionsCheck {this} {
1672#
1673# PURPOSE: Checks for all widgets from dialog options that need to be checked
1674#          for enabling/disabling other associated controls.
1675#
1676# PARAMETERS:
1677#   this   -> Instance of tol project
1678#
1679#/////////////////////////////////////////////////////////////////////////////
1680  OptionsCheckEdited           $this
1681}
1682
1683#/////////////////////////////////////////////////////////////////////////////
1684proc ::TolProject::OptionsCheckEdited {this} {
1685#
1686# PURPOSE: Checks if option chEdited is checked and enables/disabled other
1687#          associated controls.
1688#
1689# PARAMETERS:
1690#   this   -> Instance of tol project
1691#
1692#/////////////////////////////////////////////////////////////////////////////
1693  variable tmpOpt
1694  if {!$tmpOpt(var,chEdited)} {     
1695    $tmpOpt(widget,edited) configure -state disabled
1696  } else  {
1697    $tmpOpt(widget,edited) configure -state normal
1698  }
1699}
1700
1701#/////////////////////////////////////////////////////////////////////////////
1702proc ::TolProject::OptionsDestroy {this dialog} {
1703#
1704# PURPOSE: Destroy options dialog
1705#
1706# PARAMETERS:
1707#   this   -> Instance of tol project
1708#   dialog -> Options dialog
1709#
1710#/////////////////////////////////////////////////////////////////////////////
1711  variable tmpOpt
1712   
1713  array unset tmpOpt
1714  destroy $dialog
1715}
1716
1717#///////////////////////////////////////////////////////////////////////////// 
1718proc ::TolProject::OptionsApply {this} {
1719#
1720# PURPOSE: Applies options from the options dialog
1721#
1722# PARAMETERS:
1723#   this   -> Instance of tol project
1724#
1725#/////////////////////////////////////////////////////////////////////////////
1726  OptionsSet $this
1727}
1728
1729#/////////////////////////////////////////////////////////////////////////////
1730proc ::TolProject::OptionsOK {this dialog} {
1731#
1732# PURPOSE: Applies options and closes options dialog
1733#
1734# PARAMETERS:
1735#   this   -> Instance of tol project
1736#   dialog -> Options dialog
1737#
1738#/////////////////////////////////////////////////////////////////////////////
1739  OptionsApply   $this
1740  OptionsDestroy $this $dialog
1741}
1742
1743#/////////////////////////////////////////////////////////////////////////////
1744# INIFILE
1745#/////////////////////////////////////////////////////////////////////////////
1746
1747#/////////////////////////////////////////////////////////////////////////////
1748proc ::TolProject::ReadIniSpecial {} {
1749#
1750# PURPOSE: Reads common Edit Table options from .ini file. This options are
1751#          common for all instances of Tol Project Editor. They are read just
1752#          one time.
1753#
1754#/////////////////////////////////////////////////////////////////////////////
1755  variable options
1756  global toltk_options
1757
1758  set rini ::iniFile::Read
1759  set options(chEdited)   [$rini TolProject saveRecent  1]
1760  set options(numEdited)  [$rini TolProject numRecent   8]
1761  set options(edited)     [$rini TolProject recent      {}]
1762
1763  set options(font)       [$rini TolProject font  $toltk_options(fonts,Fixed)]
1764  set options(lastDir)    [$rini TolProject lastDir  ""]
1765}
1766
1767#/////////////////////////////////////////////////////////////////////////////
1768proc ::TolProject::WriteIni {this} {
1769#
1770# PURPOSE: Write common Tol Projects options to .ini file
1771#
1772# PARAMETERS:
1773#   this  -> Instance of tol project
1774#
1775#/////////////////////////////////////////////////////////////////////////////
1776  variable options
1777  upvar \#0 ${this}::data data
1778  set wini ::iniFile::Write
1779
1780  # Common options
1781  $wini TolProject saveRecent   $options(chEdited)
1782  $wini TolProject numRecent    $options(numEdited)
1783  $wini TolProject recent       $options(edited)
1784  $wini TolProject font         $options(font)
1785  $wini TolProject lastDir      $options(lastDir)
1786
1787  ::iniFile::Flush
1788}
1789
1790#/////////////////////////////////////////////////////////////////////////////
1791# Métodos que estaban en ::BayesTreeview (bftrview.tcl)
1792#/////////////////////////////////////////////////////////////////////////////
1793
1794#/////////////////////////////////////////////////////////////////////////////
1795proc ::TolProject::WtreeFromFile {tv path {proc ""}} {
1796#
1797# PURPOSE: Loads a wtree info data from a text especification file of a wtree.
1798#
1799# PARAMETERS:
1800#   tv   -> wtree's path
1801#   path -> name of file
1802# proc -> procedure that converts type node to the path of the image of node
1803#
1804# RETURN: Returns 1 if wtree has been loaded correctly or 0 if not.
1805#
1806#/////////////////////////////////////////////////////////////////////////////
1807  if ![file exists $path] {
1808    return -code error "File $path doesn't exist"
1809  }
1810  set fd [iniparse:openfile $path]
1811  BNodeFromFile $tv root "" $fd $proc
1812  iniparse:closefile $fd
1813  return 1
1814}
1815
1816#/////////////////////////////////////////////////////////////////////////////
1817proc ::TolProject::WtreeToFile {tv path} {
1818#
1819# PURPOSE: Saves a wtree info data into a text especification file of a wtree.
1820#
1821# PARAMETERS:
1822#   tv   -> wtree's path
1823#   path -> name of file
1824#
1825# RETURN: Returns 1 if file has been saved correctly or 0 if not.
1826#
1827#/////////////////////////////////////////////////////////////////////////////
1828  #borrar archivo pq iniparse:openfile abre para solo lectura si existe
1829  file delete $path
1830  set fd [iniparse:openfile $path]
1831  BNodeToFile $tv root $fd
1832  iniparse:closefile $fd
1833  return 1
1834}
1835
1836#/////////////////////////////////////////////////////////////////////////////
1837proc ::TolProject::BNodeToFile {tv index fd} {
1838#
1839# PURPOSE: Saves a wtree's node info data into a text file.
1840#
1841# PARAMETERS:
1842#   tv    -> wtree's path
1843#   index -> wtree node index
1844#   fd    -> channel identifier of text file
1845#
1846#/////////////////////////////////////////////////////////////////////////////
1847  set key $index
1848
1849  # Guardar data del nodo actual
1850  set columnNames [list FileName Description Type Exclude ExcludeTOL]
1851  foreach item $columnNames {
1852    writeini $fd $key $item [$tv item text $index $item]
1853  }
1854 
1855  writeini $fd $key Label [$tv item text $index FileName]
1856  # Guardar sus hijos
1857  writeini $fd $key Children [$tv item children $index]
1858
1859  # Llamar recursivamente para los hijos
1860  foreach child [$tv item children $index] {
1861    BNodeToFile $tv $child $fd
1862  }
1863}
1864
1865#/////////////////////////////////////////////////////////////////////////////
1866proc ::TolProject::BNodeFromFile {tv index parent fd {imgFromType ""}} {
1867#
1868# PURPOSE: Loads a wtree's node info data from a text file.
1869#
1870# PARAMETERS:
1871#   tv     -> wtree's path
1872#   index  -> wtree node index
1873#   parent -> wtree node's parent index
1874#   fd     -> channel identifier of text file
1875#
1876#/////////////////////////////////////////////////////////////////////////////
1877  set key $index
1878  set image "" 
1879  set filename ""
1880  set description ""
1881  set type ""
1882  set exclude 0
1883  set excludeTOL 0 ;#@ puede que no lo tenga el prj
1884  foreach item [readini $fd $key] {
1885    set value [readini $fd $key $item]
1886    switch -exact $item {
1887      FileName { set filename $value }
1888      Description { set description $value }
1889      Type { set type $value }
1890      Exclude { set exclude $value }
1891      ExcludeTOL { set excludeTOL $value }
1892      Label { set void 0 }     
1893    }
1894    if {[string equal $item "Type"] && ![string equal $imgFromType ""]} {
1895      if ![string equal [set img [$imgFromType $value]] ""] {
1896        #@ $tv entry configure $idx -icons [list $img $img]
1897        set image $img
1898      }
1899    }
1900  }
1901  if ![string equal $parent ""] {
1902    #@ se inserta un nodo
1903    if { $type eq "Fol" } {
1904      set hasbutton 1
1905    } else {
1906      set hasbutton 0
1907    } 
1908    set idx [$tv item create -parent $parent -button $hasbutton -open 0]
1909    $tv item image $idx FileName $img
1910    $tv item text $idx FileName $filename Description $description \
1911      Type $type Exclude $exclude ExcludeTOL $excludeTOL 
1912  } else {
1913    #@ se actualiza root
1914    $tv item image root FileName $img
1915    $tv item text root FileName $filename Description $description \
1916      Type $type Exclude $exclude ExcludeTOL $excludeTOL
1917    set idx root
1918  } 
1919  # Llamar recursivamente para los hijos
1920  foreach child [readini $fd $key Children] {
1921    BNodeFromFile $tv $child $idx $fd $imgFromType
1922  }
1923}
1924
1925::TolProject::ReadIniSpecial
Note: See TracBrowser for help on using the repository browser.