Context Navigation

tolinspe.tcl @ e3362cc

1941-docker-image-to-testdevel

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

fixes #945, ticket done & test updated, see also commit [2400], updating new functions in tclIndex

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

Property mode set to 100644

File size: 123.6 KB

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

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

Context Navigation

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

Download in other formats: