Context Navigation

tolinspe.tcl @ ca01e16

1941-docker-image-to-testdevel

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

Deal with custom GUI method implemented in clases derived from @MenuDesc

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

Property mode set to 100644

File size: 115.8 KB

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

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

Context Navigation

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

Download in other formats: