source: tol/tolbase/lib/toltk/tolprj.tcl @ e0578ae

1941-docker-image-to-testdevel
Last change on this file since e0578ae was 6d7779d, checked in by Jorge Pérez <josp.jorge@…>, 18 years ago

initial import

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