source: tol/tolbase/lib/toltk/tolinspe.tcl @ e4cddd7

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

refs #1457, portando la solucion desde 3.1, hay que mencionar que este error se manifestaba solo en windows.

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

  • Property mode set to 100644
File size: 128.7 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      #puts "Tol_ClassOfFromReference $objRef"
811      set classOf [Tol_ClassOfFromReference $objRef]
812      #puts "Tol_InstanceContentFromReference $objRef"
813      set insCont [Tol_InstanceContentFromReference $objRef]
814      if {$insCont ne ""} {
815        set data [lreplace $data 3 3 [TrimContent $grammar $insCont]]
816      } elseif {$classOf ne ""} {
817        set data [lreplace $data 3 3 $classOf]
818      }
819      set objAddress [ tol::info address $objRef ]
820      set icon_grammar [ ::ImageManager::getIconForInstance $objAddress ]
821    }
822  } elseif { $grammar eq "Anything" } {
823    set item "item$item_id"
824    set anyType [ tol::info anything $objRef ]
825    set icon_grammar [ ::Bitmap::get $anyType ]
826  } else {
827    set item "item$item_id"
828    set icon_grammar [ ::Bitmap::get $grammar ]
829  }
830  set idnew [$tree insert 0 -label $item]
831  set label [OneLine $name]
832  if {$label eq ""} {
833    if {[set label $brief_desc] eq ""} {
834      set label " "
835    }
836  }
837  $ht entry configure $idnew -label $label \
838      -icons [list $icon_grammar $icon_grammar] -data $data \
839       -foreground $fcolor
840  set item_data($item_id) [list $content $desc $grammar]
841  incr item_id
842}
843
844#/////////////////////////////////////////////////////////////////////////////
845proc ::TolInspector::ClearHiertables { } {
846#
847# PURPOSE:
848#
849#/////////////////////////////////////////////////////////////////////////////
850  variable w_tabset
851  variable ht_vars
852  variable ht_funcs
853  variable item_data
854  variable OnSelectItem
855
856  $ht_vars  entry delete root 0 end
857  $ht_funcs entry delete root 0 end
858  $ht_vars column  configure Index -hide no
859  $ht_funcs column configure Index -hide no
860  catch {
861    unset item_data
862  }
863  $w_tabset tab configure Variables -text [mc Variables] -state normal
864  $w_tabset tab configure Functions -state normal
865
866  if { [string length $OnSelectItem] } {
867    $OnSelectItem
868  }
869}
870
871# este proc debe pasar a ser un getContainerReference
872#
873proc ::TolInspector::getPackageReference { treePath } {
874  variable ht_tree
875
876  #puts "::TolInspector::getPackageReference $treePath"
877  catch {
878    set typeContainer "NameBlock"
879    set order [ lindex  [ split [ lindex $treePath 2 ] "-" ] end ]
880    incr order -1
881    #puts "path,2 = [ lindex $treePath 2 ]"
882    #puts "order = $order"
883    set idx [lindex [ $ht_tree entry children "root-packages"] $order]
884    set nameContainer [ $ht_tree entry cget $idx -label ]
885    #puts "en root-package:"
886    #puts "\torder=$order"
887    #puts "\tidx=$idx"
888    #puts "\tnameContainer=$nameContainer"
889    set container [ list $typeContainer $nameContainer ]
890    if { [ llength $treePath ] > 3 } {
891      foreach c [ lrange $treePath 3 end-1 ] {
892        set orderItem [ lindex  [ split $c "-" ] end ]
893        lappend container $orderItem
894      }
895      set tolindex [ lindex  [ split [ lindex $treePath end ] "-" ] end ]
896    } else {
897      set tolindex [ list ]
898    }
899  } msg
900  #puts "::TolInspector::getPackageReference: $msg"
901  #puts "::TolInspector::getPackageReference: [ list $container $tolindex ]"
902  return [ list $container $tolindex ]
903}
904
905#/////////////////////////////////////////////////////////////////////////////
906proc ::TolInspector::OpenObject { index } {
907#
908# PURPOSE: Script called each time a node in ht_tree (left treeview) is
909#          opened.
910#
911# PARAMETERS:
912#   index : The id of the node opened
913#
914#/////////////////////////////////////////////////////////////////////////////
915  variable tolset
916  variable tolindex
917  variable iterSet
918  variable at_set
919  variable node_prefix
920  variable ht_tree
921  variable data
922
923  #puts "OpenObject: index=$index"
924  set path [$ht_tree get -full $index]
925  #puts "path = $path"
926  if { $index } {
927    set parent1 [lindex $path 1]
928    if { [set ispackage [string equal $parent1 "root-packages"]] ||
929         [set isfile [string equal $parent1 "root-files"]] ||
930         [set isconsole [string equal $parent1 "root-console"]] ||
931         [string equal $parent1 "root-pool"] } {
932      set lpath [llength $path]
933      #puts "lpath = $lpath"
934      if { $lpath == 2 } {
935        if { $ispackage } {
936          InsertPackages
937        } elseif { $isfile } {
938          InsertFiles
939        } elseif { $isconsole } {
940          InsertConsoleObj
941        } else {
942          InsertPoolObj
943        }
944      } else {
945        #puts "OpenObject: path = $path"
946        set leaf [lindex $path end]
947        set leaf_info [split $leaf "-"]
948        set node_prefix [lindex $leaf_info 0]
949        set _tolset $tolset
950        if { $parent1 eq "root-packages" } {
951          foreach {tolset tolindex} [ getPackageReference $path ] break
952        } elseif { [string equal $parent1 "root-pool"] } {
953          #Tolcon_Trace "OpenObject. tolset=$tolset"
954          set tolset $data(pool,reference,[lindex $leaf_info 0])
955          #puts "OpenObject: Spool: tolset=$tolset, leaf_info=$leaf_info"
956          if { $lpath == 3 } {
957            set tolindex [lrange $tolset 1 end]
958            set tolset [lindex $tolset 0]
959          } else {
960            set tolindex [lrange $leaf_info 1 end]
961                    if {[lindex $tolset 0] eq "Console"} {
962                      set tolset [lindex $tolset 0] 
963                    } else {
964                      set tolset [lrange $tolset 0 1]
965                    }
966            #set tolindex [lrange $tolset 1 end]
967            #set tolset [lindex $tolset 0]
968            #lappend tolindex [lindex $leaf_info end]
969          }
970          #Tolcon_Trace "OpenObject. tolset=$tolset"
971        } elseif {[regexp -- "console(.+)" $node_prefix --> idx_con]} {
972          set tolset "Console"
973          #puts "OpenObject: Console: leaf_info = $leaf_info"
974          if {[llength $leaf_info] == 1} {
975            set tolindex $idx_con
976          } else {
977            #set tolindex [list $idx_con [lrange $leaf_info 1 end]]
978            set tolindex [lrange $leaf_info 1 end]
979          }
980        } else {
981          set idx [$ht_tree find -name $node_prefix]
982          array set aryData [$ht_tree entry cget $idx -data]
983          set tolset [list File $aryData(FileName)]
984          #set tolset [$ht_tree entry cget [$ht_tree find -name $node_prefix] -label]
985          if { $lpath == 3 } {
986            set tolindex ""
987          } else {
988            set tolindex [lrange $leaf_info 1 end]
989          }
990        }
991        Busy
992        set at_set $index
993        set iterSet [eval list $tolset $tolindex]
994        variable gra_parent [ GetParentGrammar $iterSet ]
995        ::tol::forallchild $iterSet ::TolInspector::InsertSubset
996        set tolset $_tolset
997        NotBusy
998      }
999    }
1000  }
1001}
1002
1003#/////////////////////////////////////////////////////////////////////////////
1004proc ::TolInspector::InsertPackages {} {
1005#
1006# PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL
1007#          packages
1008#
1009#/////////////////////////////////////////////////////////////////////////////
1010  variable ht_tree
1011  #upvar \#0 ::TolTk::Images Images
1012   
1013  set order 1
1014  foreach pkg [::tol::info packages] {
1015    # takes an icon with the same name that the grammar
1016    set img [ ::Bitmap::get NameBlock ]
1017    $ht_tree insert -at "root-packages" end package-$order -label $pkg\
1018          -icons [list $img $img] -button yes
1019    incr order
1020  }
1021}
1022
1023#/////////////////////////////////////////////////////////////////////////////
1024proc ::TolInspector::InsertGrammars {} {
1025#
1026# PURPOSE: Inserts a node in ht_tree (left ::blt::treeview) for each TOL
1027#          grammar
1028#
1029#/////////////////////////////////////////////////////////////////////////////
1030  variable ht_tree
1031  #upvar \#0 ::TolTk::Images Images
1032   
1033  set id 1
1034  foreach g [::tol::info grammars] {
1035    # takes an icon with the same name that the grammar
1036    set img [::Bitmap::get $g]
1037    $ht_tree insert -at "root-grammars" end grammar-$id -label $g\
1038          -icons [list $img $img]
1039    incr id
1040  }
1041}
1042
1043#/////////////////////////////////////////////////////////////////////////////
1044proc ::TolInspector::InsertFiles { } {
1045#
1046# PURPOSE: Inserts a node in ht_tree (left treeview) for each Included file
1047#
1048#/////////////////////////////////////////////////////////////////////////////
1049  variable ht_tree
1050  variable blt_tree
1051
1052  set index 1
1053  #set img [::Bitmap::get "File"]
1054  foreach f [lreverse [::tol::info included]] {
1055    set finfo   [::tol::info included $f]
1056    set button  [lindex $finfo 3]
1057    set subtype [lindex $finfo 4]
1058    # tomar la imagen en funcion del subtype
1059    set img [SubTypeImage $subtype]
1060    set tag_file "file$index"
1061    set blt_idx [$blt_tree insert "root-files" \
1062             -label $tag_file -tags $tag_file]
1063    # Tail del fichero. Podría hacerse configurable por el usuario
1064    set label [file tail $f]
1065    $ht_tree entry configure $blt_idx -label $label\
1066    -icons  [list $img $img] -button $button -data [list "FileName" $f]
1067    incr index
1068  }
1069}
1070
1071#/////////////////////////////////////////////////////////////////////////////
1072proc ::TolInspector::InsertConsoleObj { } {
1073#
1074# PURPOSE: Inserts a node in ht_tree (left treeview) for each Console object
1075#
1076#/////////////////////////////////////////////////////////////////////////////
1077  variable ht_tree
1078  variable has_button 0
1079   
1080  set index 1
1081  foreach co [::tol::console stack list] {
1082    set grammar [lindex $co 0]
1083    if {$grammar eq "Set" || $grammar eq "NameBlock"} {
1084      # SUBTYPE: icono en funcion de [lindex $co 7]
1085      if {$grammar eq "Set"} {
1086        set icon [SubTypeImage [lindex $co 7]]
1087      } else  {
1088        set objRef [ list "Console" $index ]
1089        set objAddress [ tol::info address $objRef ]
1090        set icon [ ::ImageManager::getIconForInstance $objAddress ]
1091      }
1092      set name [lindex $co 1]
1093      #tol::forallchild $name HasSubset
1094      set has_button [lindex $co 6]
1095      if {$name eq ""} {
1096        if {[set name [TrimContent DONTCARE [lindex $co 4]]] eq ""} {
1097          set name " "
1098        }
1099      }
1100      $ht_tree insert -at root-console end "console$index" -label $name \
1101          -icons  [list $icon $icon] -button $has_button -data [list "FileName" $index]
1102    }
1103    incr index
1104  }
1105}
1106
1107#/////////////////////////////////////////////////////////////////////////////
1108proc ::TolInspector::InsertPoolObj { } {
1109#
1110# PURPOSE: Inserts a node in ht_tree (left treeview) for each object in Spool
1111#
1112#/////////////////////////////////////////////////////////////////////////////
1113  variable data
1114  variable ht_tree
1115  array unset data pool,reference,*
1116  set index 1
1117
1118  foreach _obj $data(pool,objects) {
1119    #Tolcon_Trace "InsertPoolObj. _obj=$_obj"
1120    array set obj $_obj
1121    if { [string equal $obj(grammar) "Set"] || [string equal $obj(grammar) "NameBlock"] } {
1122      #Si la referencia del objeto tiene espacios en la ruta, el
1123      # llength me daría > 1, por eso añado la 2ª parte de la condicion
1124      if { ([llength $obj(reference)] > 1) && \
1125            ![string equal $obj(reference) $obj(objName)]} {
1126        set infoObj [::tol::info variable $obj(reference)]
1127      } else {
1128        if {[catch { set infoObj [concat [list "Set" $obj(reference)] \
1129                            [::tol::info included $obj(reference)]] }]} {
1130          set infoObj [concat [list "Set" $obj(reference)] \
1131                 [::tol::info variable "Set" $obj(reference)]]
1132        } else {
1133          # Insertamos el 1 de isFile
1134          set infoObj [linsert $infoObj 5 1]
1135        }
1136      }
1137      #Tolcon_Trace "infoObj=$infoObj"
1138      if {[set name [file tail [lindex $infoObj 1]]] eq ""} {
1139        if {[set name [TrimContent DONTCARE [lindex $infoObj 4]]] eq ""} {
1140          set name " "
1141        }
1142      }
1143      set has_button [lindex $infoObj 6]
1144      #set icon [SubTypeImage [lindex $infoObj 7]]
1145      if {$obj(grammar) eq "Set"} {
1146        set icon [SubTypeImage [lindex $infoObj 7]]
1147      } else  {
1148        #puts "en pool = $obj(reference)"
1149        set objAddress [ tol::info address $objRef ]
1150        set icon [ ::ImageManager::getIconForInstance $objAddress ]
1151      }
1152
1153      $ht_tree insert -at root-pool end "pool$index" -label $name \
1154          -icon [list $icon $icon] -button $has_button
1155      #Tolcon_Trace "InsertPoolObj. name=$name"
1156      if { ([llength $obj(reference)] > 1) && \
1157            [string equal $obj(reference) $obj(objName)]} {
1158        set obj(reference) [list $obj(reference)]
1159      }
1160      set data(pool,reference,pool$index) $obj(reference)
1161    }
1162    incr index
1163  }
1164}
1165
1166proc ::TolInspector::FilterNameBlockMember { name } {
1167  set st_reg [ regexp {(.+::)?(_)?(\.)?(.*)} $name => p1 p2 p3 p4]
1168  if { !$st_reg } {
1169    list -show 1 -fcolor "black" -name $name
1170  } elseif { $p2 eq "_" } {
1171    if { $p3 eq "." } {
1172      if { [string match {autodoc.member.*} $p4] } {
1173        # es un elemento de autodocumentacion y no se muestra
1174        list -show 0
1175      } {
1176        # es un miembro de solo lectura
1177        list -show 1 -fcolor "gray50" -name "_.$p4"
1178      }
1179    } else {
1180      # es un miembro oculto,
1181      set showPrivate [ Tol_GetViewPrivateMembers ]
1182      list -show $showPrivate -fcolor "gray75" -name "_$p4"
1183    }
1184  } else {
1185    list -show 1 -fcolor "black" -name $p4
1186  }
1187}
1188
1189#/////////////////////////////////////////////////////////////////////////////
1190proc ::TolInspector::InsertSubset { args } {
1191#
1192# PURPOSE: Inserts a node in ht_tree (left treeview) for each child of a Set
1193#
1194# PARAMETERS:
1195#   args[0] -> grammar
1196#   args[1] -> name
1197#   args[2] -> content
1198#   args[3] -> path
1199#   args[4] -> desc
1200#   Si grammar == "Set"
1201#    args[5] -> indexes of the set
1202#    args[6] -> is file?
1203#    args[7] -> has subset?
1204#    args[8] -> subtype
1205#
1206#/////////////////////////////////////////////////////////////////////////////
1207  variable ht_tree
1208  variable at_set
1209  variable tolset
1210  variable iterSet
1211  variable node_prefix
1212  variable has_button 0
1213  variable blt_tree
1214  variable gra_parent
1215  catch {
1216  #puts "InsertSubset, args=$args"
1217  set grammar [lindex $args 0]
1218  if {$grammar eq "Set" || $grammar eq "NameBlock"} {
1219    #puts "InsertSubset, args=$args"
1220    if { $gra_parent eq "NameBlock" } {
1221      array set info_member [ FilterNameBlockMember [ lindex $args 1 ] ]
1222      if { !$info_member(-show) } {
1223        return
1224      }
1225      set name $info_member(-name)
1226      set fcolor $info_member(-fcolor)
1227    } else {
1228      set name [ lindex $args 1 ]
1229      set fcolor "black"
1230    }
1231    set content [lindex $args 2]
1232    # idx es el indice completo desde el Set root
1233    set idx     [lindex $args 5]
1234    set isfile  [lindex $args 6]
1235    set has_button [lindex $args 7]
1236    set subtype [lindex $args 8]
1237    #tol::forallchild $tolset $idx HasSubset
1238    if {$grammar eq "Set"} {
1239      set icon [SubTypeImage $subtype]
1240    } else {
1241      set objRef $iterSet
1242      lappend objRef [ lindex $idx end ]
1243      set objAddress [ tol::info address $objRef ]
1244      set icon [ ::ImageManager::getIconForInstance $objAddress ]
1245    }
1246    # Tail por si es un fichero. Podría hacerse configurable por el usuario
1247    set label [file tail $name]
1248    #puts [list InsertSubset, idx {lindex $args 5} = $idx]
1249    set idnew [ $blt_tree insert $at_set \
1250                   -label [ GetItemName $node_prefix $idx ] ]
1251
1252    #puts "InsertSubset, node_prefix = $node_prefix"
1253    #puts "InsertSubset, idnew = $idnew"
1254    #puts "InsertSubset, -label = [GetItemName $node_prefix $idx]"
1255
1256    if {$label eq ""} {
1257      if {[set label [TrimContent DONTCARE [lindex $args 4]]] eq ""} {
1258        set label " "
1259      }
1260    }
1261    $ht_tree entry configure $idnew -label $label -button $has_button \
1262      -icons [list $icon $icon] -foreground $fcolor
1263  }
1264} msg
1265#puts "InsertSubSet: $msg"
1266}
1267
1268#/////////////////////////////////////////////////////////////////////////////
1269proc ::TolInspector::ClearConsoleObj { } {
1270#/////////////////////////////////////////////////////////////////////////////
1271  variable ht_tree
1272  variable data
1273   
1274  set idx_con [$ht_tree index root-console]
1275  $ht_tree entry delete $idx_con 0 end
1276   
1277  #Quitamos del spool todos los objetos que provengan de la consola
1278  foreach _obj $data(pool,objects) {
1279    array set obj $_obj
1280    if {[string equal $obj(origin) "root-console"]} {
1281      set idx [lsearch $data(pool,objects) $_obj]
1282      set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
1283    }
1284  }
1285  UpdatePoolObj
1286  #Finalmente limpiamos el stack de la consola de tol
1287  ::tol::console stack release
1288}
1289
1290#/////////////////////////////////////////////////////////////////////////////
1291proc ::TolInspector::ClearConsoleObjSel {ht} {
1292#/////////////////////////////////////////////////////////////////////////////
1293  variable vars_selected
1294  variable data
1295
1296  foreach var $vars_selected {
1297    set name [$ht entry cget $var -label]
1298    #puts "name=$name"
1299    #Quitamos del spool todos los objetos que provengan de la consola
1300    foreach _obj $data(pool,objects) {
1301      array set obj $_obj
1302      #puts "_obj=$_obj"
1303      if {[string equal $obj(origin) "root-console"] && [string equal $obj(objName) $name]} {
1304        set idx [lsearch $data(pool,objects) $_obj]
1305        set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
1306      }
1307    }
1308    UpdatePoolObj
1309    #Finalmente quitamos el objeto de la consola de tol
1310    ::tol::console stack release $name
1311  }
1312  UpdateConsoleObj
1313}
1314
1315#/////////////////////////////////////////////////////////////////////////////
1316proc ::TolInspector::UpdateFileRoot { } {
1317#///////////////////////////////////////////////////////////////////////////// 
1318  variable ht_tree
1319  set open 0
1320  set idx_file [$ht_tree index root-files]
1321  if { [$ht_tree entry isopen $idx_file] } {
1322    $ht_tree close $idx_file
1323    set open 1
1324  }
1325  if { [$ht_tree index focus] == $idx_file } {
1326    SelectObject
1327  }
1328  if $open {
1329    $ht_tree open $idx_file
1330  }
1331}
1332
1333#/////////////////////////////////////////////////////////////////////////////
1334proc ::TolInspector::UpdateConsoleObj { } {
1335#///////////////////////////////////////////////////////////////////////////// 
1336  variable ht_tree
1337
1338  set idx_con [$ht_tree index root-console]
1339  if { [$ht_tree entry isopen $idx_con] } {
1340    $ht_tree close $idx_con
1341  }
1342  $ht_tree selection anchor root-console
1343  $ht_tree selection mark root-console
1344  #Tolcon_Trace "Abierto el nodo root-console"
1345  if { [$ht_tree index focus] == $idx_con } {
1346    SelectObject
1347  }
1348}
1349
1350
1351#/////////////////////////////////////////////////////////////////////////////
1352proc ::TolInspector::UpdatePoolObj { } {
1353#///////////////////////////////////////////////////////////////////////////// 
1354  variable ht_tree
1355
1356  set idx_pool [$ht_tree index root-pool]
1357  if { [$ht_tree entry isopen $idx_pool] } {
1358    $ht_tree close $idx_pool
1359  }
1360  if { [$ht_tree index focus] == $idx_pool } {
1361    SelectObject
1362  }
1363}
1364
1365
1366#/////////////////////////////////////////////////////////////////////////////
1367proc ::TolInspector::SelectObject { } {
1368#
1369# PURPOSE: Script called each time a node in ht_tree (left treeview) is
1370#          selected.
1371#
1372#/////////////////////////////////////////////////////////////////////////////
1373
1374  #Tolcon_Trace "LLAMADA A SELECTOBJECT"
1375  variable w_tabset
1376  variable ht_tree
1377  #variable set_type ""
1378  variable tolset
1379  variable tolindex
1380  #variable closing
1381  variable node_prefix ""
1382  variable data
1383  variable knownReference ""
1384
1385  set index [$ht_tree index anchor]
1386   
1387  if { ![string length $index] } {
1388    ClearHiertables
1389    return
1390  }
1391  ClearHiertables
1392
1393  set path [ $ht_tree get -full $index ]
1394  set tolset ""
1395  if { $index } {
1396    #puts "SelectObject index = $index"
1397    #puts "SelectObject: full = $path"
1398    set info_node [split [lindex $path end] "-"] ;# ojo si el path tiene -
1399    set node_type [lindex $info_node 0]
1400    set node_name [lindex $info_node 1]
1401    #puts "SelectObject: info_node = $info_node"
1402  } else {
1403    set node_type root
1404    set node_name root
1405  }
1406
1407  Busy
1408  #puts "SelectObject: node_type = $node_type, node_name = $node_name"
1409  switch -regexp $node_type  {
1410    root {
1411      switch $node_name {
1412        root -
1413        grammars {
1414          ClearHiertables
1415          #$w_tabset tab configure Variables -state disabled
1416          #$w_tabset tab configure Functions -state disabled
1417        }
1418        package {
1419          puts "implementa el llenado del panel derecho"
1420        }
1421        files {
1422          SelectFileRoot
1423        }
1424        console {
1425          SelectConsoleRoot
1426        }
1427        pool {
1428          SelectPoolRoot
1429        }
1430      }
1431    }
1432    grammar {
1433      SelectGrammar
1434    }
1435    default {
1436      set node_prefix $node_type
1437      #puts "SelectObject: node_prefix = $node_prefix"
1438      if { $node_type eq "package" } {
1439        foreach {tolset tolindex} [ getPackageReference $path ] break
1440      } elseif {[regexp -- "pool" $node_type]} {
1441        set tolset $data(pool,reference,[lindex $node_type 0])
1442        #puts "SelectObject: Spool: tolset=$tolset, info_node=$info_node"
1443        if { [llength $info_node] == 1 } {
1444          set tolindex [lrange $tolset 1 end]
1445          set tolset [lindex $tolset 0]
1446        } else {
1447          #set tolindex [lrange $tolset 1 end]
1448          #set tolset [lindex $tolset 0]
1449          #lappend tolindex [lindex $info_node end]
1450          set tolindex [lrange $info_node 1 end]
1451          if {[lindex $tolset 0] eq "Console"} {
1452            set tolset [lindex $tolset 0] 
1453          } else {
1454            set tolset [lrange $tolset 0 1]
1455          }
1456        }
1457      } elseif {[regexp -- "console(.+)" $node_type --> idx_con]} {
1458        #puts "SelectObject: Console: tolset=$tolset info_node=$info_node idx_con=$idx_con"
1459        set tolset "Console"
1460        #set idx [$ht_tree find -name $node_type]
1461        #array set aryData [$ht_tree entry cget $idx -data]
1462        #set tolindex [eval list $aryData(FileName) [lrange $info_node 1 end]]
1463        if {[llength $info_node] == 1} {
1464          set tolindex $idx_con
1465        } else {
1466          set tolindex [lrange $info_node 1 end]
1467          #set tolindex [concat [list $idx_con] $tolindex]
1468        }
1469      } else {
1470        set idx [$ht_tree find -name $node_type]
1471        array set aryData [$ht_tree entry cget $idx -data]
1472        #puts "SelectObject: FileName=$aryData(FileName) info_node=$info_node"
1473        set tolset [list File $aryData(FileName)]
1474        set tolindex [lrange $info_node 1 end]
1475        #set tolindex [lrange $info_node 2 end]
1476      }
1477      #puts "SelectObject end: tolset=$tolset, tolindex=$tolindex"
1478      SelectSet
1479    }
1480  }
1481  NotBusy
1482}
1483
1484#/////////////////////////////////////////////////////////////////////////////
1485proc ::TolInspector::SelectFileRoot { } {
1486#
1487# PURPOSE: Script called each time 'Included Files' node in ht_tree is
1488#          selected. Gets information about each node that must be in
1489#          included files, and inserts it in the right treeview.
1490#
1491#/////////////////////////////////////////////////////////////////////////////
1492  variable item_id 1
1493  variable w_tabset
1494  variable knownReference ""
1495
1496  ClearHiertables
1497  $w_tabset tab configure Variables -text [mc Files]
1498  #  $w_tabset tab configure Functions -state disabled
1499  $w_tabset select 0
1500  foreach f [lreverse [::tol::info included]] {
1501    # this catch is needed because info include could return files not
1502    # realy included.
1503    if { [ catch { ::tol::info included $f } fi ] } continue
1504    # tener en cuenta el subtype cuando lo retorne
1505    set knownReference [ list "File" $f ]
1506    InsertChild Set $f \
1507        [lindex $fi 0] [lindex $fi 1] [list [lindex $fi 2]] $item_id 1 [lindex $fi 3] [lindex $fi 4]
1508  }
1509}
1510
1511#/////////////////////////////////////////////////////////////////////////////
1512proc ::TolInspector::SelectConsoleRoot { } {
1513#
1514# PURPOSE: Script called each time 'Console Objects' node in ht_tree is
1515#          selected. Gets information about each node that must be in console,
1516#          and inserts it in the right treeview.
1517#
1518#/////////////////////////////////////////////////////////////////////////////
1519  variable w_tabset
1520  variable ht_vars
1521  variable ht_funcs
1522  variable item_id 1
1523  variable iterSet "Console"
1524  variable knownReference ""
1525
1526  ClearHiertables
1527#(pgea) se quita la linea que oculta la columna del indice y que
1528#(pgea) el procedimimento anterior ClearHiertables muestra
1529#  $ht_vars column  configure Index -hide yes
1530#  $w_tabset tab configure Functions -state disabled
1531 
1532  foreach co [::tol::console stack list] {
1533   #puts "SelectConsoleRoot: co = $co"
1534   set gra  [lindex $co 0]
1535   set name [lindex $co 1]
1536   set cont [lindex $co 2]
1537   set path [lindex $co 3]
1538   set desc [lindex $co 4]
1539   set knownReference [ list Console $item_id ]
1540    switch [lindex $co 0 ] {
1541      Code {
1542        InsertChild $gra $name $cont $path [list $desc] 0
1543      }
1544      NameBlock -
1545      Set {
1546        #puts "switch: SelectConsoleRoot $gra"
1547        InsertChild $gra $name $cont $path [list $desc] \
1548            $item_id [lindex $co 5] [lindex $co 6] [lindex $co 7] \
1549            [list Reference [list "Console" $item_id]]
1550      }
1551      default {
1552        InsertChild $gra $name $cont $path [list $desc] \
1553            [list Reference [list "Console" $item_id]]
1554      }
1555    }
1556  }
1557  set knownReference ""
1558}
1559
1560#/////////////////////////////////////////////////////////////////////////////
1561proc ::TolInspector::SelectPoolRoot { } {
1562#
1563# PURPOSE: Script called each time 'Spool Objects' node in ht_tree is
1564#          selected. Gets information about each node that must be in pool,
1565#          and inserts it in the right treeview.
1566#
1567#/////////////////////////////////////////////////////////////////////////////
1568  variable w_tabset
1569  variable ht_vars
1570  variable data
1571  variable item_id 1
1572  variable knownReference ""
1573
1574  ClearHiertables
1575  $ht_vars column  configure Index -hide yes
1576
1577  array unset data pool,variables,*
1578  # Para cada uno de los objetos que debe haber en el spool
1579  # busco la información del nodo y lo inserto en el treeview de la derecha
1580  foreach _obj $data(pool,objects) {
1581    array set obj $_obj
1582    #Si la referencia del objeto tiene espacios en la ruta, el
1583    # llength me daría > 1, por eso añado la 2ª parte de la condicion
1584    #puts "SelectPoolRoot: obj(grammar)=$obj(grammar) obj(objName)=$obj(objName) obj(reference)=$obj(reference)"
1585    if { ([llength $obj(reference)] > 1) && ![string equal $obj(reference) $obj(objName)]} {
1586      if {$obj(grammar) eq "Code"} {
1587        set infoObj [concat [list $obj(grammar) $obj(objName)] \
1588            [::tol::info function $obj(reference)]]
1589      } else  {
1590        set infoObj [::tol::info variable $obj(reference)]
1591      }
1592      #Tolcon_Trace "tol info (var|function) reference"
1593    } else {
1594      if {[catch { set infoObj [concat [list "Set" $obj(reference)] \
1595                          [::tol::info included $obj(reference)]] }]} {
1596        if {$obj(grammar) eq "Code"} {
1597          set infoObj [concat [list $obj(grammar) $obj(reference)] \
1598               [::tol::info function $obj(graApply) $obj(reference)]]
1599        } else  {
1600          #set infoObj [concat [list $obj(grammar) $obj(reference)] \
1601          #     [::tol::info variable $obj(grammar) $obj(reference)]]
1602          set infoObj [::tol::info variable [list $obj(grammar) $obj(reference)]]
1603        }
1604        #Tolcon_Trace "tol info (var|function) Grammar nameGlobal"
1605      } else {
1606        # Insertamos el 1 de isFile
1607        set infoObj [linsert $infoObj 5 1]
1608        #Tolcon_Trace "tol info included"
1609      }
1610    }
1611    #Tolcon_Trace "INFOOBJ: $infoObj"
1612    set gra  [lindex $infoObj 0]
1613    set name [lindex $infoObj 1]
1614    set cont [lindex $infoObj 2]
1615    set path [lindex $infoObj 3]
1616    set desc [lindex $infoObj 4]
1617    set data(pool,variables,$item_id) $obj(reference)
1618
1619    switch $gra {
1620      Code {
1621        InsertChild $gra $name $cont $path [list $desc] 0 "Reference $obj(reference)"
1622      }
1623      Set -
1624      NameBlock {
1625        set knownReference $obj(reference)
1626        InsertChild $gra $name $cont $path [list $desc] \
1627            $item_id [lindex $infoObj 5] [lindex $infoObj 6] [lindex $infoObj 7] "Reference $obj(reference)"
1628        set knownReference ""
1629      }
1630      default {
1631        InsertChild $gra $name $cont $path [list $desc] "Reference $obj(reference)"
1632      }
1633    }
1634  } 
1635}
1636
1637#/////////////////////////////////////////////////////////////////////////////
1638proc ::TolInspector::SelectGrammar { } {
1639#
1640# PURPOSE: Script called each time a Grammar node in ht_tree is selected. Gets
1641#          information about each var and function of this grammar, and
1642#          inserts them in the right treeview.
1643#
1644#/////////////////////////////////////////////////////////////////////////////
1645  variable w_tabset
1646  variable ht_tree
1647  variable ht_vars
1648  variable ht_funcs
1649  variable item_id 1
1650  variable OnSelectItem
1651  variable knownReference
1652
1653  set knownReference ""
1654  ClearHiertables
1655  $ht_vars column  configure Index -hide yes
1656  $ht_funcs column configure Index -hide yes
1657  set grammar [$ht_tree entry cget anchor -label]
1658  if { [string compare $grammar "Anything"] } {
1659    if { [string length $OnSelectItem] } {
1660      $OnSelectItem [::tol::info grammars $grammar]
1661    }
1662    foreach var  [::tol::info variables $grammar] {
1663      if {[catch {
1664        set vinfo [::tol::info variables [list $grammar $var]]
1665      } msg]} {
1666        Tol_HciWriter "<E>in ::TolInspector::SelectGrammar : $msg\n</E>"
1667        continue
1668      }
1669      if { [string equal $grammar "Code"] } {
1670        #Tolcon_Trace "Code : -- $vinfo --"
1671        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] 1 
1672      } elseif { $grammar eq "Set" || $grammar eq "NameBlock" } {
1673        #Tolcon_Trace "Set : -- $vinfo --"
1674        set knownReference [ list $grammar $var ]
1675        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] \
1676          $item_id [lindex $vinfo 5] [lindex $vinfo 6] [lindex $vinfo 7]
1677      } else {
1678        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [list [lindex $vinfo 4]] $item_id 0
1679      } 
1680    }
1681  } else {
1682#    $w_tabset tab configure Variables -state disabled
1683#    $w_tabset select 1
1684  }
1685  foreach fun  [::tol::info functions $grammar] {
1686    set finfo [::tol::info functions $grammar $fun]
1687    InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0   
1688  }
1689}
1690
1691#/////////////////////////////////////////////////////////////////////////////
1692proc ::TolInspector::SelectSet { } {
1693#
1694# PURPOSE: Script called each time a Set node in ht_tree is selected. Gets
1695#          information about each child of this set, and inserts it in the
1696#          right treeview.
1697#
1698#/////////////////////////////////////////////////////////////////////////////
1699  variable ht_tree
1700  variable ht_vars
1701  variable ht_funcs
1702 
1703  variable tolset
1704  variable tolindex
1705  variable iterSet
1706  variable var_id 1
1707  variable fun_id 1
1708  variable item_id
1709  #variable selecting_set
1710 
1711  #  if { $selecting_set } {
1712  #puts "eoooo ..."
1713  #    return
1714  #  }
1715  ClearHiertables
1716  #  set selecting_set 1
1717  set item_id 1
1718 
1719  #puts "SelectSet: tolset=$tolset tolindex=$tolindex"
1720  set iterSet [eval list $tolset $tolindex]
1721  variable gra_parent [ GetParentGrammar $iterSet ]
1722  ::tol::forallchild $iterSet ::TolInspector::_InsertChild
1723  #  set selecting_set 0
1724}
1725
1726proc ::TolInspector::GetParentGrammar { set_ref } {
1727  set root [ lindex $set_ref 0 ]
1728  set L [ llength $set_ref ]
1729  if { ( $root eq "File" && $L <= 2 ) } {
1730    set root
1731  } else {
1732    lindex [ tol::info var $set_ref ] 0
1733  }
1734}
1735
1736#/////////////////////////////////////////////////////////////////////////////
1737proc ::TolInspector::CloseObject { index } {
1738#
1739# PURPOSE: Script called each time a node in ht_tree (left treeview) is
1740#          closed.
1741#
1742# PARAMETERS:
1743#   index : The id of the node closed
1744#
1745#/////////////////////////////////////////////////////////////////////////////
1746  variable ht_tree
1747  #variable closing 1
1748  set path [$ht_tree get -full $index]
1749  if { $index } {
1750    set parent1 [lindex $path 1]
1751    if { [string equal $parent1 "root-packages"] ||
1752         [string equal $parent1 "root-files"] ||
1753         [string equal $parent1 "root-console"] ||
1754         [string equal $parent1 "root-pool"] } {
1755      $ht_tree entry delete $index 0 end
1756    }
1757  }
1758}
1759
1760#/////////////////////////////////////////////////////////////////////////////
1761proc ::TolInspector::HasSubset { args } {
1762#///////////////////////////////////////////////////////////////////////////// 
1763  if { [string equal [lindex $args 0] "Set"] } {
1764    variable has_button 1
1765    return 0
1766  }
1767  return 1
1768}
1769
1770#/////////////////////////////////////////////////////////////////////////////
1771proc ::TolInspector::OpenVariable { index } {
1772#
1773# PURPOSE: ????
1774#
1775# PARAMETERS:
1776#   index ->
1777#
1778#/////////////////////////////////////////////////////////////////////////////
1779  variable tolset     ;# Name of the current TOL set variable
1780  variable ht_vars    ;# ::blt::treeview of variables
1781  variable ht_tree    ;# ::blt::treeview left
1782  variable blt_tree   ;# ::blt::tree left
1783  variable item_data  ;# Array to hold the full content & description of items
1784 
1785  if { ![string length $index] } {
1786    return
1787  }
1788  set node_anchor [lindex [$ht_tree get -full anchor] end]
1789 
1790  set tree_index -1
1791  #puts "OpenVariable = $item_data([lindex [$ht_vars entry cget $index -data] end])"
1792  if { ![regexp -- "grammar-" $node_anchor] } {
1793    set grammar [lindex $item_data([lindex [$ht_vars entry cget $index -data] end]) 2]
1794    if {$grammar eq "Set" || $grammar eq "NameBlock"} {
1795      $ht_tree open anchor
1796      #puts "full = [$ht_vars get -full $index]"
1797      set local_name [lindex [$ht_vars get -full $index] end]
1798      set idx_anchor [$ht_tree index anchor]
1799      #puts "a buscar $local_name dentro de $idx_anchor"
1800      if {[set tree_index [$blt_tree findchild $idx_anchor $local_name]] == -1} {
1801        foreach idx [$ht_tree entry children anchor] {
1802          if { [string equal $local_name [lindex [$ht_tree get -full $idx] end]] } {
1803            set tree_index $idx
1804            break
1805          }
1806        }
1807      }
1808    }
1809  }
1810  if { $tree_index != -1 } {
1811    update
1812    blt::tv::SetSelectionAnchor $ht_tree $tree_index
1813    set blt::tv::scroll 1
1814    #$ht_tree selection clearall
1815    #$ht_tree see $tree_index
1816    #$ht_tree focus $tree_index
1817    #$ht_tree selection set $tree_index
1818    #$ht_tree selection anchor $tree_index
1819    #set blt::Hiertable::scroll 1
1820  }
1821}
1822
1823#/////////////////////////////////////////////////////////////////////////////
1824proc ::TolInspector::SelectItem { ht } {
1825#
1826# PURPOSE: Procedure that is executed when the user selects an element of
1827#          the trees of variables orfunctions.
1828#          First it take all the arguments necessary of the node of tree to
1829#          execute the procedure stored in the variable OnSelectItem, and
1830#          later executes it passing those arguments.
1831#
1832# PARAMETERS: path of ht_* (::blt::treeview of variables or of functions)
1833#
1834#/////////////////////////////////////////////////////////////////////////////
1835 # variable w_text       ;# TODO: ????
1836  variable OnSelectItem ;#Command to invoke on SelectItem in ht_*
1837  variable item_data    ;# Array to hold the full content & description of items
1838 
1839  set entry [$ht index anchor] ;# id of entry selected 
1840  if { [string length $OnSelectItem] } {
1841    # there are associated command
1842    if { [string length $entry] } {
1843      # almost one entry of ht_* selected
1844      array set aryData [$ht entry cget $entry -data]
1845      set name [$ht entry cget $entry -label] ;# name of item
1846      set itemid $aryData(Index)              ;# id of item
1847      set path   $aryData(Path)               ;# path of file of item
1848      #(pgea) se anyade la propiedad Reference
1849      set objRef $aryData(Reference)          ;# info of item
1850      set full_data $item_data($itemid) ;# {value} {desc} {grammar}       
1851      set value [lindex $full_data 0]   ;# value of item PE:
1852                                         # Anything Field(Set s, Text nombre)
1853
1854      if { [string equal \"\n\" $value] } {
1855        # hasn't value       
1856        set value {"\n"}
1857      } else {
1858        set value [string trim $value]
1859      }
1860      set desc [string trim [lindex $full_data 1]]
1861      set grammar [lindex $full_data 2]
1862      set icon [lindex [$ht entry cget $entry -icons] 0]
1863      #(pgea) lista de argumentos que recibe ::TolConsole::OnInfo
1864      set args [list $icon $grammar $name $value $path $desc $objRef]
1865    } else {
1866      set args ""
1867    }
1868    eval "$OnSelectItem $args"
1869  }
1870  return
1871#;# TODO: ????
1872#  if { [string length $entry] } {
1873#    FillText $ht $entry
1874#  } else {
1875#    $w_text delete 1.0 end
1876#  }
1877}
1878
1879#/////////////////////////////////////////////////////////////////////////////
1880#(pgea) se usa?
1881proc ::TolInspector::FillText { ht entry } {
1882#/////////////////////////////////////////////////////////////////////////////
1883  variable w_text
1884  variable item_data
1885  #upvar #0 ::TolTk::Images Images
1886
1887  $w_text delete 1.0 end
1888  array set aryData [$ht entry cget $entry -data]
1889  set name [$ht entry cget $entry -label]
1890  set itemid $aryData(Index)
1891  set full_data $item_data($itemid)
1892 
1893  set value [lindex $full_data 0]
1894  if { [string equal \"\n\" $value] } {
1895    set value {"\n"}
1896  }
1897  set desc [string trim [lindex $full_data 1]]
1898  set grammar [lindex $full_data 2]
1899  set icon [lindex [$ht entry cget $entry -icons] 0]
1900  foreach {prop val} [list "Grammar: " $grammar "Name: " $name "Value: " [string trim $value]] {
1901    set idx_start [$w_text index "end -1 chars"]
1902    $w_text insert end $prop
1903    set idx_end   [$w_text index "end -1 chars"]
1904    $w_text tag add tagLabel $idx_start $idx_end
1905    if {[string equal $prop "Grammar: "]} {
1906      $w_text image create end -image $icon
1907      $w_text insert end "  "
1908    }
1909    $w_text insert end "$val\n"
1910    $w_text tag add tagValue $idx_end [$w_text index "end -1 chars"]
1911  }
1912  $w_text tag configure tagLabel -font fnBold
1913  $w_text tag configure tagValue -wrap none
1914  if { [string length $desc] } {
1915    set idx_start [$w_text index "end -1 chars"]
1916    $w_text insert end "Description\n"
1917    set idx_end [$w_text index "end -1 chars"]
1918    $w_text tag add tagPropLabel $idx_start $idx_end
1919    $w_text insert end $desc
1920    $w_text tag add tagPropValue $idx_end [$w_text index "end -1 chars"]
1921    $w_text tag configure tagPropLabel -font fnBold -underline 1
1922    $w_text tag configure tagPropValue -wrap word
1923  }
1924}
1925
1926#proc ::TolInspector::GetIndexes { nodeid } {
1927#  variable ht_tree
1928#  # No se utiliza
1929#  # name is prefix-i1-i2-i3-...-in
1930#
1931#  if { $nodeid } {
1932#    lrange [split [$ht_tree get $nodeid] "-"] 1 end
1933#  } else list
1934#}
1935
1936#/////////////////////////////////////////////////////////////////////////////
1937proc ::TolInspector::GetItemName { prefix idx_list } {
1938#///////////////////////////////////////////////////////////////////////////// 
1939  set node_id $prefix
1940  foreach id $idx_list {
1941    append node_id "-$id"
1942  }
1943  set node_id
1944}
1945
1946#/////////////////////////////////////////////////////////////////////////////
1947proc ::TolInspector::OnBusy { cmd } {
1948#///////////////////////////////////////////////////////////////////////////// 
1949  variable OnBusyCmd $cmd
1950}
1951
1952#/////////////////////////////////////////////////////////////////////////////
1953proc ::TolInspector::Busy { } {
1954#///////////////////////////////////////////////////////////////////////////// 
1955  variable OnBusyCmd
1956  variable ht_tree
1957  variable ht_vars
1958
1959  $ht_tree configure -cursor watch
1960  $ht_vars configure -cursor watch
1961  if { [string length $OnBusyCmd] } {
1962    eval $OnBusyCmd 1
1963  }
1964}
1965
1966#/////////////////////////////////////////////////////////////////////////////
1967proc ::TolInspector::NotBusy { } {
1968#///////////////////////////////////////////////////////////////////////////// 
1969  variable OnBusyCmd
1970  variable ht_tree
1971  variable ht_vars
1972
1973  $ht_tree configure -cursor ""
1974  $ht_vars configure -cursor ""
1975
1976  if { [string length $OnBusyCmd] } {
1977    eval $OnBusyCmd 0
1978  }
1979}
1980
1981proc Tol_GetViewPrivateMembers { } {
1982  set viewOpt 0
1983  catch {
1984    # no funciona
1985    tol::console eval {
1986      Real __getViewPrivateMembers_tmp__ =
1987      TolConfigManager::Config::Various::View::PrivateMembers;
1988    }
1989    set x [ lindex [ tol::info variable { Real __getViewPrivateMembers_tmp__ } ] 2 ]
1990    tol::console stack release __getViewPrivateMembers_tmp__
1991    set viewOpt [ expr { int( $x ) } ]
1992   
1993  } msg
1994  #puts "Tol_GetViewPrivateMembers: $msg"
1995  return $viewOpt
1996}
1997
1998proc Tol_ObjIsClassOf { obj_addr cls_name } {
1999  tol::console eval [ string map [ list %A $obj_addr %C $cls_name ] {
2000    Real __gui_check__ = IsInstanceOf( GetObjectFromAddress( "%A" ),"%C" )
2001  } ]
2002  set info [ tol::info variable {Real __gui_check__} ]
2003  set x [ lindex $info 2 ]
2004  tol::console stack release __gui_check__
2005  expr { round($x) }
2006}
2007
2008proc Tol_ClassOf { obj_addr } {
2009  tol::console eval [ string map [ list %A $obj_addr ] {
2010    Text __gui_classof__ = {
2011      Anything obj = GetObjectFromAddress( "%A" );
2012      // WriteLn( "Tol_ClassOf " << Grammar( obj ) );
2013      Text If( Grammar( obj ) == "NameBlock", ClassOf( obj ), "" )
2014    }
2015  } ]
2016  set info [ tol::info variable {Text __gui_classof__} ]
2017  set x [ string trim [ lindex $info 2 ]  \" ]
2018  tol::console stack release __gui_classof__
2019  set x
2020}
2021
2022proc Tol_ClassOfFromReference { objReference } {
2023  set addr [ ::tol::info address $objReference ]
2024  return [ Tol_ClassOf $addr ]
2025}
2026
2027proc Tol_StructOf { obj_addr } {
2028  set tolcode [ string map [ list %A $obj_addr ]  {
2029    Text {
2030      Anything obj = GetObjectFromAddress( "%A" );
2031      // WriteLn( "Tol_StructOf " << Grammar( obj ) );
2032      Text If( Grammar( obj ) == "Set", StructName( obj ), "" )
2033    }
2034  } ]
2035  return [ lindex [ toltcl::eval $tolcode ] 0 ]
2036}
2037
2038proc Tol_StructOfFromReference { objReference } {
2039  # WATCH!!!!
2040  # when Tol_StructOfFromReference is invoken on {File xxx} xxx is
2041  # decompiled!!!!
2042  if { [ llength $objReference ] == 2 &&
2043       [ lindex $objReference 0 ] eq "File" } {
2044    return ""
2045  }
2046  set addr [ ::tol::info address $objReference ]
2047  return [ Tol_StructOf $addr ]
2048}
2049
2050#(pgea) nueva funcion para obtener la informacion de instancia
2051proc Tol_InstanceInfo { obj_addr } {
2052  tol::console eval [ string map [ list %A $obj_addr ] {
2053    Text __gui_instanceinfo__ = {
2054      Anything __intance__ = GetObjectFromAddress("%A");
2055      Text If(ObjectExist("Code", "__intance__::_.get.autodoc.info"),
2056        __intance__::_.get.autodoc.info(?), "")
2057    }
2058  } ]
2059  set info [ tol::info variable {Text __gui_instanceinfo__} ]
2060  set x [ string trim [ lindex $info 2 ]  \" ]
2061  tol::console stack release __gui_instanceinfo__
2062  set x
2063}
2064
2065#(pgea) nueva funcion para obtener la informacion de instancia
2066proc Tol_InstanceInfoFromReference { objReference } {
2067  set addr [ ::tol::info address $objReference ]
2068  return [ Tol_InstanceInfo $addr ]
2069}
2070
2071#(pgea) nueva funcion para obtener el contenido de la instancia
2072proc Tol_InstanceContent { obj_addr } {
2073  tol::console eval [ string map [ list %A $obj_addr ] {
2074    Text __gui_instancecontent__ = {
2075      Anything __intance__ = GetObjectFromAddress("%A");
2076      Text If(ObjectExist("Code", "__intance__::_.get.autodoc.content"),
2077        __intance__::_.get.autodoc.content(?), "")
2078    }
2079  } ]
2080  set info [ tol::info variable {Text __gui_instancecontent__} ]
2081  set x [ string trim [ lindex $info 2 ]  \" ]
2082  tol::console stack release __gui_instancecontent__
2083  set x
2084}
2085
2086#(pgea) nueva funcion para obtener el contenido de la instancia
2087proc Tol_InstanceContentFromReference { objReference } {
2088  set addr [ ::tol::info address $objReference ]
2089  return [ Tol_InstanceContent $addr ]
2090}
2091
2092proc TolGui_GetMenuEntries { selection idx } {
2093  #puts "TolGui_GetMenuEntries $selection $idx"
2094  array set instances {}
2095  array set menu_class {}
2096  set i 0
2097  foreach obj_info $selection {
2098    set tcl_ref [ lindex $obj_info 0 ]
2099    set obj_addr [ ::tol::info address $tcl_ref ]
2100    if { [ Tol_ObjIsClassOf $obj_addr "GuiTools::@MenuDesc" ] } {
2101      set class [ Tol_ClassOf $obj_addr ]
2102      lappend instances($class) $obj_addr
2103      set name_inst [ lindex $obj_info 1 ]
2104      set menu_items [ TolGui_GetObjMenu $obj_addr ]
2105      # esto hace que estemos guardando la ultima instancia, asumimos
2106      # tambien que todas las instancia tienen la misma espcificacion
2107      # de menu
2108      if { ![ llength [ array names menu_class $class ] ] || $i == $idx } {
2109        set menu_class($class) \
2110            [ list $name_inst $obj_addr $menu_items ]
2111      }
2112    }
2113    incr i
2114  }
2115  set menu_info [ list ]
2116  foreach c [ array names instances ] {
2117    lappend menu_info [ list $c $menu_class($c) $instances($c) ]
2118  }
2119  #puts "$menu_info"
2120  set menu_info
2121}
2122
2123proc TolGui_InsertEntriesFromMenuManager { targetMenu selection } {
2124  set addrList [ list ]
2125  foreach obj_info $selection {
2126    set tcl_ref [ lindex $obj_info 0 ]
2127    lappend addrList [ ::tol::info address $tcl_ref ]
2128  }
2129  ::MenuManager::insertEntriesForSelection $targetMenu $addrList
2130}
2131
2132proc TolGui_GetObjMenu { obj_addr } {
2133  set try [ catch {
2134    tol::console eval [ string map [ list %A $obj_addr ] {
2135      GuiTools::@MenuDesc __aux_menu__ = GetObjectFromAddress("%A");
2136      Set __gui_menu_entries__ = __aux_menu__::getMenuEntries(?)
2137    } ] } msg ]
2138  if { $try } {
2139    puts "ERROR TolGui_GetObjMenu : $msg"
2140    set result ""
2141  } else {
2142    set result [ TolObj2TclObj {Set __gui_menu_entries__} ]
2143  }
2144  tol::console stack release __aux_menu__
2145  tol::console stack release __gui_menu_entries__
2146  set result
2147}
2148
2149proc TolGui_InvokeMethod { method obj_addr } {
2150  #puts "TolGui_InvokeMethod $method $obj_addr"
2151  set try [ catch {
2152    tol::console eval [ string map [ list %A $obj_addr %M $method ] {
2153      NameBlock __aux_instance__ = GetObjectFromAddress("%A");
2154      Real __aux_result__ = __aux_instance__::%M(?)
2155    } ] } msg ]
2156  if { $try } {
2157    puts "ERROR TolGui_InvokeMethod : $msg"
2158  }
2159  tol::console stack release __aux_instance__
2160  tol::console stack release __aux_result__
2161}
2162
2163proc TclList2SetOfText { lst } {
2164  set result [ list ]
2165  foreach i $lst {
2166    lappend result \"[string map {\" \\\"} $i]\"
2167  }
2168  return "SetOfText([join $result ,])"
2169}
2170
2171proc TolGui_InvokeGroup { cname function group } {
2172  set SOA [ TclList2SetOfText $group ]
2173  set try [ catch {
2174    tol::console eval \
2175        [ string map [ list %C $cname %F $function %S $SOA ] {
2176          Real __aux_result__ = {
2177            Set aux = EvalSet( %S, NameBlock( Text addr ) {
2178              NameBlock GetObjectFromAddress( addr )
2179            } );
2180            Real %C::%F( aux )
2181          }
2182        } ] } msg ]
2183  if { $try } {
2184    puts "ERROR TolGui_InvokeGroup : $msg"
2185  }
2186  tol::console stack release __aux_result__
2187}
2188
2189#/////////////////////////////////////////////////////////////////////////////
2190proc ::TolInspector::PostVariable { x y } {
2191#
2192# PURPOSE: Composes a popup menu for variables and displays it. Its composed
2193#          depending on the node/s clicked by user.
2194#
2195# PARAMETERS:
2196#   x -> x-coordinate where popup menu is drawn
2197#   y -> y-coordinate where popup menu is drawn
2198#
2199#/////////////////////////////////////////////////////////////////////////////
2200  variable data_menu
2201  variable vars_selected
2202  variable options_selected
2203  variable ht_vars
2204  variable ht_tree
2205  variable item_data
2206  variable data
2207
2208  variable tolset
2209  variable tolindex
2210
2211  #User functions to contextual menu
2212  ::TolInspector::ReadUserFunctions
2213
2214  array unset options_selected
2215
2216  foreach it [array names data_menu] {
2217    $data_menu($it) delete 0 end
2218  }
2219  set InRootConsole [string equal [lindex [$ht_tree get -full anchor] end] "root-console"]
2220  set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
2221  set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end] "root-files"]
2222  #puts "PostVariable: InRootConsole,InRootPool,InRootFiles = $InRootConsole,$InRootPool,$InRootFiles"
2223  set node_act [$ht_vars index current]
2224  if { [string length $node_act] } {
2225    set vars_selected [$ht_vars curselection]
2226    if { [lsearch $vars_selected $node_act] >= 0 } {
2227      foreach var $vars_selected {
2228        array set aryData [$ht_vars entry cget $var -data]
2229        #puts "PostVariable: aryData = [array get aryData]"
2230        set itemid $aryData(Index)
2231        set path   $aryData(Path)
2232        set grammar [lindex $item_data($itemid) 2]
2233        set objName [$ht_vars entry cget $var -label]
2234        #puts "OBJECT=$objName, PATH=$path"
2235        if { $InRootPool } {
2236          set object $data(pool,variables,$itemid)
2237                } else {
2238          if {[llength $aryData(Reference)]} {
2239            #set object [lindex $aryData(Reference) 0]
2240            set object [lrange $aryData(Reference) 0 end]
2241          } else {
2242            if { [string length $tolset] } {
2243              #set object [concat [list File $tolset] $tolindex $itemid]
2244              set object [concat $tolset $tolindex $itemid]
2245              #puts "tolset = $tolset"
2246            } else {
2247              if [llength $objName] {
2248                set object [list $grammar $objName]
2249              } else {
2250                set object $objName
2251              }
2252            }
2253          }
2254        }
2255        #puts "PostVariable: OBJECT=$object OBJNAME=$objName TOLSET=$tolset PATH=$path GRAMMAR=$grammar"
2256        switch -- $grammar {
2257          Code    -
2258          Complex -
2259          Date    -
2260          Matrix  -
2261          VMatrix -
2262          Polyn   -
2263          Ratio   -
2264          Real    -
2265          Serie   -
2266          Anything -
2267          Text    -
2268          NameBlock -
2269          TimeSet {
2270            lappend options_selected($grammar) [list $object $objName $path]
2271          }
2272          Set {
2273            # Si el objeto se da como referencia
2274            if { [llength $object] > 1 }  {
2275              #puts "PostVariable: Set: object = $object"
2276              if {$InRootFiles} {
2277                set isFile 1
2278              } else {
2279                set info [::tol::info var $object]
2280                set isFile [expr [lindex $info 7] == 4]
2281              }
2282              #set desc [lindex $info 4]
2283            } else {
2284              if {[catch "::tol::info included $object" info]} {
2285                set info [::tol::info var [list Set $objName]]
2286                #set isFile [expr [lindex $info 5] == 4]
2287                set isFile [expr [lindex $info 7] == 4]
2288                #set desc [lindex $info 4]
2289              } else {
2290                #set info [::tol::info included $objName]
2291                #set isFile [expr [lindex $info 4] == 4]
2292                set isFile 1
2293                #set desc ""
2294              }
2295            }
2296            if $isFile {
2297              lappend options_selected(File) [list $object $objName $path]
2298            } else {
2299              lappend options_selected($grammar) [list $object $objName $path]
2300            }
2301          }
2302        }
2303      }
2304      set grammar_selected [array names options_selected]
2305      if { [llength $grammar_selected] } {
2306        foreach grammar $grammar_selected {
2307          switch -- $grammar {
2308            VMatrix -
2309            Matrix  {
2310              $data_menu(main) add cascade -label [mc "Export matrix"]\
2311              -menu $data_menu(Matrix,Export)
2312              if {[llength $options_selected($grammar)] == 1} {
2313                set object [lindex [lindex $options_selected($grammar) 0] 0]
2314                $data_menu(main) add command -label [mc "Table matrix"] \
2315                  -command [list ::TolInspector::TableMatrix $object]
2316                $data_menu(Matrix,Export) add command -label "BDT" \
2317                  -command [list ::TolInspector::ExportBDTMatrix $object]
2318                $data_menu(main) add command -label [mc "Draw matrix"] \
2319                  -command [list ::TolInspector::DrawMatrix $object]
2320              } else {
2321                $data_menu(main) add cascade -label [mc "Table matrix"] \
2322                  -menu $data_menu(Matrix,Table)
2323                $data_menu(Matrix,Export) add cascade -label "BDT" \
2324                  -menu $data_menu(Matrix,Export,BDT)
2325                $data_menu(main) add cascade -label [mc "Draw matrix"] \
2326                  -menu $data_menu(Matrix,Draw)
2327                foreach objInfo $options_selected(Matrix) {
2328                  $data_menu(Matrix,Table) add command -label [lindex $objInfo 1]\
2329                    -command [list ::TolInspector::TableMatrix [lindex $objInfo 0]]
2330                  $data_menu(Matrix,Export,BDT) add command -label [lindex $objInfo 1]\
2331                    -command [list ::TolInspector::ExportBDTMatrix [lindex $objInfo 0]]
2332                  $data_menu(Matrix,Draw) add command -label [lindex $objInfo 1] \
2333                    -command [list ::TolInspector::DrawMatrix [lindex $objInfo 0]]
2334                }
2335              }
2336            }
2337            Serie   {
2338              if {[llength $options_selected(Serie)] == 1} {
2339                set lblSerie "serie"
2340              } else  {
2341                set lblSerie "series"
2342              }
2343              $data_menu(main) add command -label [mc "Draw $lblSerie"]\
2344              -command ::TolInspector::DrawSerie
2345              $data_menu(main) add command -label [mc "Table $lblSerie"]\
2346              -command ::TolInspector::TableSerie             
2347              if {[llength $options_selected(Serie)] == 1} {
2348                set object [lindex [lindex $options_selected(Serie) 0] 0]
2349                $data_menu(main) add command -label [mc "Draw autocorrelation"] \
2350                  -command [list ::TolInspector::DrawAutocorSerie $object]
2351                $data_menu(main) add command -label [mc "Table autocorrelation"] \
2352                  -command [list ::TolInspector::TableAutocorSerie $object]
2353              } else {
2354                $data_menu(main) add cascade -label [mc "Draw autocorrelation"] \
2355                  -menu $data_menu(Serie,DrawAutocor)
2356                $data_menu(main) add cascade -label [mc "Table autocorrelation"] \
2357                  -menu $data_menu(Serie,TableAutocor)
2358                foreach objInfo $options_selected(Serie) {
2359                  $data_menu(Serie,DrawAutocor) add command -label [lindex $objInfo 1]\
2360                    -command [list ::TolInspector::DrawAutocorSerie [lindex $objInfo 0]]
2361                  $data_menu(Serie,TableAutocor) add command -label [lindex $objInfo 1]\
2362                    -command [list ::TolInspector::TableAutocorSerie [lindex $objInfo 0]]
2363                }
2364              }
2365              $data_menu(main) add command -label [mc "Table statistics"]\
2366                  -command ::TolInspector::TableStatisticsSerie
2367            }
2368            TimeSet {
2369              if {[llength $options_selected(TimeSet)] == 1} {
2370                set object [lindex [lindex $options_selected(TimeSet) 0] 0]
2371                $data_menu(main) add command -label [mc "View timeset"] \
2372                  -command [list ::TolInspector::ViewTimeSet $object]
2373              } else {
2374                $data_menu(main) add cascade -label [mc "View timeset"] \
2375                  -menu $data_menu(TimeSet,View)
2376                foreach objInfo $options_selected(TimeSet) {
2377                  $data_menu(TimeSet,View) add command -label [lindex $objInfo 1] \
2378                    -command [list ::TolInspector::ViewTimeSet [lindex $objInfo 0]]
2379                }
2380              }
2381            }
2382            NameBlock {
2383              # entradas desde MenuManager
2384              if 0 {
2385              TolGui_InsertEntriesFromMenuManager \
2386                  $data_menu(main) \
2387                  $options_selected(NameBlock)
2388              }
2389              # entradas desde @MenuDesc
2390              # @MenuDesc sera reemplazado, ver https://www.tol-project.org/ticket/1372
2391              set sel_length [ llength $options_selected(NameBlock) ]
2392              if { $sel_length } {
2393                set idx_current [ lsearch $vars_selected $node_act ]
2394                set all_nb_options \
2395                    [ TolGui_GetMenuEntries \
2396                          $options_selected(NameBlock) $idx_current ]
2397                set num_options [ llength $all_nb_options ]
2398                #puts "num_options = $num_options"
2399                foreach mi $all_nb_options {
2400                  set _cname [ lindex $mi 0 ]
2401                  set cname [ string map [ list @ "" . _ ] $_cname ]
2402                  #puts "cname = $cname"
2403                  foreach { ninst obj_addr entries } [ lindex $mi 1 ] break
2404                  set instances [ lindex $mi 2 ]
2405                  if { $num_options > 1 } {
2406                  # creo el menu de la clase si no existe
2407                    set mclass $data_menu(main).cls$cname
2408                    if { ![ winfo exists $mclass ] } {
2409                      menu $mclass -tearoff 0
2410                    } else {
2411                      $mclass delete 0 end
2412                    }
2413                    $data_menu(main) add cascade -label $cname -menu $mclass
2414                    set target_menu $mclass
2415                  } else {
2416                    set target_menu $data_menu(main)
2417                  }
2418                  foreach inst_entry $entries {
2419                    foreach { label single group } $inst_entry break
2420                    set opt_label \
2421                        "$label [ expr { $sel_length>1 ? $ninst : {} } ]"
2422                    $target_menu add command -label $opt_label \
2423                        -command [ list TolGui_InvokeMethod \
2424                                       $single $obj_addr ]
2425                    if { $group ne "" && [ llength $instances ] > 1 } {
2426                      # hay una funcion que se aplica a toda la seleccion
2427                      $target_menu add command -label "$label All" \
2428                          -command [ list TolGui_InvokeGroup \
2429                                         $_cname $group $instances ]
2430                    }
2431                  }
2432                }
2433              }
2434            }
2435            Set {
2436              if {[llength $options_selected(Set)] == 1} {
2437                set object  [lindex [lindex $options_selected(Set) 0] 0]
2438                $data_menu(main) add command -label [mc "Table set"] \
2439                  -command [list ::TolInspector::TableSet $object]
2440                $data_menu(main) add command -label [mc "Draw set"] \
2441                  -command [list ::TolInspector::DrawSet $object]
2442                # menu special
2443                $data_menu(main) add cascade -label [mc "Draw set special"] \
2444                  -menu $data_menu(Set,Draw,Special)
2445                $data_menu(Set,Draw,Special) add command \
2446                   -label [mc SetGraphAllFirst] \
2447                  -command [list ::TolInspector::DrawSet $object 1]
2448                $data_menu(Set,Draw,Special) add command \
2449                  -label [mc SetGraphAllGeneric] \
2450                  -command [list ::TolInspector::DrawSet $object 2]
2451                $data_menu(Set,Draw,Special) add command \
2452                  -label [mc SetGraphEvenUneven] \
2453                  -command [list ::TolInspector::DrawSet $object 3]               
2454              } else {
2455                $data_menu(main) add cascade -label [mc "Table set"] \
2456                  -menu $data_menu(Set,Table)
2457                $data_menu(main) add cascade -label [mc "Draw set"] \
2458                  -menu $data_menu(Set,Draw)
2459                foreach objInfo $options_selected(Set) {
2460                  $data_menu(Set,Table) add command -label [lindex $objInfo 1] \
2461                    -command [list ::TolInspector::TableSet [lindex $objInfo 0]]
2462                  $data_menu(Set,Draw) add command -label [lindex $objInfo 1] \
2463                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0]]
2464                }
2465                # menu special
2466                set i 0
2467                $data_menu(main) add cascade -label [mc "Draw set special"] \
2468                  -menu $data_menu(Set,Draw,Special,M)                 
2469                foreach objInfo $options_selected(Set) {
2470                  # exists menu previus ?
2471                  if {[winfo exists $data_menu(Set,Draw,Special,M).setdrawspecialm$i]} {
2472                    destroy $data_menu(Set,Draw,Special,M).setdrawspecialm$i
2473                  }
2474                  set mn \
2475                    [menu $data_menu(Set,Draw,Special,M).setdrawspecialm$i \
2476                      -tearoff 0]
2477                  $data_menu(Set,Draw,Special,M) add cascade \
2478                    -label [lindex $objInfo 1] -menu $mn
2479                  $mn add command -label [mc SetGraphAllFirst] \
2480                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 1]
2481                  $mn add command -label [mc SetGraphAllGeneric] \
2482                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 2]
2483                  $mn add command -label [mc SetGraphEvenUneven] \
2484                    -command [list ::TolInspector::DrawSet [lindex $objInfo 0] 3]                                 
2485                  incr i
2486                }               
2487              }
2488            }
2489            File {
2490              if {[llength $options_selected(File)] == 1} {
2491                set objName [lindex [lindex $options_selected(File) 0] 1]
2492                $data_menu(main) add command -label [mc "View file"] \
2493                  -command [list ::TolInspector::ViewFile $objName]
2494                if $InRootFiles {
2495                   $data_menu(main) add command -label [mc "Decompile file"] \
2496                     -command [list ::TolInspector::DecompileFile $objName]
2497                }
2498              } else {
2499                $data_menu(main) add cascade -label [mc "View file"] \
2500                  -menu $data_menu(File,View)
2501                foreach objInfo $options_selected(File) {
2502                  $data_menu(File,View) add command -label [lindex $objInfo 1] \
2503                    -command [list ::TolInspector::ViewFile [lindex $objInfo 1]]
2504                }
2505                if $InRootFiles {
2506                  $data_menu(main) add cascade -label [mc "Decompile file"] \
2507                    -menu $data_menu(File,Decompile)
2508                  foreach objInfo $options_selected(File) {
2509                    $data_menu(File,Decompile) add command -label [lindex $objInfo 1] \
2510                      -command [list ::TolInspector::DecompileFile [lindex $objInfo 1]]
2511                  }
2512                }
2513              }           
2514            }
2515          } ;# end del switch
2516          # inserto las opciones definidas en MenuManager
2517          if { $grammar ne "Anything" } {
2518            TolGui_InsertEntriesFromMenuManager \
2519                $data_menu(main) \
2520                $options_selected($grammar)
2521          }
2522
2523          $data_menu(main) add separator
2524          $data_menu(main) add cascade -label [mc "Functions"] \
2525             -menu $data_menu($grammar,Functions)
2526          ShowMenuUserFunc $grammar
2527          if {[llength $options_selected($grammar)] == 1} {
2528            set objName [lindex [lindex $options_selected($grammar) 0] 1]
2529            set path    [lindex [lindex $options_selected($grammar) 0] 2]
2530            $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
2531               -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
2532          } else {
2533            $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
2534               -menu $data_menu($grammar,File)
2535            foreach objInfo $options_selected($grammar) {
2536              $data_menu($grammar,File) add command -label [lindex $objInfo 1]\
2537              -command [list ::TolInspector::ViewDefinition\
2538                              [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
2539            }
2540          }
2541          $data_menu(main) add separator
2542        } ;#end del foreach
2543        if { $InRootPool } {
2544          $data_menu(main) add command -label [mc "Remove from spool"] \
2545            -command [list ::TolInspector::RemoveFromSpool $ht_vars]
2546        } else  {
2547          $data_menu(main) add command -label [mc "Add to spool"] \
2548            -command [list ::TolInspector::AddToSpool $ht_vars [lindex [$ht_tree get -full anchor] 1]]
2549        }
2550        $data_menu(main) add command -label [mc "To Eval window"] \
2551                -command [list ::TolInspector::AddToEvalWindow $ht_vars]
2552        $data_menu(main) add separator
2553        if { $InRootConsole} {
2554          $data_menu(main) add command -label [mc "Decompile"] \
2555            -command [list ::TolInspector::ClearConsoleObjSel $ht_vars]
2556          $data_menu(main) add separator
2557        }
2558        $data_menu(main) add command -label [mc "Select all"] \
2559                -command [list ::TolInspector::SelectAll $ht_vars]
2560        $data_menu(main) add command -label [mc "Toggle selection"] \
2561                -command [list ::TolInspector::ToggleSelection $ht_vars]
2562        tk_popup $data_menu(main) $x $y
2563      } ;#end del if
2564    }
2565  }
2566}
2567
2568#/////////////////////////////////////////////////////////////////////////////
2569proc ::TolInspector::PostFunction { x y } {
2570#
2571# PURPOSE: Composes a popup menu for functions and displays it. Its composed
2572#          depending on the node/s clicked by user.
2573#
2574# PARAMETERS:
2575#   x -> x-coordinate where popup menu is drawn
2576#   y -> y-coordinate where popup menu is drawn
2577#
2578#/////////////////////////////////////////////////////////////////////////////
2579  variable data_menu
2580  variable vars_selected
2581  variable ht_funcs
2582  variable ht_tree
2583  variable item_data
2584  variable data
2585 
2586  variable tolset
2587  variable tolindex
2588 
2589  array unset options_selected
2590  foreach it [array names data_menu] {
2591    $data_menu($it) delete 0 end
2592  }
2593 
2594  set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end] "root-pool"]
2595  set node_act [$ht_funcs index current]
2596  if { [string length $node_act] } {
2597    set vars_selected [$ht_funcs curselection]
2598    if { [lsearch $vars_selected $node_act] >= 0 } {
2599      foreach var $vars_selected {
2600        array set aryData [$ht_funcs entry cget $var -data]
2601        set itemid $aryData(Index)
2602        set path   $aryData(Path)
2603        set grammar [lindex $item_data($itemid) 2]
2604        set objName [$ht_funcs entry cget $var -label]
2605       
2606        if { $InRootPool } {
2607          set object $data(pool,variables,$itemid)
2608        } else {
2609          if { [string length $tolset] } {
2610            set object [concat [list $tolset] $tolindex $itemid]
2611          } else {
2612            set object $objName
2613          }
2614        }
2615        # La única gramática seleccionable en ht_funcs es Code
2616        lappend code_selected [list $object $objName $path]
2617      }
2618   
2619      if {[llength $code_selected] == 1} {
2620        set objName [lindex [lindex $code_selected 0] 1]
2621        set path    [lindex [lindex $code_selected 0] 2]
2622        $data_menu(main) add command -label [mc "View %1\$s's definition" $grammar] \
2623                -command [list ::TolInspector::ViewDefinition $objName $path $grammar]
2624      } else {
2625        $data_menu(main) add cascade -label [mc "View %1\$s's definition" $grammar] \
2626                -menu $data_menu($grammar,File)
2627        foreach objInfo $code_selected {
2628          $data_menu($grammar,File) add command -label [lindex $objInfo 1]\
2629                -command [list ::TolInspector::ViewDefinition\
2630                [lindex $objInfo 1] [lindex $objInfo 2] $grammar]
2631        }
2632      }
2633 
2634      if { $InRootPool } {
2635         $data_menu(main) add command -label [mc "Remove from spool"] \
2636                  -command [list ::TolInspector::RemoveFromSpool $ht_funcs]
2637      } else  {
2638         $data_menu(main) add command -label [mc "Add to spool"] \
2639                  -command [list ::TolInspector::AddToSpool $ht_funcs [lindex [$ht_tree get -full anchor] 1]]
2640      }
2641      $data_menu(main) add command -label [mc "To Eval window"] \
2642                -command [list ::TolInspector::AddToEvalWindow $ht_funcs]
2643      $data_menu(main) add separator
2644      $data_menu(main) add command -label [mc "Select all"] \
2645              -command [list ::TolInspector::SelectAll $ht_funcs]
2646      $data_menu(main) add command -label [mc "Toggle selection"] \
2647              -command [list ::TolInspector::ToggleSelection $ht_funcs]
2648      tk_popup $data_menu(main) $x $y
2649    }
2650  }
2651}
2652
2653#/////////////////////////////////////////////////////////////////////////////
2654proc ::TolInspector::PostTree { x y } {
2655#
2656# PURPOSE: Composes a popup menu for left treeview and displays it. Its
2657#          composed depending on the node clicked by user.
2658#
2659# PARAMETERS:
2660#   x -> x-coordinate where popup menu is drawn
2661#   y -> y-coordinate where popup menu is drawn
2662#
2663#/////////////////////////////////////////////////////////////////////////////
2664  variable data_menu
2665  variable vars_selected
2666  variable ht_tree
2667  variable item_data
2668  variable data
2669  variable tolset
2670  variable tolindex
2671  variable item_id
2672  #puts "ht_tree: $ht_tree"
2673  #No terminado todavía
2674  #return
2675  array unset options_selected
2676 
2677  #puts "::TolInspector::PostTree $x $y"
2678  foreach it [array names data_menu] {
2679    $data_menu($it) delete 0 end
2680  }
2681  set InRootPool  [string equal [lindex [$ht_tree get -full anchor] end-1] "root-pool"]
2682  #puts "InRootPool: $InRootPool"
2683  # InRootFiles has a value 1 if node is a File
2684  set InRootFiles [string equal [lindex [$ht_tree get -full anchor] end-1] "root-files"]
2685  #puts "InRootFiles: $InRootFiles"
2686  # index of the selected node
2687  set node_act [$ht_tree index current]
2688  #puts "node_act: $node_act" 
2689  if { [string length $node_act] } {
2690    set vars_selected [$ht_tree curselection]
2691    #puts "vars_selected: $vars_selected"     
2692    if { [lsearch $vars_selected $node_act] >= 0 } { ;# Not root node
2693      set index [$ht_tree index anchor]
2694      #puts "index: $index"   
2695      if { $index } {
2696        set info_node [split [lindex [$ht_tree get -full $index] end] "-"]
2697        #puts "info_node: $info_node" 
2698        set node_type [lindex $info_node 0]
2699        #puts "node_type: $node_type"         
2700        set node_name [lindex $info_node 1]
2701        #puts "node_name: $node_name"         
2702      } else { ;# root node
2703        set node_type root
2704        set node_name root
2705      }
2706      # if user selects a root or a grammar doesn't nothing
2707      switch -regexp $node_type  {
2708        root -
2709        grammar { return }
2710      }
2711      # label of object showed in the tree
2712      set objName [$ht_tree entry cget $index -label]
2713      #puts "objName: $objName"
2714      set object $objName
2715
2716      if {$InRootFiles} {
2717        array set aryData [$ht_tree entry cget $index -data]
2718        if [info exist aryData(FileName)]  {
2719          set objName $aryData(FileName)
2720        }
2721      }
2722      #puts "2objName: $objName"   
2723      if { $InRootPool } {
2724        #puts "es InRootPool $item_id"       
2725        set itemid $item_id
2726        #set object $data(pool,variables,$itemid)
2727        set object $data(pool,reference,$node_type)
2728      } else {
2729        #puts "NO InRootPool"
2730        if { [string length $tolset] } {         
2731          set object [concat [list $tolset] $tolindex]
2732        } else {
2733          set object $objName
2734        }
2735      }
2736      #puts "object = $objName '[$ht_tree entry cget $index -data]'"
2737#Tolcon_Trace "***********************************" {red}
2738#Tolcon_Trace "index=$index, node_type=$node_type, node_name=$node_name" {red}
2739#Tolcon_Trace "tolset=$tolset, tolindex=$tolindex, aryData= [$ht_tree entry cget $index -data]" {red}
2740#Tolcon_Trace "object=$object, label=$objName" {red}
2741#Tolcon_Trace "***********************************" {red}
2742     
2743      #
2744      # TICKET: #1438
2745      # Por que se pregunta aqui por los objetos de consola?
2746      #
2747      set stackList [::tol::console stack list]
2748      #puts "stackList: $stackList"
2749      set stackValue {}
2750      foreach stackItem $stackList {
2751        #puts "stackItem: $stackItem"
2752        #puts "lindex $stackValue 1: [lindex $stackValue 1]"
2753        #puts "objName: $objName" 
2754        if {[lindex $stackItem 1] eq $objName} {
2755          set stackValue $stackItem
2756        }
2757        break
2758      }
2759      #puts "stackValue: $stackValue"
2760      set grammar [lindex $stackValue 0]     
2761      #puts "grammar: $grammar"
2762      #set full_data $item_data($index) ;# {value} {desc} {grammar}   
2763      #set grammar [lindex $full_data 2]
2764     
2765      #foreach fun  [::tol::info functions $grammar] {
2766      #  set finfo [::tol::info functions $grammar $fun]
2767      #  InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [list [lindex $finfo 2]] 0   
2768      #}
2769      if {[catch {set info [::tol::info included $objName]}]} {
2770        if { !($grammar eq "")} {
2771          if {[catch {set info [::tol::info var [list $grammar $object]}]} {
2772            #set info [concat [list "$grammar" $objName ] [::tol::info var $grammar $objName]]
2773                        set info [::tol::info var [list $grammar $objName]]
2774            #Tolcon_Trace "INFO de ::tol::info var Set objName"
2775          } else  {
2776            set info [::tol::info var [list $grammar $object]]
2777            #Tolcon_Trace "INFO de ::tol::info var $grammar object"
2778          }       
2779          set isFile [expr [lindex $info 5] == 4]
2780        } else {
2781          set isFile 0
2782        }
2783
2784      } else {
2785        set info [::tol::info included $objName]
2786        #Tolcon_Trace "INFO de ::tol::info included objName"
2787        set isFile 1
2788      }
2789      #puts "paso"
2790
2791      if $isFile {
2792        #puts "entro como fichero"       
2793        $data_menu(main) add command -label [mc "View file"] \
2794                -command [list ::TolInspector::ViewFile $objName]
2795        if $InRootFiles {
2796          $data_menu(main) add command -label [mc "Decompile file"] \
2797                -command [list ::TolInspector::DecompileFile $objName]
2798        }
2799      } else {
2800        #puts "no entro como fichero"       
2801        if { $grammar eq "Set" } {
2802          $data_menu(main) add command -label [mc "Table set"] \
2803                -command [list ::TolInspector::TableSet $object]
2804          $data_menu(main) add command -label [mc "Draw set"] \
2805                -command [list ::TolInspector::DrawSet $object]
2806        }
2807      }
2808      tk_popup $data_menu(main) $x $y
2809    }
2810  }
2811}
2812
2813
2814#/////////////////////////////////////////////////////////////////////////////
2815# Procedures asociated with tol inspector popup menu
2816#/////////////////////////////////////////////////////////////////////////////
2817
2818#/////////////////////////////////////////////////////////////////////////////
2819proc ::TolInspector::RemoveFromSpool {ht} {
2820#
2821# PURPOSE: Removes from spool all selected objects
2822#
2823#/////////////////////////////////////////////////////////////////////////////
2824  variable vars_selected
2825  variable item_data
2826  variable tolset
2827  variable tolindex
2828  variable data
2829
2830  foreach var $vars_selected {
2831    array set aryData [$ht entry cget $var -data]
2832    set itemid $aryData(Index)
2833    set path   $aryData(Path)
2834    set reference $aryData(Reference)
2835    set grammar [lindex $item_data($itemid) 2]
2836
2837    set objName [$ht entry cget $var -label]
2838
2839    set _objpool [list "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
2840    if {$grammar eq "Code"} {
2841      set graApply [lindex $aryData(Content) 0]
2842      lappend _objpool "graApply" $graApply
2843    }
2844    #Tolcon_Trace "OBJPOOL on REMOVE: $_objpool"
2845
2846    # Buscamos el objeto (identificador: referencia)
2847    array set objpool $_objpool
2848    foreach _obj $data(pool,objects) {
2849      array set obj $_obj
2850      #Tolcon_Trace "obj(reference)=$obj(reference), objpool(reference)=$objpool(reference)"
2851      if {[string equal $obj(reference) $objpool(reference)]} {
2852        if {$obj(grammar) eq "Code"} {
2853          if {[string equal $obj(graApply) $objpool(graApply)]} {
2854            set idx [lsearch $data(pool,objects) $_obj]
2855            #Tolcon_Trace "El obj a quitar tiene idx=$idx"
2856            set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
2857          }
2858        } else {
2859          set idx [lsearch $data(pool,objects) $_obj]
2860          #Tolcon_Trace "El obj a quitar tiene idx=$idx"
2861          set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
2862        }
2863      }
2864    }
2865  }
2866  #Tolcon_Trace "P.O. after REMOVE: $data(pool,objects)"
2867  UpdatePoolObj
2868}
2869
2870#/////////////////////////////////////////////////////////////////////////////
2871proc ::TolInspector::AddToSpool {ht origin} {
2872#/////////////////////////////////////////////////////////////////////////////
2873  variable vars_selected
2874  variable item_data
2875  variable tolset
2876  variable tolindex
2877  variable data
2878
2879  foreach var $vars_selected {
2880    array set aryData [$ht entry cget $var -data]
2881    set itemid $aryData(Index)
2882    set path   $aryData(Path)
2883    set grammar [lindex $item_data($itemid) 2]
2884    set objName [$ht entry cget $var -label]
2885        #puts "AddToSpool: Reference=$aryData(Reference) tolset=$tolset grammar=$grammar"
2886    if {[llength $aryData(Reference)]} {
2887      set reference $aryData(Reference)
2888    } else {
2889      if { [string length $tolset] } {
2890        #set object [concat [list $tolset] $tolindex $itemid]
2891        #set object [concat [list File $tolset] $tolindex $itemid]
2892        set object [concat $tolset $tolindex $itemid]
2893        #puts "AddToSpool: object=$object"
2894        set reference [::tol::info reference $object]
2895      } else {
2896        if {$grammar eq "Set"} {
2897          #puts "AddToSpool: origin=$origin"
2898          set reference [::tol::info reference [list Set $objName]]
2899          #Tolcon_Trace "reference de ::tol::info reference [list $objName]"
2900        } else {
2901          if [catch {set reference [::tol::info reference [list $grammar $objName]]}] {
2902            set reference $objName
2903            #Tolcon_Trace "reference NO SE QUE PONER"
2904          }
2905          #Tolcon_Trace "reference de ::tol::info reference $grammar $objName"
2906        }
2907      }
2908    }
2909    set _objpool [list "origin" $origin "grammar" $grammar "objName" $objName "reference" $reference "path" $path]
2910    if {$grammar eq "Code"} {
2911      set graApply [lindex $aryData(Content) 0]
2912      lappend _objpool "graApply" $graApply
2913    }
2914    #Tolcon_Trace "***************"
2915    #Tolcon_Trace "OBJPOOL on ADD:"
2916    #Tolcon_Trace "***************"
2917    #foreach {key value} $_objpool {
2918    #  Tolcon_Trace "  $key=$value"
2919    #}
2920    set inserted 0
2921    # Si la referencia es igual, el objeto es el mismo (salvo para obj de tipo Code)
2922    array set objpool $_objpool
2923    foreach _obj $data(pool,objects) {
2924      array set obj $_obj
2925      if {[string equal $obj(reference) $objpool(reference)]} {
2926        #Si es de la gramatica Code miro a ver la gramatica sobre la que se aplica
2927        if {$objpool(grammar) eq "Code"} {
2928          if {[string equal $obj(graApply) $objpool(graApply)]} {
2929            set inserted 1
2930          }
2931        } else {
2932          set inserted 1
2933        }
2934      }
2935    }
2936    if {!$inserted} {
2937      lappend data(pool,objects) $_objpool
2938      #puts "AddToSpool: P.O. after ADD: $data(pool,objects)"
2939    } else  {
2940      #puts "$_objpool ALREADY IN SPOOL"
2941    }
2942  }
2943 
2944}
2945
2946#/////////////////////////////////////////////////////////////////////////////
2947proc ::TolInspector::AddToEvalWindow {ht} {
2948#
2949# PURPOSE: Adds names of selected objects (vars or functions) in treeview ht
2950#          to eval window
2951#
2952#/////////////////////////////////////////////////////////////////////////////
2953  variable ht_vars
2954  variable vars_selected
2955
2956  set names ""
2957  foreach var $vars_selected {   
2958    lappend names [$ht entry cget $var -label]
2959  }
2960  ::TolConsole::ToEvalWindow [ListToStr $names]
2961}
2962
2963
2964#/////////////////////////////////////////////////////////////////////////////
2965proc ::TolInspector::SelectAll {ht} {
2966#
2967# PURPOSE: Selects all nodes of a given treeview
2968#
2969# PARAMETERS:
2970#   ht -> treeview's path
2971#
2972#/////////////////////////////////////////////////////////////////////////////
2973  set found [$ht find]
2974  if {[llength $found] > 1} {
2975    $ht selection set [lindex $found 1] [lindex $found end]
2976  }
2977}
2978
2979
2980#/////////////////////////////////////////////////////////////////////////////
2981  proc ::TolInspector::ToggleSelection {ht} {
2982#
2983# PURPOSE: Toggles selection of nodes of a given treeview
2984#
2985# PARAMETERS:
2986#   ht -> treeview's path
2987#
2988#/////////////////////////////////////////////////////////////////////////////
2989  set found [$ht find]
2990  if {[llength $found] > 1} {
2991    $ht selection toggle [lindex $found 1] [lindex $found end]
2992  }
2993}
2994
2995#/////////////////////////////////////////////////////////////////////////////
2996proc ::TolInspector::DrawSet {setref {type 0}} {
2997#
2998# PURPOSE: Graph a Set. For it it calls to a form for the selection of
2999#          columns to graph
3000#
3001# PARAMETERS:
3002#   setref -> Set to graph
3003#   type   -> 0 for custom association of data columns
3004#          -> 1 for all data columns to first one
3005#          -> 2 for all data columns to generic
3006#          -> 3 for even data columns to odd ones
3007#
3008#/////////////////////////////////////////////////////////////////////////////
3009  variable group_id
3010  variable w_tabset
3011  #puts "::TolInspector::DrawSet. setref: $setref"
3012  incr group_id
3013  if {[llength $setref] > 1} {
3014    set name [lindex [::tol::info variable $setref] 1]
3015  } else {
3016    set name $setref
3017  }
3018  set cmd tablecmd$group_id
3019  if {![catch {::tol::tableset create $cmd $setref}]} {
3020    switch $type {
3021      0 {
3022        set tl [::project::CreateForm \
3023          -width 500 -height 500 -type Graphs \
3024          -iniconfig Graph \
3025          -title [mc "Set graph: %s" $name] -helpkey "Tb4GraSet"]
3026        $tl withdraw
3027        set tlf [$tl getframe]
3028        if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $setref]] != 0} {
3029          bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd]
3030          pack $tlf.g -fill both -expand yes
3031          $tl restore
3032          update
3033          # Esta opción se debe aplicar cuando el gráfico esté empacado
3034          ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3035        } else {
3036          destroy $tl
3037          return
3038        }
3039        $tl bind <Control-F4> [list $tl kill]             
3040      }
3041      1 -
3042      2 -
3043      3 {
3044        # windows
3045        set tl [::project::CreateForm \
3046          -title [mc "Set graph: %s" $name] -type Graphs -iniconfig SetGraph]
3047        $tl withdraw       
3048        set tlf [$tl getframe]
3049        set Instance [::SetGraphDialog::DrawSet $tlf.g $cmd $setref $type]
3050        bind $tlf.g <Destroy> +[list ::tol::tableset destroy $cmd]
3051        pack $tlf.g -fill both -expand yes
3052        $tl restore
3053        update
3054        # Esta opción se debe aplicar cuando el gráfico esté empacado       
3055        ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3056      }
3057    }
3058  } else {
3059    tk_messageBox -type ok -icon warning \
3060        -message [mc "Set is not graficable: %s" $::errorInfo] \
3061        -parent $w_tabset -title [mc "Warning"]
3062  }
3063}
3064
3065#/////////////////////////////////////////////////////////////////////////////
3066proc ::TolInspector::DrawMatrix {matref} {
3067#
3068# PURPOSE: draw the given matrix
3069#
3070# PARAMETERS:
3071#   matref -> reference to the tol matrix
3072#
3073#/////////////////////////////////////////////////////////////////////////////
3074  variable group_id
3075  variable w_tabset
3076
3077  incr group_id
3078  if {[llength $matref] > 1} {
3079    set name [lindex [::tol::info variable $matref] 1]
3080  } else {
3081    if { ([info exists obj]) } {
3082      set name $obj
3083    }
3084  }
3085  if { ([info exists name]) } {
3086    set cmd tablecmd$group_id
3087    if {![catch {::tol::tablematrix create $cmd $matref}]} {
3088      set tl [::project::CreateForm \
3089                  -width 500 -height 500 -type Graphs \
3090                  -iniconfig Graph \
3091                  -title [mc "Matrix graph: %s" $name] -helpkey "Tb4Gra"]
3092      $tl withdraw
3093   
3094      set tlf [$tl getframe]
3095      if {[set Instance [::SetGraphDialog::Init $tlf.g $cmd $matref]] != 0} {
3096        bind $tlf.g <Destroy> +[list ::tol::tablematrix destroy $cmd]
3097        pack $tlf.g -fill both -expand yes
3098            $tl restore
3099        update
3100        # Esta opción se debe aplicar cuando el gráfico esté empacado
3101        ::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3102      } else {
3103        destroy $tl
3104        return
3105      }
3106      $tl bind <Control-F4> [list $tl kill]
3107    } else {
3108      tk_messageBox -type ok -icon warning \
3109        -message [mc "Matrix is not graficable: %s" $::errorInfo] \
3110        -parent $w_tabset -title [mc "Warning"]
3111    }
3112  }
3113}
3114
3115#/////////////////////////////////////////////////////////////////////////////
3116proc ::TolInspector::TableSet { set } {
3117#///////////////////////////////////////////////////////////////////////////// 
3118  variable w_tabset
3119  variable group_id
3120
3121  incr group_id
3122  if {[llength $set] > 1} {
3123    set nameSet [lindex [::tol::info variable $set] 1]
3124  } else {
3125    set nameSet $set
3126  }
3127  set setgrp group$group_id
3128  if {![catch {::tol::tableset create $setgrp $set}]} {
3129    # create
3130    set tl [::project::CreateForm \
3131        -title    "[mc "Set table"]: $nameSet" \
3132        -iniconfig SetTable \
3133        -type Tables -helpkey "Tb4Edt"
3134    ]
3135    set tlf [$tl getframe]
3136    # config
3137    btable $tlf.t -parent $tl \
3138                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3139                  -iniconfig btable
3140    $tlf.t fillSet $setgrp
3141    pack $tlf.t -fill both -expand yes
3142    bind $tlf.t <Destroy> +[list ::tol::tableset destroy $setgrp]
3143    $tl bind <Control-F4> [list $tl kill]
3144    update
3145  } else {
3146    tk_messageBox -type ok -icon warning -message [mc "Set not tabulable"]\
3147        -parent $w_tabset -title [mc Warning]
3148  }
3149}
3150
3151#/////////////////////////////////////////////////////////////////////////////
3152proc ::TolInspector::TableMatrix { matrix } {
3153#/////////////////////////////////////////////////////////////////////////////
3154  set mattb [::tol::matrix $matrix]
3155  # create
3156  set tl [::project::CreateForm \
3157              -title "[mc {Matrix table}]: [lindex $mattb 0]" \
3158              -iniconfig MatrixTable \
3159              -type Tables -helpkey "Tb4Edt"
3160  ]
3161  set tlf [$tl getframe]
3162  # create matrix
3163  btable $tlf.t -parent $tl \
3164                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3165                -iniconfig btable
3166  $tlf.t fillMatrix $mattb
3167  $tl bind <Control-F4> [list $tl kill] 
3168  pack $tlf.t -fill both -expand yes
3169
3170  #if {$grammar == "VMatrix"} {
3171    #::tol::console stack release "zxw._.wxz"
3172  #}
3173}
3174
3175#/////////////////////////////////////////////////////////////////////////////
3176proc ::TolInspector::ExportBDTMatrix { matrix } {
3177#/////////////////////////////////////////////////////////////////////////////
3178  variable group_id
3179 
3180  incr group_id
3181  set tl [toplevel .top$group_id]
3182  wm title $tl "ExportBDTMatrix"
3183 
3184  #pack $tl.t -fill both -expand yes
3185}
3186
3187#/////////////////////////////////////////////////////////////////////////////
3188proc ::TolInspector::DrawSerie { } {
3189#///////////////////////////////////////////////////////////////////////////// 
3190  variable options_selected
3191  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
3192 
3193  #puts "DrawSerie: series_selected=$series_selected"
3194  set series ""
3195  foreach it $series_selected {
3196    lappend series [lindex $it 0]
3197  }
3198  DrawSeries $series
3199}
3200
3201#/////////////////////////////////////////////////////////////////////////////
3202proc ::TolInspector::DrawSeries { series {gcf ""}} {
3203#///////////////////////////////////////////////////////////////////////////// 
3204  variable group_id
3205
3206  if { [llength $series] } {
3207    incr group_id
3208    # series     
3209    set sergrp group$group_id
3210    set t0 [time {
3211    eval "::tol::seriegrp create $sergrp $series"
3212    }]
3213    # name
3214    set name [$sergrp serie 0 name]
3215    if { [$sergrp serie size] > 1} {
3216      set name ${name}...
3217    }
3218    # create
3219    set t1 [time {
3220    set tl [::project::CreateForm \
3221        -title [mc "Series graph: %s" $name] \
3222        -type Graphs \
3223        -iniconfig SeriesGraph \
3224        -width 900 -height 650 -helpkey "Tb4GraSer"
3225           ]}]
3226    set tlf [$tl getframe]
3227    # configuration
3228    set t2 [time {
3229    set Instance [::SeriesGraph::Create $tlf.g $sergrp]
3230    }]
3231    #puts "t0 = $t0"
3232    #puts "t1 = $t1"
3233    #puts "t2 = $t2"
3234    if { $gcf != "" } {
3235      ::bayesGraph::LoadGCF $Instance $gcf
3236    }
3237    bind $tlf.g <Destroy> +[list ::tol::seriegrp destroy $sergrp]
3238    pack $tlf.g -fill both -expand yes
3239    $tl bind <Control-F4> [list $tl kill]
3240    update
3241    # Esta opción se debe aplicar cuando el gráfico esté empacado
3242    #::bayesGraph::GrapOptApplyAxisTicks $Instance ${Instance}::options gr,0
3243  }
3244}
3245
3246#/////////////////////////////////////////////////////////////////////////////
3247proc ::TolInspector::DrawAutocorSerie { serie } {
3248#///////////////////////////////////////////////////////////////////////////// 
3249  variable group_id
3250   
3251  incr group_id
3252  # title
3253 
3254  if {[llength $serie] > 1} {
3255    set nameSerie [lindex [::tol::info variable $serie] 1]
3256  } else {
3257    set nameSerie $serie
3258  }
3259  # create
3260  set tl [::project::CreateForm \
3261      -title "[mc "Autocorrelation graph"]: $nameSerie" \
3262      -iniconfig AutocorGraph \
3263      -type Graphs \
3264      -width 900 -height 650 -helpkey "Tb4GraAco"
3265  ]
3266  set tlf [$tl getframe]
3267  # configuration
3268  ::AutocorGraph::Create $tlf.g $serie
3269  $tl bind <Control-F4> "$tl kill; break"
3270  pack $tlf.g -fill both -expand yes
3271  update
3272}
3273
3274#/////////////////////////////////////////////////////////////////////////////
3275proc ::TolInspector::TableSerie { } {
3276#///////////////////////////////////////////////////////////////////////////// 
3277  variable options_selected
3278  variable group_id
3279  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
3280
3281  set series ""
3282  foreach it $series_selected {
3283    lappend series [lindex $it 0]
3284  }
3285
3286  if { [llength $series] } {
3287    incr group_id
3288
3289    set sergrp group$group_id
3290    eval "::tol::seriegrp create $sergrp $series"
3291   
3292    # create
3293    set tl [::project::CreateForm \
3294        -title [mc "Time series table"] \
3295        -iniconfig SeriesTable \
3296        -type Tables -helpkey "Tb4Edt"
3297    ]
3298        set tlf [$tl getframe]
3299    # configuration
3300    btable $tlf.t -parent $tl \
3301                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3302                  -iniconfig btable
3303    $tlf.t fillSerie $sergrp
3304    bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp]
3305    pack $tlf.t -fill both -expand yes
3306    $tl bind <Control-F4> [list $tl kill]
3307    update
3308  }
3309}
3310
3311#/////////////////////////////////////////////////////////////////////////////
3312proc ::TolInspector::TableAutocorSerie { serie } {
3313#///////////////////////////////////////////////////////////////////////////// 
3314  variable group_id
3315   
3316  incr group_id
3317  # title
3318  if {[llength $serie] > 1} {
3319    set nameSerie [lindex [::tol::info variable $serie] 1]
3320  } else {
3321    set nameSerie $serie
3322  }
3323  # create
3324  set tl [::project::CreateForm \
3325      -title "[mc "Autocorrelation table"]: $nameSerie" \
3326      -iniconfig AutocorGraphTable \
3327      -type Tables -helpkey "Tb4Edt"
3328  ]
3329  set tlf [$tl getframe]
3330  # configuration
3331  btable $tlf.t -parent $tl \
3332                -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3333                -iniconfig btable
3334  $tlf.t fillAutocor $serie ""
3335  $tl bind <Control-F4> [list $tl kill]
3336  pack $tlf.t -fill both -expand yes
3337}
3338
3339#/////////////////////////////////////////////////////////////////////////////
3340proc ::TolInspector::TableStatisticsSerie { } {
3341#/////////////////////////////////////////////////////////////////////////////
3342  variable options_selected
3343  variable group_id
3344  upvar \#0 ::TolInspector::options_selected(Serie) series_selected
3345
3346  set series ""
3347  foreach it $series_selected {
3348    lappend series [lindex $it 0]
3349  }
3350
3351  if { [llength $series] } {
3352    incr group_id
3353
3354    set sergrp group$group_id
3355    eval "::tol::seriegrp create $sergrp $series"
3356    # create
3357    set tl [::project::CreateForm \
3358        -title [mc "Statistics table"] \
3359        -iniconfig StatisticsTable \
3360        -type Tables -helpkey "Tb4Edt"
3361    ]
3362    set tlf [$tl getframe]
3363    # configuration
3364    btable $tlf.t -parent $tl \
3365                  -posteditcmd [list ::TolConsole::TableRecentUpdate $tlf.t] \
3366                  -iniconfig btable
3367    $tlf.t fillStatistics $sergrp
3368    bind $tlf.t <Destroy> +[list ::tol::seriegrp destroy $sergrp]
3369    $tl bind <Control-F4> [list $tl kill]
3370    pack $tlf.t -fill both -expand yes
3371  }
3372}
3373
3374#/////////////////////////////////////////////////////////////////////////////
3375proc ::TolInspector::ViewTimeSet { tms args } {
3376#/////////////////////////////////////////////////////////////////////////////
3377  variable group_id
3378 
3379  incr group_id
3380 
3381  #puts "::TolInspector::ViewTimeSet $tms"
3382  # args
3383  array set opts [list \
3384    -title "[mc "TimeSet calendar"]: $tms" \
3385    -geometry {}
3386  ]
3387  array set opts $args 
3388 
3389  # create
3390  set tl [::project::CreateForm \
3391      -title $opts(-title) \
3392      -iniconfig Calendar \
3393      -type TimeSets -width 470 -height 345 -helpkey "Tb4Cal"
3394  ]
3395  # geometry
3396  $tl setgeometry $opts(-geometry)
3397 
3398  set tlf [$tl getframe]
3399  # configuration
3400  set tmscmd tms$group_id
3401  ::tol::timeset create $tmscmd $tms
3402  ::CalendarTms::Create $tlf.t $tmscmd
3403  bind $tlf.t <Destroy> +[list ::tol::timeset destroy $tmscmd]
3404  bind $tl <Control-F4> [list $tl kill]
3405  pack $tlf.t -fill both -expand yes
3406 
3407  return $tl
3408}
3409
3410#/////////////////////////////////////////////////////////////////////////////
3411proc ::TolInspector::ViewDefinition {name path grammar} {
3412#/////////////////////////////////////////////////////////////////////////////
3413  variable w_tabset
3414  if {$path == ""} {
3415    tk_messageBox -type ok -icon warning\
3416      -message [mc "Object %1\$s is not defined in a tol file" $name]\
3417      -parent $w_tabset -title [mc Warning]
3418    return
3419  }
3420  set ext [file extension $path]
3421  switch -- $ext {
3422    .tol -
3423    .TOL {
3424      set Instance [::Editor::Open $path]
3425      update
3426      if {[string equal $grammar "Code"] ||
3427          [string equal $grammar "Anything"]} {
3428        append txtFind " " $name "( )*\\("
3429      } else {
3430        #append txtFind $grammar "( )+" $name
3431        append txtFind $name
3432      }
3433      #Me situo al principio del texto
3434      set editor [::Editor::GetText $Instance]
3435      tk::TextSetCursor $editor 1.0
3436      ::BayesText::FindShow $editor 1 $txtFind 1
3437      #::Editor::CmdFindNext $Instance $txtFind
3438    }
3439    .bst -
3440    .BST -
3441    .bdt -
3442    .BDT {
3443      # Igual luego se abre como tabla
3444      ::Editor::Open $path
3445    }
3446  }
3447}
3448
3449#/////////////////////////////////////////////////////////////////////////////
3450proc ::TolInspector::ViewFile {name} {
3451#
3452# PURPOSE:
3453#
3454# PARAMETERS:
3455#   name -> cadena con el nombre de un archivo o el de una variable
3456#           que hace referencia a un archivo
3457#
3458#/////////////////////////////////////////////////////////////////////////////
3459  #  En name puede venir el nombre de un archivo o el de una variable
3460  # que hace referencia a un archivo.
3461  #puts "ViewFile. name=$name"
3462  if [file isfile $name] {
3463    set path $name
3464  } else  {
3465    set path [::tol::info path $name]
3466  }
3467  ::Editor::Open $path
3468}
3469
3470#/////////////////////////////////////////////////////////////////////////////
3471proc ::TolInspector::DecompileFile {name} {
3472#
3473# PURPOSE:
3474#
3475# PARAMETERS:
3476#   name -> cadena con el nombre de un archivo o el de una variable
3477#           que hace referencia a un archivo
3478#
3479# TODO: Actualmente en name solo puede llegar el nombre de un archivo
3480#
3481#/////////////////////////////////////////////////////////////////////////////
3482  variable data
3483  #puts "DECOMPILE 1.1, name=$name"
3484  if {[file isfile $name]} {
3485    set path $name
3486  } else  {
3487    set path [::tol::info path $name]
3488  }
3489  #puts "DECOMPILE 1.2"
3490  #Comprobar si el archivo ya está abierto y si es así poner que no está compilado
3491  if [namespace exists ::Editor] {
3492    foreach ins [namespace children ::Editor] {
3493      upvar \#0 ${ins}::data dataEd
3494      if [string equal $dataEd(nameFile) $path] {
3495        set dataEd(isCompiled) 0
3496      }
3497    }
3498  }
3499  #puts "DECOMPILE 1.3"
3500  #Quitar del spool todos los objetos provenientes de este archivo
3501 
3502  foreach _obj $data(pool,objects) {
3503    array set obj $_obj
3504    #Tolcon_Trace "REFERENCIA: $obj(reference)"
3505    if {[string equal [lindex $obj(reference) 0] $path]} {
3506      set idx [lsearch $data(pool,objects) $_obj]
3507      set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
3508    }
3509  }
3510  ::tol::decompile $path
3511  ::TolInspector::UpdateFileRoot
3512}
3513
3514#/////////////////////////////////////////////////////////////////////////////
3515proc ::TolInspector::ReadUserFunctions {} {
3516#
3517# PURPOSE: Recorre el set global que tiene la definicion de funciones y va
3518#          guardando esa informacion en arrays para almacenarla finalmente en
3519#          regFunLst
3520#
3521#/////////////////////////////////////////////////////////////////////////////
3522  variable regFunLst
3523 
3524  #Set global que tiene la definicion de funciones
3525  set obj GuiFunction
3526
3527  if { [llength [set infAry [TclInfoVar Set $obj]] ] } {
3528    #Tolcon_Trace "ReadUserFunctions: infAry = $infAry"
3529    array set info $infAry
3530    set nFun [lindex $info(CONTENT) 0]
3531    #Tolcon_Trace "Numero de funciones =$nFun"
3532    for  {set idf 1} {$idf <= $nFun} {incr idf} {
3533      array set ifNameFun [TclInfoRef [list Set $obj $idf 1]]
3534      array set ifNameGui [TclInfoRef [list Set $obj $idf 2]]
3535      array set ifTypeGui [TclInfoRef [list Set $obj $idf 3]]
3536      array set ifTypeOut [TclInfoRef [list Set $obj $idf 4]]
3537      array set ifParams  [TclInfoRef [list Set $obj $idf 5]]
3538      #Hago lindex $a(CONTENT) 0 para quitar las comillas
3539      set regFun($idf,nameFun) [lindex $ifNameFun(CONTENT) 0]
3540      set regFun($idf,nameGui) [lindex $ifNameGui(CONTENT) 0]
3541      set regFun($idf,typeGui) [lindex $ifTypeGui(CONTENT) 0]
3542      set regFun($idf,typeOut) [lindex $ifTypeOut(CONTENT) 0]
3543      set nPar [lindex $ifParams(CONTENT) 0]
3544      #Tolcon_Trace "Numero de parametros =$nPar"
3545      for  {set idp 1} {$idp <= $nPar} {incr idp} {
3546        array set ipNameGui [TclInfoRef [list Set $obj $idf 5 $idp 1]]
3547        array set ipTypePar [TclInfoRef [list Set $obj $idf 5 $idp 2]]
3548        array set ipTypeSel [TclInfoRef [list Set $obj $idf 5 $idp 3]]
3549        array set ipListVal [TclInfoRef [list Set $obj $idf 5 $idp 4]]
3550        set regPar($idp,nameGui) [lindex $ipNameGui(CONTENT) 0]
3551        set regPar($idp,typePar) [lindex $ipTypePar(CONTENT) 0]
3552        set regPar($idp,typeSel)         $ipTypeSel(CONTENT)
3553        set nVal [lindex $ipListVal(CONTENT) 0]
3554        #Tolcon_Trace "nVal=$nVal"
3555        set lstVal ""
3556        for  {set idv 1} {$idv <= $nVal} {incr idv} {
3557           array set iVal [TclInfoRef [list Set $obj $idf 5 $idp 4 $idv]]
3558           lappend lstVal [lindex $iVal(CONTENT) 0]
3559        }
3560        set regPar($idp,lstVal) $lstVal
3561      }
3562      set regFun($idf,parameters) [array get regPar]
3563      array unset regPar
3564      #parray regFun
3565    }
3566    set regFunLst [array get regFun]
3567  } else {
3568    set regFunLst ""
3569  }
3570}
3571
3572#/////////////////////////////////////////////////////////////////////////////
3573proc ::TolInspector::ShowMenuUserFunc {gra} {
3574#
3575# PURPOSE: Muestra un menu contextual que...
3576#
3577#/////////////////////////////////////////////////////////////////////////////
3578  variable data_menu
3579  variable regFunLst
3580 
3581  #puts "ShowMenuUserFunc: gra=$gra"
3582  if {[expr [info exist ::TolInspector::regFunLst] && [llength $regFunLst] ]} {
3583    array set regFun $regFunLst
3584    regsub -all ,nameGui \
3585       [array names regFun *,nameGui] "" lstFun
3586    foreach idf [lsort -integer $lstFun] {
3587      set typeGui [split $regFun($idf,typeGui) .]
3588      switch  [lindex $typeGui 0] {
3589        Ite - Set {
3590          if {[lindex $typeGui 1] eq $gra} {
3591            $data_menu($gra,Functions) add command -label [mc $regFun($idf,nameGui)]\
3592              -command [list ::TolInspector::CallUserFunction $gra $idf]
3593          }
3594        }
3595        default {
3596        }
3597      }
3598    }
3599  }
3600}
3601
3602#/////////////////////////////////////////////////////////////////////////////
3603proc ::TolInspector::CallUserFunction {grammar idx} {
3604#
3605# PURPOSE: Para los tipos de funciones Ite y Set, muestra un dialogo que
3606#          pide los
3607#
3608#/////////////////////////////////////////////////////////////////////////////
3609  variable regFunLst
3610  variable group_id
3611  variable data
3612  variable options_selected
3613
3614  upvar \#0 ::TolInspector::options_selected($grammar) items_selected
3615  #puts "CallUserFunction. grammar=$grammar, idx=$idx, items_selected=$items_selected"
3616 
3617  set all_objs [ list ]
3618  foreach it $items_selected {
3619    set tcl_ref [ lindex $it 0 ]
3620    set obj_addr [ ::tol::info address $tcl_ref ]
3621    lappend all_objs "GetObjectFromAddress(\"$obj_addr\")"
3622  }
3623
3624  if { [ llength $all_objs ] } {
3625    incr group_id
3626    array set regFun $regFunLst
3627    set gui [bguifunction .t$group_id \
3628                 -title $regFun($idx,nameGui) \
3629                 -regpars $regFun($idx,parameters)]
3630    set txtPars [join [$gui get values] ,]
3631    if {$txtPars ne ""} {
3632      set txtPars ",$txtPars"
3633    }
3634    destroy $gui
3635    set typeGui [split $regFun($idx,typeGui) .]
3636    switch [lindex $typeGui 0] {
3637      Ite {
3638        foreach obj $all_objs {
3639          set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($obj $txtPars)"
3640          #Tolcon_Trace "Ite.cmd=$cmd"
3641          ::tol::console eval $cmd
3642          ::TolConsole::SaveEval $cmd
3643        }
3644      }
3645      Set {
3646        set obj_args [join $all_objs ,]
3647        set setCmd "SetOf[lindex $typeGui 1] ($obj_args)"
3648        set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($setCmd $txtPars)"
3649        #Tolcon_Trace "Set.cmd=$cmd"
3650        ::tol::console eval $cmd
3651        ::TolConsole::SaveEval $cmd
3652      }
3653      default {
3654      }
3655    }
3656    ::TolInspector::UpdateConsoleObj
3657  }
3658}
3659
3660namespace eval ::LoadStatus {
3661  variable data
3662}
3663
3664#proc ::LoadStatus::Show {file} {
3665#   
3666#  set f [toplevel .topStatus]
3667#  #wm protocol $path WM_DELETE_WINDOW [list ::Editor::OnDelete $this]
3668#  # bind Destroy más abajo
3669# 
3670#  label $f.lfile -text $file
3671#  # frame y label para barra de estado
3672#  set data(sb,frame) [frame $f.fop -relief groove -bd 1 -height 7]
3673#  set data(sb,objs)  [label $f.fop.objs -relief groove -bd 1 -width 16]
3674#  set data(sb,files) [label $f.fop.files -text [mc "Not Compiled"] \
3675#          -relief raised -bd 1 -width 16]
3676#  set data(sb,time)  [label $f.fop.time -bd 1 -width 14]
3677#  set data(sb,rell)  [label $f.fop.rell -relief groove -bd 1]
3678# 
3679# 
3680#  # empaquetamos los label de estado
3681#  pack $f.fop.objs $f.fop.files $f.fop.time -side left
3682#  pack $f.fop.rell -expand true -fill x
3683# 
3684#  grid $f.lfile -sticky news
3685#  grid $f.fop   -sticky ews
3686# 
3687#  grid rowconfigure    $f 1 -weight 1
3688#  grid columnconfigure $f 0 -weight 1
3689#   
3690#}
3691#
3692#
3693#proc ::LoadStatus::Hide {w} {
3694#   
3695#
Note: See TracBrowser for help on using the repository browser.