source: tol/tolbase/lib/toltk/tolprj.tcl @ 0fce7d3

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

Refs #1933
Se revisa tolprj.
Se prescinden de algunos métodos auxiliares creados en tolprj para usar wtree/treectrl.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7347 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 61.5 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    -highlightbackground gray75 -highlightcolor black \
411    -highlightthickness 0 -font $toltk_options(fonts,Label) \
412    -columns [list \
413      [list {image text} -label FileName -tags FileName] \
414      [list text -label Description -tags Description] \
415      [list text -label Type -tags Type] \
416      [list text -label Exclude -tags Exclude] \
417      [list text -label ExcludeTOL -tags ExcludeTOL] \
418    ] ]
419  set data(treeview) $tv
420  $tv item style set root FileName    [$tv column cget FileName -itemstyle]
421  $tv item style set root Description [$tv column cget Description -itemstyle]
422  $tv item style set root Type        [$tv column cget Type -itemstyle]
423  $tv item style set root Exclude     [$tv column cget Exclude -itemstyle]
424  $tv item style set root ExcludeTOL  [$tv column cget ExcludeTOL -itemstyle]
425  $tv column configure "range 1 end" -visible no
426  $tv column configure first -expand yes -weight 1
427  $tv column configure all -itembackground ""       
428  $tv notify bind $tv <Selection> "::TolProject::SelectProc $this"       
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
444  bind $tv.frameTree.t <Control-KeyRelease> [list ::TolProject::OnControlKey $this %K %k]
445
446  bind $tv.frameTree.t <Button-1> "::focus $tv" 
447 
448  bind $tv.frameTree.t <Button-3> +[list ::TolProject::PostVariable $this %X %Y]
449 
450  set prevBind [bind $tv.frameTree.t <Double-1>]
451  set newBind "[lrange $prevBind 0 [expr [llength $prevBind]-3]] ; mdidoc disableglobalraise ; ::TolProject::OpenNodeIfTerminal $this ; break"
452  #@ mdidoc disableglobalraise y break parece que cumplen el mismo cometido
453  bind $tv.frameTree.t <Double-1> $newBind
454 
455  set prevBind [bind $tv.frameTree.t <KeyPress-Return>]
456  set newBind "[lrange $prevBind 0 [expr [llength $prevBind]-3]] ; ::TolProject::OpenNodeIfTerminal $this ; break"
457  bind $tv.frameTree.t <KeyPress-Return> $newBind   
458
459  bind $tv.frameTree.t <KeyPress-space>  +[list ::TolProject::NodeActiveAttributes $this]
460  bind $tv.frameTree.t <KeyPress-Delete> +[list ::TolProject::DeleteActiveNode     $this]
461  bind $tv.frameTree.t <KeyPress-F9>     "::TolProject::CompileActiveNode    $this ; break"
462  bind $tv.frameTree.t <KeyPress-F8>     "::TolProject::DecompileActiveNode  $this ; break" 
463 
464  set data(mainMenu) [menu $tv.m -tearoff 0]
465
466  bind $data(f) <Destroy> +[list ::TolProject::Destroy $this %W]
467  $data(f) bind <Control-F4> "$data(f) kill; break"
468  return $this
469}
470
471#///////////////////////////////////////////////////////////////////////////
472proc ::TolProject::OnControlKey {this keysym keycode} {
473#
474# PURPOSE: Control the "Control + Key Press"
475#
476# PARAMETERS: this ->  Instance of project editor
477#             keysym -> The keysym corresponding to the event,
478#                       substituted as a textual string
479#             keycode -> The keycode field from the event
480#
481#///////////////////////////////////////////////////////////////////////////
482  #puts "PLATFORM: $::tcl_platform(platform)"
483  switch [string toupper $keysym] {
484    A { ::TolProject::CmdOpen $this}
485    N { ::TolProject::CmdNew  $this}
486    S { ::TolProject::CmdSave $this}
487  }
488}
489
490#/////////////////////////////////////////////////////////////////////////////
491# File management commands (new, open, save, save as...)
492#/////////////////////////////////////////////////////////////////////////////
493
494#/////////////////////////////////////////////////////////////////////////////
495proc ::TolProject::CmdNew {this} {
496#
497# PURPOSE: Cleans project window to edit a new white project
498#
499# PARAMETERS:
500#   this  -> Instance of Tol project
501#
502#/////////////////////////////////////////////////////////////////////////////
503  upvar \#0 ${this}::data data
504
505  set tv [GetTreeview $this]
506  if [string equal [CheckOpen $this] "cancel"] return
507  $tv item delete all
508  set img [GetImageFromType ROOT]
509  $tv item image root FileName $img
510  $tv item text root FileName "" Description "Root node" \
511    Type "ROOT" Exclude 0 ExcludeTOL 0
512  InitState $this new
513}
514
515#/////////////////////////////////////////////////////////////////////////////
516proc ::TolProject::UpdateListEdited {path} {
517#
518# PURPOSE: Updates list of last edited project files adding a new file path.
519#
520# PARAMETERS:
521#   path  -> path of the last edited project file
522#
523#/////////////////////////////////////////////////////////////////////////////
524  variable options
525  # guardamos el ultimo directorio abierto
526  set options(lastDir) [file dirname $path]
527  if { [set idx [lsearch $options(edited) $path]] == -1 } {
528    set options(edited) [linsert $options(edited) 0 $path]
529  } else {
530    set ll ""
531    lappend ll $path
532    set i 0
533    foreach f $options(edited) {
534      if  {$i != $idx} {
535        lappend ll $f
536      }
537      incr i
538    }
539    set options(edited) $ll
540  }
541  set options(edited) [lrange $options(edited) 0 [expr $options(numEdited)-1]]
542}
543
544#/////////////////////////////////////////////////////////////////////////////
545proc ::TolProject::CmdOpen {{this ""}} {
546#
547# PURPOSE: Asks for a project file path and if it's given opens it into the
548#          project window.
549#
550# PARAMETERS:
551#   this -> Instance of tol project
552#
553#/////////////////////////////////////////////////////////////////////////////
554  variable options
555  variable typelist
556  variable defExt
557 
558  if {$this == ""} {
559    set parent .
560  } else  {
561    set parent [GetTreeview $this]
562    if [string equal [CheckOpen $this] "cancel"] return
563  }
564
565  set path [tk_getOpenFile -title [mc "Open"] \
566          -parent $parent -initialdir $options(lastDir) \
567          -defaultextension $defExt -filetypes $typelist]
568
569  if { $path != "" } {
570    # abrimos solo si no esta ya abierto
571    foreach ins [namespace children ::TolProject::] {
572      upvar \#0 ${ins}::data data
573      if {[string equal "$data(baseDir)/$data(nameFile)" $path]} {
574        $data(f) raise
575            set resp [tk_messageBox -type ok -icon warning \
576             -message [mc "The project is allready opened!"] ]
577        return
578      }
579    }
580    if {$this == ""} {
581      set this [New $path]
582    }
583    GetFromFile $this $path
584  }
585}
586
587#/////////////////////////////////////////////////////////////////////////////
588proc ::TolProject::GetFromFile {this path {run 0}} {
589#
590# PURPOSE: Loads a project into the project window . This converts from the
591#          file especification to the treeview representation.
592#
593# PARAMETERS:
594#   this -> Instance of tol project
595#   path -> project file's path
596#   run  -> if 1 the project will be automatically compiled
597#
598#/////////////////////////////////////////////////////////////////////////////
599  upvar \#0 ${this}::data data
600  set tv [GetTreeview $this]
601  $tv item delete all
602  if {[::TolProject::WtreeFromFile $tv $path ::TolProject::GetImageFromType]} {
603    set data(baseDir) [file dirname $path]
604    set data(lastOpenedNodeDir) $data(baseDir)
605    set data(nameFile) [file tail $path]
606    UpdateListEdited $path
607  } else {
608    set data(nameFile) ""
609  }
610  $data(f) raise
611  InitState $this open
612  if { $run } {
613    CompileNode $this root
614  }
615}
616
617#/////////////////////////////////////////////////////////////////////////////
618proc ::TolProject::CheckAll {} {
619#
620# PURPOSE: Checks for files opened if anyone has changed and asks for saving.
621#
622#/////////////////////////////////////////////////////////////////////////////
623  if { ![ catch { set lst [namespace children ::TolProject] } msgerr] } {
624    foreach ins $lst {
625      if {[CheckOpen $ins] eq "cancel"} {
626        return "cancel"
627      }
628    }
629  }
630  return "ok"
631}
632
633#/////////////////////////////////////////////////////////////////////////////
634proc ::TolProject::CheckOpen {this {type "yesnocancel"}} {
635#
636# PURPOSE: Checks if a file has changed and asks for saving.
637#
638# PARAMETERS:
639#   this -> Instance of Tol project
640#   type -> type of messageBox to ask. (yesnocancel by default)
641#
642# RETURN: Returns user answer for saving.
643#
644#/////////////////////////////////////////////////////////////////////////////
645  upvar \#0 ${this}::data data
646   
647  # comprobamos si necesita ser guardado
648  if { !$data(isSaved)} {
649    if {$data(nameFile) != ""} {
650      set name $data(nameFile)
651    } else  {
652      set name "untitled.prj"
653    }
654    # preguntamos por conformidad
655    set tv [GetTreeview $this]
656    set rq [tk_messageBox -type $type -icon warning -title [mc "Warning"]\
657            -parent $tv -message "[mc "File %1\$s has changed!" $name].\n\
658            [mc "Do you want to save changes?"]"]
659    switch -exact $rq {
660      yes {
661        if {$data(nameFile) != "" } {
662          FileSave $this $data(nameFile)
663        } else {
664          CmdSaveAs $this $data(nameFile)
665        }
666      }
667      cancel {return cancel}
668      default {return ok}
669    }
670  }
671  return ok
672}
673
674#/////////////////////////////////////////////////////////////////////////////
675proc ::TolProject::CmdSave {this} {
676#
677# PURPOSE: Saves project info actually opened in the project editor. If it
678#          doesn't have a name, asks for ti (CmdSaveAs).
679#
680# PARAMETERS:
681#   this -> Instance of Tol project
682#
683# RETURN: Returns 1 if file has been saved correctly or 0 if not.
684#
685#/////////////////////////////////////////////////////////////////////////////
686  upvar \#0 ${this}::data data
687
688  if {$data(nameFile) == ""} {
689    set ok [CmdSaveAs $this]
690  } else {
691    set ok [FileSave $this $data(nameFile)]
692  }
693  return $ok
694}
695
696#/////////////////////////////////////////////////////////////////////////////
697proc ::TolProject::CmdSaveAs {this {nf ""}} {
698#
699# PURPOSE: Saves project actually opened in project editor asking for the
700#          user to select a file to save it.
701#
702# PARAMETERS:
703#   this -> Instance of Tol project
704#   nf   -> name of file proposed
705#
706# RETURN: Returns 1 if file has been saved correctly or 0 if not.
707#
708#/////////////////////////////////////////////////////////////////////////////
709  upvar \#0 ${this}::data data
710  variable options
711  variable typelist
712  variable defExt
713  set tv [GetTreeview $this]
714 
715  if {$nf == ""} {
716    set dir $options(lastDir)
717    set fil ""
718  } else  {
719    set dir "[file dirname $nf]"
720    set fil "[file tail $nf]"
721  }
722  set path [tk_getSaveFile -title [mc "Save as"] -initialdir $dir \
723       -initialfile $fil -parent $tv \
724       -defaultextension $defExt -filetypes $typelist]
725  if {![string equal $path ""] } {
726    set data(baseDir) [file dirname $path]
727    set data(lastOpenedNodeDir) $data(baseDir)
728    set data(nameFile) [file tail $path]
729    set ok [FileSave $this [file tail $path]]
730  } else {
731    set ok 0
732  }
733  return $ok
734}
735
736#/////////////////////////////////////////////////////////////////////////////
737proc ::TolProject::FileSave { this path } {
738#
739# PURPOSE: Saves project actually opened in project editor in a text file.
740#
741# PARAMETERS:
742#   this -> Instance of tol project
743#   path -> name of file
744#
745# RETURN: Returns 1 if file has been saved correctly or 0 if not.
746#
747#/////////////////////////////////////////////////////////////////////////////
748  variable options
749  upvar \#0 ${this}::data data
750
751  #Guardar la transformación de treeview a archivo
752  if {[::TolProject::WtreeToFile [GetTreeview $this] \
753      [::TolProject::ComputeFullPath $this $path]]} {
754    #Añadir al archivo la entrada para que pueda ser llamado desde tol.exe
755    AddEntry $this [::TolProject::ComputeFullPath $this $path]
756    set data(nameFile) $path
757    InitState $this save
758    # guardamos el ultimo directorio utilizado
759    set options(lastDir) $data(baseDir)
760    set ok 1
761  } else  {
762    set ok 0
763  }
764  return $ok
765}
766
767#/////////////////////////////////////////////////////////////////////////////
768proc ::TolProject::AddEntry {this path} {
769#
770# PURPOSE: Adds a special entry in file path for including proyect from TOL.
771#
772# PARAMETERS:
773#   this -> Instance of tol project
774#   path -> name of file
775#
776#/////////////////////////////////////////////////////////////////////////////
777  upvar \#0 ${this}::data data
778  set data(num) 1
779  set fd [iniparse:openfile $path]
780  NodeToFile $this root $fd [file tail [file rootname $path]]
781  iniparse:closefile $fd
782}
783
784#/////////////////////////////////////////////////////////////////////////////
785proc ::TolProject::NodeToFile {this index fd name} {
786#
787# PURPOSE:
788#
789# PARAMETERS:
790#   this -> Instance of tol project
791#   index -> treeview node index
792#   fd    -> channel identifier of text file
793#   name  ->
794#
795#/////////////////////////////////////////////////////////////////////////////
796  upvar \#0 ${this}::data data
797  set key "Included TOL Files"
798
799  set tv [GetTreeview $this]
800  # Guardar data del nodo actual
801  set excludeTOL [$tv item text $index ExcludeTOL]
802  if ![string equal $excludeTOL 1] {
803    if {[IsCompilable $this $index] } {
804      set filename [$tv item text $index FileName]
805      set item "Set $name.$data(num)"
806      set value "Include(\"$filename\");"
807      Tolcon_Trace "item: $item, value: $value"
808      writeini $fd $key $item $value
809      incr data(num)
810    }
811    # Llamar recursivamente para los hijos
812    foreach child [$tv item children $index] {
813      NodeToFile $this $child $fd $name
814    }
815  }
816}
817
818#/////////////////////////////////////////////////////////////////////////////
819proc ::TolProject::GetTreeview {this} {
820#
821# PURPOSE: Returns treeview's path of a given instance
822#
823# PARAMETERS:
824#   this -> Instance of tol project
825#
826# RETURN: Treeview's path
827#
828#/////////////////////////////////////////////////////////////////////////////
829  upvar \#0 ${this}::data data
830  return $data(treeview)
831}
832
833#/////////////////////////////////////////////////////////////////////////////
834proc ::TolProject::GetMenu {this} {
835#
836# PURPOSE: Returns treeview's menu of a given instance
837#
838# PARAMETERS:
839#   this -> Instance of tol project
840#
841# RETURN: Treeview menu's path
842#
843#/////////////////////////////////////////////////////////////////////////////
844  upvar \#0 ${this}::data data
845  return $data(mainMenu)
846}
847
848#/////////////////////////////////////////////////////////////////////////////
849proc ::TolProject::SelectProc {this} {
850#
851#/////////////////////////////////////////////////////////////////////////////
852  upvar \#0 ${this}::data data
853  set tv [GetTreeview $this]
854  set node [$tv selection get end] ;# anchor
855  if { $node eq "" } return
856  set description [$tv item text $node Description]
857  $data(sb,desc) configure -text "$description"
858}
859
860#/////////////////////////////////////////////////////////////////////////////
861proc ::TolProject::PostVariable {this x y} {
862#
863# PURPOSE: Composes a popup menu and displays it. Its composed depending on
864#          the node clicked by user.
865#
866# PARAMETERS:
867#   x -> x-coordinate where popup menu is drawn
868#   y -> y-coordinate where popup menu is drawn
869#
870#/////////////////////////////////////////////////////////////////////////////
871  upvar \#0 ${this}::data data
872  set tv [GetTreeview $this]
873  set menu [GetMenu $this]
874  $menu delete 0 end
875
876  set state [expr {$data(compiling)? "disabled" : "normal" }]
877
878  set node [$tv selection get end] ;# current
879  if { [string length $node] } {
880    if [IsTerminal $this $node] {
881      $menu add command -label [mc "Open node"] -accelerator Return\
882         -command [list ::TolProject::OpenNode $this $node]
883 
884      # Compute insertion point and prepare menu entry     
885      set nodefocus [$tv selection get end] ;# focus
886      set parent [$tv item parent $nodefocus]   
887      set prev [$tv item prevsibling $nodefocus]
888      if {[string equal $prev ""]} {
889        set prevCount 1
890      } else {
891        set prevCount [expr [lsearch [$tv item children $parent] $node] + 1]
892      }
893      $menu add command -label [mc "Add node"] \
894        -command [list ::TolProject::AddNode $this $parent $prevCount]\
895        -accelerator Ins
896 
897    } else {
898      # This adds to the end of the non-terminal node
899      $menu add command -label [mc "Add node"] -accelerator Ins\
900            -command [list ::TolProject::AddNode $this $node]
901    }
902    $menu add command -label [mc "Attributes"] -accelerator space\
903          -command [list ::TolProject::NodeAttributes $this $node]
904    $menu add command -label [mc "Delete node"] -accelerator Sup\
905          -command [list ::TolProject::DeleteNode $this $node]
906    $menu add separator
907    if [IsTerminal $this $node] {
908      $menu add command -label [mc "Compile node"] -state $state \
909         -command [list ::TolProject::CompileNode $this $node]\
910         -accelerator F9
911      $menu add command -label [mc "Decompile node"]  -state $state \
912         -command [list ::TolProject::DecompileNode $this $node]\
913         -accelerator F8
914    } else {
915      $menu add command -label [mc "Compile node"] -state $state \
916         -command [list ::TolProject::CompileNode $this $node]\
917         -accelerator F9
918      $menu add command -label [mc "Decompile node"]  -state $state \
919         -command [list ::TolProject::DecompileNode $this $node]\
920         -accelerator F8
921    }
922    $menu add command -label [mc "Compile to the end"] -state $state \
923       -command [list ::TolProject::CompileIfBeforeNode $this root $node]
924    $menu add command -label [mc "Compile up to here"] -state $state \
925       -command [list ::TolProject::CompileUpToHereNode $this root $node]   
926    # save as
927    $menu add separator   
928    $menu add command -label "[mc "Save as"] ..." \
929      -command [list ::TolProject::CmdSaveAs $this]   
930    # show menu
931    tk_popup $menu $x $y     
932  }
933}
934
935#/////////////////////////////////////////////////////////////////////////////
936proc ::TolProject::OpenNodeIfTerminal {this} {
937#
938# PURPOSE:
939#
940# PARAMETERS:
941#   this -> Instance of tol project
942#
943#/////////////////////////////////////////////////////////////////////////////
944  upvar \#0 ${this}::data data
945  set tv [GetTreeview $this]
946  set node [$tv selection get end] ;# anchor
947  OpenNode $this $node
948}
949
950#/////////////////////////////////////////////////////////////////////////////
951proc ::TolProject::OpenNode {this node} {
952#
953# PURPOSE: Opens a terminal node of the project. It depends on the node type
954#          what kind of editor use for opening the node (text or table).
955#
956# PARAMETERS:
957#   this -> Instance of tol project
958#   node -> Node active in treeview, which is opened
959#
960#/////////////////////////////////////////////////////////////////////////////
961  upvar \#0 ${this}::data data
962  set tv [GetTreeview $this]
963 
964  set type [$tv item text $node Type]
965  set filename [$tv item text $node FileName]
966  switch $type {
967    TOL { ::Editor::Open \
968          [::TolProject::ComputeFullPath $this $filename] }
969    BDT -
970    BST { ::EditTable::Open \
971          [::TolProject::ComputeFullPath $this $filename] }
972  }
973}
974
975#/////////////////////////////////////////////////////////////////////////////
976proc ::TolProject::AddNode {this node {prev end}} {
977#
978# PURPOSE: Adds a node to the project. First of all, asks for the node type.
979#
980# PARAMETERS:
981#   this -> Instance of tol project
982#   node -> Node active in treeview, in which the new node is added
983#   prev -> where is added, end if nothing is specified
984#
985#/////////////////////////////////////////////////////////////////////////////
986  upvar \#0 ${this}::data data
987  set tv [GetTreeview $this]
988 
989  #si no hay un directorio base establecido mostramos dialogo de guardar proyecto
990  if { $data(baseDir) eq "" } {
991    CmdSave $this
992    return
993  }
994 
995  ClearData $this
996  DialogType $this $tv
997  # si no se ha pulsado cancelar
998  if {$data(type) != -1} {
999    if {!($data(type) eq "Fol") } {
1000      set title "[mc Add] [mc {a file of type}] $data(type) "
1001    } else {
1002      set title "[mc Add] [mc folder]"
1003    }
1004    DialogAttributes $this $tv $title
1005    # si no se ha pulsado cancelar
1006    if {![string equal $data(name) ""]} {
1007
1008      # Path name gets transformed for files
1009      switch -exact $data(type) {
1010        TOL -
1011        BDT -
1012        BST {
1013          set data(lastOpenedNodeDir) [file dirname $data(name)]
1014          set data(name) \
1015          [ObtainRelativePath $data(name) $data(baseDir)]
1016        }
1017        default {
1018          # do nothing for folders
1019        }
1020      }
1021     
1022      set img [GetImageFromType $data(type)]                                       
1023      if { $data(type) eq "Fol" } {
1024        set hasbutton 1
1025      } else {
1026        set hasbutton 0
1027      }
1028      Tolcon_Trace "prev $prev node $node"
1029      if {$prev eq "end"} {
1030        set idx [$tv item create -parent $node -button $hasbutton -open 0]
1031      } else {
1032        set idx [$tv item create -prevsibling $prev -button $hasbutton -open 0]
1033      }
1034      $tv item image $idx FileName $img
1035      $tv item text $idx FileName $data(name) Description $data(desc) \
1036        Type $data(type) Exclude $data(exclude) ExcludeTOL $data(excludeTOL)
1037      set data(isSaved) 0
1038    }
1039  }
1040}
1041
1042#/////////////////////////////////////////////////////////////////////////////
1043proc ::TolProject::NodeActiveAttributes {this args} {
1044#/////////////////////////////////////////////////////////////////////////////
1045  upvar \#0 ${this}::data data
1046  set tv [GetTreeview $this]
1047  set node [$tv selection get end] ;# anchor
1048  NodeAttributes $this $node
1049}
1050
1051#/////////////////////////////////////////////////////////////////////////////
1052proc ::TolProject::NodeAttributes {this node} {
1053#
1054# PURPOSE: Shows the attributes of the selected node.
1055#
1056# PARAMETERS:
1057#   this -> Instance of tol project
1058#   node -> Node active in treeview, whose attributes are shown
1059#
1060#/////////////////////////////////////////////////////////////////////////////
1061  upvar \#0 ${this}::data data
1062  set tv [GetTreeview $this]
1063  GetDataFromNode $this $node
1064  set name_old $data(name)
1065  set desc_old $data(desc)
1066  set excl_old $data(exclude)
1067  set exct_old $data(excludeTOL)
1068  set title "[$tv item text $node FileName] [mc Attributes]"
1069  DialogAttributes $this $tv $title
1070  # si no se ha pulsado cancelar
1071  if {![string equal $data(name) ""]} {
1072    # si se ha cambiado algun dato
1073    if {![string equal $name_old $data(name)] ||
1074        ![string equal $desc_old $data(desc)] ||
1075        ![string equal $excl_old $data(exclude)] ||
1076        ![string equal $exct_old $data(excludeTOL)]} {
1077      $tv item text $node FileName $data(name) Description $data(desc) \
1078        Exclude $data(exclude) ExcludeTOL $data(excludeTOL)                       
1079      set data(isSaved) 0
1080    }
1081  }
1082}
1083
1084#/////////////////////////////////////////////////////////////////////////////
1085proc ::TolProject::DeleteActiveNode {this args} {
1086#/////////////////////////////////////////////////////////////////////////////
1087  upvar \#0 ${this}::data data
1088  set tv [GetTreeview $this]
1089  set node [$tv selection get end] ;# current
1090  DeleteNode $this $node
1091}
1092
1093#/////////////////////////////////////////////////////////////////////////////
1094proc ::TolProject::DeleteNode {this node} {
1095#
1096# PURPOSE: Deletes a node and all its childs from the project.
1097#
1098# PARAMETERS:
1099#   this -> Instance of tol project
1100#   node -> Node active in treeview, which is deleted
1101#
1102#/////////////////////////////////////////////////////////////////////////////
1103  upvar \#0 ${this}::data data
1104
1105  set tv [GetTreeview $this]
1106  set name [$tv item text $node FileName]
1107  set answer [tk_messageBox -title [mc "Question"]\
1108            -parent $tv\
1109            -message [mc "Are you sure you want to delete node %1\$s?" $name] \
1110            -type yesno -icon question]
1111  if { [string compare $answer yes] == 0 } {
1112    $tv item delete $node
1113    set data(isSaved) 0
1114  }
1115}
1116
1117#/////////////////////////////////////////////////////////////////////////////
1118proc ::TolProject::CompileActiveNode {this args} {
1119#/////////////////////////////////////////////////////////////////////////////
1120  upvar \#0 ${this}::data data
1121  set tv [GetTreeview $this]
1122  set node [$tv selection get end] ;# current
1123  CompileNode $this $node
1124}
1125
1126#/////////////////////////////////////////////////////////////////////////////
1127proc ::TolProject::CompileNode {this node } {
1128#
1129# PURPOSE: Compiles a node and all its childs if parameter 'childs' is true.
1130#
1131# PARAMETERS:
1132#   this   -> Instance of tol project
1133#   node   -> Node active in treeview, which is compiled
1134#   childs -> flag that indicates if childs must be compiled too
1135#
1136#/////////////////////////////////////////////////////////////////////////////
1137  upvar \#0 ${this}::data data
1138  set tv [GetTreeview $this]
1139  set exclude [$tv item text $node Exclude]
1140  if ![string equal $exclude 1] { 
1141    if [IsCompilable $this $node] {
1142      #Tolcon_Trace "  Compilo $node"
1143      set data(compiling) 1
1144      set filename [$tv item text $node FileName]   
1145      ::TolConsole::Include \
1146        [::TolProject::ComputeFullPath $this $filename]
1147      set data(compiling) 0
1148    }
1149    foreach child [$tv item children $node] {
1150      CompileNode $this $child
1151    }
1152  }
1153}
1154
1155#/////////////////////////////////////////////////////////////////////////////
1156proc ::TolProject::CompileIfBeforeNode {this node ref} {
1157#
1158# PURPOSE: Compiles a node if it's after a node given as reference
1159#
1160# PARAMETERS:
1161#   this -> Instance of tol project
1162#   node -> Node to check if it's after a given node to compile it
1163#   ref  -> Node given as reference
1164#
1165#/////////////////////////////////////////////////////////////////////////////
1166  set tv [GetTreeview $this]
1167  #Tolcon_Trace "CompileIfBeforeNode. node: $node, ref: $ref"
1168  set isbefore [expr [$tv item order $node] < [$tv item order $ref]] 
1169  if !$isbefore {
1170    CompileNode $this $node
1171  } else  {
1172    foreach child [$tv item children $node] {
1173      CompileIfBeforeNode $this $child $ref
1174    }
1175  }
1176}
1177
1178#/////////////////////////////////////////////////////////////////////////////
1179proc ::TolProject::CompileUpToHereNode {this node ref} {
1180#
1181# PURPOSE: Compiles up to here
1182#
1183# PARAMETERS:
1184#   this -> Instance of tol project
1185#   node -> Node to check if it's after a given node to compile it
1186#   ref  -> Node given as reference
1187#
1188#/////////////////////////////////////////////////////////////////////////////
1189  set tv [GetTreeview $this]
1190  #Tolcon_Trace "CompileUpToHereNode. node: $node, ref: $ref"
1191  set isbefore [expr [$tv item order $node] < [$tv item order $ref]] 
1192  if {((![string eq root $node] && [string eq $node $ref]) ||
1193       (![string eq root $node] && $isbefore))} {
1194    CompileNode $this $node
1195  } else  {
1196    foreach child [$tv item children $node] {
1197      CompileUpToHereNode $this $child $ref
1198    }
1199  }
1200}
1201
1202#/////////////////////////////////////////////////////////////////////////////
1203proc ::TolProject::DecompileActiveNode {this args} {
1204#/////////////////////////////////////////////////////////////////////////////
1205  upvar \#0 ${this}::data data
1206  set tv [GetTreeview $this]
1207  set node [$tv selection get end] ;# current
1208  DecompileNode $this $node
1209}
1210
1211#/////////////////////////////////////////////////////////////////////////////
1212proc ::TolProject::DecompileNode {this node} {
1213#
1214# PURPOSE: Decompiles a node and all its childs.
1215#
1216# PARAMETERS:
1217#   this   -> Instance of tol project
1218#   node   -> Node active in treeview, which is decompiled
1219#
1220#/////////////////////////////////////////////////////////////////////////////
1221  set tv [GetTreeview $this]
1222  set exclude [$tv item text $node Exclude]
1223  if ![string equal $exclude 1] {
1224    if [IsCompilable $this $node] {
1225      set filename [$tv item text $node FileName]   
1226      catch {::TolInspector::DecompileFile \
1227             [::TolProject::ComputeFullPath $this $filename]}
1228      ::TolInspector::UpdateFileRoot
1229    }
1230    foreach child [$tv item children $node] {
1231      DecompileNode $this $child
1232    }
1233  }
1234}
1235
1236#/////////////////////////////////////////////////////////////////////////////
1237proc ::TolProject::ClearData {this} {
1238#
1239# PURPOSE: Clears some variables of data array relatives to attributes of
1240#          active node.
1241#
1242# PARAMETERS:
1243#   this -> Instance of tol project
1244#
1245#/////////////////////////////////////////////////////////////////////////////
1246  upvar \#0 ${this}::data data
1247  set data(name) ""
1248  set data(desc) ""
1249  set data(type) ""
1250  set data(exclude) 0
1251  set data(excludeTOL) 0
1252}
1253
1254#/////////////////////////////////////////////////////////////////////////////
1255proc ::TolProject::GetDataFromNode {this index} {
1256#
1257# PURPOSE: Sets some variables of data array, getting its values from a given
1258#          node.
1259#
1260# PARAMETERS:
1261#   this  -> Instance of tol project
1262#   index -> node index of a treeview to get values
1263#
1264#/////////////////////////////////////////////////////////////////////////////
1265  upvar \#0 ${this}::data data
1266  set tv [GetTreeview $this]
1267  set data(name)       [$tv item text $index FileName]
1268  set data(desc)       [$tv item text $index Description]
1269  set data(type)       [$tv item text $index Type]
1270  set data(exclude)    [$tv item text $index Exclude]
1271  set data(excludeTOL) [$tv item text $index ExcludeTOL]
1272}
1273
1274#/////////////////////////////////////////////////////////////////////////////
1275proc ::TolProject::GetImageFromType {type} {
1276#
1277# PURPOSE: Returns the image's path of a node given its type
1278#
1279# PARAMETERS:
1280#   type -> type of node
1281#
1282# RETURN: Image's path that correspond to type or "" if error
1283#
1284#/////////////////////////////////////////////////////////////////////////////
1285  set path ""
1286  switch -exact $type {
1287    ROOT { set path [Bitmap::get Files] }
1288    Fol  { set path [Bitmap::get DIRFile] }
1289    TOL -
1290    BDT -
1291    BST  { set path [Bitmap::get ${type}File] }
1292  }
1293  return $path
1294}
1295
1296#/////////////////////////////////////////////////////////////////////////////
1297proc ::TolProject::IsTerminal {this node} {
1298#
1299# PURPOSE: Determines if a node is terminal or not
1300#
1301# PARAMETERS:
1302#   this -> Instance of tol project
1303#   node -> node index of a treeview
1304#
1305# RETURN: True if node is terminal and false if not
1306#
1307#/////////////////////////////////////////////////////////////////////////////
1308  set terminal 0
1309  set tv [GetTreeview $this]
1310  set type [$tv item text $node Type]
1311  switch $type {
1312    Fol -
1313    ROOT { set terminal 0 }
1314    TOL -
1315    BDT -
1316    BST { set terminal 1 }
1317  }
1318  return $terminal
1319}
1320
1321#/////////////////////////////////////////////////////////////////////////////
1322proc ::TolProject::IsCompilable {this node} {
1323#
1324# PURPOSE: Determines if a node is compilable or not
1325#
1326# PARAMETERS:
1327#   this -> Instance of tol project
1328#   node -> node index of a treeview
1329#
1330# RETURN: True if node is compilable and false if not
1331#
1332#/////////////////////////////////////////////////////////////////////////////
1333  set compilable 0
1334  set tv [GetTreeview $this]
1335  set type [$tv item text $node Type]
1336  switch $type {
1337    Fol -
1338    ROOT { set compilable 0 }
1339    TOL -
1340    BDT -
1341    BST {
1342        set compilable 1
1343    }
1344  }
1345  return $compilable
1346}
1347
1348#/////////////////////////////////////////////////////////////////////////////
1349proc ::TolProject::DialogType {this path} {
1350#
1351# PURPOSE: Shows a dialog to ask for the type of a node
1352#
1353# PARAMETERS:
1354#   this -> Instance of tol project
1355#   path -> dialog's parent path
1356#
1357#/////////////////////////////////////////////////////////////////////////////
1358  #Type node dialog
1359  set tv [GetTreeview $this]
1360  set dialog [Dialog $tv.dt -title [mc "Select node type"]\
1361          -modal local -parent $tv]
1362  wm resizable $dialog 0 0
1363  wm protocol $dialog WM_DELETE_WINDOW \
1364          [list ::TolProject::OptionsDestroy $this $dialog]
1365  set w [$dialog getframe]
1366 
1367  set ${this}::data(type) TOL
1368  set f [labelframe $w.f -text [mc "Node type"]]
1369  radiobutton $f.rbTOL -text [mc "TOL file"] -value TOL -highlightthickness 0\
1370        -pady 0 -variable ${this}::data(type)
1371  radiobutton $f.rbBDT -text [mc "BDT file"] -value BDT -highlightthickness 0\
1372        -pady 0 -variable ${this}::data(type)
1373  radiobutton $f.rbBST -text [mc "BST file"] -value BST -highlightthickness 0\
1374        -pady 0 -variable ${this}::data(type)
1375  radiobutton $f.rbFol -text [mc "Folder"]   -value Fol -highlightthickness 0\
1376        -pady 0 -variable ${this}::data(type) 
1377
1378  grid $f.rbTOL $f.rbBDT -sticky nw -padx 0
1379  grid $f.rbBST $f.rbFol -sticky nw -padx 0
1380 
1381 
1382 
1383   set w_bbox \
1384          [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1385          -homogeneous false]
1386    $w_bbox add -text [mc "Accept"] -relief link \
1387          -helptext [mc "Continue"] \
1388          -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1389          -command [list ::TolProject::DialogTypeOK $this $dialog]
1390    $w_bbox add -text [mc "Cancel"] -relief link \
1391          -helptext [mc "Cancel"]\
1392          -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1393          -command [list ::TolProject::DialogTypeDestroy $this $dialog]
1394   
1395  pack $w_bbox -expand true -fill x    -side bottom
1396  pack $f      -expand true -fill both
1397
1398  bind $dialog <F1> "ShowHelp Tb4Edp"
1399  $dialog draw
1400}
1401
1402#/////////////////////////////////////////////////////////////////////////////
1403proc ::TolProject::DialogTypeOK {this dialog} {
1404#
1405# PURPOSE:
1406#
1407# PARAMETERS:
1408#   this   -> Instance of tol project
1409#   dialog -> Get type dialog
1410#
1411#/////////////////////////////////////////////////////////////////////////////
1412  upvar \#0 ${this}::data data
1413 
1414  destroy $dialog
1415}
1416
1417#/////////////////////////////////////////////////////////////////////////////
1418proc ::TolProject::DialogTypeDestroy {this dialog} {
1419#
1420# PURPOSE: Destroy get type dialog
1421#
1422# PARAMETERS:
1423#   this   -> Instance of tol project
1424#   dialog -> Get type dialog
1425#
1426#/////////////////////////////////////////////////////////////////////////////
1427  upvar \#0 ${this}::data data
1428  set data(type) -1
1429  destroy $dialog
1430}
1431
1432#/////////////////////////////////////////////////////////////////////////////
1433proc ::TolProject::DialogAttributes {this path title} {
1434#
1435# PURPOSE: Shows a dialog to ask for the attributes of a node
1436#
1437# PARAMETERS:
1438#   this  -> Instance of tol project
1439#   path  -> dialog's parent path
1440#   title ->
1441#
1442#/////////////////////////////////////////////////////////////////////////////
1443  upvar \#0 ${this}::data data
1444  #Attributes node dialog
1445  set tv [GetTreeview $this]
1446  set dialog [Dialog $tv.da -title $title -modal local -parent $tv\
1447     -default 0 -cancel 1]
1448  wm resizable $dialog 0 0
1449  wm protocol $dialog WM_DELETE_WINDOW \
1450          [list ::TolProject::OptionsDestroy $this $dialog]
1451  set w [$dialog getframe]
1452 
1453  set f1 [labelframe $w.f1 -text [mc "File name"]]
1454 
1455  switch -exact $data(type) {
1456    TOL {
1457      set typelist {{"Tol Files" {".tol"}} {"All Files" {"*"}}}
1458      set defExt   .tol
1459    }
1460    BDT {
1461      set typelist {{"Bayes Data Table" {".bdt"}} {"All Files" {"*"}}}
1462      set defExt   .bdt
1463    }
1464    BST {
1465      set typelist {{"Bayes Struct Table" {".bst"}} {"All Files" {"*"}}}
1466      set defExt   .bst
1467    }
1468    default {
1469      set typelist {{"All Files" {"*"}}}
1470      set defExt ""
1471    }
1472  }
1473
1474  # This passes -initialdir to ::Objects::ChooseFileCreate
1475  # which might need further study
1476  entry  $f1.eFile -width 50 -textvariable ${this}::data(name)
1477  ::Objects::ChooseFileCreate ${this}::data(name) $f1.bFile \
1478    -filetypes $typelist -defaultextension $defExt \
1479    -initialdir $data(lastOpenedNodeDir)
1480 
1481  set f2 [labelframe $w.f2 -text [mc "Description"]]
1482  entry $f2.description -width 60 -textvariable ${this}::data(desc)
1483
1484  checkbutton $w.chExclude -text [mc "Exclude in TOLBase"] \
1485            -variable ${this}::data(exclude)
1486
1487  checkbutton $w.chExcludeTOL -text [mc "Exclude in tol.exe"] \
1488        -variable ${this}::data(excludeTOL)
1489
1490  if {[string equal $data(type) "Fol"] ||
1491      [string equal $data(type) "ROOT"] } {
1492    grid $f1.eFile -sticky nw -padx 2 -pady 2
1493  } else  {
1494    grid $f1.eFile $f1.bFile -sticky nw -padx 2 -pady 2
1495  }
1496  grid $f2.description     -sticky nw -padx 2 -pady 2
1497
1498  set w_bbox \
1499    [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1500    -homogeneous false]
1501  $w_bbox add -text [mc "Accept"] -relief link \
1502    -helptext [mc "Continue"] \
1503    -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1504    -command [list ::TolProject::DialogAttributesOK $this $dialog]
1505  $w_bbox add -text [mc "Cancel"] -relief link \
1506    -helptext [mc "Cancel selection"]\
1507    -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1508    -command [list ::TolProject::DialogAttributesDestroy $this $dialog]
1509 
1510  grid $f1 - -sticky news
1511  grid $f2 - -sticky news
1512  grid $w.chExclude $w.chExcludeTOL -sticky nw -pady 2
1513  grid $w_bbox                       -sticky ns -pady 2 -columnspan 2
1514
1515  focus $f1.eFile
1516 
1517  bind $dialog <F1> "ShowHelp Tb4Edp"
1518  $dialog draw
1519
1520}
1521
1522#/////////////////////////////////////////////////////////////////////////////
1523proc ::TolProject::DialogAttributesOK {this dialog} {
1524#
1525# PURPOSE:
1526#
1527# PARAMETERS:
1528#   this   -> Instance of tol project
1529#   dialog -> Get type dialog
1530#
1531#/////////////////////////////////////////////////////////////////////////////
1532  upvar \#0 ${this}::data data
1533   
1534  destroy $dialog
1535}
1536
1537#/////////////////////////////////////////////////////////////////////////////
1538proc ::TolProject::DialogAttributesDestroy {this dialog} {
1539#
1540# PURPOSE: Destroy get type dialog
1541#
1542# PARAMETERS:
1543#   this   -> Instance of tol project
1544#   dialog -> Get type dialog
1545#
1546#/////////////////////////////////////////////////////////////////////////////
1547  upvar \#0 ${this}::data data
1548  set data(name) ""
1549  destroy $dialog
1550}
1551
1552#/////////////////////////////////////////////////////////////////////////////
1553# OPTIONS
1554#/////////////////////////////////////////////////////////////////////////////
1555
1556#/////////////////////////////////////////////////////////////////////////////
1557proc ::TolProject::CmdOptions {this} {
1558#
1559# PURPOSE: Creates a dialog options for Tol Project Editors
1560#
1561# PARAMETERS:
1562#   this -> Instance of tol project
1563#
1564#/////////////////////////////////////////////////////////////////////////////
1565  set path [GetTreeview $this]
1566  set dialog [Dialog $path.d -title [mc "TOL Project Editor Options"]\
1567            -modal local -parent $path]
1568  wm resizable $dialog 0 0
1569  wm protocol $dialog WM_DELETE_WINDOW \
1570        [list ::TolProject::OptionsDestroy $this $dialog]
1571  set w [$dialog getframe]
1572  set w_tabset [NoteBook $w.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]
1573  #insertar tabset
1574  set num_i 0
1575  foreach lab_i [list Others] {
1576    $w_tabset insert $num_i $lab_i -text "  [mc $lab_i]  " -background \#d9d9d9
1577    set tab_i [$w_tabset getframe $lab_i]
1578    $tab_i configure -borderwidth 2 -background \#d9d9d9
1579    incr num_i   
1580    set f$num_i [frame $tab_i.f]
1581    pack $tab_i.f -fill both -expand yes 
1582  }
1583  $w_tabset raise [$w_tabset pages 0]
1584     
1585  OptionsGet $this
1586  OptionsCreateOthers  $this $f1 
1587  OptionsCheck $this
1588   
1589  set w_bbox \
1590    [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
1591    -homogeneous false]
1592  $w_bbox add -text [mc "Accept"] -relief link \
1593    -helptext [mc "Accept"] \
1594    -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
1595    -command [list ::TolProject::OptionsOK $this $dialog]
1596  $w_bbox add -text [mc "Cancel"] -relief link \
1597    -helptext [mc "Cancel"]\
1598    -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
1599    -command [list ::SetGraphDialog::Cancel $dialog]
1600   
1601  pack $w_bbox   -fill x -expand false -side bottom
1602  $w_tabset compute_size
1603  pack $w_tabset -fill both -expand true
1604
1605  bind $dialog <F1> "ShowHelp Tb4EdpOpc"
1606  $dialog draw
1607}
1608
1609#/////////////////////////////////////////////////////////////////////////////
1610proc ::TolProject::OptionsCreateOthers {this w} {
1611#
1612# PURPOSE: Creates a frame with general options as number of files edited
1613#          recently
1614#
1615# PARAMETERS:
1616#   this -> Instance of tol project
1617#   w    -> widget's path to allocate the frame
1618#
1619#/////////////////////////////////////////////////////////////////////////////
1620  variable tmpOpt
1621   
1622  TitleFrame $w.tf1 -text [mc "General Options"]
1623  set f1 [$w.tf1 getframe]
1624   
1625  checkbutton $f1.chEdited -text [mc "Files edited recently"]\
1626          -variable ::TolProject::tmpOpt(var,chEdited)\
1627          -command [list ::TolProject::OptionsCheckEdited $this]
1628   
1629  set tmpOpt(widget,edited) [SpinBox $f1.sbEdited -justify right -width 4 \
1630          -editable 0 -range {0 10} \
1631          -textvariable ::TolProject::tmpOpt(var,numEdited)]
1632  label $f1.lFiles -text [mc files]
1633 
1634  frame $f1.f -width 25
1635   
1636  grid $f1.f $f1.chEdited     $f1.sbEdited     $f1.lFiles -sticky nw -padx 2
1637  grid rowconfigure    $f1 0 -weight 1
1638  grid columnconfigure $f1 3 -weight 1
1639   
1640  grid $w.tf1 -sticky news -padx 2
1641   
1642  grid rowconfigure    $w 1 -weight 1
1643  grid rowconfigure    $w 2 -weight 2
1644  grid columnconfigure $w 0 -weight 1
1645}
1646
1647#/////////////////////////////////////////////////////////////////////////////
1648proc ::TolProject::OptionsGet {this} {
1649#
1650# PURPOSE: Gets all options variables values from ini file  and copies them
1651#          to the temporary tmpOpt array.
1652#
1653# PARAMETERS:
1654#   this   -> Instance of tol project
1655#
1656#/////////////////////////////////////////////////////////////////////////////
1657  variable options
1658  variable tmpOpt
1659  set tmpOpt(var,chEdited)   $options(chEdited)
1660  set tmpOpt(var,numEdited)  $options(numEdited)
1661}
1662
1663#/////////////////////////////////////////////////////////////////////////////
1664proc ::TolProject::OptionsSet {this} {
1665#
1666# PURPOSE: Copies all .
1667#
1668# PARAMETERS:
1669#   this   -> Instance of tol project
1670#
1671#/////////////////////////////////////////////////////////////////////////////
1672  variable options
1673  variable tmpOpt
1674   
1675  regsub -all var, [array names ::TolProject::tmpOpt var,*] "" optNames
1676  foreach it $optNames {
1677    set options($it) $tmpOpt(var,$it)
1678  } 
1679}
1680
1681#/////////////////////////////////////////////////////////////////////////////
1682proc ::TolProject::OptionsCheck {this} {
1683#
1684# PURPOSE: Checks for all widgets from dialog options that need to be checked
1685#          for enabling/disabling other associated controls.
1686#
1687# PARAMETERS:
1688#   this   -> Instance of tol project
1689#
1690#/////////////////////////////////////////////////////////////////////////////
1691  OptionsCheckEdited           $this
1692}
1693
1694#/////////////////////////////////////////////////////////////////////////////
1695proc ::TolProject::OptionsCheckEdited {this} {
1696#
1697# PURPOSE: Checks if option chEdited is checked and enables/disabled other
1698#          associated controls.
1699#
1700# PARAMETERS:
1701#   this   -> Instance of tol project
1702#
1703#/////////////////////////////////////////////////////////////////////////////
1704  variable tmpOpt
1705  if {!$tmpOpt(var,chEdited)} {     
1706    $tmpOpt(widget,edited) configure -state disabled
1707  } else  {
1708    $tmpOpt(widget,edited) configure -state normal
1709  }
1710}
1711
1712#/////////////////////////////////////////////////////////////////////////////
1713proc ::TolProject::OptionsDestroy {this dialog} {
1714#
1715# PURPOSE: Destroy options dialog
1716#
1717# PARAMETERS:
1718#   this   -> Instance of tol project
1719#   dialog -> Options dialog
1720#
1721#/////////////////////////////////////////////////////////////////////////////
1722  variable tmpOpt
1723   
1724  array unset tmpOpt
1725  destroy $dialog
1726}
1727
1728#///////////////////////////////////////////////////////////////////////////// 
1729proc ::TolProject::OptionsApply {this} {
1730#
1731# PURPOSE: Applies options from the options dialog
1732#
1733# PARAMETERS:
1734#   this   -> Instance of tol project
1735#
1736#/////////////////////////////////////////////////////////////////////////////
1737  OptionsSet $this
1738}
1739
1740#/////////////////////////////////////////////////////////////////////////////
1741proc ::TolProject::OptionsOK {this dialog} {
1742#
1743# PURPOSE: Applies options and closes options dialog
1744#
1745# PARAMETERS:
1746#   this   -> Instance of tol project
1747#   dialog -> Options dialog
1748#
1749#/////////////////////////////////////////////////////////////////////////////
1750  OptionsApply   $this
1751  OptionsDestroy $this $dialog
1752}
1753
1754#/////////////////////////////////////////////////////////////////////////////
1755# INIFILE
1756#/////////////////////////////////////////////////////////////////////////////
1757
1758#/////////////////////////////////////////////////////////////////////////////
1759proc ::TolProject::ReadIniSpecial {} {
1760#
1761# PURPOSE: Reads common Edit Table options from .ini file. This options are
1762#          common for all instances of Tol Project Editor. They are read just
1763#          one time.
1764#
1765#/////////////////////////////////////////////////////////////////////////////
1766  variable options
1767  global toltk_options
1768
1769  set rini ::iniFile::Read
1770  set options(chEdited)   [$rini TolProject saveRecent  1]
1771  set options(numEdited)  [$rini TolProject numRecent   8]
1772  set options(edited)     [$rini TolProject recent      {}]
1773
1774  set options(font)       [$rini TolProject font  $toltk_options(fonts,Fixed)]
1775  set options(lastDir)    [$rini TolProject lastDir  ""]
1776}
1777
1778#/////////////////////////////////////////////////////////////////////////////
1779proc ::TolProject::WriteIni {this} {
1780#
1781# PURPOSE: Write common Tol Projects options to .ini file
1782#
1783# PARAMETERS:
1784#   this  -> Instance of tol project
1785#
1786#/////////////////////////////////////////////////////////////////////////////
1787  variable options
1788  upvar \#0 ${this}::data data
1789  set wini ::iniFile::Write
1790
1791  # Common options
1792  $wini TolProject saveRecent   $options(chEdited)
1793  $wini TolProject numRecent    $options(numEdited)
1794  $wini TolProject recent       $options(edited)
1795  $wini TolProject font         $options(font)
1796  $wini TolProject lastDir      $options(lastDir)
1797
1798  ::iniFile::Flush
1799}
1800
1801#/////////////////////////////////////////////////////////////////////////////
1802# Métodos que estaban en ::BayesTreeview (bftrview.tcl)
1803#/////////////////////////////////////////////////////////////////////////////
1804
1805#/////////////////////////////////////////////////////////////////////////////
1806proc ::TolProject::WtreeFromFile {tv path {proc ""}} {
1807#
1808# PURPOSE: Loads a wtree info data from a text especification file of a wtree.
1809#
1810# PARAMETERS:
1811#   tv   -> wtree's path
1812#   path -> name of file
1813# proc -> procedure that converts type node to the path of the image of node
1814#
1815# RETURN: Returns 1 if wtree has been loaded correctly or 0 if not.
1816#
1817#/////////////////////////////////////////////////////////////////////////////
1818  if ![file exists $path] {
1819    return -code error "File $path doesn't exist"
1820  }
1821  #@ Tolcon_Trace "Llamada a WtreeFromFile"
1822  set fd [iniparse:openfile $path]
1823  BNodeFromFile $tv root "" $fd $proc
1824  iniparse:closefile $fd
1825  return 1
1826}
1827
1828#/////////////////////////////////////////////////////////////////////////////
1829proc ::TolProject::WtreeToFile {tv path} {
1830#
1831# PURPOSE: Saves a wtree info data into a text especification file of a wtree.
1832#
1833# PARAMETERS:
1834#   tv   -> wtree's path
1835#   path -> name of file
1836#
1837# RETURN: Returns 1 if file has been saved correctly or 0 if not.
1838#
1839#/////////////////////////////////////////////////////////////////////////////
1840  #borrar archivo pq iniparse:openfile abre para solo lectura si existe
1841  file delete $path
1842  set fd [iniparse:openfile $path]
1843  BNodeToFile $tv root $fd
1844  iniparse:closefile $fd
1845  return 1
1846}
1847
1848#/////////////////////////////////////////////////////////////////////////////
1849proc ::TolProject::BNodeToFile {tv index fd} {
1850#
1851# PURPOSE: Saves a wtree's node info data into a text file.
1852#
1853# PARAMETERS:
1854#   tv    -> wtree's path
1855#   index -> wtree node index
1856#   fd    -> channel identifier of text file
1857#
1858#/////////////////////////////////////////////////////////////////////////////
1859  set key $index
1860
1861  # Guardar data del nodo actual
1862  set columnNames [list FileName Description Type Exclude ExcludeTOL]
1863  foreach item $columnNames {
1864    writeini $fd $key $item [$tv item text $index $item]
1865  }
1866 
1867  writeini $fd $key Label [$tv item text $index FileName]
1868  # Guardar sus hijos
1869  writeini $fd $key Children [$tv item children $index]
1870
1871  # Llamar recursivamente para los hijos
1872  foreach child [$tv item children $index] {
1873    Tolcon_Trace "child $child"
1874    BNodeToFile $tv $child $fd
1875  }
1876}
1877
1878#/////////////////////////////////////////////////////////////////////////////
1879proc ::TolProject::BNodeFromFile {tv index parent fd {imgFromType ""}} {
1880#
1881# PURPOSE: Loads a wtree's node info data from a text file.
1882#
1883# PARAMETERS:
1884#   tv     -> wtree's path
1885#   index  -> wtree node index
1886#   parent -> wtree node's parent index
1887#   fd     -> channel identifier of text file
1888#
1889#/////////////////////////////////////////////////////////////////////////////
1890  set key $index
1891  set image "" 
1892  set filename ""
1893  set description ""
1894  set type ""
1895  set exclude 0
1896  set excludeTOL 0 ;#@ puede que no lo tenga el prj
1897  foreach item [readini $fd $key] {
1898    set value [readini $fd $key $item]
1899    switch -exact $item {
1900      FileName { set filename $value }
1901      Description { set description $value }
1902      Type { set type $value }
1903      Exclude { set exclude $value }
1904      ExcludeTOL { set excludeTOL $value }
1905      Label { set void 0 }     
1906    }
1907    if {[string equal $item "Type"] && ![string equal $imgFromType ""]} {
1908      if ![string equal [set img [$imgFromType $value]] ""] {
1909        #@ $tv entry configure $idx -icons [list $img $img]
1910        set image $img
1911      }
1912    }
1913  }
1914  if ![string equal $parent ""] {
1915    #@ se inserta un nodo
1916    if { $type eq "Fol" } {
1917      set hasbutton 1
1918    } else {
1919      set hasbutton 0
1920    } 
1921    set idx [$tv item create -parent $parent -button $hasbutton -open 0]
1922    $tv item image $idx FileName $img
1923    $tv item text $idx FileName $filename Description $description \
1924      Type $type Exclude $exclude ExcludeTOL $excludeTOL 
1925  } else {
1926    #@ se actualiza root
1927    $tv item image root FileName $img
1928    $tv item text root FileName $filename Description $description \
1929      Type $type Exclude $exclude ExcludeTOL $excludeTOL
1930    set idx root
1931  } 
1932  # Llamar recursivamente para los hijos
1933  foreach child [readini $fd $key Children] {
1934    BNodeFromFile $tv $child $idx $fd $imgFromType
1935  }
1936}
1937
1938::TolProject::ReadIniSpecial
Note: See TracBrowser for help on using the repository browser.