source: tol/tolbase/lib/toltk/tolinspe.tcl @ 82871e8

1941-docker-image-to-testdevel
Last change on this file since 82871e8 was 7a0e436f, checked in by Jorge Pérez <josp.jorge@…>, 15 years ago

#refs #1437, el campo Reference se crea para los objetos Set, eso es u porting de la solución dada en 3.1

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

  • Property mode set to 100644
File size: 128.1 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : tolinspe.tcl
3# PURPOSE : This file contains a namespace called TolInspector with its
4#           functions. Its for creating a the TOL object inspector and
5#           managing its events.
6#/////////////////////////////////////////////////////////////////////////////
7
8package require bguifunction
9package require snit
10package require btable
11
12if { 0 && ![info exists toltk_script_path] } {
13  set toltk_script_path [file dirname [info script]]
14  source [file join $toltk_script_path init_toltk.tcl]
15}
16
17if {"unix" eq $::tcl_platform(platform)} {
18  foreach "but units" [list 4 -5 5 5] {
19    set comm [string map "%d $units" {
20      %W yview scroll %d units
21    }]
22    bind TreeView <$but> $comm
23  }
24} else {
25  bind TreeView <MouseWheel> {
26    %W yview scroll [expr int(-1*%D/36)] units
27  }
28}
29#
30##/////////////////////////////////////////////////////////////////////////////
31#proc dump { args } {
32##
33## PURPOSE: Auxiliary procedure to show a string
34##
35##/////////////////////////////////////////////////////////////////////////////
36#puts $args
37#}
38
39#/////////////////////////////////////////////////////////////////////////////
40proc startupResources { } {
41#
42# PURPOSE: Establishes the preferences of the inspector
43#
44#/////////////////////////////////////////////////////////////////////////////   
45  global tcl_platform
46  global toltk_options
47  DynamicHelp::configure -background #FFFFC0
48  if {[string equal $tcl_platform(platform) "windows"]} {
49    set toltk_options(colors,SystemButtonFace) SystemButtonFace
50    set toltk_options(fonts,MenuNor)           {Tahoma 8}
51    set toltk_options(fonts,Fixed)             {{Courier New} 9}
52    set toltk_options(fonts,FixSmall)          {{Courier New} 8}
53    set toltk_options(fonts,Title1)            {Arial 9 bold}
54    set toltk_options(fonts,Label)             {Arial 9}
55    set toltk_options(fonts,TxtSmall)          {Arial 8}
56    set toltk_options(relief,ridge)            ridge
57  } else {
58    set toltk_options(colors,SystemButtonFace) #d4d4d4
59    set toltk_options(fonts,MenuNor)           {-*-helvetica-medium-r}
60    set toltk_options(fonts,Fixed)             {Courier 9}
61    set toltk_options(fonts,FixSmall)          {-*-courier-small-r}
62    set toltk_options(fonts,Title1)            {-*-helvetica-bold-r}
63    set toltk_options(fonts,Label)             {-*-helvetica-medium-r}
64    set toltk_options(fonts,TxtSmall)          {-*-helvetica-small-r}
65    set toltk_options(relief,ridge)            raised
66  }
67  option add *background         $toltk_options(colors,SystemButtonFace) user
68  option add *Label.font         $toltk_options(fonts,Label) user
69  option add *Radiobutton.font   $toltk_options(fonts,Label) user
70  option add *Checkbutton.font   $toltk_options(fonts,Label) user
71  option add *Button.font        $toltk_options(fonts,Label) user
72  option add *Menu.font          $toltk_options(fonts,MenuNor) user
73  option add *TitleFrame.l.font  $toltk_options(fonts,Title1) user
74  option add *Tabset.selectForeground black user
75
76  option readfile [file join $::toltk_script_path toltk.rc] user
77}
78
79#/////////////////////////////////////////////////////////////////////////////
80namespace eval ::TolInspector {
81#
82# PURPOSE: The purpose of this namespace is creating a the TOL object
83#          inspector and managing its events.
84# VARIABLES:
85#   data:
86#   regFunLst:    List array with functions defined by user
87#   tolset:       Name of the current TOL set variable
88#   tolindex:
89#   at_set:
90#   node_prefix:
91#   ht_tree:      Tree widget containing the TOL objects (:blt::treeview)
92#   blt_tree:     Tree widget containing the TOL objects (:blt::tree)
93#   w_tabset:     Tabset widget containing trees of variables and functions
94#   ht_vars:      Tree widget containing the tree of Variables
95#                 (:blt::treeview)
96#   blt_vartree:  Tree widget containing the tree of Variables (:blt::tree)
97#   data_menu:    Array with data of menus
98#   group_id:
99#   ht_funcs:     Tree widget containing the tree of Functions
100#                 (:blt::treeview)
101#   blt_functree: Tree widget containing the tree of Functions (:blt::tree)
102#   item_data:    Array to hold the full content & description of items
103#   item_id:      Current index of item to insert in ht_* starting from 1
104#   OnSelectItem: Command to invoke on SelectItem in ht_*
105#   OnBusyCmd:    Command to invoke when busy
106#   SubTypeImgs:  Images associated to types of set
107#
108#/////////////////////////////////////////////////////////////////////////////
109  variable data
110 
111  # List array with functions defined by user
112  variable regFunLst
113 
114  # name of the current TOL set variable.
115  variable tolset ""
116  variable tolindex ""
117  # estas variables desapareceran cuando ::tol::forallchild admita scripts
118  # completos y no solo nombres de proc
119  variable at_set
120  variable node_prefix
121
122  variable iterSet ""
123  variable knownReference ""
124
125  variable gra_parent ""
126  # tree widget containing the TOL objects.
127  variable ht_tree   ;# is a ::blt::treeview
128  variable blt_tree  ;# is a ::blt::tree
129
130  # tabset widget containing trees of variables and functions
131  variable w_tabset
132
133  # list widget containing the variables. It's the window of
134  # the tab Variable
135  variable ht_vars      ;# is a ::blt::treeview
136  variable blt_vartree  ;# is a ::blt::tree
137 
138  variable data_menu
139  variable group_id -1
140
141  # list widget containing the functions. It's the window of
142  # the tab Functions
143  variable ht_funcs     ;# is a ::blt::treeview
144  variable blt_functree ;# is a ::blt::tree
145
146  # array to hold the full content & description of items
147  variable item_data
148
149  # current index of item to insert in ht_* starting from 1
150  variable item_id
151 
152  # tell if we are processing a SelectSet event
153
154  #variable selecting_set
155  #variable closing
156
157  # command to invoke on SelectItem in ht_*
158  variable OnSelectItem
159
160  # command to invoke when busy
161  variable OnBusyCmd ""
162
163  # images associated to types of set.
164  variable SubTypeImgs {
165    GenericSet MODFile PRJFile DIRFile TOLFile
166    BDCFile BDTFile BSTFile BMTFile BSIFile TSIFile BMIFile
167    StructuredSet TableSet}
168
169}
170
171#/////////////////////////////////////////////////////////////////////////////
172proc ::TolInspector::SubTypeImage { idx } {
173#/////////////////////////////////////////////////////////////////////////////
174  variable SubTypeImgs
175
176  #Tolcon_Trace "SubTypeImage $idx = [lindex $SubTypeImgs $idx]"
177  ::Bitmap::get [lindex $SubTypeImgs $idx]
178}
179
180#/////////////////////////////////////////////////////////////////////////////
181proc ::TolInspector::CreateColumns { ht } {
182#
183# PURPOSE: Creates the columns (index, name, content, path, description )
184#          of the tree of variables or functions
185#
186# PARAMETERS:
187#   ht: path of ::blt::treeview of variables or ::blt::treeview of functions
188#
189#/////////////////////////////////////////////////////////////////////////////
190  # main column ==> Name
191  $ht column configure treeView -text [mc "Name"] -justify left \
192      -bg white -activetitlebackground gray90 -pad 3
193  # index column
194  $ht column insert 0 Index \
195      -bg white -justify left -activetitlebackground gray90
196  # columns Content Path & Description
197  #(pgea) se oculta la columna correspondiente a la referencia
198  $ht column insert end Content Description Path\
199      -bg white -justify left -activetitlebackground gray90 -pad 3
200  $ht column insert end Reference -hide yes
201  foreach c {Index Content Description Path} {
202    $ht column configure $c -text [mc "$c"]
203  }
204  # associates the command of order to each one of the titles of the
205  # columns of the trees
206  foreach column [$ht column names] {
207    $ht column configure $column \
208      -command [list ::TolInspector::SortColumn $ht $column]
209  }
210}
211
212#/////////////////////////////////////////////////////////////////////////////
213proc ::TolInspector::SortColumn {ht column} {
214#
215# PURPOSE: Associates the command of order to the title of a column of the
216#          tree of variables or the tree of functions
217#
218# PARAMETERS:
219#   ht:     path of ::blt::treeview of variables or ::blt::treeview of
220#           functions
221#   column: name of the column of this tree
222#
223#///////////////////////////////////////////////////////////////////////////// 
224  set old [$ht sort cget -column]
225  set decreasing 0
226  if { "$old" == "$column" } {
227    set decreasing [$ht sort cget -decreasing]
228    set decreasing [expr !$decreasing]
229  }
230  $ht sort configure -decreasing $decreasing -column $column -mode integer
231  $ht configure -flat no
232  $ht sort auto yes
233
234  blt::busy hold $ht
235  update
236  blt::busy release $ht
237}
238
239
240#/////////////////////////////////////////////////////////////////////////////
241proc ::TolInspector::Create { w args } {
242#
243# PURPOSE: Creates the object inspector, that contains two panels with three
244#          treeviews and three trees.
245#           - One for the left side of the inspector (with grammars,
246#             included files, console objects and object's spool)
247#           - And two for the right one (one for variables tab and one for
248#             functions tab)
249#
250# PARAMETERS:
251#   w:    path where tol inspector must be created
252#   args: list of pairs {-option value} with options for the inspector.
253#      -onselcmd  Comand to execute when a node is selected
254#      -wleft     relative weight of left pane
255#      -wrigth    relative weight of rigth pane
256#
257#/////////////////////////////////////////////////////////////////////////////
258  global toltk_options
259  variable ht_tree
260  variable blt_tree
261  variable ht_vars
262  variable blt_vartree
263  variable data_menu
264  variable ht_funcs
265  variable blt_functree
266  variable w_tabset
267  variable OnSelectItem
268  variable OnBusyCmd ""
269
270  # this should be used insted of a lot of scalar variables.
271  # but, what can we do now?
272
273  variable widgets
274  variable data
275
276  array set data {
277    pool,objects ""
278  }
279
280  array set options {
281    -onselcmd ""
282    -wleft    3
283    -wright   7
284  }
285  array set options $args
286 
287  # initializes the command OnSelectItem to ""
288  set OnSelectItem $options(-onselcmd)
289
290  #variable selecting_set 0
291  #variable closing 0
292
293  #upvar \#0 ::TolTk::Images Images
294
295  # creation of PANED WINDOW MAIN
296  set pwMain [PanedWindow $w -side bottom -pad 0 -width 4]
297  # creation of pane left and pane right
298  set paneLeft  [$pwMain add -weight $options(-wleft)]
299  set paneRight [$pwMain add -weight $options(-wright)]
300  set widgets(panes,left)  $paneLeft
301  set widgets(panes,right) $paneRight
302 
303  # when a panel is destroyed, the item 'geometry,side' of the array variable
304  # data gives the value of the width of panel 'side' (left or right)
305  bind $paneLeft <Destroy> {
306    namespace eval  ::TolInspector {
307      variable data
308      variable widgets
309      set data(geometry,left)  [winfo width $widgets(panes,left)]
310    }
311  } 
312  bind $paneRight <Destroy> {
313    namespace eval  ::TolInspector {
314      variable data
315      variable widgets
316      set data(geometry,right)  [winfo width $widgets(panes,right)]
317    }
318  }
319  # bind for destruction of paned window main
320  bind $pwMain <Destroy> ::TolInspector::Destroy
321
322  # creation of pane left with tree with the TOL OBJECTS
323  CreatePaneLeft  $paneLeft
324  # creation of the right panel with TABSET of VARIABLES and FUNCTIONS
325  CreatePaneRight $paneRight
326  # creation of the menus
327  CreateMenus
328  # packing the panedwindowmain
329  pack $pwMain -fill both -expand yes
330
331  # esto es para evitar que aparezca el icono open cuando
332  # relleno estando el mouse sobre ht_*
333  $ht_vars  bind Entry <Enter>  ""
334  $ht_vars  bind Entry <Leave>  ""
335  $ht_funcs bind Entry <Enter>  ""
336  $ht_funcs bind Entry <Leave>  ""
337}
338
339#/////////////////////////////////////////////////////////////////////////////
340proc ::TolInspector::CreatePaneLeft { paneLeft } {
341#
342# PURPOSE: Creation of TREE LEFT with the TOL OBJECTS
343#
344# PARAMETERS:
345#   paneLeft:  path of the pane of the left in TolInspector
346#
347#/////////////////////////////////////////////////////////////////////////////
348  global toltk_options
349  variable blt_tree
350  variable ht_tree
351 
352  # creation of the ScrolledWindow of the left side
353  set sw1 [ScrolledWindow $paneLeft.sw -ipad 0 -borderwidth 0 -scrollbar both ]
354  # creation of the left tree
355  set blt_tree [::blt::tree create tree$sw1.ht]
356  set ht_tree [::blt::treeview $sw1.ht -tree $blt_tree -bg white \
357           -hideroot no -activeicons "" \
358           -selectbackground gray75 -selectforeground black \
359           -selectcommand ::TolInspector::SelectObject \
360           -highlightthickness 0 -font $toltk_options(fonts,Label)]
361  # configuration of the left tree
362  $ht_tree configure \
363           -closecommand  "::TolInspector::CloseObject %#" \
364           -opencommand   "::TolInspector::OpenObject %#"
365  $ht_tree style configure text -bg white     
366  $ht_tree column configure treeView -bg white
367  $ht_tree column insert end FileName -hide true 
368  # creation of the root node "Tol Objects"
369  set img [::Bitmap::get Objects]
370  $ht_tree entry configure root -label [mc "Tol Objects"]\
371           -icons [list $img $img]
372
373  # creation of the node father "Grammars"
374  set img [::Bitmap::get Grammars] 
375  set blt_idx [$blt_tree insert root -label "root-grammars"\
376           -tags "root-grammars"]
377  $ht_tree entry configure $blt_idx -label [mc "Grammars"]\
378           -icons [list $img $img]
379  # Inserts in the node of grammars a node by each grammar that exists in Tol
380  InsertGrammars
381
382  # creation of the node father "Packages"
383  set img [::Bitmap::get "package"] 
384  set blt_idx [$blt_tree insert root -label "root-packages"\
385           -tags "root-packages"]
386  $ht_tree entry configure $blt_idx -label [mc "Packages"]\
387           -icons [list $img $img] -button yes
388
389  # creation of the node father "Included Files"
390  set img [::Bitmap::get "Files"]
391  set blt_idx [$blt_tree insert root -label "root-files" -tags "root-files"]
392  $ht_tree entry configure $blt_idx -label [mc "Included Files"] \
393      -icons [list $img $img] -button yes
394  # creation of the node father "Console Objects" 
395  set img [::Bitmap::get "Console"]
396  set blt_idx [$blt_tree insert root -label "root-console"\
397          -tags "root-console"]
398  $ht_tree entry configure $blt_idx -label [mc "Console Objects"] \
399      -icons [list $img $img] -button yes
400  # creation of the node father "Objects' Spool"
401  set img [::Bitmap::get "pool"]
402  set blt_idx [$blt_tree insert root -label "root-pool" -tags "root-pool"]
403  $ht_tree entry configure $blt_idx -label [mc "Objects' Spool"] \
404      -icons [list $img $img] -button yes
405  # associates the tree to scrolled window
406  $sw1 setwidget $ht_tree
407  # packing
408  pack $sw1 -fill both -expand yes
409  # bind the focus on tree
410  bind $ht_tree  <Button-1> "::focus $ht_tree"
411}
412
413#/////////////////////////////////////////////////////////////////////////////
414proc ::TolInspector::CreatePaneRight { paneRight } {
415#
416# PURPOSE: Creation of the right pane with TABSET with VARIABLES and FUNCTIONS
417#
418# PARAMETERS:
419#   paneLeft:  path of the pane of the right in TolInspector
420#
421#/////////////////////////////////////////////////////////////////////////////
422  global toltk_options
423  variable w_tabset
424  variable blt_vartree
425  variable ht_vars
426  variable blt_functree
427  variable ht_funcs
428 
429  # creates the tabset to display the variables & functions   
430  #set w_tabset [::blt::tabset $paneRight.ts -relief flat\
431            -bd 0 -outerpad 0 -tier 2 -slant none -textside top \
432            -highlightthickness 0 -side left -rotate 90]
433  set w_tabset [::blt::tabset $paneRight.ts -relief flat\
434            -bd 0 -outerpad 0 -tier 2 -slant right -textside right \
435            -highlightthickness 0]
436  # creates the scrolled windows for each one of the tabs
437  set sw21 [ScrolledWindow $w_tabset.sw1]
438  set sw22 [ScrolledWindow $w_tabset.sw2]
439  # inserts in the tabset the tabs of functions and variables
440  $w_tabset insert end \
441      Variables -text [mc Variables] -selectbackground \#d9d9d9 -bg gray75 \
442      -image [::Bitmap::get Variables] -pady 0\
443      Functions -text [mc Functions] -selectbackground \#d9d9d9 -bg gray75 \
444      -image [::Bitmap::get Functions] -pady 0
445
446  # Creation of the right TREE RIGHT with VARIABLES
447  set blt_vartree [::blt::tree create tree$sw21.vars]
448  set ht_vars [::blt::treeview $sw21.vars -tree $blt_vartree -flat no\
449           -bg white -hideroot yes -linewidth 0 -activeicons {}\
450           -selectmode multiple\
451           -selectbackground gray75 -selectforeground black \
452           -highlightthickness 0 -font $toltk_options(fonts,Label)]
453  #tv_ordered_selection tvsel -tv $ht_vars
454  # configuration of the tree of variables
455  $ht_vars configure \
456    -opencommand   "::TolInspector::OpenVariable %#" \
457    -selectcommand "::TolInspector::SelectItem $ht_vars"
458  $ht_vars style configure text -bg white
459  bind $ht_vars  <Button-1> "::focus $ht_vars"
460   
461  # Creation of the right TREE RIGHT with FUNCTIONS
462  set blt_functree [::blt::tree create tree$sw22.funcs]
463  set ht_funcs [::blt::treeview $sw22.funcs -tree $blt_functree -flat no\
464          -bg white -hideroot yes -linewidth 0 -activeicons {} \
465          -selectmode multiple\
466          -selectbackground gray75 -selectforeground black \
467          -highlightthickness 0 -font $toltk_options(fonts,Label)]
468  # configuration of the tree of functions
469  $ht_funcs configure  -selectcommand "::TolInspector::SelectItem $ht_funcs"
470  $ht_funcs style configure text -bg white
471  bind $ht_funcs <Button-1> "::focus $ht_funcs"
472 
473  # associates the trees to scrolled windows
474  $sw21 setwidget $ht_vars
475  $sw22 setwidget $ht_funcs
476  # configure the tabs
477  $w_tabset tab configure Variables -window $sw21 -fill both -padx 0
478  $w_tabset tab configure Functions -window $sw22 -fill both -padx 0
479  # create the columns of the trees of variables and functions
480  CreateColumns $ht_vars
481  CreateColumns $ht_funcs
482  # packing the tabset
483  pack $w_tabset -fill both -expand yes
484  $w_tabset tab configure Variables\
485         -command "::TolInspector::SelectItem $ht_vars"
486  $w_tabset tab configure Functions\
487         -command "::TolInspector::SelectItem $ht_funcs"
488}
489
490#/////////////////////////////////////////////////////////////////////////////
491proc ::TolInspector::CreateMenus {} {
492#
493# PURPOSE: Create the menus of the trees
494#
495#/////////////////////////////////////////////////////////////////////////////
496  variable data_menu
497  variable ht_vars
498  variable ht_funcs
499  variable ht_tree
500
501  set data_menu(main)          [menu $ht_vars.m -tearoff 0]
502  set data_menu(Code,File)     [menu $data_menu(main).mcof -tearoff 0]
503  set data_menu(Complex,File)  [menu $data_menu(main).mcxf -tearoff 0]
504  set data_menu(Date,File)     [menu $data_menu(main).mdaf -tearoff 0]
505  set data_menu(Matrix,File)   [menu $data_menu(main).mmaf -tearoff 0]
506  set data_menu(VMatrix,File)  [menu $data_menu(main).mvmf -tearoff 0]
507  set data_menu(Polyn,File)    [menu $data_menu(main).mpof -tearoff 0]
508  set data_menu(Ratio,File)    [menu $data_menu(main).mraf -tearoff 0]
509  set data_menu(Real,File)     [menu $data_menu(main).mref -tearoff 0]
510  set data_menu(Serie,File)    [menu $data_menu(main).msef -tearoff 0]
511  set data_menu(Set,File)      [menu $data_menu(main).mstf -tearoff 0]
512  set data_menu(File,File)     [menu $data_menu(main).mfif -tearoff 0]
513  set data_menu(Anything,File) [menu $data_menu(main).mspf -tearoff 0]
514  set data_menu(Text,File)     [menu $data_menu(main).mtef -tearoff 0]
515  set data_menu(TimeSet,File)  [menu $data_menu(main).mtif -tearoff 0]
516  set data_menu(NameBlock,File)  [menu $data_menu(main).mnbf -tearoff 0]
517
518  set data_menu(Code,Functions)     [menu $data_menu(main).mcofu -tearoff 0]
519  set data_menu(Complex,Functions)  [menu $data_menu(main).mcxfu -tearoff 0]
520  set data_menu(Date,Functions)     [menu $data_menu(main).mdafu -tearoff 0]
521  set data_menu(Matrix,Functions)   [menu $data_menu(main).mmafu -tearoff 0]
522  set data_menu(VMatrix,Functions)  [menu $data_menu(main).mvmfu -tearoff 0]
523  set data_menu(Polyn,Functions)    [menu $data_menu(main).mpofu -tearoff 0]
524  set data_menu(Ratio,Functions)    [menu $data_menu(main).mrafu -tearoff 0]
525  set data_menu(Real,Functions)     [menu $data_menu(main).mrefu -tearoff 0]
526  set data_menu(Serie,Functions)    [menu $data_menu(main).msefu -tearoff 0]
527  set data_menu(Set,Functions)      [menu $data_menu(main).mstfu -tearoff 0]
528  set data_menu(File,Functions)     [menu $data_menu(main).mfifu -tearoff 0]
529  set data_menu(Anything,Functions) [menu $data_menu(main).mspfu -tearoff 0]
530  set data_menu(Text,Functions)     [menu $data_menu(main).mtefu -tearoff 0]
531  set data_menu(TimeSet,Functions)  [menu $data_menu(main).mtifu -tearoff 0]
532  set data_menu(NameBlock,Functions)  [menu $data_menu(main).mnbfu -tearoff 0]
533
534  set data_menu(Matrix,Table)       [menu $data_menu(main).mmat   -tearoff 0]
535  set data_menu(Matrix,Export)      [menu $data_menu(main).mmae   -tearoff 0]
536  set data_menu(Matrix,Draw)        [menu $data_menu(main).mmac   -tearoff 0]
537  set data_menu(Matrix,Export,BDT)  [menu $data_menu(main).mmaebdt -tearoff 0]
538  set data_menu(Serie,DrawAutocor)  [menu $data_menu(main).mseda  -tearoff 0]
539  set data_menu(Serie,TableAutocor) [menu $data_menu(main).mseta  -tearoff 0]
540  set data_menu(Set,Table)          [menu $data_menu(main).mstt   -tearoff 0]
541  set data_menu(Set,Table2)         [menu $data_menu(main).mstt2  -tearoff 0]
542  set data_menu(Set,Draw)           [menu $data_menu(main).mstd   -tearoff 0]
543  set data_menu(Set,Draw,Special)   [menu $data_menu(main).mstds  -tearoff 0]
544  set data_menu(Set,Draw,Special,M) [menu $data_menu(main).mstdsm -tearoff 0] 
545  set data_menu(File,View)          [menu $data_menu(main).mfiv   -tearoff 0]
546  set data_menu(File,Decompile)     [menu $data_menu(main).mfid   -tearoff 0]
547  set data_menu(TimeSet,View)       [menu $data_menu(main).mtiv   -tearoff 0]
548  #$ht_vars  bind Entry <Button-3> +[$ht_vars bind Entry <Button-1>]
549 
550  # composes the  menus for each one of the trees, depending the node
551  # that is selected
552  $ht_vars  bind all <Button-3> +[list ::TolInspector::PostVariable %X %Y]
553  $ht_funcs bind all <Button-3> +[list ::TolInspector::PostFunction %X %Y]
554  $ht_tree  bind all <Button-3> +[list ::TolInspector::PostTree     %X %Y]
555}
556
557#/////////////////////////////////////////////////////////////////////////////
558proc ::TolInspector::GetWeight { pane } {
559#
560# PURPOSE: Set data(geometry,$pane) to the value of the current geometry
561#          of the pane
562#
563# PARAMETERS:
564#   pane -> string with a value "left" or "right" for each one of panels
565#
566#/////////////////////////////////////////////////////////////////////////////
567  variable widgets
568  variable data
569
570  if {[winfo exists $widgets(panes,$pane)]} {
571    set data(geometry,$pane) [winfo width $widgets(panes,$pane)]
572  }
573  set data(geometry,$pane)
574}
575
576#/////////////////////////////////////////////////////////////////////////////
577proc ::TolInspector::Destroy { } {
578#
579# PURPOSE: Destroys the three trees of TolInspector and array with full
580#          content & description of items
581#
582#///////////////////////////////////////////////////////////////////////////// 
583  variable blt_tree
584  variable blt_vartree
585  variable blt_functree
586  variable item_data
587
588  ::blt::tree destroy $blt_tree
589  ::blt::tree destroy $blt_vartree
590  ::blt::tree destroy $blt_functree
591  unset item_data
592}
593
594#/////////////////////////////////////////////////////////////////////////////
595proc ::TolInspector::OneLine { str } {
596#
597# PURPOSE: Gives a string with carriage returns \n and return this string
598#          until the first carriage return that appears after a word,
599#          replacing the rest by ... if some word existed after that carriage
600#          return
601#          Examples: the str "a\n b c"     returns "a..."
602#                            "\n \n a\n b" returns "a..."
603#                            "\n \n a\n"   returns "a"
604# PARAMETERS:
605#   str -> string with \n
606#
607#/////////////////////////////////////////////////////////////////////////////
608  set str [string trim $str]
609  set lnidx [string first "\n" $str]
610  if { $lnidx != -1 } {
611    if { [incr lnidx -1] > 0 } {
612      return "[string range $str 0 $lnidx]..."
613    } else {
614      return "..."
615    }
616  }
617  set str
618}
619
620#/////////////////////////////////////////////////////////////////////////////
621proc ::TolInspector::TrimContent { grammar content } {
622#///////////////////////////////////////////////////////////////////////////// 
623  if { [string equal "Real" $grammar] } {
624     return [::TolConsole::Format $content]
625  } else {
626    if { [string equal \"\n\" $content] } {
627      set content {"\n"}
628    }
629    return [OneLine $content]
630    set content [string trim $content]
631    set lnidx [string first "\n" $content]
632    if { $lnidx != -1 } {
633      if { [incr lnidx -1] > 0 } {
634        return "[string range $content 0 $lnidx]..."
635      } else {
636        return "..."
637      }
638    }
639    set content
640  }
641}
642
643#/////////////////////////////////////////////////////////////////////////////
644  proc ::TolInspector::_InsertChild { args } {
645#
646# PURPOSE: este proc es para ancapsular desc en una lista
647#
648#/////////////////////////////////////////////////////////////////////////////
649  eval InsertChild [lrange $args 0 3] [list [list [lindex $args 4]]] [lrange $args 5 end]
650}
651
652#/////////////////////////////////////////////////////////////////////////////
653  proc ::TolInspector::InsertChild { args } {
654#
655# PURPOSE: Inserts a node in the corresponding treeview of the right panel.
656#
657# PARAMETERS:
658#   args[0] -> grammar
659#   args[1] -> name
660#   args[2] -> content
661#   args[3] -> path
662#   args[4] -> desc
663#   Si grammar == "Code"
664#    args[5] -> ¿es una variable?
665#   Si grammar == "Set" || "NameBlock"
666#    args[5] -> indexes of the set
667#    args[6] -> is file?
668#    args[7] -> has subset?
669#    args[8] -> subtype
670#    args[end] -> "Reference {reference}" end > 4
671#
672#/////////////////////////////////////////////////////////////////////////////
673  variable ht_vars
674  variable blt_vartree
675  variable ht_funcs
676  variable blt_functree
677  variable gra_parent
678
679  #puts "InsertChild: args=$args [info level 1]"
680  set grammar [lindex $args 0]
681  set name [ lindex $args 1 ]
682  set content [lindex $args 2]
683  set path    [lindex $args 3]
684  set desc    [lindex [lindex $args 4] 0]
685
686
687  if {[llength [lindex $args end]] >= 2} {
688    #set ref [list [lindex [lindex $args end] 0] [lrange [lindex $args end] 1 end]]
689    set ref [concat [lindex [lindex $args end] 0] [lrange [lindex $args end] 1 end]]
690  } else {
691    set ref ""     
692  }
693  #puts "InsertChild: ref=$ref"
694  switch $grammar {
695    Code {
696      set isvar [lindex $args 5]
697      if { [string equal $isvar "1"] } {
698        Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc $ref
699      } else {
700        Insert_HTItem $ht_funcs $blt_functree $grammar $name $content $path $desc $ref
701      }
702    }
703    NameBlock -
704    Set {
705      #puts "HTItem, ref = '$ref' '$args'"
706      # args[5] is the index of the set object
707      # args[6] is the flag file
708      # args[8] is the subtype
709      Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc \
710        [lindex $args 5] [lindex $args 6] [lindex $args 8] $ref
711    }
712    default {
713      Insert_HTItem $ht_vars $blt_vartree $grammar $name $content $path $desc $ref
714    }
715  }
716}
717
718# si grammar == "Set"
719#   args[0] -> indexes
720#   args[1] -> ¿is a file?
721#   args[2] -> subtype
722
723#/////////////////////////////////////////////////////////////////////////////
724proc ::TolInspector::Insert_HTItem {ht tree grammar name content path desc args} {
725#/////////////////////////////////////////////////////////////////////////////
726  variable ht_tree
727  variable tolset
728  variable tolindex
729  variable iterSet
730  variable knownReference
731  variable node_prefix
732  variable item_data
733  variable item_id
734  variable gra_parent
735
736  #upvar \#0 ::TolTk::Images Images
737
738  #puts "ENTER: ::TolInspector::Insert_HTItem"
739  if { $knownReference eq "" } {
740    set objRef $iterSet
741    lappend objRef $item_id
742  } else {
743    #puts "knownReference = $knownReference"
744    set objRef $knownReference
745  }
746
747  #puts "\tobjRef = $objRef"
748  if { $gra_parent eq "NameBlock" } {
749    array set info_member [ FilterNameBlockMember $name ]
750    if { !$info_member(-show) } {
751      incr item_id
752      return
753    }
754    set fcolor $info_member(-fcolor)
755  } else {
756    set fcolor "black"
757  }
758
759  set brief_cont [TrimContent $grammar $content]
760  set brief_desc [TrimContent DONTCARE $desc]
761  #puts "Insert_HTItem: args=$args"
762  if {[llength [lindex $args end]] >= 2} {
763    set ref_value [lindex [lindex $args end] 1]
764  } elseif {[regexp -- "console" $node_prefix]} {
765    set ref_value [list Console]
766    eval lappend ref_value $tolindex $item_id
767  } else {
768    set ref_value ""
769  }
770
771  #puts "Insert_HTItem: ref_value=$ref_value tolindex=$tolindex item_id=$item_id node_prefix=$node_prefix"
772  #puts "\ttolset=$tolset"
773  set data [list Index      $item_id \
774                Content     $brief_cont \
775                Path        $path \
776                Description $brief_desc \
777                Reference   $ref_value]
778
779  if {$grammar eq "Set" || $grammar eq "NameBlock"} {
780    if {[string length $tolset] || [regexp "console" $node_prefix]} {
781      # OJO: si tolset == "" no implica que no estemos en un Set
782      # por ejemplo un Set de la consola.
783      set item [GetItemName $node_prefix [lindex $args 0]]
784      #Tolcon_Trace "InsertHTItem. item(if): $item"
785    } else {
786      switch [lindex [$ht_tree get -full anchor] end] {
787        root-files {
788          set item file$item_id
789        }
790        root-console {
791          set item console$item_id
792        }
793        root-pool {
794          set item pool$item_id
795        }
796        default {
797          set item item$item_id
798        }
799      }
800    }
801    # aqui hay que pedir el bitmap en funcion del subtype: args[2]
802    if {$grammar eq "Set"} {
803      #puts "*******Set $objRef *******"
804      set icon_grammar [SubTypeImage [lindex $args 2]]
805      set data [lreplace $data 9 9 $objRef] 
806    } else {
807      #(pgea) se reemplaza el valor de la referencia en data
808      set data [lreplace $data 9 9 $objRef] 
809      #(pgea) se utiliza la informacon de instancia
810      set classOf [Tol_ClassOfFromReference $objRef]
811      set insCont [Tol_InstanceContentFromReference $objRef]
812      if {$insCont ne ""} {
813        set data [lreplace $data 3 3 [TrimContent $grammar $insCont]]
814      } elseif {$classOf ne ""} {
815        set data [lreplace $data 3 3 $classOf]
816      }
817      set objAddress [ tol::info address $objRef ]
818      set icon_grammar [ ::ImageManager::getIconForInstance $objAddress ]
819    }
820  } elseif { $grammar eq "Anything" } {
821    set item "item$item_id"
822    set anyType [ tol::info anything $objRef ]
823    set icon_grammar [ ::Bitmap::get $anyType ]
824  } else {
825    set item "item$item_id"
826    set icon_grammar [ ::Bitmap::get $grammar ]
827  }
828  set idnew [$tree insert 0 -label $item]
829  set label [OneLine $name]
830  if {$label eq ""} {
831    if {[set label $brief_desc] eq ""} {
832      set label " "
833    }
834  }
835  $ht entry configure $idnew -label $label \
836      -icons [list $icon_grammar $icon_grammar] -data $data \
837       -foreground $fcolor
838  set item_data($item_id) [list $content $desc $grammar]
839  incr item_id
840}
841
842#/////////////////////////////////////////////////////////////////////////////
843proc ::TolInspector::ClearHiertables { } {
844#
845# PURPOSE:
846#
847#/////////////////////////////////////////////////////////////////////////////
848  variable w_tabset
849  variable ht_vars
850  variable ht_funcs
851  variable item_data
852  variable OnSelectItem
853
854  $ht_vars  entry delete root 0 end
855  $ht_funcs entry delete root 0 end
856  $ht_vars column  configure Index -hide no
857  $ht_funcs column configure Index -hide no
858  catch {
859    unset item_data
860  }
861  $w_tabset tab configure Variables -text [mc Variables] -state normal
862  $w_tabset tab configure Functions -state normal
863
864  if { [string length $OnSelectItem] } {
865    $OnSelectItem
866  }
867}
868
869# este proc debe pasar a ser un getContainerReference
870#
871proc ::TolInspector::getPackageReference { treePath } {
872  variable ht_tree
873
874  #puts "::TolInspector::getPackageReference $treePath"
875  catch {
876    set typeContainer "NameBlock"
877    set order [ lindex  [ split [ lindex $treePath 2 ] "-" ] end ]
878    incr order -1
879    #puts "path,2 = [ lindex $treePath 2 ]"
880    #puts "order = $order"
881    set idx [lindex [ $ht_tree entry children "root-packages"] $order]
882    set nameContainer [ $ht_tree entry cget $idx -label ]
883    #puts "en root-package:"
884    #puts "\torder=$order"
885    #puts "\tidx=$idx"
886    #puts "\tnameContainer=$nameContainer"
887    set container [ list $typeContainer $nameContainer ]
888    if { [ llength $treePath ] > 3 } {
889      foreach c [ lrange $treePath 3 end-1 ] {
890        set orderItem [ lindex  [ split $c "-" ] end ]
891        lappend container $orderItem
892      }
893      set tolindex [ lindex  [ split [ lindex $treePath end ] "-" ] end ]
894    } else {
895      set tolindex [ list ]
896    }
897  } msg
898  #puts "::TolInspector::getPackageReference: $msg"
899  #puts "::TolInspector::getPackageReference: [ list $container $tolindex ]"
900  return [ list $container $tolindex ]
901}
902
903#/////////////////////////////////////////////////////////////////////////////
904proc ::TolInspector::OpenObject { index } {
905#
906# PURPOSE: Script called each time a node in ht_tree (left treeview) is
907#          opened.
908#
909# PARAMETERS:
910#   index : The id of the node opened
911#
912#/////////////////////////////////////////////////////////////////////////////
913  variable tolset
914  variable tolindex
915  variable iterSet
916  variable at_set
917  variable node_prefix
918  variable ht_tree
919  variable data
920
921  #puts "OpenObject: index=$index"
922  set path [$ht_tree get -full $index]
923  #puts "path = $path"
924  if { $index } {
925    set parent1 [lindex $path 1]
926    if { [set ispackage [string equal $parent1 "root-packages"]] ||
927         [set isfile [string equal $parent1 "root-files"]] ||
928         [set isconsole [string equal $parent1 "root-console"]] ||
929         [string equal $parent1 "root-pool"] } {
930      set lpath [llength $path]
931      #puts "lpath = $lpath"
932      if { $lpath == 2 } {
933        if { $ispackage } {
934          InsertPackages
935        } elseif { $isfile } {
936          InsertFiles
937        } elseif { $isconsole } {
938          InsertConsoleObj
939        } else {
940          InsertPoolObj
941        }
942      } else {
943        #puts "OpenObject: path = $path"
944        set leaf [lindex $path end]
945        set leaf_info [split $leaf "-"]
946        set node_prefix [lindex $leaf_info 0]
947        set _tolset $tolset
948        if { $parent1 eq "root-packages" } {
949          foreach {tolset tolindex} [ getPackageReference $path ] break
950        } elseif { [string equal $parent1 "root-pool"] } {
951          #Tolcon_Trace "OpenObject. tolset=$tolset"
952          set tolset $data(pool,reference,[lindex $leaf_info 0])
953          #puts "OpenObject: Spool: tolset=$tolset, leaf_info=$leaf_info"
954          if { $lpath == 3 } {
955            set tolindex [lrange $tolset 1 end]
956            set tolset [lindex $tolset 0]
957          } else {
958            set tolindex [lrange $leaf_info 1 end]
959                    if {[lindex $tolset 0] eq "Console"} {
960                      set tolset [lindex $tolset 0] 
961                    } else {
962                      set tolset [lrange $tolset 0 1]
963                    }
964            #set tolindex [lrange $tolset 1 end]
965            #set tolset [lindex $tolset 0]
966            #lappend tolindex [lindex $leaf_info end]
967          }
968          #Tolcon_Trace "OpenObject. tolset=$tolset"
969        } elseif {[regexp -- "console(.+)" $node_prefix --> idx_con]} {
970          set tolset "Console"
971          #puts "OpenObject: Console: leaf_info = $leaf_info"
972          if {[llength $leaf_info] == 1} {
973            set tolindex $idx_con
974          } else {
975            #set tolindex [list $idx_con [lrange $leaf_info 1 end]]
976            set tolindex [lrange $leaf_info 1 end]
977          }
978        } else {
979          set idx [$ht_tree find -name $node_prefix]
980          array set aryData [$ht_tree entry cget $idx -data]
981          set tolset [list File $aryData(FileName)]
982          #set tolset [$ht_tree entry cget [$ht_tree find -name $node_prefix] -label]
983          if { $lpath == 3 } {
984            set tolindex ""
985          } else {
986            set tolindex [lrange $leaf_info 1 end]
987          }
988        }
989        Busy
990        set at_set $index
991        set iterSet [eval list $tolset $tolindex]
992        variable gra_parent [ GetParentGrammar $iterSet ]
993        ::tol::forallchild $iterSet ::TolInspector::InsertSubset
994        set tolset $_tolset
995        NotBusy
996      }
997    }
998  }
999}
1000
1001#/////////////////////////////////////////////////////////////////////////////
1002proc ::TolInspector::InsertPackages {} {
1003#
1004# PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL
1005#          packages
1006#
1007#/////////////////////////////////////////////////////////////////////////////
1008  variable ht_tree
1009  #upvar \#0 ::TolTk::Images Images
1010   
1011  set order 1
1012  foreach pkg [::tol::info packages] {
1013    # takes an icon with the same name that the grammar
1014    set img [ ::Bitmap::get NameBlock ]
1015    $ht_tree insert -at "root-packages" end package-$order -label $pkg\
1016          -icons [list $img $img] -button yes
1017    incr order
1018  }
1019}
1020
1021#/////////////////////////////////////////////////////////////////////////////
1022proc ::TolInspector::InsertGrammars {} {
1023#
1024# PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL
1025#          grammar
1026#
1027#/////////////////////////////////////////////////////////////////////////////
1028  variable ht_tree
1029  #upvar \#0 ::TolTk::Images Images
1030   
1031  set id 1
1032  foreach g [::tol::info grammars] {
1033    # takes an icon with the same name that the grammar
1034    set img [::Bitmap::get $g]
1035    $ht_tree insert -at "root-grammars" end grammar-$id -label $g\
1036          -icons [list $img $img]
1037    incr id
1038  }
1039}
1040
1041#/////////////////////////////////////////////////////////////////////////////
1042proc ::TolInspector::InsertFiles { } {
1043#
1044# PURPOSE: Inserts a node in ht_tree (left treeview) for each Included file
1045#
1046#/////////////////////////////////////////////////////////////////////////////
1047  variable ht_tree
1048  variable blt_tree
1049
1050  set index 1
1051  #set img [::Bitmap::get "File"]
1052  foreach f [lreverse [::tol::info included]] {
1053    set finfo   [::tol::info included $f]
1054    set button  [lindex $finfo 3]
1055    set subtype [lindex $finfo 4]
1056    # tomar la imagen en funcion del subtype
1057    set img [SubTypeImage $subtype]
1058    set tag_file "file$index"
1059    set blt_idx [$blt_tree insert "root-files" \
1060             -label $tag_file -tags $tag_file]
1061    # Tail del fichero. Podría hacerse configurable por el usuario
1062    set label [file tail $f]
1063    $ht_tree entry configure $blt_idx -label $label\
1064    -icons  [list $img $img] -button $button -data [list "FileName" $f]
1065    incr index
1066  }
1067}
1068
1069#/////////////////////////////////////////////////////////////////////////////
1070proc ::TolInspector::InsertConsoleObj { } {
1071#
1072# PURPOSE: Inserts a node in ht_tree (left treeview) for each Console object
1073#
1074#/////////////////////////////////////////////////////////////////////////////
1075  variable ht_tree
1076  variable has_button 0
1077   
1078  set index 1
1079  foreach co [::tol::console stack list] {
1080    set grammar [lindex $co 0]
1081    if {$grammar eq "Set" || $grammar eq "NameBlock"} {
1082      # SUBTYPE: icono en funcion de [lindex $co 7]
1083      if {$grammar eq "Set"} {
1084        set icon [SubTypeImage [lindex $co 7]]
1085      } else  {
1086        set objRef [ list "Console" $index ]
1087        set objAddress [ tol::info address $objRef ]
1088        set icon [ ::ImageManager::getIconForInstance $objAddress ]
1089      }
1090      set name [lindex $co 1]
1091      #tol::forallchild $name HasSubset
1092      set has_button [lindex $co 6]
1093      if {$name eq ""} {
1094        if {[set name [TrimContent DONTCARE [lindex $co 4]]] eq ""} {
1095          set name " "
1096        }
1097      }
1098      $ht_tree insert -at root-console end "console$index" -label $name \
1099          -icons  [list $icon $icon] -button $has_button -data [list "FileName" $index]
1100    }
1101    incr index
1102  }
1103}
1104
1105#/////////////////////////////////////////////////////////////////////////////
1106proc ::TolInspector::InsertPoolObj { } {
1107#
1108# PURPOSE: Inserts a node in ht_tree (left treeview) for each object in Spool
1109#
1110#/////////////////////////////////////////////////////////////////////////////
1111  variable data
1112  variable ht_tree
1113  array unset data pool,reference,*
1114  set index 1
1115
1116  foreach _obj $data(pool,objects) {
1117    #Tolcon_Trace "InsertPoolObj. _obj=$_obj"
1118    array set obj $_obj
1119    if { [string equal $obj(grammar) "Set"] || [string equal $obj(grammar) "NameBlock"] } {
1120      #Si la referencia del objeto tiene espacios en la ruta, el
1121      # llength me daría > 1, por eso añado la 2ª parte de la condicion
1122      if { ([llength $obj(reference)] > 1) && \
1123            ![string equal $obj(reference) $obj(objName)]} {
1124        set infoObj [::tol::info variable $obj(reference)]
1125      } else {
1126        if {[catch { set infoObj [concat [list "Set" $obj(reference)] \
1127                            [::tol::info included $obj(reference)]] }]} {
1128          set infoObj [concat [list "Set" $obj(reference)] \
1129                 [::tol::info variable "Set" $obj(reference)]]
1130        } else {
1131          # Insertamos el 1 de isFile
1132          set infoObj [linsert $infoObj 5 1]
1133        }
1134      }
1135      #Tolcon_Trace "infoObj=$infoObj"
1136      if {[set name [file tail [lindex $infoObj 1]]] eq ""} {
1137        if {[set name [TrimContent DONTCARE [lindex $infoObj 4]]] eq ""} {
1138          set name " "
1139        }
1140      }
1141      set has_button [lindex $infoObj 6]
1142      #set icon [SubTypeImage [lindex $infoObj 7]]
1143      if {$obj(grammar) eq "Set"} {
1144        set icon [SubTypeImage [lindex $infoObj 7]]
1145      } else  {
1146        #puts "en pool = $obj(reference)"
1147        set objAddress [ tol::info address $objRef ]
1148        set icon [ ::ImageManager::getIconForInstance $objAddress ]
1149      }
1150
1151      $ht_tree insert -at root-pool end "pool$index" -label $name \
1152          -icon [list $icon $icon] -button $has_button
1153      #Tolcon_Trace "InsertPoolObj. name=$name"
1154      if { ([llength $obj(reference)] > 1) && \
1155            [string equal $obj(reference) $obj(objName)]} {
1156        set obj(reference) [list $obj(reference)]
1157      }
1158      set data(pool,reference,pool$index) $obj(reference)
1159    }
1160    incr index
1161  }
1162}
1163
1164proc ::TolInspector::FilterNameBlockMember { name } {
1165  set st_reg [ regexp {(.+::)?(_)?(\.)?(.*)} $name => p1 p2 p3 p4]
1166  if { !$st_reg } {
1167    list -show 1 -fcolor "black" -name $name
1168  } elseif { $p2 eq "_" } {
1169    if { $p3 eq "." } {
1170      if { [string match {autodoc.member.*} $p4] } {
1171        # es un elemento de autodocumentacion y no se muestra
1172        list -show 0
1173      } {
1174        # es un miembro de solo lectura
1175        list -show 1 -fcolor "gray50" -name "_.$p4"
1176      }
1177    } else {
1178      # es un miembro oculto,
1179      set showPrivate [ Tol_GetViewPrivateMembers ]
1180      list -show $showPrivate -fcolor "gray75" -name "_$p4"
1181    }
1182  } else {
1183    list -show 1 -fcolor "black" -name $p4
1184  }
1185}
1186
1187#/////////////////////////////////////////////////////////////////////////////
1188proc ::TolInspector::InsertSubset { args } {
1189#
1190# PURPOSE: Inserts a node in ht_tree (left treeview) for each child of a Set
1191#
1192# PARAMETERS:
1193#   args[0] -> grammar
1194#   args[1] -> name
1195#   args[2] -> content
1196#   args[3] -> path
1197#   args[4] -> desc
1198#   Si grammar == "Set"
1199#    args[5] -> indexes of the set
1200#    args[6] -> is file?
1201#    args[7] -> has subset?
1202#    args[8] -> subtype
1203#
1204#/////////////////////////////////////////////////////////////////////////////
1205  variable ht_tree
1206  variable at_set
1207  variable tolset
1208  variable iterSet
1209  variable node_prefix
1210  variable has_button 0
1211  variable blt_tree
1212  variable gra_parent
1213  catch {
1214  #puts "InsertSubset, args=$args"
1215  set grammar [lindex $args 0]
1216  if {$grammar eq "Set" || $grammar eq "NameBlock"} {
1217    #puts "InsertSubset, args=$args"
1218    if { $gra_parent eq "NameBlock" } {
1219      array set info_member [ FilterNameBlockMember [ lindex $args 1 ] ]
1220      if { !$info_member(-show) } {
1221        return
1222      }
1223      set name $info_member(-name)
1224      set fcolor $info_member(-fcolor)
1225    } else {
1226      set name [ lindex $args 1 ]
1227      set fcolor "black"
1228    }
1229    set content [lindex $args 2]
1230    # idx es el indice completo desde el Set root
1231    set idx     [lindex $args 5]
1232    set isfile  [lindex $args 6]
1233    set has_button [lindex $args 7]
1234    set subtype [lindex $args 8]
1235    #tol::forallchild $tolset $idx HasSubset
1236    if {$grammar eq "Set"} {
1237      set icon [SubTypeImage $subtype]
1238    } else {
1239      set objRef $iterSet
1240      lappend objRef [ lindex $idx end ]
1241      set objAddress [ tol::info address $objRef ]
1242      set icon [ ::ImageManager::getIconForInstance $objAddress ]
1243    }
1244    # Tail por si es un fichero. Podría hacerse configurable por el usuario
1245    set label [file tail $name]
1246    #puts [list InsertSubset, idx {lindex $args 5} = $idx]
1247    set idnew [ $blt_tree insert $at_set \
1248                   -label [ GetItemName $node_prefix $idx ] ]
1249
1250    #puts "InsertSubset, node_prefix = $node_prefix"
1251    #puts "InsertSubset, idnew = $idnew"
1252    #puts "InsertSubset, -label = [GetItemName $node_prefix $idx]"
1253
1254    if {$label eq ""} {
1255      if {[set label [TrimContent DONTCARE [lindex $args 4]]] eq ""} {
1256        set label " "
1257      }
1258    }
1259    $ht_tree entry configure $idnew -label $label -button $has_button \
1260      -icons [list $icon $icon] -foreground $fcolor
1261  }
1262} msg
1263#puts "InsertSubSet: $msg"
1264}
1265
1266#/////////////////////////////////////////////////////////////////////////////
1267proc ::TolInspector::ClearConsoleObj { } {
1268#/////////////////////////////////////////////////////////////////////////////
1269  variable ht_tree
1270  variable data
1271   
1272  set idx_con [$ht_tree index root-console]
1273  $ht_tree entry delete $idx_con 0 end
1274   
1275  #Quitamos del spool todos los objetos que provengan de la consola
1276  foreach _obj $data(pool,objects) {
1277    array set obj $_obj
1278    if {[string equal $obj(origin) "root-console"]} {
1279      set idx [lsearch $data(pool,objects) $_obj]
1280      set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
1281    }
1282  }
1283  UpdatePoolObj
1284  #Finalmente limpiamos el stack de la consola de tol
1285  ::tol::console stack release
1286}
1287
1288#/////////////////////////////////////////////////////////////////////////////
1289proc ::TolInspector::ClearConsoleObjSel {ht} {
1290#/////////////////////////////////////////////////////////////////////////////
1291  variable vars_selected
1292  variable data
1293
1294  foreach var $vars_selected {
1295    set name [$ht entry cget $var -label]
1296    #puts "name=$name"
1297    #Quitamos del spool todos los objetos que provengan de la consola
1298    foreach _obj $data(pool,objects) {
1299      array set obj $_obj
1300      #puts "_obj=$_obj"
1301      if {[string equal $obj(origin) "root-console"] && [string equal $obj(objName) $name]} {
1302        set idx [lsearch $data(pool,objects) $_obj]
1303        set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
1304      }
1305    }
1306    UpdatePoolObj
1307    #Finalmente quitamos el objeto de la consola de tol
1308    ::tol::console stack release $name
1309  }
1310  UpdateConsoleObj
1311}
1312
1313#/////////////////////////////////////////////////////////////////////////////
1314proc ::TolInspector::UpdateFileRoot { } {
1315#///////////////////////////////////////////////////////////////////////////// 
1316  variable ht_tree
1317  set open 0
1318  set idx_file [$ht_tree index root-files]
1319  if { [$ht_tree entry isopen $idx_file] } {
1320    $ht_tree close $idx_file
1321    set open 1
1322  }
1323  if { [$ht_tree index focus] == $idx_file } {
1324    SelectObject
1325  }
1326  if $open {
1327    $ht_tree open $idx_file
1328  }
1329}
1330
1331#/////////////////////////////////////////////////////////////////////////////
1332proc ::TolInspector::UpdateConsoleObj { } {
1333#///////////////////////////////////////////////////////////////////////////// 
1334  variable ht_tree
1335
1336  set idx_con [$ht_tree index root-console]
1337  if { [$ht_tree entry isopen $idx_con] } {
1338    $ht_tree close $idx_con
1339  }
1340  $ht_tree selection anchor root-console
1341  $ht_tree selection mark root-console
1342  #Tolcon_Trace "Abierto el nodo root-console"
1343  if { [$ht_tree index focus] == $idx_con } {
1344    SelectObject
1345  }
1346}
1347
1348
1349#/////////////////////////////////////////////////////////////////////////////
1350proc ::TolInspector::UpdatePoolObj { } {
1351#///////////////////////////////////////////////////////////////////////////// 
1352  variable ht_tree
1353
1354  set idx_pool [$ht_tree index root-pool]
1355  if { [$ht_tree entry isopen $idx_pool] } {
1356    $ht_tree close $idx_pool
1357  }
1358  if { [$ht_tree index focus] == $idx_pool } {
1359    SelectObject
1360  }
1361}
1362
1363
1364#/////////////////////////////////////////////////////////////////////////////
1365proc ::TolInspector::SelectObject { } {
1366#
1367# PURPOSE: Script called each time a node in ht_tree (left treeview) is
1368#          selected.
1369#
1370#/////////////////////////////////////////////////////////////////////////////
1371  #Tolcon_Trace "LLAMADA A SELECTOBJECT"
1372  variable w_tabset
1373  variable ht_tree
1374  #variable set_type ""
1375  variable tolset
1376  variable tolindex
1377  #variable closing
1378  variable node_prefix ""
1379  variable data
1380
1381  set index [$ht_tree index anchor]
1382   
1383  if { ![string length $index] } {
1384    ClearHiertables
1385    return
1386  }
1387  ClearHiertables
1388
1389  set path [ $ht_tree get -full $index ]
1390  set tolset ""
1391  if { $index } {
1392    #puts "SelectObject index = $index"
1393    #puts "SelectObject: full = $path"
1394    set info_node [split [lindex $path end] "-"] ;# ojo si el path tiene -
1395    set node_type [lindex $info_node 0]
1396    set node_name [lindex $info_node 1]
1397    #puts "SelectObject: info_node = $info_node"
1398  } else {
1399    set node_type root
1400    set node_name root
1401  }
1402
1403  Busy
1404  #puts "SelectObject: node_type = $node_type, node_name = $node_name"
1405  switch -regexp $node_type  {
1406    root {
1407      switch $node_name {
1408        root -
1409        grammars {
1410          ClearHiertables
1411          #$w_tabset tab configure Variables -state disabled
1412          #$w_tabset tab configure Functions -state disabled
1413        }
1414        package {
1415          puts "implementa el llenado del panel derecho"
1416        }
1417        files {
1418          SelectFileRoot
1419        }
1420        console {
1421          SelectConsoleRoot
1422        }
1423        pool {
1424          SelectPoolRoot
1425        }
1426      }
1427    }
1428    grammar {
1429      SelectGrammar
1430    }
1431    default {
1432      set node_prefix $node_type
1433      #puts "SelectObject: node_prefix = $node_prefix"
1434      if { $node_type eq "package" } {
1435        foreach {tolset tolindex} [ getPackageReference $path ] break
1436      } elseif {[regexp -- "pool" $node_type]} {
1437        set tolset $data(pool,reference,[lindex $node_type 0])
1438        #puts "SelectObject: Spool: tolset=$tolset, info_node=$info_node"
1439        if { [llength $info_node] == 1 } {
1440          set tolindex [lrange $tolset 1 end]
1441          set tolset [lindex $tolset 0]
1442        } else {
1443          #set tolindex [lrange $tolset 1 end]
1444          #set tolset [lindex $tolset 0]
1445          #lappend tolindex [lindex $info_node end]
1446          set tolindex [lrange $info_node 1 end]
1447          if {[lindex $tolset 0] eq "Console"} {
1448            set tolset [lindex $tolset 0] 
1449          } else {
1450            set tolset [lrange $tolset 0 1]
1451          }
1452        }
1453      } elseif {[regexp -- "console(.+)" $node_type --> idx_con]} {
1454        #puts "SelectObject: Console: tolset=$tolset info_node=$info_node idx_con=$idx_con"
1455        set tolset "Console"
1456        #set idx [$ht_tree find -name $node_type]
1457        #array set aryData [$ht_tree entry cget $idx -data]
1458        #set tolindex [eval list $aryData(FileName) [lrange $info_node 1 end]]
1459        if {[llength $info_node] == 1} {
1460          set tolindex $idx_con
1461        } else {
1462          set tolindex [lrange $info_node 1 end]
1463          #set tolindex [concat [list $idx_con] $tolindex]
1464        }
1465      } else {
1466        set idx [$ht_tree find -name $node_type]
1467        array set aryData [$ht_tree entry cget $idx -data]
1468        #puts "SelectObject: FileName=$aryData(FileName) info_node=$info_node"
1469        set tolset [list File $aryData(FileName)]
1470        set tolindex [lrange $info_node 1 end]
1471        #set tolindex [lrange $info_node 2 end]
1472      }
1473      #puts "SelectObject end: tolset=$tolset, tolindex=$tolindex"
1474      SelectSet
1475    }
1476  }
1477  NotBusy
1478}
1479
1480#/////////////////////////////////////////////////////////////////////////////
1481proc ::TolInspector::SelectFileRoot { } {
1482#
1483# PURPOSE: Script called each time 'Included Files' node in ht_tree is
1484#          selected. Gets information about each node that must be in
1485#          included files, and inserts it in the right treeview.
1486#
1487#/////////////////////////////////////////////////////////////////////////////
1488  variable item_id 1
1489  variable w_tabset
1490   
1491  ClearHiertables
1492  $w_tabset tab configure Variables -text [mc Files]
1493  #  $w_tabset tab configure Functions -state disabled
1494  $w_tabset select 0
1495  foreach f [lreverse [::tol::info included]] {
1496    set fi [::tol::info included $f]
1497    # tener en cuenta el subtype cuando lo retorne
1498    InsertChild Set $f \
1499        [lindex $fi 0] [lindex $fi 1] [list [lindex $fi 2]] $item_id 1 [lindex $fi 3] [lindex $fi 4]
1500  }
1501}
1502
1503#/////////////////////////////////////////////////////////////////////////////
1504proc ::TolInspector::SelectConsoleRoot { } {
1505#
1506# PURPOSE: Script called each time 'Console Objects' node in ht_tree is
1507#          selected. Gets information about each node that must be in console,
1508#          and inserts it in the right treeview.
1509#
1510#/////////////////////////////////////////////////////////////////////////////
1511  variable w_tabset
1512  variable ht_vars
1513  variable ht_funcs
1514  variable item_id 1
1515  variable iterSet "Console"
1516  variable knownReference ""
1517
1518  ClearHiertables
1519#(pgea) se quita la linea que oculta la columna del indice y que
1520#(pgea) el procedimimento anterior ClearHiertables muestra
1521#  $ht_vars column  configure Index -hide yes
1522#  $w_tabset tab configure Functions -state disabled
1523 
1524  foreach co [::tol::console stack list] {
1525   #puts "SelectConsoleRoot: co = $co"
1526   set gra  [lindex $co 0]
1527   set name [lindex $co 1]
1528   set cont [lindex $co 2]
1529   set path [lindex $co 3]
1530   set desc [lindex $co 4]
1531   set knownReference [ list Console $item_id ]
1532    switch [lindex $co 0 ] {
1533      Code {
1534        InsertChild $gra $name $cont $path [list $desc] 0
1535      }
1536      NameBlock -
1537      Set {
1538        #puts "switch: SelectConsoleRoot $gra"
1539        InsertChild $gra $name $cont $path [list $desc] \
1540            $item_id [lindex $co 5] [lindex $co 6] [lindex $co 7] \
1541            [list Reference [list "Console" $item_id]]
1542      }
1543      default {
1544        InsertChild $gra $name $cont $path [list $desc] \
1545            [list Reference [list "Console" $item_id]]
1546      }
1547    }
1548  }
1549  set knownReference ""
1550}
1551
1552#/////////////////////////////////////////////////////////////////////////////
1553proc ::TolInspector::SelectPoolRoot { } {
1554#
1555# PURPOSE: Script called each time 'Spool Objects' node in ht_tree is
1556#          selected. Gets information about each node that must be in pool,
1557#          and inserts it in the right treeview.
1558#
1559#/////////////////////////////////////////////////////////////////////////////
1560  variable w_tabset
1561  variable ht_vars
1562  variable data
1563  variable item_id 1
1564  variable knownReference ""
1565
1566  ClearHiertables
1567  $ht_vars column  configure Index -hide yes
1568
1569  array unset data pool,variables,*
1570  # Para cada uno de los objetos que debe haber en el spool
1571  # busco la información del nodo y lo inserto en el treeview de la derecha
1572  foreach _obj $data(pool,objects) {
1573    array set obj $_obj
1574    #Si la referencia del objeto tiene espacios en la ruta, el
1575    # llength me daría > 1, por eso añado la 2ª parte de la condicion
1576    #puts "SelectPoolRoot: obj(grammar)=$obj(grammar) obj(objName)=$obj(objName) obj(reference)=$obj(reference)"
1577    if { ([llength $obj(reference)] > 1) && ![string equal $obj(reference) $obj(objName)]} {
1578      if {$obj(grammar) eq "Code"} {
1579        set infoObj [concat [list $obj(grammar) $obj(objName)] \
1580            [::tol::info function $obj(reference)]]
1581      } else  {
1582        set infoObj [::tol::info variable $obj(reference)]
1583      }
1584      #Tolcon_Trace "tol info (var|function) reference"
1585    } else {
1586      if {[catch { set infoObj [concat [list "Set" $obj(reference)] \
1587                          [::tol::info included $obj(reference)]] }]} {
1588        if {$obj(grammar) eq "Code"} {
1589          set infoObj [concat [list $obj(grammar) $obj(reference)] \
1590               [::tol::info function $obj(graApply) $obj(reference)]]
1591        } else  {
1592          #set infoObj [concat [list $obj(grammar) $obj(reference)] \
1593          #     [::tol::info variable $obj(grammar) $obj(reference)]]
1594          set infoObj [::tol::info variable [list $obj(grammar) $obj(reference)]]
1595        }
1596        #Tolcon_Trace "tol info (var|function) Grammar nameGlobal"
1597      } else {
1598        # Insertamos el 1 de isFile
1599        set infoObj [linsert $infoObj 5 1]
1600        #Tolcon_Trace "tol info included"
1601      }
1602    }
1603    #Tolcon_Trace "INFOOBJ: $infoObj"
1604    set gra  [lindex $infoObj 0]
1605    set name [lindex $infoObj 1]
1606    set cont [lindex $infoObj 2]
1607    set path [lindex $infoObj 3]
1608    set desc [lindex $infoObj 4]
1609    set data(pool,variables,$item_id) $obj(reference)
1610
1611    switch $gra {
1612      Code {
1613        InsertChild $gra $name $cont $path [list $desc] 0 "Reference $obj(reference)"
1614      }
1615      Set -
1616      NameBlock {
1617        set knownReference $obj(reference)
1618        InsertChild $gra $name $cont $path [list $desc] \
1619            $item_id [lindex $infoObj 5] [lindex $infoObj 6] [lindex $infoObj 7] "Reference $obj(reference)"
1620        set knownReference ""
1621      }
1622      default {
1623        InsertChild $gra $name $cont $path [list $desc] "Reference $obj(reference)"
1624      }
1625    }
1626  } 
1627}
1628
1629#/////////////////////////////////////////////////////////////////////////////
1630proc ::TolInspector::SelectGrammar { } {
1631#
1632# PURPOSE: Script called each time a Grammar node in ht_tree is selected. Gets
1633#          information about each var and function of this grammar, and
1634#          inserts them in the right treeview.
1635#
1636#/////////////////////////////////////////////////////////////////////////////
1637  variable w_tabset
1638  variable ht_tree
1639  variable ht_vars
1640  variable ht_funcs
1641  variable item_id 1
1642  variable OnSelectItem
1643  variable knownReference
1644
1645  set knownReference ""
1646  ClearHiertables
1647  $ht_vars column  configure Index -hide yes
1648  $ht_funcs column configure Index -hide yes
1649  set grammar [$ht_tree entry cget anchor -label]
1650  if { [string compare $grammar "Anything"] } {
1651    if { [string length $OnSelectItem] } {
1652      $OnSelectItem [::tol::info grammars $grammar]
1653    }
1654    foreach var  [::tol::info variables $grammar] {
1655      if {[catch {
1656        set vinfo [::tol::info variables [list $grammar $var]]
1657      } msg]} {
1658        Tol_HciWriter "<E>in ::TolInspector::SelectGrammar : $msg\n</E>"
1659        continue
1660      }
1661      if { [string equal $grammar "Code"] } {
1662        #Tolcon_Trace "Code : -- $vinfo --"
1663        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] 1 
1664      } elseif { $grammar eq "Set" || $grammar eq "NameBlock" } {
1665        #Tolcon_Trace "Set : -- $vinfo --"
1666        if { $grammar eq "NameBlock" } {
1667          set knownReference [ list "NameBlock" $var ]
1668        }
1669        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] \
1670          $item_id [lindex $vinfo 5] [lindex $vinfo 6] [lindex $vinfo 7]
1671      } else {
1672        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] $item_id 0
1673      } 
1674    }
1675  } else {
1676#    $w_tabset tab configure Variables -state disabled
1677#    $w_tabset select 1
1678  }
1679  foreach fun  [::tol::info functions $grammar] {
1680    set finfo [::tol::info functions $grammar $fun]
1681    InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0   
1682  }
1683}
1684
1685#/////////////////////////////////////////////////////////////////////////////
1686proc ::TolInspector::SelectSet { } {
1687#
1688# PURPOSE: Script called each time a Set node in ht_tree is selected. Gets
1689#          information about each child of this set, and inserts it in the
1690#          right treeview.
1691#
1692#/////////////////////////////////////////////////////////////////////////////
1693  variable ht_tree
1694  variable ht_vars
1695  variable ht_funcs
1696 
1697  variable tolset
1698  variable tolindex
1699  variable iterSet
1700  variable var_id 1
1701  variable fun_id 1
1702  variable item_id
1703  #variable selecting_set
1704 
1705  #  if { $selecting_set } {
1706  #puts "eoooo ..."
1707  #    return
1708  #  }
1709  ClearHiertables
1710  #  set selecting_set 1
1711  set item_id 1
1712 
1713  #puts "SelectSet: tolset=$tolset tolindex=$tolindex"
1714  set iterSet [eval list $tolset $tolindex]
1715  variable gra_parent [ GetParentGrammar $iterSet ]
1716  ::tol::forallchild $iterSet ::TolInspector::_InsertChild
1717  #  set selecting_set 0
1718}
1719
1720proc ::TolInspector::GetParentGrammar { set_ref } {
1721  set root [ lindex $set_ref 0 ]
1722  set L [ llength $set_ref ]
1723  if { ( $root eq "File" && $L <= 2 ) } {
1724    set root
1725  } else {
1726    lindex [ tol::info var $set_ref ] 0
1727  }
1728}
1729
1730#/////////////////////////////////////////////////////////////////////////////
1731proc ::TolInspector::CloseObject { index } {
1732#
1733# PURPOSE: Script called each time a node in ht_tree (left treeview) is
1734#          closed.
1735#
1736# PARAMETERS:
1737#   index : The id of the node closed
1738#
1739#/////////////////////////////////////////////////////////////////////////////
1740  variable ht_tree
1741  #variable closing 1
1742  set path [$ht_tree get -full $index]
1743  if { $index } {
1744    set parent1 [lindex $path 1]
1745    if { [string equal $parent1 "root-packages"] ||
1746         [string equal $parent1 "root-files"] ||
1747         [string equal $parent1 "root-console"] ||
1748         [string equal $parent1 "root-pool"] } {
1749      $ht_tree entry delete $index 0 end
1750    }
1751  }
1752}
1753
1754#/////////////////////////////////////////////////////////////////////////////
1755proc ::TolInspector::HasSubset { args } {
1756#///////////////////////////////////////////////////////////////////////////// 
1757  if { [string equal [lindex $args 0] "Set"] } {
1758    variable has_button 1
1759    return 0
1760  }
1761  return 1
1762}
1763
1764#/////////////////////////////////////////////////////////////////////////////
1765proc ::TolInspector::OpenVariable { index } {
1766#
1767# PURPOSE: ????
1768#
1769# PARAMETERS:
1770#   index ->
1771#
1772#/////////////////////////////////////////////////////////////////////////////
1773  variable tolset     ;# Name of the current TOL set variable
1774  variable ht_vars    ;# ::blt::treeview of variables
1775  variable ht_tree    ;# ::blt::treeview left
1776  variable blt_tree   ;# ::blt::tree left
1777  variable item_data  ;# Array to hold the full content & description of items
1778 
1779  if { ![string length $index] } {
1780    return
1781  }
1782  set node_anchor [lindex [$ht_tree get -full anchor] end]
1783 
1784  set tree_index -1
1785  #puts "OpenVariable = $item_data([lindex [$ht_vars entry cget $index -data] end])"
1786  if { ![regexp -- "grammar-" $node_anchor] } {
1787    set grammar [lindex $item_data([lindex [$ht_vars entry cget $index -data] end]) 2]
1788    if {$grammar eq "Set" || $grammar eq "NameBlock"} {
1789      $ht_tree open anchor
1790      #puts "full = [$ht_vars get -full $index]"
1791      set local_name [lindex [$ht_vars get -full $index] end]
1792      set idx_anchor [$ht_tree index anchor]
1793      #puts "a buscar $local_name dentro de $idx_anchor"
1794      if {[set tree_index [$blt_tree findchild $idx_anchor $local_name]] == -1} {
1795        foreach idx [$ht_tree entry children anchor] {
1796          if { [string equal $local_name [lindex [$ht_tree get -full $idx] end]] } {
1797            set tree_index $idx
1798            break
1799          }
1800        }
1801      }
1802    }
1803  }
1804  if { $tree_index != -1 } {
1805    update
1806    blt::tv::SetSelectionAnchor $ht_tree $tree_index
1807    set blt::tv::scroll 1
1808    #$ht_tree selection clearall
1809    #$ht_tree see $tree_index
1810    #$ht_tree focus $tree_index
1811    #$ht_tree selection set $tree_index
1812    #$ht_tree selection anchor $tree_index
1813    #set blt::Hiertable::scroll 1
1814  }
1815}
1816
1817#/////////////////////////////////////////////////////////////////////////////
1818proc ::TolInspector::SelectItem { ht } {
1819#
1820# PURPOSE: Procedure that is executed when the user selects an element of
1821#          the trees of variables orfunctions.
1822#          First it take all the arguments necessary of the node of tree to
1823#          execute the procedure stored in the variable OnSelectItem, and
1824#          later executes it passing those arguments.
1825#
1826# PARAMETERS: path of ht_* (::blt::treeview of variables or of functions)
1827#
1828#/////////////////////////////////////////////////////////////////////////////
1829 # variable w_text       ;# TODO: ????
1830  variable OnSelectItem ;#Command to invoke on SelectItem in ht_*
1831  variable item_data    ;# Array to hold the full content & description of items
1832 
1833  set entry [$ht index anchor] ;# id of entry selected 
1834  if { [string length $OnSelectItem] } {
1835    # there are associated command
1836    if { [string length $entry] } {
1837      # almost one entry of ht_* selected
1838      array set aryData [$ht entry cget $entry -data]
1839      set name [$ht entry cget $entry -label] ;# name of item
1840      set itemid $aryData(Index)              ;# id of item
1841      set path   $aryData(Path)               ;# path of file of item
1842      #(pgea) se anyade la propiedad Reference
1843      set objRef $aryData(Reference)          ;# info of item
1844      set full_data $item_data($itemid) ;# {value} {desc} {grammar}       
1845      set value [lindex $full_data 0]   ;# value of item PE:
1846                                         # Anything Field(Set s, Text nombre)
1847
1848      if { [string equal \"\n\" $value] } {
1849        # hasn't value       
1850        set value {"\n"}
1851      } else {
1852        set value [string trim $value]
1853      }
1854      set desc [string trim [lindex $full_data 1]]
1855      set grammar [lindex $full_data 2]
1856      set icon [lindex [$ht entry cget $entry -icons] 0]
1857      #(pgea) lista de argumentos que recibe ::TolConsole::OnInfo
1858      set args [list $icon $grammar $name $value $path $desc $objRef]
1859    } else {
1860      set args ""
1861    }
1862    eval "$OnSelectItem $args"
1863  }
1864  return
1865#;# TODO: ????
1866#  if { [string length $entry] } {
1867#    FillText $ht $entry
1868#  } else {
1869#    $w_text delete 1.0 end
1870#  }
1871}
1872
1873#/////////////////////////////////////////////////////////////////////////////
1874#(pgea) se usa?
1875proc ::TolInspector::FillText { ht entry } {
1876#/////////////////////////////////////////////////////////////////////////////
1877  variable w_text
1878  variable item_data
1879  #upvar #0 ::TolTk::Images Images
1880
1881  $w_text delete 1.0 end
1882  array set aryData [$ht entry cget $entry -data]
1883  set name [$ht entry cget $entry -label]
1884  set itemid $aryData(Index)
1885  set full_data $item_data($itemid)
1886 
1887  set value [lindex $full_data 0]
1888  if { [string equal \"\n\" $value] } {
1889    set value {"\n"}
1890  }
1891  set desc [string trim [lindex $full_data 1]]
1892  set grammar [lindex $full_data 2]
1893  set icon [lindex [$ht entry cget $entry -icons] 0]
1894  foreach {prop val} [list "Grammar: " $grammar "Name: " $name "Value: " [string trim $value]] {
1895    set idx_start [$w_text index "end -1 chars"]
1896    $w_text insert end $prop
1897    set idx_end   [$w_text index "end -1 chars"]
1898    $w_text tag add tagLabel $idx_start $idx_end
1899    if {[string equal $prop "Grammar: "]} {
1900      $w_text image create end -image $icon
1901      $w_text insert end "  "
1902    }
1903    $w_text insert end "$val\n"
1904    $w_text tag add tagValue $idx_end [$w_text index "end -1 chars"]
1905  }
1906  $w_text tag configure tagLabel -font fnBold
1907  $w_text tag configure tagValue -wrap none
1908  if { [string length $desc] } {
1909    set idx_start [$w_text index "end -1 chars"]
1910    $w_text insert end "Description\n"
1911    set idx_end [$w_text index "end -1 chars"]
1912    $w_text tag add tagPropLabel $idx_start $idx_end
1913    $w_text insert end $desc
1914    $w_text tag add tagPropValue $idx_end [$w_text index "end -1 chars"]
1915    $w_text tag configure tagPropLabel -font fnBold -underline 1
1916    $w_text tag configure tagPropValue -wrap word
1917  }
1918}
1919
1920#proc ::TolInspector::GetIndexes { nodeid } {
1921#  variable ht_tree
1922#  # No se utiliza
1923#  # name is prefix-i1-i2-i3-...-in
1924#
1925#  if { $nodeid } {
1926#    lrange [split [$ht_tree get $nodeid] "-"] 1 end
1927#  } else list
1928#}
1929
1930#/////////////////////////////////////////////////////////////////////////////
1931proc ::TolInspector::GetItemName { prefix idx_list } {
1932#///////////////////////////////////////////////////////////////////////////// 
1933  set node_id $prefix
1934  foreach id $idx_list {
1935    append node_id "-$id"
1936  }
1937  set node_id
1938}
1939
1940#/////////////////////////////////////////////////////////////////////////////
1941proc ::TolInspector::OnBusy { cmd } {
1942#///////////////////////////////////////////////////////////////////////////// 
1943  variable OnBusyCmd $cmd
1944}
1945
1946#/////////////////////////////////////////////////////////////////////////////
1947proc ::TolInspector::Busy { } {
1948#///////////////////////////////////////////////////////////////////////////// 
1949  variable OnBusyCmd
1950  variable ht_tree
1951  variable ht_vars
1952
1953  $ht_tree configure -cursor watch
1954  $ht_vars configure -cursor watch
1955  if { [string length $OnBusyCmd] } {
1956    eval $OnBusyCmd 1
1957  }
1958}
1959
1960#/////////////////////////////////////////////////////////////////////////////
1961proc ::TolInspector::NotBusy { } {
1962#///////////////////////////////////////////////////////////////////////////// 
1963  variable OnBusyCmd
1964  variable ht_tree
1965  variable ht_vars
1966
1967  $ht_tree configure -cursor ""
1968  $ht_vars configure -cursor ""
1969
1970  if { [string length $OnBusyCmd] } {
1971    eval $OnBusyCmd 0
1972  }
1973}
1974
1975proc Tol_GetViewPrivateMembers { } {
1976  set viewOpt 0
1977  catch {
1978    # no funciona
1979    tol::console eval {
1980      Real __getViewPrivateMembers_tmp__ =
1981      TolConfigManager::Config::Various::View::PrivateMembers;
1982    }
1983    set x [ lindex [ tol::info variable { Real __getViewPrivateMembers_tmp__ } ] 2 ]
1984    tol::console stack release __getViewPrivateMembers_tmp__
1985    set viewOpt [ expr { int( $x ) } ]
1986   
1987  } msg
1988  #puts "Tol_GetViewPrivateMembers: $msg"
1989  return $viewOpt
1990}
1991
1992proc Tol_ObjIsClassOf { obj_addr cls_name } {
1993  tol::console eval [ string map [ list %A $obj_addr %C $cls_name ] {
1994    Real __gui_check__ = IsInstanceOf( GetObjectFromAddress( "%A" ),"%C" )
1995  } ]
1996  set info [ tol::info variable {Real __gui_check__} ]
1997  set x [ lindex $info 2 ]
1998  tol::console stack release __gui_check__
1999  expr { round($x) }
2000}
2001
2002proc Tol_ClassOf { obj_addr } {
2003  tol::console eval [ string map [ list %A $obj_addr ] {
2004    Text __gui_classof__ = {
2005      Anything obj = GetObjectFromAddress( "%A" );
2006      // WriteLn( "Tol_ClassOf " << Grammar( obj ) );
2007      Text If( Grammar( obj ) == "NameBlock", ClassOf( obj ), "" )
2008    }
2009  } ]
2010  set info [ tol::info variable {Text __gui_classof__} ]
2011  set x [ string trim [ lindex $info 2 ]  \" ]
2012  tol::console stack release __gui_classof__
2013  set x
2014}
2015
2016proc Tol_ClassOfFromReference { objReference } {
2017  set addr [ ::tol::info address $objReference ]
2018  return [ Tol_ClassOf $addr ]
2019}
2020
2021proc Tol_StructOf { obj_addr } {
2022  set tolcode [ string map [ list %A $obj_addr ]  {
2023    Text {
2024      Anything obj = GetObjectFromAddress( "%A" );
2025      // WriteLn( "Tol_StructOf " << Grammar( obj ) );
2026      Text If( Grammar( obj ) == "Set", StructName( obj ), "" )
2027    }
2028  } ]
2029  return [ lindex [ toltcl::eval $tolcode ] 0 ]
2030}
2031
2032proc Tol_StructOfFromReference { objReference } {
2033  set addr [ ::tol::info address $objReference ]
2034  return [ Tol_StructOf $addr ]
2035}
2036
2037#(pgea) nueva funcion para obtener la informacion de instancia
2038proc Tol_InstanceInfo { obj_addr } {
2039  tol::console eval [ string map [ list %A $obj_addr ] {
2040    Text __gui_instanceinfo__ = {
2041      Anything __intance__ = GetObjectFromAddress("%A");
2042      Text If(ObjectExist("Code", "__intance__::_.get.autodoc.info"),
2043        __intance__::_.get.autodoc.info(?), "")
2044    }
2045  } ]
2046  set info [ tol::info variable {Text __gui_instanceinfo__} ]
2047  set x [ string trim [ lindex $info 2 ]  \" ]
2048  tol::console stack release __gui_instanceinfo__
2049  set x
2050}
2051
2052#(pgea) nueva funcion para obtener la informacion de instancia
2053proc Tol_InstanceInfoFromReference { objReference } {
2054  set addr [ ::tol::info address $objReference ]
2055  return [ Tol_InstanceInfo $addr ]
2056}
2057
2058#(pgea) nueva funcion para obtener el contenido de la instancia
2059proc Tol_InstanceContent { obj_addr } {
2060  tol::console eval [ string map [ list %A $obj_addr ] {
2061    Text __gui_instancecontent__ = {
2062      Anything __intance__ = GetObjectFromAddress("%A");
2063      Text If(ObjectExist("Code", "__intance__::_.get.autodoc.content"),
2064        __intance__::_.get.autodoc.content(?), "")
2065    }
2066  } ]
2067  set info [ tol::info variable {Text __gui_instancecontent__} ]
2068  set x [ string trim [ lindex $info 2 ]  \" ]
2069  tol::console stack release __gui_instancecontent__
2070  set x
2071}
2072
2073#(pgea) nueva funcion para obtener el contenido de la instancia
2074proc Tol_InstanceContentFromReference { objReference } {
2075  set addr [ ::tol::info address $objReference ]
2076  return [ Tol_InstanceContent $addr ]
2077}
2078
2079proc TolGui_GetMenuEntries { selection idx } {
2080  #puts "TolGui_GetMenuEntries $selection $idx"
2081  array set instances {}
2082  array set menu_class {}
2083  set i 0
2084  foreach obj_info $selection {
2085    set tcl_ref [ lindex $obj_info 0 ]
2086    set obj_addr [ ::tol::info address $tcl_ref ]
2087    if { [ Tol_ObjIsClassOf $obj_addr "GuiTools::@MenuDesc" ] } {
2088      set class [ Tol_ClassOf $obj_addr ]
2089      lappend instances($class) $obj_addr
2090      set name_inst [ lindex $obj_info 1 ]
2091      set menu_items [ TolGui_GetObjMenu $obj_addr ]
2092      # esto hace que estemos guardando la ultima instancia, asumimos
2093      # tambien que todas las instancia tienen la misma espcificacion
2094      # de menu
2095      if { ![ llength [ array names menu_class $class ] ] || $i == $idx } {
2096        set menu_class($class) \
2097            [ list $name_inst $obj_addr $menu_items ]
2098      }
2099    }
2100    incr i
2101  }
2102  set menu_info [ list ]
2103  foreach c [ array names instances ] {
2104    lappend menu_info [ list $c $menu_class($c) $instances($c) ]
2105  }
2106  #puts "$menu_info"
2107  set menu_info
2108}
2109
2110proc TolGui_InsertEntriesFromMenuManager { targetMenu selection } {
2111  set addrList [ list ]
2112  foreach obj_info $selection {
2113    set tcl_ref [ lindex $obj_info 0 ]
2114    lappend addrList [ ::tol::info address $tcl_ref ]
2115  }
2116  ::MenuManager::insertEntriesForSelection $targetMenu $addrList
2117}
2118
2119proc TolGui_GetObjMenu { obj_addr } {
2120  set try [ catch {
2121    tol::console eval [ string map [ list %A $obj_addr ] {
2122      GuiTools::@MenuDesc __aux_menu__ = GetObjectFromAddress("%A");
2123      Set __gui_menu_entries__ = __aux_menu__::getMenuEntries(?)
2124    } ] } msg ]
2125  if { $try } {
2126    puts "ERROR TolGui_GetObjMenu : $msg"
2127    set result ""
2128  } else {
2129    set result [ TolObj2TclObj {Set __gui_menu_entries__} ]
2130  }
2131  tol::console stack release __aux_menu__
2132  tol::console stack release __gui_menu_entries__
2133  set result
2134}
2135
2136proc TolGui_InvokeMethod { method obj_addr } {
2137  #puts "TolGui_InvokeMethod $method $obj_addr"
2138  set try [ catch {
2139    tol::console eval [ string map [ list %A $obj_addr %M $method ] {
2140      NameBlock __aux_instance__ = GetObjectFromAddress("%A");
2141      Real __aux_result__ = __aux_instance__::%M(?)
2142    } ] } msg ]
2143  if { $try } {
2144    puts "ERROR TolGui_InvokeMethod : $msg"
2145  }
2146  tol::console stack release __aux_instance__
2147  tol::console stack release __aux_result__
2148}
2149
2150proc TclList2SetOfText { lst } {
2151  set result [ list ]
2152  foreach i $lst {
2153    lappend result \"[string map {\" \\\"} $i]\"
2154  }
2155  return "SetOfText([join $result ,])"
2156}
2157
2158proc TolGui_InvokeGroup { cname function group } {
2159  set SOA [ TclList2SetOfText $group ]
2160  set try [ catch {
2161    tol::console eval \
2162        [ string map [ list %C $cname %F $function %S $SOA ] {
2163          Real __aux_result__ = {
2164            Set aux = EvalSet( %S, NameBlock( Text addr ) {
2165              NameBlock GetObjectFromAddress( addr )
2166            } );
2167            Real %C::%F( aux )
2168          }
2169        } ] } msg ]
2170  if { $try } {
2171    puts "ERROR TolGui_InvokeGroup : $msg"
2172  }
2173  tol::console stack release __aux_result__
2174}
2175
2176#/////////////////////////////////////////////////////////////////////////////
2177proc ::TolInspector::PostVariable { x y } {
2178#
2179# PURPOSE: Composes a popup menu for variables and displays it. Its composed
2180#          depending on the node/s clicked by user.
2181#
2182# PARAMETERS:
2183#   x -> x-coordinate where popup menu is drawn
2184#   y -> y-coordinate where popup menu is drawn
2185#
2186#/////////////////////////////////////////////////////////////////////////////
2187  variable data_menu
2188  variable vars_selected
2189  variable options_selected
2190  variable ht_vars
2191  variable ht_tree
2192  variable item_data
2193  variable data
2194
2195  variable tolset
2196  variable tolindex
2197
2198  #User functions to contextual menu
2199  ::TolInspector::ReadUserFunctions
2200
2201  array unset options_selected
2202
2203  foreach it [array names data_menu] {
2204    $data_menu($it) delete 0 end
2205  }
2206  set InRootConsole [string equal [lindex [$ht_tree get -full anchor] end] "root-console"]
2207  set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
2208  set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end] "root-files"]
2209  #puts "PostVariable: InRootConsole,InRootPool,InRootFiles = $InRootConsole,$InRootPool,$InRootFiles"
2210  set node_act [$ht_vars index current]
2211  if { [string length $node_act] } {
2212    set vars_selected [$ht_vars curselection]
2213    if { [lsearch $vars_selected $node_act] >= 0 } {
2214      foreach var $vars_selected {
2215        array set aryData [$ht_vars entry cget $var -data]
2216        #puts "PostVariable: aryData = [array get aryData]"
2217        set itemid $aryData(Index)
2218        set path   $aryData(Path)
2219        set grammar [lindex $item_data($itemid) 2]
2220        set objName [$ht_vars entry cget $var -label]
2221        #puts "OBJECT=$objName, PATH=$path"
2222        if { $InRootPool } {
2223          set object $data(pool,variables,$itemid)
2224                } else {
2225          if {[llength $aryData(Reference)]} {
2226            #set object [lindex $aryData(Reference) 0]
2227            set object [lrange $aryData(Reference) 0 end]
2228          } else {
2229            if { [string length $tolset] } {
2230              #set object [concat [list File $tolset] $tolindex $itemid]
2231              set object [concat $tolset $tolindex $itemid]
2232              #puts "tolset = $tolset"
2233            } else {
2234              if [llength $objName] {
2235                set object [list $grammar $objName]
2236              } else {
2237                set object $objName
2238              }
2239            }
2240          }
2241        }
2242        #puts "PostVariable: OBJECT=$object OBJNAME=$objName TOLSET=$tolset PATH=$path GRAMMAR=$grammar"
2243        switch -- $grammar {
2244          Code    -
2245          Complex -
2246          Date    -
2247          Matrix  -
2248          VMatrix -
2249          Polyn   -
2250          Ratio   -
2251          Real    -
2252          Serie   -
2253          Anything -
2254          Text    -
2255          NameBlock -
2256          TimeSet {
2257            lappend options_selected($grammar) [list $object $objName $path]
2258          }
2259          Set {
2260            # Si el objeto se da como referencia
2261            if { [llength $object] > 1 }  {
2262              #puts "PostVariable: Set: object = $object"
2263              if {$InRootFiles} {
2264                set isFile 1
2265              } else {
2266                set info [::tol::info var $object]
2267                set isFile [expr [lindex $info 7] == 4]
2268              }
2269              #set desc [lindex $info 4]
2270            } else {
2271              if {[catch "::tol::info included $object" info]} {
2272                set info [::tol::info var [list Set $objName]]
2273                #set isFile [expr [lindex $info 5] == 4]
2274                set isFile [expr [lindex $info 7] == 4]
2275                #set desc [lindex $info 4]
2276              } else {
2277                #set info [::tol::info included $objName]
2278                #set isFile [expr [lindex $info 4] == 4]
2279                set isFile 1
2280                #set desc ""
2281              }
2282            }
2283            if $isFile {
2284              lappend options_selected(File) [list $object $objName $path]
2285            } else {
2286              lappend options_selected($grammar) [list $object $objName $path]
2287            }
2288          }
2289        }
2290      }
2291      set grammar_selected [array names options_selected]
2292      if { [llength $grammar_selected] } {
2293        foreach grammar $grammar_selected {
2294          switch -- $grammar {
2295            VMatrix -
2296            Matrix  {
2297              $data_menu(main) add cascade -label [mc "Export matrix"]\
2298              -menu $data_menu(Matrix,Export)
2299              if {[llength $options_selected($grammar)] == 1} {
2300                set object [lindex [lindex $options_selected($grammar) 0] 0]
2301                $data_menu(main) add command -label [mc "Table matrix"] \
2302                  -command [list ::TolInspector::TableMatrix $object]
2303                $data_menu(Matrix,Export) add command -label "BDT" \
2304                  -command [list ::TolInspector::ExportBDTMatrix $object]
2305                $data_menu(main) add command -label [mc "Draw matrix"] \
2306                  -command [list ::TolInspector::DrawMatrix $object]
2307              } else {
2308                $data_menu(main) add cascade -label [mc "Table matrix"] \
2309                  -menu $data_menu(Matrix,Table)
2310                $data_menu(Matrix,Export) add cascade -label "BDT" \
2311                  -menu $data_menu(Matrix,Export,BDT)
2312                $data_menu(main) add cascade -label [mc "Draw matrix"] \
2313                  -menu $data_menu(Matrix,Draw)
2314                foreach objInfo $options_selected(Matrix) {
2315                  $data_menu(Matrix,Table) add command -label [lindex $objInfo 1]\
2316                    -command [list ::TolInspector::TableMatrix [lindex $objInfo 0]]
2317                  $data_menu(Matrix,Export,BDT) add command -label [lindex $objInfo 1]\
2318                    -command [list ::TolInspector::ExportBDTMatrix [lindex $objInfo 0]]
2319                  $data_menu(Matrix,Draw) add command -label [lindex $objInfo 1] \
2320                    -command [list ::TolInspector::DrawMatrix [lindex $objInfo 0]]
2321                }
2322              }
2323            }
2324            Serie   {
2325              if {[llength $options_selected(Serie)] == 1} {
2326                set lblSerie "serie"
2327              } else  {
2328                set lblSerie "series"
2329              }
2330              $data_menu(main) add command -label [mc "Draw $lblSerie"]\
2331              -command ::TolInspector::DrawSerie
2332              $data_menu(main) add command -label [mc "Table $lblSerie"]\
2333              -command ::TolInspector::TableSerie             
2334              if {[llength $options_selected(Serie)] == 1} {
2335                set object [lindex [lindex $options_selected(Serie) 0] 0]
2336                $data_menu(main) add command -label [mc "Draw autocorrelation"] \
2337                  -command [list ::TolInspector::DrawAutocorSerie $object]
2338                $data_menu(main) add command -label [mc "Table autocorrelation"] \
2339                  -command [list ::TolInspector::TableAutocorSerie $object]
2340              } else {
2341                $data_menu(main) add cascade -label [mc "Draw autocorrelation"] \
2342                  -menu $data_menu(Serie,DrawAutocor)
2343                $data_menu(main) add cascade -label [mc "Table autocorrelation"] \
2344                  -menu $data_menu(Serie,TableAutocor)
2345                foreach objInfo $options_selected(Serie) {
2346                  $data_menu(Serie,DrawAutocor) add command -label [lindex $objInfo 1]\
2347                    -command [list ::TolInspector::DrawAutocorSerie [lindex $objInfo 0]]
2348                  $data_menu(Serie,TableAutocor) add command -label [lindex $objInfo 1]\
2349                    -command [list ::TolInspector::TableAutocorSerie [lindex $objInfo 0]]
2350                }
2351              }
2352              $data_menu(main) add command -label [mc "Table statistics"]\
2353                  -command ::TolInspector::TableStatisticsSerie
2354            }
2355            TimeSet {
2356              if {[llength $options_selected(TimeSet)] == 1} {
2357                set object [lindex [lindex $options_selected(TimeSet) 0] 0]
2358                $data_menu(main) add command -label [mc "View timeset"] \
2359                  -command [list ::TolInspector::ViewTimeSet $object]
2360              } else {
2361                $data_menu(main) add cascade -label [mc "View timeset"] \
2362                  -menu $data_menu(TimeSet,View)
2363                foreach objInfo $options_selected(TimeSet) {
2364                  $data_menu(TimeSet,View) add command -label [lindex $objInfo 1] \
2365                    -command [list ::TolInspector::ViewTimeSet [lindex $objInfo 0]]
2366                }
2367              }
2368            }
2369            NameBlock {
2370              # entradas desde MenuManager
2371              if 0 {
2372              TolGui_InsertEntriesFromMenuManager \
2373                  $data_menu(main) \
2374                  $options_selected(NameBlock)
2375              }
2376              # entradas desde @MenuDesc
2377              # @MenuDesc sera reemplazado, ver https://www.tol-project.org/ticket/1372
2378              set sel_length [ llength $options_selected(NameBlock) ]
2379              if { $sel_length } {
2380                set idx_current [ lsearch $vars_selected $node_act ]
2381                set all_nb_options \
2382                    [ TolGui_GetMenuEntries \
2383                          $options_selected(NameBlock) $idx_current ]
2384                set num_options [ llength $all_nb_options ]
2385                #puts "num_options = $num_options"
2386                foreach mi $all_nb_options {
2387                  set _cname [ lindex $mi 0 ]
2388                  set cname [ string map [ list @ "" . _ ] $_cname ]
2389                  #puts "cname = $cname"
2390                  foreach { ninst obj_addr entries } [ lindex $mi 1 ] break
2391                  set instances [ lindex $mi 2 ]
2392                  if { $num_options > 1 } {
2393                  # creo el menu de la clase si no existe
2394                    set mclass $data_menu(main).cls$cname
2395                    if { ![ winfo exists $mclass ] } {
2396                      menu $mclass -tearoff 0
2397                    } else {
2398                      $mclass delete 0 end
2399                    }
2400                    $data_menu(main) add cascade -label $cname -menu $mclass
2401                    set target_menu $mclass
2402                  } else {
2403                    set target_menu $data_menu(main)
2404                  }
2405                  foreach inst_entry $entries {
2406                    foreach { label single group } $inst_entry break
2407                    set opt_label \
2408                        "$label [ expr { $sel_length>1 ? $ninst : {} } ]"
2409                    $target_menu add command -label $opt_label \
2410                        -command [ list TolGui_InvokeMethod \
2411                                       $single $obj_addr ]
2412                    if { $group ne "" && [ llength $instances ] > 1 } {
2413                      # hay una funcion que se aplica a toda la seleccion
2414                      $target_menu add command -label "$label All" \
2415                          -command [ list TolGui_InvokeGroup \
2416                                         $_cname $group $instances ]
2417                    }
2418                  }
2419                }
2420              }
2421            }
2422            Set {
2423              if {[llength $options_selected(Set)] == 1} {
2424                set object  [lindex [lindex $options_selected(Set) 0] 0]
2425                $data_menu(main) add command -label [mc "Table set"] \
2426                  -command [list ::TolInspector::TableSet $object]
2427                $data_menu(main) add command -label [mc "Draw set"] \
2428                  -command [list ::TolInspector::DrawSet $object]
2429                # menu special
2430                $data_menu(main) add cascade -label [mc "Draw set special"] \
2431                  -menu $data_menu(Set,Draw,Special)
2432                $data_menu(Set,Draw,Special) add command \
2433                   -label [mc SetGraphAllFirst] \
2434                  -command [list ::TolInspector::DrawSet $object 1]
2435                $data_menu(Set,Draw,Special) add command \
2436                  -label [mc SetGraphAllGeneric] \
2437                  -command [list ::TolInspector::DrawSet $object 2]
2438                $data_menu(Set,Draw,Special) add command \
2439                  -label [mc SetGraphEvenUneven] \
2440                  -command [list ::TolInspector::DrawSet $object 3]               
2441              } else {
2442                $data_menu(main) add cascade -label [mc "Table set"] \
2443                  -menu $data_menu(Set,Table)
2444                $data_menu(main) add cascade -label [mc "Draw set"] \
2445                  -menu $data_menu(Set,Draw)
2446                foreach objInfo $options_selected(Set) {
2447                  $data_menu(Set,Table) add command -label [lindex $objInfo 1] \
2448                    -command [list ::TolInspector::TableSet [lindex $objInfo 0]]
2449                  $data_menu(Set,Draw) add command -label [lindex $objInfo 1] \
2450                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0]]
2451                }
2452                # menu special
2453                set i 0
2454                $data_menu(main) add cascade -label [mc "Draw set special"] \
2455                  -menu $data_menu(Set,Draw,Special,M)                 
2456                foreach objInfo $options_selected(Set) {
2457                  # exists menu previus ?
2458                  if {[winfo exists $data_menu(Set,Draw,Special,M).setdrawspecialm$i]} {
2459                    destroy $data_menu(Set,Draw,Special,M).setdrawspecialm$i
2460                  }
2461                  set mn \
2462                    [menu $data_menu(Set,Draw,Special,M).setdrawspecialm$i \
2463                      -tearoff 0]
2464                  $data_menu(Set,Draw,Special,M) add cascade \
2465                    -label [lindex $objInfo 1] -menu $mn
2466                  $mn add command -label [mc SetGraphAllFirst] \
2467                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 1]
2468                  $mn add command -label [mc SetGraphAllGeneric] \
2469                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 2]
2470                  $mn add command -label [mc SetGraphEvenUneven] \
2471                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 3]                                 
2472                  incr i
2473                }               
2474              }
2475            }
2476            File {
2477              if {[llength $options_selected(File)] == 1} {
2478                set objName [lindex [lindex $options_selected(File) 0] 1]
2479                $data_menu(main) add command -label [mc "View file"] \
2480                  -command [list ::TolInspector::ViewFile $objName]
2481                if $InRootFiles {
2482                   $data_menu(main) add command -label [mc "Decompile file"] \
2483                     -command [list ::TolInspector::DecompileFile $objName]
2484                }
2485              } else {
2486                $data_menu(main) add cascade -label [mc "View file"] \
2487                  -menu $data_menu(File,View)
2488                foreach objInfo $options_selected(File) {
2489                  $data_menu(File,View) add command -label [lindex $objInfo 1] \
2490                    -command [list ::TolInspector::ViewFile [lindex $objInfo 1]]
2491                }
2492                if $InRootFiles {
2493                  $data_menu(main) add cascade -label [mc "Decompile file"] \
2494                    -menu $data_menu(File,Decompile)
2495                  foreach objInfo $options_selected(File) {
2496                    $data_menu(File,Decompile) add command -label [lindex $objInfo 1] \
2497                      -command [list ::TolInspector::DecompileFile [lindex $objInfo 1]]
2498                  }
2499                }
2500              }           
2501            }
2502          } ;# end del switch
2503          # inserto las opciones definidas en MenuManager
2504          if { $grammar ne "Anything" } {
2505            TolGui_InsertEntriesFromMenuManager \
2506                $data_menu(main) \
2507                $options_selected($grammar)
2508          }
2509
2510          $data_menu(main) add separator
2511          $data_menu(main) add cascade -label [mc "Functions"] \
2512             -menu $data_menu($grammar,Functions)
2513          ShowMenuUserFunc $grammar
2514          if {[llength $options_selected($grammar)] == 1} {
2515            set objName [lindex [lindex $options_selected($grammar) 0] 1]
2516            set path    [lindex [lindex $options_selected($grammar) 0] 2]
2517            $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
2518               -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
2519          } else {
2520            $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
2521               -menu $data_menu($grammar,File)
2522            foreach objInfo $options_selected($grammar) {
2523              $data_menu($grammar,File) add command -label [lindex $objInfo 1]\
2524              -command [list ::TolInspector::ViewDefinition\
2525                              [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
2526            }
2527          }
2528          $data_menu(main) add separator
2529        } ;#end del foreach
2530        if { $InRootPool } {
2531          $data_menu(main) add command -label [mc "Remove from spool"] \
2532            -command [list ::TolInspector::RemoveFromSpool $ht_vars]
2533        } else  {
2534          $data_menu(main) add command -label [mc "Add to spool"] \
2535            -command [list ::TolInspector::AddToSpool $ht_vars [lindex [$ht_tree get -full anchor] 1]]
2536        }
2537        $data_menu(main) add command -label [mc "To Eval window"] \
2538                -command [list ::TolInspector::AddToEvalWindow $ht_vars]
2539        $data_menu(main) add separator
2540        if { $InRootConsole} {
2541          $data_menu(main) add command -label [mc "Decompile"] \
2542            -command [list ::TolInspector::ClearConsoleObjSel $ht_vars]
2543          $data_menu(main) add separator
2544        }
2545        $data_menu(main) add command -label [mc "Select all"] \
2546                -command [list ::TolInspector::SelectAll $ht_vars]
2547        $data_menu(main) add command -label [mc "Toggle selection"] \
2548                -command [list ::TolInspector::ToggleSelection $ht_vars]
2549        tk_popup $data_menu(main) $x $y
2550      } ;#end del if
2551    }
2552  }
2553}
2554
2555#/////////////////////////////////////////////////////////////////////////////
2556proc ::TolInspector::PostFunction { x y } {
2557#
2558# PURPOSE: Composes a popup menu for functions and displays it. Its composed
2559#          depending on the node/s clicked by user.
2560#
2561# PARAMETERS:
2562#   x -> x-coordinate where popup menu is drawn
2563#   y -> y-coordinate where popup menu is drawn
2564#
2565#/////////////////////////////////////////////////////////////////////////////
2566  variable data_menu
2567  variable vars_selected
2568  variable ht_funcs
2569  variable ht_tree
2570  variable item_data
2571  variable data
2572 
2573  variable tolset
2574  variable tolindex
2575 
2576  array unset options_selected
2577  foreach it [array names data_menu] {
2578    $data_menu($it) delete 0 end
2579  }
2580 
2581  set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
2582  set node_act [$ht_funcs index current]
2583  if { [string length $node_act] } {
2584    set vars_selected [$ht_funcs curselection]
2585    if { [lsearch $vars_selected $node_act] >= 0 } {
2586      foreach var $vars_selected {
2587        array set aryData [$ht_funcs entry cget $var -data]
2588        set itemid $aryData(Index)
2589        set path   $aryData(Path)
2590        set grammar [lindex $item_data($itemid) 2]
2591        set objName [$ht_funcs entry cget $var -label]
2592       
2593        if { $InRootPool } {
2594          set object $data(pool,variables,$itemid)
2595        } else {
2596          if { [string length $tolset] } {
2597            set object [concat [list $tolset] $tolindex $itemid]
2598          } else {
2599            set object $objName
2600          }
2601        }
2602        # La única gramática seleccionable en ht_funcs es Code
2603        lappend code_selected [list $object $objName $path]
2604      }
2605   
2606      if {[llength $code_selected] == 1} {
2607        set objName [lindex [lindex $code_selected 0] 1]
2608        set path    [lindex [lindex $code_selected 0] 2]
2609        $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
2610                -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
2611      } else {
2612        $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
2613                -menu $data_menu($grammar,File)
2614        foreach objInfo $code_selected {
2615          $data_menu($grammar,File) add command -label [lindex $objInfo 1]\
2616                -command [list ::TolInspector::ViewDefinition\
2617                [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
2618        }
2619      }
2620 
2621      if { $InRootPool } {
2622         $data_menu(main) add command -label [mc "Remove from spool"] \
2623                  -command [list ::TolInspector::RemoveFromSpool $ht_funcs]
2624      } else  {
2625         $data_menu(main) add command -label [mc "Add to spool"] \
2626                  -command [list ::TolInspector::AddToSpool $ht_funcs [lindex [$ht_tree get -full anchor] 1]]
2627      }
2628      $data_menu(main) add command -label [mc "To Eval window"] \
2629                -command [list ::TolInspector::AddToEvalWindow $ht_funcs]
2630      $data_menu(main) add separator
2631      $data_menu(main) add command -label [mc "Select all"] \
2632              -command [list ::TolInspector::SelectAll $ht_funcs]
2633      $data_menu(main) add command -label [mc "Toggle selection"] \
2634              -command [list ::TolInspector::ToggleSelection $ht_funcs]
2635      tk_popup $data_menu(main) $x $y
2636    }
2637  }
2638}
2639
2640#/////////////////////////////////////////////////////////////////////////////
2641proc ::TolInspector::PostTree { x y } {
2642#
2643# PURPOSE: Composes a popup menu for left treeview and displays it. Its
2644#          composed depending on the node clicked by user.
2645#
2646# PARAMETERS:
2647#   x -> x-coordinate where popup menu is drawn
2648#   y -> y-coordinate where popup menu is drawn
2649#
2650#/////////////////////////////////////////////////////////////////////////////
2651  variable data_menu
2652  variable vars_selected
2653  variable ht_tree
2654  variable item_data
2655  variable data
2656  variable tolset
2657  variable tolindex
2658  variable item_id
2659  #puts "ht_tree: $ht_tree"
2660  #No terminado todavía
2661  #return
2662  array unset options_selected
2663 
2664  puts "::TolInspector::PostTree $x $y"
2665  foreach it [array names data_menu] {
2666    $data_menu($it) delete 0 end
2667  }
2668  set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end-1] "root-pool"]
2669  #puts "InRootPool: $InRootPool"
2670  # InRootFiles has a value 1 if node is a File
2671  set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end-1] "root-files"]
2672  #puts "InRootFiles: $InRootFiles"
2673  # index of the selected node
2674  set node_act [$ht_tree index current]
2675  #puts "node_act: $node_act" 
2676  if { [string length $node_act] } {
2677    set vars_selected [$ht_tree curselection]
2678    #puts "vars_selected: $vars_selected"     
2679    if { [lsearch $vars_selected $node_act] >= 0 } { ;# Not root node
2680      set index [$ht_tree index anchor]
2681      #puts "index: $index"   
2682      if { $index } {
2683        set info_node [split [lindex [$ht_tree get -full $index] end] "-"]
2684        #puts "info_node: $info_node" 
2685        set node_type [lindex $info_node 0]
2686        #puts "node_type: $node_type"         
2687        set node_name [lindex $info_node 1]
2688        #puts "node_name: $node_name"         
2689      } else { ;# root node
2690        set node_type root
2691        set node_name root
2692      }
2693      # if user selects a root or a grammar doesn't nothing
2694      switch -regexp $node_type  {
2695        root -
2696        grammar { return }
2697      }
2698      # label of object showed in the tree
2699      set objName [$ht_tree entry cget $index -label]
2700      #puts "objName: $objName"
2701      set object $objName
2702
2703      if {$InRootFiles} {
2704        array set aryData [$ht_tree entry cget $index -data]
2705        if [info exist aryData(FileName)]  {
2706          set objName $aryData(FileName)
2707        }
2708      }
2709      #puts "2objName: $objName"   
2710      if { $InRootPool } {
2711        #puts "es InRootPool"       
2712        set itemid $item_id
2713        set object $data(pool,variables,$itemid)
2714      } else {
2715        #puts "NO InRootPool"
2716        if { [string length $tolset] } {         
2717          set object [concat [list $tolset] $tolindex]
2718        } else {
2719          set object $objName
2720        }
2721      }
2722      #puts "object = $objName '[$ht_tree entry cget $index -data]'"
2723#Tolcon_Trace "***********************************" {red}
2724#Tolcon_Trace "index=$index, node_type=$node_type, node_name=$node_name" {red}
2725#Tolcon_Trace "tolset=$tolset, tolindex=$tolindex, aryData= [$ht_tree entry cget $index -data]" {red}
2726#Tolcon_Trace "object=$object, label=$objName" {red}
2727#Tolcon_Trace "***********************************" {red}
2728      set stackList [::tol::console stack list]
2729      #puts "stackList: $stackList"
2730      set stackValue {}
2731      foreach stackItem $stackList {
2732        #puts "stackItem: $stackItem"
2733        #puts "lindex $stackValue 1: [lindex $stackValue 1]"
2734        #puts "objName: $objName" 
2735        if {[lindex $stackItem 1] eq $objName} {
2736          set stackValue $stackItem
2737        }
2738        break
2739      }
2740      #puts "stackValue: $stackValue"
2741      set grammar [lindex $stackValue 0]     
2742      #puts "grammar: $grammar"
2743      #set full_data $item_data($index) ;# {value} {desc} {grammar}   
2744      #set grammar [lindex $full_data 2]
2745     
2746      #foreach fun  [::tol::info functions $grammar] {
2747      #  set finfo [::tol::info functions $grammar $fun]
2748      #  InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0   
2749      #}
2750      if {[catch {set info [::tol::info included $objName]}]} {
2751        if { !($grammar eq "")} {
2752          if {[catch {set info [::tol::info var [list $grammar $object]}]} {
2753            #set info [concat [list "$grammar" $objName ] [::tol::info var $grammar $objName]]
2754                        set info [::tol::info var [list $grammar $objName]]
2755            #Tolcon_Trace "INFO de ::tol::info var Set objName"
2756          } else  {
2757            set info [::tol::info var [list $grammar $object]]
2758            #Tolcon_Trace "INFO de ::tol::info var $grammar object"
2759          }       
2760          set isFile [expr [lindex $info 5] == 4]
2761        } else {
2762          set isFile 0
2763        }
2764
2765      } else {
2766        set info [::tol::info included $objName]
2767        #Tolcon_Trace "INFO de ::tol::info included objName"
2768        set isFile 1
2769      }
2770      #puts "paso"
2771
2772      if $isFile {
2773        #puts "entro como fichero"       
2774        $data_menu(main) add command -label [mc "View file"] \
2775                -command [list ::TolInspector::ViewFile $objName]
2776        if $InRootFiles {
2777          $data_menu(main) add command -label [mc "Decompile file"] \
2778                -command [list ::TolInspector::DecompileFile $objName]
2779        }
2780      } else {
2781        #puts "no entro como fichero"       
2782        if { $grammar eq "Set" } {
2783          $data_menu(main) add command -label [mc "Table set"] \
2784                -command [list ::TolInspector::TableSet $object]
2785          $data_menu(main) add command -label [mc "Draw set"] \
2786                -command [list ::TolInspector::DrawSet $object]
2787        }
2788      }
2789      tk_popup $data_menu(main) $x $y
2790    }
2791  }
2792}
2793
2794
2795#/////////////////////////////////////////////////////////////////////////////
2796# Procedures asociated with tol inspector popup menu
2797#/////////////////////////////////////////////////////////////////////////////
2798
2799#/////////////////////////////////////////////////////////////////////////////
2800proc ::TolInspector::RemoveFromSpool {ht} {
2801#
2802# PURPOSE: Removes from spool all selected objects
2803#
2804#/////////////////////////////////////////////////////////////////////////////
2805  variable vars_selected
2806  variable item_data
2807  variable tolset
2808  variable tolindex
2809  variable data
2810
2811  foreach var $vars_selected {
2812    array set aryData [$ht entry cget $var -data]
2813    set itemid $aryData(Index)
2814    set path   $aryData(Path)
2815    set reference $aryData(Reference)
2816    set grammar [lindex $item_data($itemid) 2]
2817
2818    set objName [$ht entry cget $var -label]
2819
2820    set _objpool [list "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
2821    if {$grammar eq "Code"} {
2822      set graApply [lindex $aryData(Content) 0]
2823      lappend _objpool "graApply" $graApply
2824    }
2825    #Tolcon_Trace "OBJPOOL on REMOVE: $_objpool"
2826
2827    # Buscamos el objeto (identificador: referencia)
2828    array set objpool $_objpool
2829    foreach _obj $data(pool,objects) {
2830      array set obj $_obj
2831      #Tolcon_Trace "obj(reference)=$obj(reference), objpool(reference)=$objpool(reference)"
2832      if {[string equal $obj(reference) $objpool(reference)]} {
2833        if {$obj(grammar) eq "Code"} {
2834          if {[string equal $obj(graApply) $objpool(graApply)]} {
2835            set idx [lsearch $data(pool,objects) $_obj]
2836            #Tolcon_Trace "El obj a quitar tiene idx=$idx"
2837            set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
2838          }
2839        } else {
2840          set idx [lsearch $data(pool,objects) $_obj]
2841          #Tolcon_Trace "El obj a quitar tiene idx=$idx"
2842          set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
2843        }
2844      }
2845    }
2846  }
2847  #Tolcon_Trace "P.O. after REMOVE: $data(pool,objects)"
2848  UpdatePoolObj
2849}
2850
2851#/////////////////////////////////////////////////////////////////////////////
2852proc ::TolInspector::AddToSpool {ht origin} {
2853#/////////////////////////////////////////////////////////////////////////////
2854  variable vars_selected
2855  variable item_data
2856  variable tolset
2857  variable tolindex
2858  variable data
2859
2860  foreach var $vars_selected {
2861    array set aryData [$ht entry cget $var -data]
2862    set itemid $aryData(Index)
2863    set path   $aryData(Path)
2864    set grammar [lindex $item_data($itemid) 2]
2865    set objName [$ht entry cget $var -label]
2866        #puts "AddToSpool: Reference=$aryData(Reference) tolset=$tolset grammar=$grammar"
2867    if {[llength $aryData(Reference)]} {
2868      set reference $aryData(Reference)
2869    } else {
2870      if { [string length $tolset] } {
2871        #set object [concat [list $tolset] $tolindex $itemid]
2872        #set object [concat [list File $tolset] $tolindex $itemid]
2873        set object [concat $tolset $tolindex $itemid]
2874        #puts "AddToSpool: object=$object"
2875        set reference [::tol::info reference $object]
2876      } else {
2877        if {$grammar eq "Set"} {
2878          #puts "AddToSpool: origin=$origin"
2879          set reference [::tol::info reference [list Set $objName]]
2880          #Tolcon_Trace "reference de ::tol::info reference [list $objName]"
2881        } else {
2882          if [catch {set reference [::tol::info reference [list $grammar $objName]]}] {
2883            set reference $objName
2884            #Tolcon_Trace "reference NO SE QUE PONER"
2885          }
2886          #Tolcon_Trace "reference de ::tol::info reference $grammar $objName"
2887        }
2888      }
2889    }
2890    set _objpool [list "origin" $origin "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
2891    if {$grammar eq "Code"} {
2892      set graApply [lindex $aryData(Content) 0]
2893      lappend _objpool "graApply" $graApply
2894    }
2895    #Tolcon_Trace "***************"
2896    #Tolcon_Trace "OBJPOOL on ADD:"
2897    #Tolcon_Trace "***************"
2898    #foreach {key value} $_objpool {
2899    #  Tolcon_Trace "  $key=$value"
2900    #}
2901    set inserted 0
2902    # Si la referencia es igual, el objeto es el mismo (salvo para obj de tipo Code)
2903    array set objpool $_objpool
2904    foreach _obj $data(pool,objects) {
2905      array set obj $_obj
2906      if {[string equal $obj(reference) $objpool(reference)]} {
2907        #Si es de la gramatica Code miro a ver la gramatica sobre la que se aplica
2908        if {$objpool(grammar) eq "Code"} {
2909          if {[string equal $obj(graApply) $objpool(graApply)]} {
2910            set inserted 1
2911          }
2912        } else {
2913          set inserted 1
2914        }
2915      }
2916    }
2917    if {!$inserted} {
2918      lappend data(pool,objects) $_objpool
2919      #puts "AddToSpool: P.O. after ADD: $data(pool,objects)"
2920    } else  {
2921      #puts "$_objpool ALREADY IN SPOOL"
2922    }
2923  }
2924 
2925}
2926
2927#/////////////////////////////////////////////////////////////////////////////
2928proc ::TolInspector::AddToEvalWindow {ht} {
2929#
2930# PURPOSE: Adds names of selected objects (vars or functions) in treeview ht
2931#          to eval window
2932#
2933#/////////////////////////////////////////////////////////////////////////////
2934  variable ht_vars
2935  variable vars_selected
2936
2937  set names ""
2938  foreach var $vars_selected {   
2939    lappend names [$ht entry cget $var -label]
2940  }
2941  ::TolConsole::ToEvalWindow [ListToStr $names]
2942}
2943
2944
2945#/////////////////////////////////////////////////////////////////////////////
2946proc ::TolInspector::SelectAll {ht} {
2947#
2948# PURPOSE: Selects all nodes of a given treeview
2949#
2950# PARAMETERS:
2951#   ht -> treeview's path
2952#
2953#/////////////////////////////////////////////////////////////////////////////
2954  set found [$ht find]
2955  if {[llength $found] > 1} {
2956    $ht selection set [lindex $found 1] [lindex $found end]
2957  }
2958}
2959
2960
2961#/////////////////////////////////////////////////////////////////////////////
2962  proc ::TolInspector::ToggleSelection {ht} {
2963#
2964# PURPOSE: Toggles selection of nodes of a given treeview
2965#
2966# PARAMETERS:
2967#   ht -> treeview's path
2968#
2969#/////////////////////////////////////////////////////////////////////////////
2970  set found [$ht find]
2971  if {[llength $found] > 1} {
2972    $ht selection toggle [lindex $found 1] [lindex $found end]
2973  }
2974}
2975
2976#/////////////////////////////////////////////////////////////////////////////
2977proc ::TolInspector::DrawSet {setref {type 0}} {
2978#
2979# PURPOSE: Graph a Set. For it it calls to a form for the selection of
2980#          columns to graph
2981#
2982# PARAMETERS:
2983#   setref -> Set to graph
2984#   type   -> 0 for custom association of data columns
2985#          -> 1 for all data columns to first one
2986#          -> 2 for all data columns to generic
2987#          -> 3 for even data columns to odd ones
2988#
2989#/////////////////////////////////////////////////////////////////////////////
2990  variable group_id
2991  variable w_tabset
2992  #puts "::TolInspector::DrawSet. setref: $setref"
2993  incr group_id
2994  if {[llength $setref] > 1} {
2995    set name [lindex [::tol::info variable $setref] 1]
2996  } else {
2997    set name $setref
2998  }
2999  set cmd tablecmd$group_id
3000  if {![catch {::tol::tableset create $cmd $setref}]} {
3001    switch $type {
3002      0 {
3003        set tl [::project::CreateForm \
3004          -width 500 -height 500 -type Graphs \
3005          -iniconfig Graph \
3006          -title [mc "Set graph: %s" $name] -helpkey "Tb4GraSet"]
3007        $tl withdraw
3008        set tlf [$tl getframe]
3009        if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $setref]] != 0} {
3010          bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd]
3011          pack $tlf.g -fill both -expand yes
3012          $tl restore
3013          update
3014          # Esta opción se debe aplicar cuando el gráfico esté empacado
3015          ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3016        } else {
3017          destroy $tl
3018          return
3019        }
3020        $tl bind <Control-F4> [list $tl kill]             
3021      }
3022      1 -
3023      2 -
3024      3 {
3025        # windows
3026        set tl [::project::CreateForm \
3027          -title [mc "Set graph: %s" $name] -type Graphs -iniconfig SetGraph]
3028        $tl withdraw       
3029        set tlf [$tl getframe]
3030        set Instance [::SetGraphDialog::DrawSet $tlf.g $cmd $setref $type]
3031        bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd]
3032        pack $tlf.g -fill both -expand yes
3033        $tl restore
3034        update
3035        # Esta opción se debe aplicar cuando el gráfico esté empacado       
3036        ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3037      }
3038    }
3039  } else {
3040    tk_messageBox -type ok -icon warning \
3041        -message [mc "Set is not graficable: %s" $::errorInfo] \
3042        -parent $w_tabset -title [mc "Warning"]
3043  }
3044}
3045
3046#/////////////////////////////////////////////////////////////////////////////
3047proc ::TolInspector::DrawMatrix {matref} {
3048#
3049# PURPOSE: draw the given matrix
3050#
3051# PARAMETERS:
3052#   matref -> reference to the tol matrix
3053#
3054#/////////////////////////////////////////////////////////////////////////////
3055  variable group_id
3056  variable w_tabset
3057
3058  incr group_id
3059  if {[llength $matref] > 1} {
3060    set name [lindex [::tol::info variable $matref] 1]
3061  } else {
3062    if { ([info exists obj]) } {
3063      set name $obj
3064    }
3065  }
3066  if { ([info exists name]) } {
3067    set cmd tablecmd$group_id
3068    if {![catch {::tol::tablematrix create $cmd $matref}]} {
3069      set tl [::project::CreateForm \
3070                  -width 500 -height 500 -type Graphs \
3071                  -iniconfig Graph \
3072                  -title [mc "Matrix graph: %s" $name] -helpkey "Tb4Gra"]
3073      $tl withdraw
3074   
3075      set tlf [$tl getframe]
3076      if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $matref]] != 0} {
3077        bind $tlf.g <Destroy> +[list ::tol::tablematrix destroy $cmd]
3078        pack $tlf.g -fill both -expand yes
3079            $tl restore
3080        update
3081        # Esta opción se debe aplicar cuando el gráfico esté empacado
3082        ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3083      } else {
3084        destroy $tl
3085        return
3086      }
3087      $tl bind <Control-F4> [list $tl kill]
3088    } else {
3089      tk_messageBox -type ok -icon warning \
3090        -message [mc "Matrix is not graficable: %s" $::errorInfo] \
3091        -parent $w_tabset -title [mc "Warning"]
3092    }
3093  }
3094}
3095
3096#/////////////////////////////////////////////////////////////////////////////
3097proc ::TolInspector::TableSet { set } {
3098#///////////////////////////////////////////////////////////////////////////// 
3099  variable w_tabset
3100  variable group_id
3101
3102  incr group_id
3103  if {[llength $set] > 1} {
3104    set nameSet [lindex [::tol::info variable $set] 1]
3105  } else {
3106    set nameSet $set
3107  }
3108  set setgrp group$group_id
3109  if {![catch {::tol::tableset create $setgrp $set}]} {
3110    # create
3111    set tl [::project::CreateForm \
3112        -title    "[mc "Set table"]: $nameSet" \
3113        -iniconfig SetTable \
3114        -type Tables -helpkey "Tb4Edt"
3115    ]
3116    set tlf [$tl getframe]
3117    # config
3118    btable $tlf.t -parent $tl \
3119                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3120                  -iniconfig btable
3121    $tlf.t fillSet $setgrp
3122    pack $tlf.t -fill both -expand yes
3123    bind $tlf.t <Destroy> +[list ::tol::tableset destroy $setgrp]
3124    $tl bind <Control-F4> [list $tl kill]
3125    update
3126  } else {
3127    tk_messageBox -type ok -icon warning -message [mc "Set not tabulable"]\
3128        -parent $w_tabset -title [mc Warning]
3129  }
3130}
3131
3132#/////////////////////////////////////////////////////////////////////////////
3133proc ::TolInspector::TableMatrix { matrix } {
3134#/////////////////////////////////////////////////////////////////////////////
3135  set mattb [::tol::matrix $matrix]
3136  # create
3137  set tl [::project::CreateForm \
3138              -title "[mc {Matrix table}]: [lindex $mattb 0]" \
3139              -iniconfig MatrixTable \
3140              -type Tables -helpkey "Tb4Edt"
3141  ]
3142  set tlf [$tl getframe]
3143  # create matrix
3144  btable $tlf.t -parent $tl \
3145                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3146                -iniconfig btable
3147  $tlf.t fillMatrix $mattb
3148  $tl bind <Control-F4> [list $tl kill] 
3149  pack $tlf.t -fill both -expand yes
3150
3151  #if {$grammar == "VMatrix"} {
3152    #::tol::console stack release "zxw._.wxz"
3153  #}
3154}
3155
3156#/////////////////////////////////////////////////////////////////////////////
3157proc ::TolInspector::ExportBDTMatrix { matrix } {
3158#/////////////////////////////////////////////////////////////////////////////
3159  variable group_id
3160 
3161  incr group_id
3162  set tl [toplevel .top$group_id]
3163  wm title $tl "ExportBDTMatrix"
3164 
3165  #pack $tl.t -fill both -expand yes
3166}
3167
3168#/////////////////////////////////////////////////////////////////////////////
3169proc ::TolInspector::DrawSerie { } {
3170#///////////////////////////////////////////////////////////////////////////// 
3171  variable options_selected
3172  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
3173 
3174  #puts "DrawSerie: series_selected=$series_selected"
3175  set series ""
3176  foreach it $series_selected {
3177    lappend series [lindex $it 0]
3178  }
3179  DrawSeries $series
3180}
3181
3182#/////////////////////////////////////////////////////////////////////////////
3183proc ::TolInspector::DrawSeries { series {gcf ""}} {
3184#///////////////////////////////////////////////////////////////////////////// 
3185  variable group_id
3186
3187  if { [llength $series] } {
3188    incr group_id
3189    # series     
3190    set sergrp group$group_id
3191    set t0 [time {
3192    eval "::tol::seriegrp create $sergrp $series"
3193    }]
3194    # name
3195    set name [$sergrp serie 0 name]
3196    if { [$sergrp serie size] > 1} {
3197      set name ${name}...
3198    }
3199    # create
3200    set t1 [time {
3201    set tl [::project::CreateForm \
3202        -title [mc "Series graph: %s" $name] \
3203        -type Graphs \
3204        -iniconfig SeriesGraph \
3205        -width 900 -height 650 -helpkey "Tb4GraSer"
3206           ]}]
3207    set tlf [$tl getframe]
3208    # configuration
3209    set t2 [time {
3210    set Instance [::SeriesGraph::Create $tlf.g $sergrp]
3211    }]
3212    #puts "t0 = $t0"
3213    #puts "t1 = $t1"
3214    #puts "t2 = $t2"
3215    if { $gcf != "" } {
3216      ::bayesGraph::LoadGCF $Instance $gcf
3217    }
3218    bind $tlf.g <Destroy> +[list ::tol::seriegrp destroy $sergrp]
3219    pack $tlf.g -fill both -expand yes
3220    $tl bind <Control-F4> [list $tl kill]
3221    update
3222    # Esta opción se debe aplicar cuando el gráfico esté empacado
3223    #::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3224  }
3225}
3226
3227#/////////////////////////////////////////////////////////////////////////////
3228proc ::TolInspector::DrawAutocorSerie { serie } {
3229#///////////////////////////////////////////////////////////////////////////// 
3230  variable group_id
3231   
3232  incr group_id
3233  # title
3234 
3235  if {[llength $serie] > 1} {
3236    set nameSerie [lindex [::tol::info variable $serie] 1]
3237  } else {
3238    set nameSerie $serie
3239  }
3240  # create
3241  set tl [::project::CreateForm \
3242      -title "[mc "Autocorrelation graph"]: $nameSerie" \
3243      -iniconfig AutocorGraph \
3244      -type Graphs \
3245      -width 900 -height 650 -helpkey "Tb4GraAco"
3246  ]
3247  set tlf [$tl getframe]
3248  # configuration
3249  ::AutocorGraph::Create $tlf.g $serie
3250  $tl bind <Control-F4> "$tl kill; break"
3251  pack $tlf.g -fill both -expand yes
3252  update
3253}
3254
3255#/////////////////////////////////////////////////////////////////////////////
3256proc ::TolInspector::TableSerie { } {
3257#///////////////////////////////////////////////////////////////////////////// 
3258  variable options_selected
3259  variable group_id
3260  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
3261
3262  set series ""
3263  foreach it $series_selected {
3264    lappend series [lindex $it 0]
3265  }
3266
3267  if { [llength $series] } {
3268    incr group_id
3269
3270    set sergrp group$group_id
3271    eval "::tol::seriegrp create $sergrp $series"
3272   
3273    # create
3274    set tl [::project::CreateForm \
3275        -title [mc "Time series table"] \
3276        -iniconfig SeriesTable \
3277        -type Tables -helpkey "Tb4Edt"
3278    ]
3279        set tlf [$tl getframe]
3280    # configuration
3281    btable $tlf.t -parent $tl \
3282                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3283                  -iniconfig btable
3284    $tlf.t fillSerie $sergrp
3285    bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp]
3286    pack $tlf.t -fill both -expand yes
3287    $tl bind <Control-F4> [list $tl kill]
3288    update
3289  }
3290}
3291
3292#/////////////////////////////////////////////////////////////////////////////
3293proc ::TolInspector::TableAutocorSerie { serie } {
3294#///////////////////////////////////////////////////////////////////////////// 
3295  variable group_id
3296   
3297  incr group_id
3298  # title
3299  if {[llength $serie] > 1} {
3300    set nameSerie [lindex [::tol::info variable $serie] 1]
3301  } else {
3302    set nameSerie $serie
3303  }
3304  # create
3305  set tl [::project::CreateForm \
3306      -title "[mc "Autocorrelation table"]: $nameSerie" \
3307      -iniconfig AutocorGraphTable \
3308      -type Tables -helpkey "Tb4Edt"
3309  ]
3310  set tlf [$tl getframe]
3311  # configuration
3312  btable $tlf.t -parent $tl \
3313                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3314                -iniconfig btable
3315  $tlf.t fillAutocor $serie ""
3316  $tl bind <Control-F4> [list $tl kill]
3317  pack $tlf.t -fill both -expand yes
3318}
3319
3320#/////////////////////////////////////////////////////////////////////////////
3321proc ::TolInspector::TableStatisticsSerie { } {
3322#/////////////////////////////////////////////////////////////////////////////
3323  variable options_selected
3324  variable group_id
3325  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
3326
3327  set series ""
3328  foreach it $series_selected {
3329    lappend series [lindex $it 0]
3330  }
3331
3332  if { [llength $series] } {
3333    incr group_id
3334
3335    set sergrp group$group_id
3336    eval "::tol::seriegrp create $sergrp $series"
3337    # create
3338    set tl [::project::CreateForm \
3339        -title [mc "Statistics table"] \
3340        -iniconfig StatisticsTable \
3341        -type Tables -helpkey "Tb4Edt"
3342    ]
3343    set tlf [$tl getframe]
3344    # configuration
3345    btable $tlf.t -parent $tl \
3346                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3347                  -iniconfig btable
3348    $tlf.t fillStatistics $sergrp
3349    bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp]
3350    $tl bind <Control-F4> [list $tl kill]
3351    pack $tlf.t -fill both -expand yes
3352  }
3353}
3354
3355#/////////////////////////////////////////////////////////////////////////////
3356proc ::TolInspector::ViewTimeSet { tms args } {
3357#/////////////////////////////////////////////////////////////////////////////
3358  variable group_id
3359 
3360  incr group_id
3361 
3362  #puts "::TolInspector::ViewTimeSet $tms"
3363  # args
3364  array set opts [list \
3365    -title "[mc "TimeSet calendar"]: $tms" \
3366    -geometry {}
3367  ]
3368  array set opts $args 
3369 
3370  # create
3371  set tl [::project::CreateForm \
3372      -title $opts(-title) \
3373      -iniconfig Calendar \
3374      -type TimeSets -width 470 -height 345 -helpkey "Tb4Cal"
3375  ]
3376  # geometry
3377  $tl setgeometry $opts(-geometry)
3378 
3379  set tlf [$tl getframe]
3380  # configuration
3381  set tmscmd tms$group_id
3382  ::tol::timeset create $tmscmd $tms
3383  ::CalendarTms::Create $tlf.t $tmscmd
3384  bind $tlf.t <Destroy> +[list ::tol::timeset destroy $tmscmd]
3385  bind $tl <Control-F4> [list $tl kill]
3386  pack $tlf.t -fill both -expand yes
3387 
3388  return $tl
3389}
3390
3391#/////////////////////////////////////////////////////////////////////////////
3392proc ::TolInspector::ViewDefinition {name path grammar} {
3393#/////////////////////////////////////////////////////////////////////////////
3394  variable w_tabset
3395  if {$path == ""} {
3396    tk_messageBox -type ok -icon warning\
3397      -message [mc "Object %1\$s is not defined in a tol file" $name]\
3398      -parent $w_tabset -title [mc Warning]
3399    return
3400  }
3401  set ext [file extension $path]
3402  switch -- $ext {
3403    .tol -
3404    .TOL {
3405      set Instance [::Editor::Open $path]
3406      update
3407      if {[string equal $grammar "Code"] ||
3408          [string equal $grammar "Anything"]} {
3409        append txtFind " " $name "( )*\\("
3410      } else {
3411        #append txtFind $grammar "( )+" $name
3412        append txtFind $name
3413      }
3414      #Me situo al principio del texto
3415      set editor [::Editor::GetText $Instance]
3416      tk::TextSetCursor $editor 1.0
3417      ::BayesText::FindShow $editor 1 $txtFind 1
3418      #::Editor::CmdFindNext $Instance $txtFind
3419    }
3420    .bst -
3421    .BST -
3422    .bdt -
3423    .BDT {
3424      # Igual luego se abre como tabla
3425      ::Editor::Open $path
3426    }
3427  }
3428}
3429
3430#/////////////////////////////////////////////////////////////////////////////
3431proc ::TolInspector::ViewFile {name} {
3432#
3433# PURPOSE:
3434#
3435# PARAMETERS:
3436#   name -> cadena con el nombre de un archivo o el de una variable
3437#           que hace referencia a un archivo
3438#
3439#/////////////////////////////////////////////////////////////////////////////
3440  #  En name puede venir el nombre de un archivo o el de una variable
3441  # que hace referencia a un archivo.
3442  #puts "ViewFile. name=$name"
3443  if [file isfile $name] {
3444    set path $name
3445  } else  {
3446    set path [::tol::info path $name]
3447  }
3448  ::Editor::Open $path
3449}
3450
3451#/////////////////////////////////////////////////////////////////////////////
3452proc ::TolInspector::DecompileFile {name} {
3453#
3454# PURPOSE:
3455#
3456# PARAMETERS:
3457#   name -> cadena con el nombre de un archivo o el de una variable
3458#           que hace referencia a un archivo
3459#
3460# TODO: Actualmente en name solo puede llegar el nombre de un archivo
3461#
3462#/////////////////////////////////////////////////////////////////////////////
3463  variable data
3464  #puts "DECOMPILE 1.1, name=$name"
3465  if {[file isfile $name]} {
3466    set path $name
3467  } else  {
3468    set path [::tol::info path $name]
3469  }
3470  #puts "DECOMPILE 1.2"
3471  #Comprobar si el archivo ya está abierto y si es así poner que no está compilado
3472  if [namespace exists ::Editor] {
3473    foreach ins [namespace children ::Editor] {
3474      upvar \#0 ${ins}::data dataEd
3475      if [string equal $dataEd(nameFile) $path] {
3476        set dataEd(isCompiled) 0
3477      }
3478    }
3479  }
3480  #puts "DECOMPILE 1.3"
3481  #Quitar del spool todos los objetos provenientes de este archivo
3482 
3483  foreach _obj $data(pool,objects) {
3484    array set obj $_obj
3485    #Tolcon_Trace "REFERENCIA: $obj(reference)"
3486    if {[string equal [lindex $obj(reference) 0] $path]} {
3487      set idx [lsearch $data(pool,objects) $_obj]
3488      set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
3489    }
3490  }
3491  ::tol::decompile $path
3492  ::TolInspector::UpdateFileRoot
3493}
3494
3495#/////////////////////////////////////////////////////////////////////////////
3496proc ::TolInspector::ReadUserFunctions {} {
3497#
3498# PURPOSE: Recorre el set global que tiene la definicion de funciones y va
3499#          guardando esa informacion en arrays para almacenarla finalmente en
3500#          regFunLst
3501#
3502#/////////////////////////////////////////////////////////////////////////////
3503  variable regFunLst
3504 
3505  #Set global que tiene la definicion de funciones
3506  set obj GuiFunction
3507
3508  if { [llength [set infAry [TclInfoVar Set $obj]] ] } {
3509    #Tolcon_Trace "ReadUserFunctions: infAry = $infAry"
3510    array set info $infAry
3511    set nFun [lindex $info(CONTENT) 0]
3512    #Tolcon_Trace "Numero de funciones =$nFun"
3513    for  {set idf 1} {$idf <= $nFun} {incr idf} {
3514      array set ifNameFun [TclInfoRef [list Set $obj $idf 1]]
3515      array set ifNameGui [TclInfoRef [list Set $obj $idf 2]]
3516      array set ifTypeGui [TclInfoRef [list Set $obj $idf 3]]
3517      array set ifTypeOut [TclInfoRef [list Set $obj $idf 4]]
3518      array set ifParams  [TclInfoRef [list Set $obj $idf 5]]
3519      #Hago lindex $a(CONTENT) 0 para quitar las comillas
3520      set regFun($idf,nameFun) [lindex $ifNameFun(CONTENT) 0]
3521      set regFun($idf,nameGui) [lindex $ifNameGui(CONTENT) 0]
3522      set regFun($idf,typeGui) [lindex $ifTypeGui(CONTENT) 0]
3523      set regFun($idf,typeOut) [lindex $ifTypeOut(CONTENT) 0]
3524      set nPar [lindex $ifParams(CONTENT) 0]
3525      #Tolcon_Trace "Numero de parametros =$nPar"
3526      for  {set idp 1} {$idp <= $nPar} {incr idp} {
3527        array set ipNameGui [TclInfoRef [list Set $obj $idf 5 $idp 1]]
3528        array set ipTypePar [TclInfoRef [list Set $obj $idf 5 $idp 2]]
3529        array set ipTypeSel [TclInfoRef [list Set $obj $idf 5 $idp 3]]
3530        array set ipListVal [TclInfoRef [list Set $obj $idf 5 $idp 4]]
3531        set regPar($idp,nameGui) [lindex $ipNameGui(CONTENT) 0]
3532        set regPar($idp,typePar) [lindex $ipTypePar(CONTENT) 0]
3533        set regPar($idp,typeSel)         $ipTypeSel(CONTENT)
3534        set nVal [lindex $ipListVal(CONTENT) 0]
3535        #Tolcon_Trace "nVal=$nVal"
3536        set lstVal ""
3537        for  {set idv 1} {$idv <= $nVal} {incr idv} {
3538           array set iVal [TclInfoRef [list Set $obj $idf 5 $idp 4 $idv]]
3539           lappend lstVal [lindex $iVal(CONTENT) 0]
3540        }
3541        set regPar($idp,lstVal) $lstVal
3542      }
3543      set regFun($idf,parameters) [array get regPar]
3544      array unset regPar
3545      #parray regFun
3546    }
3547    set regFunLst [array get regFun]
3548  } else {
3549    set regFunLst ""
3550  }
3551}
3552
3553#/////////////////////////////////////////////////////////////////////////////
3554proc ::TolInspector::ShowMenuUserFunc {gra} {
3555#
3556# PURPOSE: Muestra un menu contextual que...
3557#
3558#/////////////////////////////////////////////////////////////////////////////
3559  variable data_menu
3560  variable regFunLst
3561 
3562  #puts "ShowMenuUserFunc: gra=$gra"
3563  if {[expr [info exist ::TolInspector::regFunLst] && [llength $regFunLst] ]} {
3564    array set regFun $regFunLst
3565    regsub -all ,nameGui \
3566       [array names regFun *,nameGui] "" lstFun
3567    foreach idf [lsort -integer $lstFun] {
3568      set typeGui [split $regFun($idf,typeGui) .]
3569      switch  [lindex $typeGui 0] {
3570        Ite - Set {
3571          if {[lindex $typeGui 1] eq $gra} {
3572            $data_menu($gra,Functions) add command -label [mc $regFun($idf,nameGui)]\
3573              -command [list ::TolInspector::CallUserFunction $gra $idf]
3574          }
3575        }
3576        default {
3577        }
3578      }
3579    }
3580  }
3581}
3582
3583#/////////////////////////////////////////////////////////////////////////////
3584proc ::TolInspector::CallUserFunction {grammar idx} {
3585#
3586# PURPOSE: Para los tipos de funciones Ite y Set, muestra un dialogo que
3587#          pide los
3588#
3589#/////////////////////////////////////////////////////////////////////////////
3590  variable regFunLst
3591  variable group_id
3592  variable data
3593  variable options_selected
3594
3595  upvar \#0 ::TolInspector::options_selected($grammar) items_selected
3596  #puts "CallUserFunction. grammar=$grammar, idx=$idx, items_selected=$items_selected"
3597 
3598  set all_objs [ list ]
3599  foreach it $items_selected {
3600    set tcl_ref [ lindex $it 0 ]
3601    set obj_addr [ ::tol::info address $tcl_ref ]
3602    lappend all_objs "GetObjectFromAddress(\"$obj_addr\")"
3603  }
3604
3605  if { [ llength $all_objs ] } {
3606    incr group_id
3607    array set regFun $regFunLst
3608    set gui [bguifunction .t$group_id \
3609                 -title $regFun($idx,nameGui) \
3610                 -regpars $regFun($idx,parameters)]
3611    set txtPars [join [$gui get values] ,]
3612    if {$txtPars ne ""} {
3613      set txtPars ",$txtPars"
3614    }
3615    destroy $gui
3616    set typeGui [split $regFun($idx,typeGui) .]
3617    switch [lindex $typeGui 0] {
3618      Ite {
3619        foreach obj $all_objs {
3620          set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($obj $txtPars)"
3621          #Tolcon_Trace "Ite.cmd=$cmd"
3622          ::tol::console eval $cmd
3623          ::TolConsole::SaveEval $cmd
3624        }
3625      }
3626      Set {
3627        set obj_args [join $all_objs ,]
3628        set setCmd "SetOf[lindex $typeGui 1] ($obj_args)"
3629        set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($setCmd $txtPars)"
3630        #Tolcon_Trace "Set.cmd=$cmd"
3631        ::tol::console eval $cmd
3632        ::TolConsole::SaveEval $cmd
3633      }
3634      default {
3635      }
3636    }
3637    ::TolInspector::UpdateConsoleObj
3638  }
3639}
3640
3641namespace eval ::LoadStatus {
3642  variable data
3643}
3644
3645#proc ::LoadStatus::Show {file} {
3646#   
3647#  set f [toplevel .topStatus]
3648#  #wm protocol $path WM_DELETE_WINDOW [list ::Editor::OnDelete $this]
3649#  # bind Destroy más abajo
3650# 
3651#  label $f.lfile -text $file
3652#  # frame y label para barra de estado
3653#  set data(sb,frame) [frame $f.fop -relief groove -bd 1 -height 7]
3654#  set data(sb,objs)  [label $f.fop.objs -relief groove -bd 1 -width 16]
3655#  set data(sb,files) [label $f.fop.files -text [mc "Not Compiled"] \
3656#          -relief raised -bd 1 -width 16]
3657#  set data(sb,time)  [label $f.fop.time -bd 1 -width 14]
3658#  set data(sb,rell)  [label $f.fop.rell -relief groove -bd 1]
3659# 
3660# 
3661#  # empaquetamos los label de estado
3662#  pack $f.fop.objs $f.fop.files $f.fop.time -side left
3663#  pack $f.fop.rell -expand true -fill x
3664# 
3665#  grid $f.lfile -sticky news
3666#  grid $f.fop   -sticky ews
3667# 
3668#  grid rowconfigure    $f 1 -weight 1
3669#  grid columnconfigure $f 0 -weight 1
3670#   
3671#}
3672#
3673#
3674#proc ::LoadStatus::Hide {w} {
3675#   
3676#
Note: See TracBrowser for help on using the repository browser.