source: tol/tolbase/lib/toltk/tolinspe__wtree1.tcl @ 0731938

1941-docker-image-to-testdevel
Last change on this file since 0731938 was 0731938, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933

  • Se corrige la acción del doble clic sobre un nodo, para evitar errores cuando no está seleccionado.
  • Se utiliza la columna gramática para obtenerla cuando hace falta.
  • Se obvia (temporalmente) el insert de wtree por lento, se insertándose directamente sobre treectrl.
  • Se corrige ClearHiertables para evitar que se intenten seleccionar nodos mientras se borran.
  • Se sustituye el tabset de BLT por el NoteBook de BWidget. Se dejan sin efecto la desactivación de las pestañas (véanse los comentarios #@D)

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

  • Property mode set to 100644
File size: 28.6 KB
Line 
1
2#/////////////////////////////////////////////////////////////////////////////
3proc ::TolInspector::LNodeDef { } {
4#/////////////////////////////////////////////////////////////////////////////
5  return [list \
6    [list {image text} -label Name] \
7    [list text -label Index] \
8    [list text -label Grammar] \
9    [list text -label Reference]
10  ]
11}
12
13#/////////////////////////////////////////////////////////////////////////////
14proc ::TolInspector::LNode {index grammar icon name reference} {
15#/////////////////////////////////////////////////////////////////////////////
16  return [list \
17    [list $icon $name] \
18    [list $index] \
19    [list $grammar] \
20    [list $reference] \
21  ]
22}
23
24proc ::TolInspector::LiName         { } { return 0 }
25proc ::TolInspector::LiIndex        { } { return 1 }
26proc ::TolInspector::LiGrammar      { } { return 2 }
27proc ::TolInspector::LiReference    { } { return 3 }
28
29#/////////////////////////////////////////////////////////////////////////////
30proc ::TolInspector::RNodeDef { } {
31#/////////////////////////////////////////////////////////////////////////////
32  return [list \
33    [list text -label Index] \
34    [list text -label Grammar] \
35    [list {image text} -label Name] \
36    [list text -label Content] \
37    [list text -label Description] \
38    [list text -label Path] \
39    [list text -label Reference] \
40  ]
41}
42
43#/////////////////////////////////////////////////////////////////////////////
44proc ::TolInspector::RNode {index grammar icon name content description path reference} {
45#/////////////////////////////////////////////////////////////////////////////
46  return [list \
47    [list $index] \
48    [list $grammar] \
49    [list $icon $name] \
50    [list $content] \
51    [list $description] \
52    [list $path] \
53    [list $reference] \
54  ]
55}
56
57proc ::TolInspector::RiIndex        { } { return 0 }
58proc ::TolInspector::RiGrammar      { } { return 1 }
59proc ::TolInspector::RiName         { } { return 2 }
60proc ::TolInspector::RiContent      { } { return 3 }
61proc ::TolInspector::RiDescription  { } { return 4 }
62proc ::TolInspector::RiPath         { } { return 5 }
63proc ::TolInspector::RiReference    { } { return 6 }
64
65#/////////////////////////////////////////////////////////////////////////////
66proc ::TolInspector::InsertChild { args } {
67#
68# PURPOSE: Inserts a node in the corresponding wtree of the right panel.
69#
70# PARAMETERS:
71#   args[0] -> grammar
72#   args[1] -> name
73#   args[2] -> content
74#   args[3] -> path
75#   args[4] -> desc
76#   Si grammar == "Code"
77#    args[5] -> ¿es una variable?
78#   Si grammar == "Set" || "NameBlock"
79#    args[5] -> indexes of the set
80#    args[6] -> is file?
81#    args[7] -> has subset?
82#    args[8] -> subtype
83#
84#/////////////////////////////////////////////////////////////////////////////
85  variable wt_vars
86  variable wt_funcs
87
88  set grammar [lindex $args 0]
89  set name    [lindex $args 1]
90  set content [lindex $args 2]
91  set path    [lindex $args 3]
92  set desc    [lindex $args 4]
93
94  switch $grammar {
95    Code {
96      set isvar [lindex $args 5]
97      if { [string equal $isvar "1"] } {
98        InsertItem $wt_vars $grammar $name $content $path $desc {}
99      } else {
100        InsertItem $wt_funcs $grammar $name $content $path $desc {}
101      }
102    }
103    NameBlock -
104    Set {
105      #puts "HTItem, ref = '$ref' '$args'"
106      # args[5] is the index of the set object
107      # args[6] is the flag file
108      # args[8] is the subtype
109      InsertItem $wt_vars $grammar $name $content $path $desc [lindex $args 8]
110      # [lindex $args 5] [lindex $args 6] [lindex $args 8] $ref
111    }
112    default {
113      InsertItem $wt_vars $grammar $name $content $path $desc {}
114    }
115  }
116}
117
118#/////////////////////////////////////////////////////////////////////////////
119proc ::TolInspector::InsertItem {wt grammar name content path desc subtype} {
120#/////////////////////////////////////////////////////////////////////////////
121  variable wt_tree
122  variable arguments
123
124  #upvar \#0 ::TolTk::Images Images
125
126  set parent_grammar $arguments(parent_grammar) 
127 
128  #@ Si la llamada a InsertChild viene de SelectSet el argumento tolref
129  #@ no está definido y se crea a partir de parent_tolref
130  set tolref $arguments(tolref)
131  if { $tolref eq "" } {
132    set tolref $arguments(parent_tolref)
133    lappend tolref $arguments(index)
134  }
135 
136  if { $parent_grammar eq "NameBlock" } {
137    array set info_member [ FilterNameBlockMember $name ]
138    if { !$info_member(-show) } {
139      incr arguments(index)
140      return
141    }
142    set fcolor $info_member(-fcolor)
143  } else {
144    set fcolor "black"
145  }
146
147  set brief_cont [TrimContent $grammar $content]
148  set brief_desc [TrimContent DONTCARE $desc]
149               
150  set data3 $brief_cont
151  if {$grammar eq "NameBlock"} {
152    #(pgea) se utiliza la informacon de instancia
153    #puts "Tol_ClassOfFromReference $tolref"
154    set classOf [Tol_ClassOfFromReference $tolref]
155    #puts "Tol_InstanceContentFromReference $tolref"
156    set insCont [Tol_InstanceContentFromReference $tolref]
157    if {$insCont ne ""} {
158      set data3 [TrimContent $grammar $insCont]
159    } elseif {$classOf ne ""} {
160      set data3 $classOf
161    }   
162  }
163
164  #@ Se localiza el icono según la gramática
165  if {$grammar eq "Set" || $grammar eq "NameBlock"} {
166    if {$grammar eq "Set"} {
167      set icon_grammar [SubTypeImage $subtype]
168    } else {
169      set objAddress [tol::info address $tolref]
170      set icon_grammar [::ImageManager::getIconForInstance $objAddress]
171    }
172  } elseif { $grammar eq "Anything" } {
173    set anyType [ tol::info Anything $tolref ]
174    set icon_grammar [::Bitmap::get $anyType]
175  } else {
176    set icon_grammar [::Bitmap::get $grammar]
177  }
178 
179  #? set label [OneLine $name]
180  #? if {$label eq ""} {
181  #?   if {[set label $brief_desc] eq ""} {
182  #?     set label " "
183  #?   }
184  #? }
185 
186  #@ ::TolInspector::RNode index grammar
187  #@   icon name content description path reference
188  #@! set wt_row [::TolInspector::RNode $arguments(index) $grammar \
189    $icon_grammar $name $data3 $brief_desc $path $tolref] 
190  #@! set idx [$wt insert $wt_row -at child -relative root]
191  #@! Las líneas anteriores parecen lentas y se sustituyen por las siguientes:
192  set idx [$wt item create -button 1]
193  $wt item element configure $idx \
194    [RiIndex] eTXT -text $arguments(index) , \
195    [RiGrammar] eTXT -text $grammar , \
196    [RiName] eIMG -image $icon_grammar + eTXT -text $name , \
197    [RiContent] eTXT -text $data3 , \
198    [RiDescription] eTXT -text $brief_desc , \
199    [RiPath] eTXT -text $path , \
200    [RiReference] eTXT -text $tolref
201  $wt item lastchild root $idx 
202 
203  $wt item element configure $idx \
204    [RiIndex] eTXT -fill $fcolor , \
205    [RiName] eTXT -fill $fcolor , \
206    [RiContent] eTXT -fill $fcolor , \
207    [RiDescription] eTXT -fill $fcolor , \
208    [RiPath] eTXT -fill $fcolor
209
210  incr arguments(index)
211}
212
213#/////////////////////////////////////////////////////////////////////////////
214proc ::TolInspector::ClearHiertables { } {
215#
216# PURPOSE:
217#
218#/////////////////////////////////////////////////////////////////////////////
219  variable w_tabset
220  variable wt_vars
221  variable wt_funcs
222  variable OnSelectItem
223
224  $wt_vars selection clear
225  $wt_vars item delete all
226  $wt_funcs selection clear
227  $wt_funcs item delete all
228
229  #@ToDo $wt_vars  column configure Index -hide no
230  #@ToDo $wt_funcs column configure Index -hide no
231 
232  $w_tabset itemconfigure Variables -text [mc Variables] -state normal
233  $w_tabset itemconfigure Functions -state normal
234
235  if { [string length $OnSelectItem] } {
236    $OnSelectItem
237  }
238}
239
240#/////////////////////////////////////////////////////////////////////////////
241proc ::TolInspector::OpenObject { node } {
242#
243# PURPOSE: Script called each time a node in wt_tree (left wtree) is opened.
244#
245# PARAMETERS:
246#   node : The id of the node opened
247#
248#/////////////////////////////////////////////////////////////////////////////
249  variable wt_tree
250  variable arguments
251 
252  #@ No es necesario llenar ni el nodo root (0) ni root-grammars (1)
253  if { $node == 0 } return
254  if { $node == 1 } return 
255
256  #@ Argumentos pasados por atributo
257  #@  + parent_node es usado por InsertSubset para saber dónde insertar
258  set arguments(parent_node) $node
259  set tolReference [$wt_tree item text $node [LiReference]]
260 
261  if { [llength $tolReference] == 1 } {
262    #@ Aquí llegan los nodos raíz y las gramáticas
263    switch $tolReference {
264      Package InsertPackages
265      File    InsertFiles
266      Console InsertConsoleObj
267      default return
268    }
269  } elseif { [lindex $tolReference 0] == "Grammar" } {
270    return
271  } else {
272    Busy
273    #@ Argumentos pasados por atributo
274    #@  + parent_grammar es usado por InsertSubset para abrir o no un nodo
275    #@  + parent_tolref es usado por InsertSubset para determinar tolref
276    set arguments(parent_grammar) [$wt_tree item text $node [LiGrammar]]
277    set arguments(parent_tolref) $tolReference
278    ::tol::forallchild $tolReference ::TolInspector::InsertSubset
279    NotBusy
280  }
281}
282
283#/////////////////////////////////////////////////////////////////////////////
284proc ::TolInspector::InsertPackages {} {
285#
286# PURPOSE: Inserts a node in wt_tree (left ::wtree) for each TOL packages
287#
288#/////////////////////////////////////////////////////////////////////////////
289  variable wt_tree
290  #upvar \#0 ::TolTk::Images Images
291 
292  set order 1
293  foreach pkg [::tol::info packages] {
294    # takes an icon with the same name that the grammar
295    set img [ ::Bitmap::get NameBlock ]
296    set wt_row [::TolInspector::LNode $order NameBlock $img $pkg "NameBlock $pkg"]       
297    $wt_tree insert $wt_row -at child -relative "root-packages" \
298      -tags "package-$order" -button yes
299    incr order
300  }
301}
302
303#/////////////////////////////////////////////////////////////////////////////
304proc ::TolInspector::InsertGrammars {} {
305#
306# PURPOSE: Inserts a node in wt_tree (left ::blt::treeview) for each TOL grammar
307#
308#/////////////////////////////////////////////////////////////////////////////
309  variable wt_tree
310  #upvar \#0 ::TolTk::Images Images
311 
312  set id 1
313  foreach g [::tol::info grammars] {
314    # takes an icon with the same name that the grammar
315    set img [::Bitmap::get $g] 
316    set wt_row [::TolInspector::LNode $id Grammar $img $g "Grammar $g"]     
317    $wt_tree insert $wt_row -at child -relative "root-grammars" \
318      -tags "grammar-$id" -button no
319    incr id
320  }
321}
322
323#/////////////////////////////////////////////////////////////////////////////
324proc ::TolInspector::InsertFiles { } {
325#
326# PURPOSE: Inserts a node in wt_tree (left treeview) for each Included file
327#
328#/////////////////////////////////////////////////////////////////////////////
329  variable wt_tree
330
331  set index 1
332  #set img [::Bitmap::get "File"]
333  foreach f [lreverse [::tol::info included]] {
334    set finfo   [::tol::info included $f]
335    set button  [lindex $finfo 3]
336    set subtype [lindex $finfo 4]
337    # tomar la imagen en funcion del subtype
338    set img [SubTypeImage $subtype]
339    # Tail del fichero. Podría hacerse configurable por el usuario
340    set label [file tail $f]
341    set wt_row [::TolInspector::LNode $index File $img $label [list File $f]]     
342    #@ la columna FileName se incorpora en la columna 4
343    $wt_tree insert $wt_row -at child -relative "root-files" \
344      -tags "file-$index" -button $button
345    incr index
346  }
347}
348
349#/////////////////////////////////////////////////////////////////////////////
350proc ::TolInspector::InsertConsoleObj { } {
351#
352# PURPOSE: Inserts a node in wt_tree (left treeview) for each Console object
353#
354#/////////////////////////////////////////////////////////////////////////////
355  variable wt_tree
356   
357  set index 1
358  foreach co [::tol::console stack list] {
359    set grammar [lindex $co 0]
360    if {$grammar eq "Set" || $grammar eq "NameBlock"} {
361      # SUBTYPE: icono en funcion de [lindex $co 7]
362      if {$grammar eq "Set"} {
363        set icon [SubTypeImage [lindex $co 7]]
364      } else  {
365        set objRef [ list "Console" $index ]
366        set objAddress [ tol::info address $objRef ]
367        set icon [ ::ImageManager::getIconForInstance $objAddress ]
368      }
369      set name [lindex $co 1]
370      set has_button [lindex $co 6]
371      if {$name eq ""} {
372        if {[set name [TrimContent DONTCARE [lindex $co 4]]] eq ""} {
373          set name " "
374        }
375      }
376      set wt_row [::TolInspector::LNode $index $grammar $icon $name "Console $index"]     
377      #@ la columna FileName de ht_tree se incorpora en la columna 4
378      $wt_tree insert $wt_row -at child -relative "root-console" \
379        -tags "console-$index" -button $has_button     
380    }
381    incr index
382  }
383}
384
385#/////////////////////////////////////////////////////////////////////////////
386proc ::TolInspector::InsertSubset { args } {
387#
388# PURPOSE: Inserts a node in wt_tree (left treeview) for each child of a Set
389#
390# PARAMETERS:
391#   args[0] -> grammar
392#   args[1] -> name
393#   args[2] -> content
394#   args[3] -> path
395#   args[4] -> desc
396#   Si grammar == "Set"
397#    args[5] -> indexes of the set
398#    args[6] -> is file?
399#    args[7] -> has subset?
400#    args[8] -> subtype
401#
402#/////////////////////////////////////////////////////////////////////////////
403  variable wt_tree
404  variable arguments
405 
406  #@ para saber dónde insertar
407  set parent_node $arguments(parent_node)
408  ## para distinguir set de nameblocks
409  set parent_grammar $arguments(parent_grammar)
410  #@ para obtener el icono de las instancias
411  set parent_tolref $arguments(parent_tolref)
412 
413#@# Tolcon_Trace "InsertSubset $args"   
414  catch {
415  #puts "InsertSubset, args=$args"
416  set grammar [lindex $args 0]
417  if {$grammar eq "Set" || $grammar eq "NameBlock"} {
418    #puts "InsertSubset, args=$args"
419    if { $parent_grammar eq "NameBlock" } {
420      array set info_member [ FilterNameBlockMember [ lindex $args 1 ] ]
421      if { !$info_member(-show) } {
422        return
423      }
424      set name $info_member(-name)
425      set fcolor $info_member(-fcolor)
426    } else {
427      set name [ lindex $args 1 ]
428      set fcolor "black"
429    }
430    set content [lindex $args 2]
431    # indices es el indice completo desde el Set root
432    set indices     [lindex $args 5]
433    set isfile  [lindex $args 6]
434    set has_button [lindex $args 7]
435    set subtype [lindex $args 8]
436    if {$grammar eq "Set"} {
437      set icon [SubTypeImage $subtype]
438    } else {
439      set objRef $parent_tolref
440      lappend objRef [ lindex $indices end ]
441      set objAddress [ tol::info address $objRef ]
442      set icon [ ::ImageManager::getIconForInstance $objAddress ]
443    }
444    # Tail por si es un fichero. Podría hacerse configurable por el usuario
445    set label [file tail $name]
446    #puts [list InsertSubset, indices {lindex $args 5} = $indices]
447   
448#noaun set obj_ref [lappend [$wt_tree item text $parent_node [LiReference] $indices] ]
449#noaun Tolcon_Trace "Inserto un nodo nuevo. $obj_ref"
450    set index [lindex $indices end]
451    set tolRefe [eval list [$wt_tree item text $parent_node [LiReference]] $index]
452    set wt_row [::TolInspector::LNode $index $grammar $icon $label $tolRefe]
453
454    if {$label eq ""} {
455      if {[set label [TrimContent DONTCARE [lindex $args 4]]] eq ""} {
456        set label " "
457      }
458    }
459
460    set idnew [ $wt_tree insert $wt_row -at end -relative $parent_node -button $has_button]
461    $wt_tree item element configure $idnew [LiName] eTXT -fill $fcolor
462  }
463  } msg
464  #@! Tolcon_Trace "InsertSubSet: $msg"
465}
466
467#/////////////////////////////////////////////////////////////////////////////
468proc ::TolInspector::SelectObject { } {
469#
470# PURPOSE: Script called each time a node in wt_tree (left wtree) is selected.
471#
472#/////////////////////////////////////////////////////////////////////////////
473  variable w_tabset
474  variable wt_tree
475  variable arguments
476 
477  set node [$wt_tree selection get 0]
478  if { ![string length $node] } return
479  if { $node == 0 } {
480    ClearHiertables
481    #@D $w_tabset itemconfigure Variables -state disabled
482    #@D $w_tabset itemconfigure Functions -state disabled   
483    return
484  }
485 
486  set tolReference [$wt_tree item text $node [LiReference]]
487 
488  Busy
489  if { [llength $tolReference] == 1 } {
490    #@ Aquí llegan los nodos raíz y las gramáticas
491    #@ Argumentos pasados por atributo
492    #@  + parent_grammar es usado por InsertItem para saber si es NameBlock 
493    set arguments(parent_grammar) ""
494    switch $tolReference {
495      Package SelectPackageRoot
496      File    SelectFileRoot
497      Console SelectConsoleRoot
498      default {
499        ClearHiertables
500        #@D $w_tabset itemconfigure Variables -state disabled
501        #@D $w_tabset itemconfigure Functions -state disabled
502      }
503    }
504  } elseif { [lindex $tolReference 0] == "Grammar" } {
505    #@ Argumentos pasados por atributo
506    #@  + parent_grammar es usado por InsertItem para saber si es NameBlock
507    set arguments(parent_grammar) ""
508    SelectGrammar
509  } else {
510    #@ Argumentos pasados por atributo
511    #@  + parent_grammar es usado por InsertItem para saber si es NameBlock
512    set arguments(parent_grammar) [$wt_tree item text $node [LiGrammar]]
513    SelectSet $tolReference
514  }
515  NotBusy
516}
517
518#/////////////////////////////////////////////////////////////////////////////
519proc ::TolInspector::SelectPackageRoot { } {
520#
521# PURPOSE: Script called each time 'Packages' node in wt_tree is
522#          selected. Gets information about each node that must be in
523#          packages, and inserts it in the right wtree.
524#
525#/////////////////////////////////////////////////////////////////////////////
526  variable w_tabset
527  variable arguments
528 
529  #@ Argumentos pasados por atributo
530  #@  + index es usado e incrementado por InsertItem
531  set arguments(index) 1
532
533  ClearHiertables
534  $w_tabset itemconfigure Variables -text [mc Packages] 
535  $w_tabset raise Variables 
536  #@D $w_tabset itemconfigure Functions -state disabled 
537 
538  #@=> tiene que incrementarse automáticamente es el contador del foreach 
539 
540  foreach pkg [::tol::info packages] {
541    set pi [::tol::info var "NameBlock $pkg"]
542    #@ Argumentos pasados por atributo
543    #@  + tolref es usado por InsertItem   
544    set arguments(tolref) [list "NameBlock" $pkg]
545    InsertChild NameBlock $pkg [lindex $pi 2] [lindex $pi 3] [lindex $pi 4] \
546      $arguments(index) [lindex $pi 5] [lindex $pi 6] [lindex $pi 7]       
547  }
548}
549
550#/////////////////////////////////////////////////////////////////////////////
551proc ::TolInspector::SelectFileRoot { } {
552#
553# PURPOSE: Script called each time 'Included Files' node in wt_tree is
554#          selected. Gets information about each node that must be in
555#          included files, and inserts it in the right wtree.
556#
557#/////////////////////////////////////////////////////////////////////////////
558  variable w_tabset
559  variable arguments
560 
561  #@ Argumentos pasados por atributo
562  #@  + index es usado e incrementado por InsertItem
563  set arguments(index) 1
564
565  ClearHiertables
566  $w_tabset itemconfigure Variables -text [mc Files]
567  $w_tabset raise Variables
568  #@D $w_tabset itemconfigure Functions -state disabled
569 
570  #@=> tiene que incrementarse automáticamente es el contador del foreach 
571  foreach f [lreverse [::tol::info included]] {
572    # this catch is needed because info include could return files not really included
573    if { [catch { ::tol::info included $f } fi] } continue
574    #@ Argumentos pasados por atributo
575    #@  + tolref es usado por InsertItem
576    set arguments(tolref) [list "File" $f]
577    set label [file tail $f]
578    InsertChild Set $label [lindex $fi 0] [lindex $fi 2] [lindex $fi 1] \
579      $arguments(index) 1 [lindex $fi 3] [lindex $fi 4]       
580  }
581}
582
583#/////////////////////////////////////////////////////////////////////////////
584proc ::TolInspector::SelectConsoleRoot { } {
585#
586# PURPOSE: Script called each time 'Console Objects' node in wt_tree is
587#          selected. Gets information about each node that must be in console,
588#          and inserts it in the right wtree.
589#
590#/////////////////////////////////////////////////////////////////////////////
591  variable wt_tree
592  variable arguments
593 
594  #@ Argumentos pasados por atributo
595  #@  + index es usado e incrementado por InsertItem
596  set arguments(index) 1
597
598  ClearHiertables
599
600#(pgea) se quita la linea que oculta la columna del indice y que
601#(pgea) el procedimimento anterior ClearHiertables muestra
602#  $ht_vars column  configure Index -hide yes
603 
604  foreach co [::tol::console stack list] {
605  Tolcon_Trace "co $co"
606    #puts "SelectConsoleRoot: co = $co"
607    set gra  [lindex $co 0]
608    set name [lindex $co 1]
609    set cont [lindex $co 2]
610    set path [lindex $co 3]
611    set desc [lindex $co 4]
612    #@ Argumentos pasados por atributo
613    #@  + tolref es usado por InsertItem
614    set arguments(tolref) [list Console $arguments(index)]
615    switch [lindex $co 0 ] {
616      Code {
617        InsertChild $gra $name $cont $path $desc 0
618      }
619      NameBlock -
620      Set {
621        #puts "switch: SelectConsoleRoot $gra"
622        InsertChild $gra $name $cont $path $desc \
623            $arguments(index) [lindex $co 5] [lindex $co 6] [lindex $co 7]
624      }
625      default {
626        InsertChild $gra $name $cont $path $desc
627      }
628    }
629  }
630  set arguments(tolref) ""
631}
632
633#/////////////////////////////////////////////////////////////////////////////
634proc ::TolInspector::SelectGrammar { } {
635#
636# PURPOSE: Script called each time a Grammar node in wt_tree is selected. Gets
637#          information about each var and function of this grammar, and
638#          inserts them in the right treeview.
639#
640#/////////////////////////////////////////////////////////////////////////////
641  variable w_tabset
642  variable wt_tree
643  variable OnSelectItem
644  variable arguments
645 
646  #@ Argumentos pasados por atributo
647  #@  + index es usado e incrementado por InsertItem 
648  set arguments(index) 1
649 
650  ClearHiertables
651  #@! $ht_vars column  configure Index -hide yes
652  #@! $ht_funcs column configure Index -hide yes
653 
654  set selAnchor [$wt_tree selection get 0]
655 
656  set grammar [$wt_tree item text $selAnchor [LiName] ]
657  if { [string compare $grammar "Anything"] } {
658    #@ Por aquí si no es Anything
659    if { [string length $OnSelectItem] } {
660      $OnSelectItem [::tol::info grammars $grammar]
661    }
662    foreach var [::tol::info variables $grammar] {
663      if {[catch {
664        set vinfo [::tol::info variables [list $grammar $var]]
665        #@ Devuelve:
666        #@ Grammar Name Content Path Description [IsFile HasSubset ? Subtype?]
667      } msg]} {
668        Tol_HciWriter "<E>in ::TolInspector::SelectGrammar : $msg\n</E>"
669        continue
670      }
671      #@ Argumentos pasados por atributo
672      #@  + tolref es usado por InsertItem
673      set arguments(tolref) [list $grammar $var]
674      #@ InsertChild grammar name content path desc [Set|Nameblock: index isfile hassubset subtype] [Code: isvariable]
675      if { [string equal $grammar "Code"] } {
676        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [lindex $vinfo 4] 1 
677      } elseif { $grammar eq "Set" || $grammar eq "NameBlock" } {
678        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [lindex $vinfo 4] \
679          $arguments(index) [lindex $vinfo 5] [lindex $vinfo 6] [lindex $vinfo 7]
680      } else {
681        InsertChild $grammar $var [lindex $vinfo 2] [lindex $vinfo 3] [lindex $vinfo 4]
682      } 
683    }
684  } else {
685    $w_tabset raise Functions 
686    #@D $w_tabset itemconfigure Variables -state disabled
687  }
688  foreach fun  [::tol::info functions $grammar] {
689    set finfo [::tol::info functions $grammar $fun]
690    #@ Argumentos pasados por atributo
691    #@  + tolref es usado por InsertItem   
692    set arguments(tolref) [list Code $fun]
693    InsertChild Code $fun [lindex $finfo 0] [lindex $finfo 1] [lindex $finfo 2] 0   
694  }
695}
696
697#/////////////////////////////////////////////////////////////////////////////
698proc ::TolInspector::SelectSet { tolReference } {
699#
700# PURPOSE: Script called each time a Set node in wt_tree is selected. Gets
701#          information about each child of this set, and inserts it in the
702#          right treeview.
703#
704#/////////////////////////////////////////////////////////////////////////////
705  variable var_id 1
706  variable fun_id 1
707  variable arguments
708 
709  ClearHiertables
710 
711  #@ Argumentos pasados por atributo
712  #@  + index es usado e incrementado por InsertItem
713  #@  + tolref indica a InsertItem que se ha de obtener desde parent_tolref
714  #@  + parent_tolref es usado por InsertItem para encontrar tolref 
715  set arguments(index) 1 
716  set arguments(tolref) ""
717  set arguments(parent_tolref) $tolReference
718  ::tol::forallchild $tolReference ::TolInspector::InsertChild
719}
720
721#/////////////////////////////////////////////////////////////////////////////
722proc ::TolInspector::CloseObject { node } {
723#
724# PURPOSE: Script called each time a node in wt_tree (left treeview) is closed.
725#
726# PARAMETERS:
727#   node : The id of the node closed
728#
729#/////////////////////////////////////////////////////////////////////////////
730  variable wt_tree
731 
732  #@ No es necesario vaciar ni el nodo root (0) ni root-grammars (1)
733  if { $node == 0 } return
734  if { $node == 1 } return
735  foreach it [$wt_tree item children $node] {
736    $wt_tree item delete $it
737  }   
738}
739
740#/////////////////////////////////////////////////////////////////////////////
741proc ::TolInspector::OpenVariable { node } {
742#
743# PURPOSE: Script called each time a node in wt_vars (right wtree) is opened.
744#
745# PARAMETERS:
746#   node : The id of the node opened
747#
748#/////////////////////////////////////////////////////////////////////////////
749  variable wt_tree
750  variable wt_vars
751 
752  if { ![string length $node] } { return }
753 
754  set treeParent [$wt_tree selection get 0]
755  set treeParent_tolRef [$wt_tree item text $treeParent [LiReference]]
756 
757  set treeNode -1
758  if { [llength $treeParent_tolRef] > 1 } {
759    set grammar [$wt_vars item text $node [RiGrammar]]
760    if {$grammar eq "Set" || $grammar eq "NameBlock"} {
761      $wt_tree item expand $treeParent
762      #@ Se localiza el nodo seleccionado en el árbol (wt_tree)
763      set index [$wt_vars item text $node [RiIndex]]     
764      foreach node_i [$wt_tree item children $treeParent] {
765        set index_i [$wt_tree item text $node_i [LiIndex]]
766        if { [string equal $index $index_i] } {
767          set treeNode $node_i
768          break
769        }
770      }
771    }
772  }
773  if { $treeNode != -1 } {
774    update
775    $wt_tree selection clear   
776    $wt_tree selection add $treeNode
777   
778#@!! REVISAR 
779#@!! blt::tv::SetSelectionAnchor $ht_tree $treeNode
780#@!! set blt::tv::scroll 1
781    #$ht_tree selection clearall
782    #$ht_tree see $treeNode
783    #$ht_tree focus $treeNode
784    #$ht_tree selection set $treeNode
785    #$ht_tree selection anchor $treeNode
786    #set blt::Hiertable::scroll 1
787  }
788}
789
790#/////////////////////////////////////////////////////////////////////////////
791proc ::TolInspector::SelectItem { wt } {
792#
793# PURPOSE: Procedure that is executed when the user selects an element of
794#          the trees of variables or functions.
795#          First it take all the arguments necessary of the node of tree to
796#          execute the procedure stored in the variable OnSelectItem, and
797#          later executes it passing those arguments.
798#
799# PARAMETERS: path of wt_* (::wtree of variables or of functions)
800#
801#/////////////////////////////////////////////////////////////////////////////
802# variable w_text       ;# TODO: ????
803  variable OnSelectItem ;#Command to invoke on SelectItem in wt_*
804 
805  #@! set entry [$wt selection anchor] ;# id of entry selected
806  set entry [$wt selection get end] ;# id of entry selected
807 
808  Tolcon_Trace "SelectItem $entry"
809
810  if { [string length $OnSelectItem] } {
811    # there are associated command
812    if { [string length $entry] } {
813      # almost one entry of wt_* selected
814      set name   [$wt item text $entry [RiName]] ;# name of item     
815      set itemid [$wt item text $entry [RiIndex]] ;# id of item       
816      set path   [$wt item text $entry [RiPath]] ;# path of file of item
817      set objRef [$wt item text $entry [RiReference]] ;# info of item
818      set value [$wt item text $entry [RiContent]]
819      if { [string equal \"\n\" $value] } {
820        # hasn't value       
821        set value {"\n"}
822      } else {
823        set value [string trim $value]
824      }
825      set desc [$wt item text $entry [RiDescription]]
826      set grammar [$wt item text $entry [RiGrammar]]
827      set icon [$wt item image $entry [RiName]]
828      #(pgea) lista de argumentos que recibe ::TolConsole::OnInfo
829      set args [list $icon $grammar $name $value $path $desc $objRef]
830    } else {
831      set args ""
832    }
833    eval "$OnSelectItem $args"
834  }
835  return
836}
Note: See TracBrowser for help on using the repository browser.