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

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

(Cont.) Se resuelven las dos primeras propuestas.
Refs #1130

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