Context Navigation

tolinspe.tcl @ 56ade3b

1941-docker-image-to-testdevel

Last change on this file since 56ade3b was 56ade3b, checked in by Jorge Pérez <josp.jorge@…>, 10 years ago

fixes #1932, se ha creado la rama trunk/tolbaseBLT copia de trunk/tolbase

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

Property mode set to 100644

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: tol/tolbaseBLT/lib/toltk/tolinspe.tcl @ 56ade3b

Download in other formats: