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

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

fixes #953

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