Context Navigation

tolinspe.tcl @ 3f0542d

1941-docker-image-to-testdevel

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

fixes #896

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

Property mode set to 100644

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

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

Context Navigation

source: tol/tolbase/lib/toltk/tolinspe.tcl @ 3f0542d

Download in other formats: