Context Navigation

tolinspe.tcl @ bc68cb2

1941-docker-image-to-testdevel

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

refs #1438, evito el error en el spool, todavia no se cierra el ticket

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

Property mode set to 100644

File size: 128.2 KB

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

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

Context Navigation

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

Download in other formats: