source: tol/tolbaseBLT/lib/toltk/tolconfig_gui.tcl @ 56ade3b

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

fixes #1932, se ha creado la rama trunk/tolbaseBLT copia de trunk/tolbase

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7330 be4846ae-f051-483a-831f-b64e7d08527f

  • Property mode set to 100644
File size: 2.7 KB
Line 
1package require BWidget
2package require wtree
3package require msgcat
4
5namespace eval ::TolConfigGUI {
6
7  namespace import ::msgcat::*
8
9  variable win
10  variable tree
11}
12
13proc ::TolConfigGUI::GetFullName { member parent } {
14  return [ expr { $parent eq "" ? "$member" : "${parent}::$member" } ]
15}
16
17proc ::TolConfigGUI::CreateSectionNode { section secParent dictConfig } {
18  variable tree
19  variable treeInfo
20
21  set fullSection [ GetFullName $section $secParent ]
22  set nid [ $tree insert [ list [ list "" [ mc $section ] ] [ list "" ] ] \
23               -at end -relative $treeInfo(node,$secParent) -button auto ]
24  set treeInfo(node,$fullSection) $nid
25
26  array set config $dictConfig
27  foreach _n [ array names config ] {
28    if { [ regexp _.autodoc.member.(.+) $_n ==> n ] } {
29      FillTree $n $fullSection $config($n)
30    }
31  }
32  return $fullSection
33}
34
35proc ::TolConfigGUI::CreateMemberNode { member secParent value } {
36 variable tree
37  variable treeInfo
38
39  set full [ GetFullName $member $secParent ]
40  set nid [ $tree insert [ list [ list "" [ mc $member ] ] [ list $value ] ] \
41               -at end -relative $treeInfo(node,$secParent) -button auto ]
42  set treeInfo(node,$full) $nid
43  set treeInfo(value,$full) $value
44
45  return $full
46}
47
48proc ::TolConfigGUI::FillTree { member secParent value } {
49  variable win
50  variable treeInfo
51
52 
53  set full [ GetFullName $member $secParent ]
54  set type [ ::TolConfig::GetType $full ]
55  if { $type eq "section" } {
56    CreateSectionNode $member $secParent $value
57  } else {
58    CreateMemberNode $member $secParent $value
59  }
60}
61
62proc ::TolConfigGUI::FillTreeConfig { } {
63  variable win
64  variable tree
65  variable treeInfo
66
67  array unset treeInfo
68  set treeInfo(node,) root
69  $tree item delete all
70  FillTree TolConfigManager::Config "" [ ::TolConfig::GetConfig ]
71
72}
73
74proc ::TolConfigGUI::AcceptConfig { } {
75  puts AcceptConfig
76}
77
78proc ::TolConfigGUI::Show { } {
79  variable win
80  variable tree
81
82  set win .tolconfig
83  if { ![ winfo exists $win ] } {
84    Dialog $win -title [ mc "Tol configuration"] \
85        -modal local
86    $win add -text Ok
87    $win add -text Cancel
88   
89    set f [ $win getframe ]
90    grid rowconfigure $f 0 -weight 1
91    grid columnconfigure $f 0 -weight 1
92    set pw [ PanedWindow $f.pw -side bottom -pad 0 -width 4 ]
93    set paneLeft  [ $pwMain add ]
94    set paneRight [ $pwMain add ]
95
96    set tree $f.tree
97    wtree  $tree
98    $tree configure -table no -filter yes -columns {
99      { {image text} -tags NAME -label "Name" }
100      { {text} -tags STATUS -label "Value" }
101    }
102    grid $tree -row 0 -column 0 -sticky "snew"
103    grid rowconfigure $win 1 -weight 1
104    grid columnconfigure $win 0 -weight 1
105  }
106  FillTreeConfig
107  set ans [ $win draw ]
108  if { $ans == 0 } {
109    AcceptConfig
110  }
111}
Note: See TracBrowser for help on using the repository browser.