source: tol/tolbase/lib/toltk/tolinspe.tcl @ 57e34db

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

closes #885, un elemento de menu retornado por getMenuEntries sigue la
siguiente estructura:

  [[ "Option Label", "Instance_Method", "Group_Method" ]]

donde:

"Option Label" es la etiqueta que se muestra en el menu

"Instance_Method" es el nombre del metodo de instancia que se invoca

al seleccionar la opcion de menu.

"Group_Method" es el nombre de metodo estatico que se invoca cuando

se aplica la opcion de menu sobre una seleccion
multiple. Este valor es opcional.

por ejemplo las variables de MMS implementan el el metodo:

   Set getMenuEntries(Real void) {
    Set [[ [[ "Chart", "Chart", "ChartGroup" ]] ]]
   }

y las clases derivadas deben implementar el metodo de instancia Chart
y el metodo Static ChartGroup con el siguiente prototipo:

  Real Chart( Real void )
  Static Real ChartGroup( Set instances )

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