Context Navigation

tolinspe.tcl @ 8d687fe

1941-docker-image-to-testdevel

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

refs #1364, todas los tipos de TOL, excepto Anything, despliegan opciones de menu definidas en MenuManager, ver ejemplo https://www.tol-project.org/browser/tolp/OfficialTolArchiveNetwork/GuiTools/test/test_0005/test.tol?rev=3955

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

Property mode set to 100644

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

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

Context Navigation

source: tol/tolbase/lib/toltk/tolinspe.tcl @ 8d687fe

Download in other formats: