Context Navigation

tolinspe.tcl @ 6d7779d

1941-docker-image-to-testdevel

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

initial import

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

Property mode set to 100644

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

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

Context Navigation

source: tol/tolbase/lib/toltk/tolinspe.tcl @ 6d7779d

Download in other formats: