source: tol/tolbase/lib/toltk/tolinspe__main.tcl @ 6f7a669

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

Refs #1933
Se revisan los binds respecto a wtree y su treectrl.
Se quitan los métodos específicos para la creación de columnas e inserción de nodos que quedaban en tolinspe.
Se añade un update del nodo de paquetes para que se actualice ante un "require".
Se revisan los métodos de botón derecho para que aparezcan sólo sobre los objetos seleccionados.
Se añade un método a wtree para gestionar el color de todas las columnas de un nodo.
Se añaden las columnas al root de wtree.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7355 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 31.2 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : tolinspe.tcl
3# PURPOSE : This file contains a namespace called TolInspector with its
4#           functions. Its for creating a the TOL object inspector and
5#           managing its events.
6#/////////////////////////////////////////////////////////////////////////////
7
8package require bguifunction
9package require snit
10package require btable
11package require wtree
12
13if { 0 && ![info exists toltk_script_path] } {
14  set toltk_script_path [file dirname [info script]]
15  source [file join $toltk_script_path init_toltk.tcl]
16}
17
18if {"unix" eq $::tcl_platform(platform)} {
19  foreach "but units" [list 4 -5 5 5] {
20    set comm [string map "%d $units" {
21      %W yview scroll %d units
22    }]
23    bind TreeView <$but> $comm
24  }
25} else {
26  bind TreeView <MouseWheel> {
27    %W yview scroll [expr int(-1*%D/36)] units
28  }
29}
30
31#/////////////////////////////////////////////////////////////////////////////
32proc startupResources { } {
33#
34# PURPOSE: Establishes the preferences of the inspector
35#
36#/////////////////////////////////////////////////////////////////////////////   
37  global tcl_platform
38  global toltk_options
39  DynamicHelp::configure -background #FFFFC0
40  if {[string equal $tcl_platform(platform) "windows"]} {
41    set toltk_options(colors,SystemButtonFace) SystemButtonFace
42    set toltk_options(fonts,MenuNor)           {Tahoma 8}
43    set toltk_options(fonts,Fixed)             {{Courier New} 9}
44    set toltk_options(fonts,FixSmall)          {{Courier New} 8}
45    set toltk_options(fonts,Title1)            {Arial 9 bold}
46    set toltk_options(fonts,Label)             {Arial 9}
47    set toltk_options(fonts,TxtSmall)          {Arial 8}
48    set toltk_options(relief,ridge)            ridge
49  } else {
50    set toltk_options(colors,SystemButtonFace) #d4d4d4
51    set toltk_options(fonts,MenuNor)           {-*-helvetica-medium-r}
52    set toltk_options(fonts,Fixed)             {Courier 9}
53    set toltk_options(fonts,FixSmall)          {-*-courier-small-r}
54    set toltk_options(fonts,Title1)            {-*-helvetica-bold-r}
55    set toltk_options(fonts,Label)             {-*-helvetica-medium-r}
56    set toltk_options(fonts,TxtSmall)          {-*-helvetica-small-r}
57    set toltk_options(relief,ridge)            raised
58  }
59  option add *background         $toltk_options(colors,SystemButtonFace) user
60  option add *Label.font         $toltk_options(fonts,Label) user
61  option add *Radiobutton.font   $toltk_options(fonts,Label) user
62  option add *Checkbutton.font   $toltk_options(fonts,Label) user
63  option add *Button.font        $toltk_options(fonts,Label) user
64  option add *Menu.font          $toltk_options(fonts,MenuNor) user
65  option add *TitleFrame.l.font  $toltk_options(fonts,Title1) user
66  option add *Tabset.selectForeground black user
67
68  option readfile [file join $::toltk_script_path toltk.rc] user
69}
70
71#/////////////////////////////////////////////////////////////////////////////
72namespace eval ::TolInspector {
73#
74# PURPOSE: The purpose of this namespace is creating a the TOL object
75#          inspector and managing its events.
76# VARIABLES:
77#   data:
78#   regFunLst:    List array with functions defined by user
79#   wt_tree:      Tree widget containing the TOL objects (::wtree)
80#   w_tabset:     Tabset widget containing trees of variables and functions
81#   wt_vars:      Tree widget containing the tree of Variables (::wtree)
82#   data_menu:    Array with data of menus
83#   group_id:
84#   wt_funcs:     Tree widget containing the tree of Functions (::wtree)
85#   OnSelectItem: Command to invoke on SelectItem in wt_*
86#   OnBusyCmd:    Command to invoke when busy
87#   SubTypeImgs:  Images associated to types of set
88#
89#/////////////////////////////////////////////////////////////////////////////
90  variable data
91  variable arguments
92 
93  # List array with functions defined by user
94  variable regFunLst
95 
96  # tree widget containing the TOL objects.
97  variable wt_tree   ;# is a ::wtree
98 
99  # tabset widget containing trees of variables and functions
100  variable w_tabset
101
102  # list widget containing the variables. It's the window of the tab Variable
103  variable wt_vars      ;# is a ::wtree
104 
105  variable data_menu
106  variable group_id -1
107
108  # list widget containing the functions. It's the window of the tab Functions
109  variable wt_funcs     ;# is a ::wtree
110
111  # command to invoke on SelectItem in wt_*
112  variable OnSelectItem
113
114  # command to invoke when busy
115  variable OnBusyCmd ""
116
117  # images associated to types of set.
118  variable SubTypeImgs {
119    GenericSet MODFile PRJFile DIRFile TOLFile
120    BDCFile BDTFile BSTFile BMTFile BSIFile TSIFile BMIFile
121    StructuredSet TableSet}
122
123}
124
125#/////////////////////////////////////////////////////////////////////////////
126proc ::TolInspector::SubTypeImage { idx } {
127#/////////////////////////////////////////////////////////////////////////////
128  variable SubTypeImgs
129
130  #Tolcon_Trace "SubTypeImage $idx = [lindex $SubTypeImgs $idx]"
131  ::Bitmap::get [lindex $SubTypeImgs $idx]
132}
133
134#/////////////////////////////////////////////////////////////////////////////
135proc ::TolInspector::Create { w args } {
136#
137# PURPOSE: Creates the object inspector, that contains two panels with three
138#          treeviews and three trees.
139#           - One for the left side of the inspector (with grammars,
140#             included files and console objects)
141#           - And two for the right one (one for variables tab and one for
142#             functions tab)
143#
144# PARAMETERS:
145#   w:    path where tol inspector must be created
146#   args: list of pairs {-option value} with options for the inspector.
147#      -onselcmd  Comand to execute when a node is selected
148#      -wleft     relative weight of left pane
149#      -wrigth    relative weight of rigth pane
150#
151#/////////////////////////////////////////////////////////////////////////////
152  global toltk_options
153  variable wt_tree 
154  variable wt_vars 
155  variable data_menu
156  variable wt_funcs 
157  variable w_tabset
158  variable OnSelectItem
159  variable OnBusyCmd ""
160
161  # this should be used insted of a lot of scalar variables.
162  # but, what can we do now?
163
164  variable widgets
165  variable data
166
167  array set options {
168    -onselcmd ""
169    -wleft    3
170    -wright   7
171  }
172  array set options $args
173 
174  # initializes the command OnSelectItem to ""
175  set OnSelectItem $options(-onselcmd)
176
177  #upvar \#0 ::TolTk::Images Images
178 
179  bind TreeCtrl <Button1-Motion> {
180    TreeCtrl::Motion1 %W %x %y
181  }
182
183  # creation of PANED WINDOW MAIN
184  set pwMain [PanedWindow $w -side bottom -pad 0 -width 4]
185  # creation of pane left and pane right
186  set paneLeft  [$pwMain add -weight $options(-wleft)]
187  set paneRight [$pwMain add -weight $options(-wright)]
188  set widgets(panes,left)  $paneLeft
189  set widgets(panes,right) $paneRight
190 
191  # when a panel is destroyed, the item 'geometry,side' of the array variable
192  # data gives the value of the width of panel 'side' (left or right)
193  bind $paneLeft <Destroy> {
194    namespace eval  ::TolInspector {
195      variable data
196      variable widgets
197      set data(geometry,left)  [winfo width $widgets(panes,left)]
198    }
199  } 
200  bind $paneRight <Destroy> {
201    namespace eval  ::TolInspector {
202      variable data
203      variable widgets
204      set data(geometry,right)  [winfo width $widgets(panes,right)]
205    }
206  }
207  # bind for destruction of paned window main
208  bind $pwMain <Destroy> ::TolInspector::Destroy
209
210  # creation of pane left with tree with the TOL OBJECTS
211  CreatePaneLeft  $paneLeft
212  # creation of the right panel with TABSET of VARIABLES and FUNCTIONS
213  CreatePaneRight $paneRight
214  # creation of the menus
215  CreateMenus
216  # packing the panedwindowmain
217  pack $pwMain -fill both -expand yes
218}
219
220#/////////////////////////////////////////////////////////////////////////////
221proc ::TolInspector::CreatePaneLeft { paneLeft } {
222#
223# PURPOSE: Creation of TREE LEFT with the TOL OBJECTS
224#
225# PARAMETERS:
226#   paneLeft:  path of the pane of the left in TolInspector
227#
228#/////////////////////////////////////////////////////////////////////////////
229  global toltk_options
230  variable wt_tree
231 
232  # creation of the ScrolledWindow of the left side
233  set sw1 [ScrolledWindow $paneLeft.sw -ipad 0 -borderwidth 0 -scrollbar none]
234
235  # creation of the left tree
236  set wt_tree [::wtree $sw1.wt -table 0 -filter no \
237    -background white -showroot 1 -selectmode single -showheader 0 \
238    -highlightbackground gray75 -highlightcolor black \
239    -highlightthickness 0 -font $toltk_options(fonts,Label) \
240    -columns [list \
241    [list {image text} -label Name -tags Name] \
242    [list text -label Index -tags Index] \
243    [list text -label Grammar -tags Grammar] \
244    [list text -label Reference -tags Reference]
245  ]]
246   
247  # configuration of the left tree
248  $wt_tree column configure "range 1 end" -visible no
249  $wt_tree column configure first -expand yes -weight 1
250  $wt_tree column configure all -itembackground ""       
251  $wt_tree notify bind $wt_tree <Selection> "::TolInspector::SelectObject"   
252  $wt_tree notify bind $wt_tree <Expand-before> "::TolInspector::OpenObject %I"
253  $wt_tree notify bind $wt_tree <Collapse-before> "::TolInspector::CloseObject %I" 
254           
255  # creation of the root node "Tol Objects"
256  set img [::Bitmap::get Objects]
257  $wt_tree item text root Name [mc "Tol Objects"]
258  $wt_tree item image root Name $img
259
260  # creation of the node father "Grammars"
261  set node [$wt_tree item create -parent root -button 1 -open 0 -tags "root-grammars"]
262  $wt_tree item image $node Name [::Bitmap::get Grammars]
263  $wt_tree item text $node Index "" Grammar "Root" Name [mc "Grammars"] Reference "Grammar" 
264  # Inserts in the node of grammars a node by each grammar that exists in Tol
265  InsertGrammars
266
267  # creation of the node father "Packages"
268  set node [$wt_tree item create -parent root -button 1 -open 0 -tags "root-packages"]
269  $wt_tree item image $node Name [::Bitmap::get "package"]
270  $wt_tree item text $node Index "" Grammar "Root" Name [mc "Packages"] Reference "Package" 
271
272  # creation of the node father "Included Files"
273  set node [$wt_tree item create -parent root -button 1 -open 0 -tags "root-files"]
274  $wt_tree item image $node Name [::Bitmap::get "Files"]
275  $wt_tree item text $node Index "" Grammar "Root" Name [mc "Included Files"] Reference "File" 
276     
277  # creation of the node father "Console Objects"
278  set node [$wt_tree item create -parent root -button 1 -open 0 -tags "root-console"]
279  $wt_tree item image $node Name [::Bitmap::get "Console"]
280  $wt_tree item text $node Index "" Grammar "Root" Name [mc "Console Objects"] Reference "Console"
281
282 
283  # associates the tree to scrolled window
284  $sw1 setwidget $wt_tree
285
286  # packing
287  pack $sw1 -fill both -expand yes
288 
289  # bind the focus on tree
290  bind $wt_tree <Button-1> "::focus $wt_tree"
291 
292  # expand/collapse (and fill/unfill) a node with a double clic
293  bind $wt_tree <Double-1> "::TolInspector::ToggleItem %x %y"
294}
295
296#/////////////////////////////////////////////////////////////////////////////
297proc ::TolInspector::CreatePaneRight { paneRight } {
298#
299# PURPOSE: Creation of the right pane with TABSET with VARIABLES and FUNCTIONS
300#
301# PARAMETERS:
302#   paneLeft:  path of the pane of the right in TolInspector
303#
304#/////////////////////////////////////////////////////////////////////////////
305  global toltk_options
306  variable w_tabset
307  variable wt_vars
308  variable wt_funcs
309 
310  # creates the tabset to display the variables & functions
311  set w_tabset [NoteBook $paneRight.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]           
312 
313  # inserts in the tabset the tabs of functions and variables       
314  $w_tabset insert 0 Variables -text [mc Variables] -image [::Bitmap::get Variables] -background \#d9d9d9
315  $w_tabset insert 1 Functions -text [mc Functions] -image [::Bitmap::get Functions] -background \#d9d9d9
316  $w_tabset raise Variables
317 
318  # creates the scrolled windows for each one of the tabs
319  set tab1 [$w_tabset getframe Variables]
320  set tab2 [$w_tabset getframe Functions]
321  set sw21 [ScrolledWindow $tab1.sw12 -scrollbar none] 
322  set sw22 [ScrolledWindow $tab2.sw22 -scrollbar none]
323
324  # Creation of the right TREE RIGHT with VARIABLES
325  set wt_vars [::wtree $sw21.vars -table 1 -filter no \
326    -background white -showroot 0 -selectmode extended -showheader 1 \
327    -highlightbackground gray75 -highlightcolor black \
328    -highlightthickness 0 -font $toltk_options(fonts,Label) \
329    -columns [list \
330    [list text -label Index -tags Index] \
331    [list text -label Grammar -tags Grammar] \
332    [list {image text} -label Name -tags Name] \
333    [list text -label Content -tags Content] \
334    [list text -label Description -tags Description] \
335    [list text -label Path -tags Path] \
336    [list text -label Reference -tags Reference] \
337  ]]
338  # configuration of the tree of variables
339  $wt_vars column configure Grammar -visible no
340  $wt_vars column configure Reference -visible no
341  $wt_vars column configure all -itembackground ""
342  $wt_vars notify bind $wt_vars <Expand-before> "::TolInspector::OpenVariable %I"
343  $wt_vars notify bind $wt_vars <Selection> "::TolInspector::SelectItem $wt_vars"
344  bind $wt_vars <Button-1> "::focus $wt_vars"   
345  bind $wt_vars <Double-1> "::TolInspector::SelectionExpand"
346 
347  # Creation of the right TREE RIGHT with FUNCTIONS
348  set wt_funcs [::wtree $sw22.vars -table 1 -filter no \
349    -background white -showroot 0 -selectmode extended -showheader 1 \
350    -highlightbackground gray75 -highlightcolor black \
351    -highlightthickness 0 -font $toltk_options(fonts,Label) \
352    -columns [list \
353    [list text -label Index -tags Index] \
354    [list text -label Grammar -tags Grammar] \
355    [list {image text} -label Name -tags Name] \
356    [list text -label Content -tags Content] \
357    [list text -label Description -tags Description] \
358    [list text -label Path -tags Path] \
359    [list text -label Reference -tags Reference] \
360  ]]
361  # configuration of the tree of functions
362  $wt_funcs column configure Grammar -visible no
363  $wt_funcs column configure Reference -visible no
364  $wt_funcs column configure all -itembackground ""     
365  $wt_funcs notify bind $wt_funcs <Selection> "::TolInspector::SelectItem $wt_funcs"     
366  bind $wt_funcs <Button-1> "::focus $wt_funcs"     
367 
368  # associates the trees to scrolled windows
369  $sw21 setwidget $wt_vars
370  $sw22 setwidget $wt_funcs 
371  # configure the tabs
372  $tab1 configure -borderwidth 2 -background \#d9d9d9
373  $tab2 configure -borderwidth 2 -background \#d9d9d9
374
375  # packing the tabset
376  pack $tab1.sw12 -fill both -expand yes
377  pack $tab2.sw22 -fill both -expand yes   
378  pack $w_tabset -fill both -expand yes 
379}
380
381#/////////////////////////////////////////////////////////////////////////////
382proc ::TolInspector::CreateMenus {} {
383#
384# PURPOSE: Create the menus of the trees
385#
386#/////////////////////////////////////////////////////////////////////////////
387  variable data_menu
388  variable wt_vars
389  variable wt_funcs
390  variable wt_tree 
391
392  set data_menu(main)          [menu $wt_tree.m -tearoff 0]
393  set data_menu(Code,File)     [menu $data_menu(main).mcof -tearoff 0]
394  set data_menu(Complex,File)  [menu $data_menu(main).mcxf -tearoff 0]
395  set data_menu(Date,File)     [menu $data_menu(main).mdaf -tearoff 0]
396  set data_menu(Matrix,File)   [menu $data_menu(main).mmaf -tearoff 0]
397  set data_menu(VMatrix,File)  [menu $data_menu(main).mvmf -tearoff 0]
398  set data_menu(Polyn,File)    [menu $data_menu(main).mpof -tearoff 0]
399  set data_menu(Ratio,File)    [menu $data_menu(main).mraf -tearoff 0]
400  set data_menu(Real,File)     [menu $data_menu(main).mref -tearoff 0]
401  set data_menu(Serie,File)    [menu $data_menu(main).msef -tearoff 0]
402  set data_menu(Set,File)      [menu $data_menu(main).mstf -tearoff 0]
403  set data_menu(File,File)     [menu $data_menu(main).mfif -tearoff 0]
404  set data_menu(Anything,File) [menu $data_menu(main).mspf -tearoff 0]
405  set data_menu(Text,File)     [menu $data_menu(main).mtef -tearoff 0]
406  set data_menu(TimeSet,File)  [menu $data_menu(main).mtif -tearoff 0]
407  set data_menu(NameBlock,File)  [menu $data_menu(main).mnbf -tearoff 0]
408
409  set data_menu(Code,Functions)     [menu $data_menu(main).mcofu -tearoff 0]
410  set data_menu(Complex,Functions)  [menu $data_menu(main).mcxfu -tearoff 0]
411  set data_menu(Date,Functions)     [menu $data_menu(main).mdafu -tearoff 0]
412  set data_menu(Matrix,Functions)   [menu $data_menu(main).mmafu -tearoff 0]
413  set data_menu(VMatrix,Functions)  [menu $data_menu(main).mvmfu -tearoff 0]
414  set data_menu(Polyn,Functions)    [menu $data_menu(main).mpofu -tearoff 0]
415  set data_menu(Ratio,Functions)    [menu $data_menu(main).mrafu -tearoff 0]
416  set data_menu(Real,Functions)     [menu $data_menu(main).mrefu -tearoff 0]
417  set data_menu(Serie,Functions)    [menu $data_menu(main).msefu -tearoff 0]
418  set data_menu(Set,Functions)      [menu $data_menu(main).mstfu -tearoff 0]
419  set data_menu(File,Functions)     [menu $data_menu(main).mfifu -tearoff 0]
420  set data_menu(Anything,Functions) [menu $data_menu(main).mspfu -tearoff 0]
421  set data_menu(Text,Functions)     [menu $data_menu(main).mtefu -tearoff 0]
422  set data_menu(TimeSet,Functions)  [menu $data_menu(main).mtifu -tearoff 0]
423  set data_menu(NameBlock,Functions)  [menu $data_menu(main).mnbfu -tearoff 0]
424
425  set data_menu(Matrix,Table)       [menu $data_menu(main).mmat   -tearoff 0]
426  set data_menu(Matrix,Export)      [menu $data_menu(main).mmae   -tearoff 0]
427  set data_menu(Matrix,Draw)        [menu $data_menu(main).mmac   -tearoff 0]
428  set data_menu(Matrix,Export,BDT)  [menu $data_menu(main).mmaebdt -tearoff 0]
429  set data_menu(Serie,DrawAutocor)  [menu $data_menu(main).mseda  -tearoff 0]
430  set data_menu(Serie,TableAutocor) [menu $data_menu(main).mseta  -tearoff 0]
431  set data_menu(Set,Table)          [menu $data_menu(main).mstt   -tearoff 0]
432  set data_menu(Set,Table2)         [menu $data_menu(main).mstt2  -tearoff 0]
433  set data_menu(Set,Draw)           [menu $data_menu(main).mstd   -tearoff 0]
434  set data_menu(Set,Draw,Special)   [menu $data_menu(main).mstds  -tearoff 0]
435  set data_menu(Set,Draw,Special,M) [menu $data_menu(main).mstdsm -tearoff 0] 
436  set data_menu(File,View)          [menu $data_menu(main).mfiv   -tearoff 0]
437  set data_menu(File,Decompile)     [menu $data_menu(main).mfid   -tearoff 0]
438  set data_menu(TimeSet,View)       [menu $data_menu(main).mtiv   -tearoff 0]
439  #$ht_vars  bind Entry <Button-3> +[$ht_vars bind Entry <Button-1>]
440 
441  # composes the  menus for each one of the trees, depending the node that is selected
442  bind $wt_tree <Button-3> "::TolInspector::PostTree %x %y %X %Y"
443  bind $wt_vars <Button-3> "::TolInspector::PostVariable %x %y %X %Y"
444  bind $wt_funcs <Button-3> "::TolInspector::PostFunction %x %y %X %Y"
445}
446
447#/////////////////////////////////////////////////////////////////////////////
448proc ::TolInspector::GetWeight { pane } {
449#
450# PURPOSE: Set data(geometry,$pane) to the value of the current geometry
451#          of the pane
452#
453# PARAMETERS:
454#   pane -> string with a value "left" or "right" for each one of panels
455#
456#/////////////////////////////////////////////////////////////////////////////
457  variable widgets
458  variable data
459
460  if {[winfo exists $widgets(panes,$pane)]} {
461    set data(geometry,$pane) [winfo width $widgets(panes,$pane)]
462  }
463  set data(geometry,$pane)
464}
465
466#/////////////////////////////////////////////////////////////////////////////
467proc ::TolInspector::Destroy { } {
468#
469# PURPOSE: Destroys the three trees of TolInspector and array with full
470#          content & description of items
471#
472#///////////////////////////////////////////////////////////////////////////// 
473  #@ Hay algo que destruir?
474  return
475}
476
477#/////////////////////////////////////////////////////////////////////////////
478proc ::TolInspector::OneLine { str } {
479#
480# PURPOSE: Gives a string with carriage returns \n and return this string
481#          until the first carriage return that appears after a word,
482#          replacing the rest by ... if some word existed after that carriage
483#          return
484#          Examples: the str "a\n b c"     returns "a..."
485#                            "\n \n a\n b" returns "a..."
486#                            "\n \n a\n"   returns "a"
487# PARAMETERS:
488#   str -> string with \n
489#
490#/////////////////////////////////////////////////////////////////////////////
491  set str [string trim $str]
492  set lnidx [string first "\n" $str]
493  if { $lnidx != -1 } {
494    if { [incr lnidx -1] > 0 } {
495      return "[string range $str 0 $lnidx]..."
496    } else {
497      return "..."
498    }
499  }
500  set str
501}
502
503#/////////////////////////////////////////////////////////////////////////////
504proc ::TolInspector::TrimContent { grammar content } {
505#///////////////////////////////////////////////////////////////////////////// 
506  if { [string equal "Real" $grammar] } {
507     return [::TolConsole::Format $content]
508  } else {
509    if { [string equal \"\n\" $content] } {
510      set content {"\n"}
511    }
512    return [OneLine $content]
513    set content [string trim $content]
514    set lnidx [string first "\n" $content]
515    if { $lnidx != -1 } {
516      if { [incr lnidx -1] > 0 } {
517        return "[string range $content 0 $lnidx]..."
518      } else {
519        return "..."
520      }
521    }
522    set content
523  }
524}
525
526#>> [tolinspe_wtree1.tcl]
527#>> proc ::TolInspector::InsertChild
528#>> proc ::TolInspector::InsertItem
529#>> proc ::TolInspector::ClearHiertables
530#>> proc ::TolInspector::OpenObject
531#>> proc ::TolInspector::InsertPackages
532#>> proc ::TolInspector::InsertGrammars
533#>> proc ::TolInspector::InsertFiles
534#>> proc ::TolInspector::InsertConsoleObj
535#>> proc ::TolInspector::InsertSubset
536
537#/////////////////////////////////////////////////////////////////////////////
538proc ::TolInspector::FilterNameBlockMember { name } {
539#/////////////////////////////////////////////////////////////////////////////
540  set st_reg [ regexp {(.+::)?(_)?(\.)?(.*)} $name => p1 p2 p3 p4]
541  if { !$st_reg } {
542    list -show 1 -fcolor "black" -name $name
543  } elseif { $p2 eq "_" } {
544    if { $p3 eq "." } {
545      if { [string match {autodoc.member.*} $p4] } {
546        # es un elemento de autodocumentacion y no se muestra
547        list -show 0
548      } {
549        # es un miembro de solo lectura
550        list -show 1 -fcolor "gray50" -name "_.$p4"
551      }
552    } else {
553      # es un miembro oculto,
554      set showPrivate [ Tol_GetViewPrivateMembers ]
555      list -show $showPrivate -fcolor "gray75" -name "_$p4"
556    }
557  } else {
558    list -show 1 -fcolor "black" -name $p4
559  }
560}
561
562#>> [tolinspe__wtree2.tcl]
563#>> proc ::TolInspector::ClearConsoleObj
564#>> proc ::TolInspector::ClearConsoleObjSel
565#>> proc ::TolInspector::UpdateFileRoot
566#>> proc ::TolInspector::UpdateConsoleObj
567
568#>> [tolinspe_wtree1.tcl]
569#>> proc ::TolInspector::SelectObject
570#>> proc ::TolInspector::SelectFileRoot
571#>> proc ::TolInspector::SelectConsoleRoot
572#>> proc ::TolInspector::SelectGrammar
573#>> proc ::TolInspector::SelectSet
574
575#>> [tolinspe_wtree1.tcl]
576#>> proc ::TolInspector::CloseObject
577#>> proc ::TolInspector::OpenVariable
578#>> proc ::TolInspector::SelectItem
579
580#/////////////////////////////////////////////////////////////////////////////
581proc ::TolInspector::GetItemName { prefix idx_list } {
582#///////////////////////////////////////////////////////////////////////////// 
583  set node_id $prefix
584  foreach id $idx_list {
585    append node_id "-$id"
586  }
587  set node_id
588}
589
590#/////////////////////////////////////////////////////////////////////////////
591proc ::TolInspector::OnBusy { cmd } {
592#///////////////////////////////////////////////////////////////////////////// 
593  variable OnBusyCmd $cmd
594}
595
596#/////////////////////////////////////////////////////////////////////////////
597proc ::TolInspector::Busy { } {
598#///////////////////////////////////////////////////////////////////////////// 
599  variable OnBusyCmd
600  variable wt_tree 
601  variable wt_vars
602
603  $wt_tree configure -cursor watch
604  $wt_vars configure -cursor watch
605  if { [string length $OnBusyCmd] } {
606    eval $OnBusyCmd 1
607  }
608}
609
610#/////////////////////////////////////////////////////////////////////////////
611proc ::TolInspector::NotBusy { } {
612#///////////////////////////////////////////////////////////////////////////// 
613  variable OnBusyCmd
614  variable wt_tree   
615  variable wt_vars
616
617  $wt_tree configure -cursor ""
618  $wt_vars configure -cursor ""
619
620  if { [string length $OnBusyCmd] } {
621    eval $OnBusyCmd 0
622  }
623}
624
625#>> [tolinspe__tolgui.tcl]
626#>> proc TclList2SetOfText
627#>> proc Tol_*
628#>> proc TolGui_*
629
630
631#>> [tolinspe__wtree2.tcl]
632#>> proc ::TolInspector::PostVariable
633#>> proc ::TolInspector::PostFunction
634#>> proc ::TolInspector::PostTree
635#>> proc ::TolInspector::AddToEvalWindow
636#>> proc ::TolInspector::SelectAll
637#>> proc ::TolInspector::ToggleSelection
638
639#>> [__draw.tcl]
640#>> proc ::TolInspector::ExportBDTMatrix
641#>> proc ::TolInspector::Draw*
642#>> proc ::TolInspector::Table*
643#>> proc ::TolInspector::View*
644
645#/////////////////////////////////////////////////////////////////////////////
646proc ::TolInspector::DecompileFile {name} {
647#
648# PURPOSE:
649#
650# PARAMETERS:
651#   name -> cadena con el nombre de un archivo o el de una variable
652#           que hace referencia a un archivo
653#
654# TODO: Actualmente en name solo puede llegar el nombre de un archivo
655#
656#/////////////////////////////////////////////////////////////////////////////
657  #puts "DECOMPILE 1.1, name=$name"
658  if {[file isfile $name]} {
659    set path $name
660  } else  {
661    set path [::tol::info path $name]
662  }
663  #puts "DECOMPILE 1.2"
664  #Comprobar si el archivo ya está abierto y si es así poner que no está compilado
665  if [namespace exists ::Editor] {
666    foreach ins [namespace children ::Editor] {
667      upvar \#0 ${ins}::data dataEd
668      if [string equal $dataEd(nameFile) $path] {
669        set dataEd(isCompiled) 0
670      }
671    }
672  }
673  # https://www.tol-project.org/ticket/1483
674  catch {
675    ::tol::decompile $path
676  }
677  ::TolInspector::UpdateFileRoot
678}
679
680#/////////////////////////////////////////////////////////////////////////////
681proc ::TolInspector::ReadUserFunctions {} {
682#
683# PURPOSE: Recorre el set global que tiene la definicion de funciones y va
684#          guardando esa informacion en arrays para almacenarla finalmente en
685#          regFunLst
686#
687#/////////////////////////////////////////////////////////////////////////////
688  variable regFunLst
689 
690  #Set global que tiene la definicion de funciones
691  set obj GuiFunction
692
693  if { [llength [set infAry [TclInfoVar Set $obj]] ] } {
694    #Tolcon_Trace "ReadUserFunctions: infAry = $infAry"
695    array set info $infAry
696    set nFun [lindex $info(CONTENT) 0]
697    #Tolcon_Trace "Numero de funciones =$nFun"
698    for  {set idf 1} {$idf <= $nFun} {incr idf} {
699      array set ifNameFun [TclInfoRef [list Set $obj $idf 1]]
700      array set ifNameGui [TclInfoRef [list Set $obj $idf 2]]
701      array set ifTypeGui [TclInfoRef [list Set $obj $idf 3]]
702      array set ifTypeOut [TclInfoRef [list Set $obj $idf 4]]
703      array set ifParams  [TclInfoRef [list Set $obj $idf 5]]
704      #Hago lindex $a(CONTENT) 0 para quitar las comillas
705      set regFun($idf,nameFun) [lindex $ifNameFun(CONTENT) 0]
706      set regFun($idf,nameGui) [lindex $ifNameGui(CONTENT) 0]
707      set regFun($idf,typeGui) [lindex $ifTypeGui(CONTENT) 0]
708      set regFun($idf,typeOut) [lindex $ifTypeOut(CONTENT) 0]
709      set nPar [lindex $ifParams(CONTENT) 0]
710      #Tolcon_Trace "Numero de parametros =$nPar"
711      for  {set idp 1} {$idp <= $nPar} {incr idp} {
712        array set ipNameGui [TclInfoRef [list Set $obj $idf 5 $idp 1]]
713        array set ipTypePar [TclInfoRef [list Set $obj $idf 5 $idp 2]]
714        array set ipTypeSel [TclInfoRef [list Set $obj $idf 5 $idp 3]]
715        array set ipListVal [TclInfoRef [list Set $obj $idf 5 $idp 4]]
716        set regPar($idp,nameGui) [lindex $ipNameGui(CONTENT) 0]
717        set regPar($idp,typePar) [lindex $ipTypePar(CONTENT) 0]
718        set regPar($idp,typeSel)         $ipTypeSel(CONTENT)
719        set nVal [lindex $ipListVal(CONTENT) 0]
720        #Tolcon_Trace "nVal=$nVal"
721        set lstVal ""
722        for  {set idv 1} {$idv <= $nVal} {incr idv} {
723           array set iVal [TclInfoRef [list Set $obj $idf 5 $idp 4 $idv]]
724           lappend lstVal [lindex $iVal(CONTENT) 0]
725        }
726        set regPar($idp,lstVal) $lstVal
727      }
728      set regFun($idf,parameters) [array get regPar]
729      array unset regPar
730      #parray regFun
731    }
732    set regFunLst [array get regFun]
733  } else {
734    set regFunLst ""
735  }
736}
737
738#/////////////////////////////////////////////////////////////////////////////
739proc ::TolInspector::ShowMenuUserFunc {gra} {
740#
741# PURPOSE: Muestra un menu contextual que...
742#
743#/////////////////////////////////////////////////////////////////////////////
744  variable data_menu
745  variable regFunLst
746 
747  #puts "ShowMenuUserFunc: gra=$gra"
748  if {[expr [info exist ::TolInspector::regFunLst] && [llength $regFunLst] ]} {
749    array set regFun $regFunLst
750    regsub -all ,nameGui \
751       [array names regFun *,nameGui] "" lstFun
752    foreach idf [lsort -integer $lstFun] {
753      set typeGui [split $regFun($idf,typeGui) .]
754      switch  [lindex $typeGui 0] {
755        Ite - Set {
756          if {[lindex $typeGui 1] eq $gra} {
757            $data_menu($gra,Functions) add command -label [mc $regFun($idf,nameGui)]\
758              -command [list ::TolInspector::CallUserFunction $gra $idf]
759          }
760        }
761        default {
762        }
763      }
764    }
765  }
766}
767
768#/////////////////////////////////////////////////////////////////////////////
769proc ::TolInspector::CallUserFunction {grammar idx} {
770#
771# PURPOSE: Para los tipos de funciones Ite y Set, muestra un dialogo que
772#          pide los
773#
774#/////////////////////////////////////////////////////////////////////////////
775  variable regFunLst
776  variable group_id
777  variable options_selected
778
779  upvar \#0 ::TolInspector::options_selected($grammar) items_selected
780  #puts "CallUserFunction. grammar=$grammar, idx=$idx, items_selected=$items_selected"
781 
782  set all_objs [ list ]
783  foreach it $items_selected {
784    set tcl_ref [ lindex $it 0 ]
785    set obj_addr [ ::tol::info address $tcl_ref ]
786    lappend all_objs "GetObjectFromAddress(\"$obj_addr\")"
787  }
788
789  if { [ llength $all_objs ] } {
790    incr group_id
791    array set regFun $regFunLst
792    set gui [bguifunction .t$group_id \
793                 -title $regFun($idx,nameGui) \
794                 -regpars $regFun($idx,parameters)]
795    set txtPars [join [$gui get values] ,]
796    if {$txtPars ne ""} {
797      set txtPars ",$txtPars"
798    }
799    destroy $gui
800    set typeGui [split $regFun($idx,typeGui) .]
801    switch [lindex $typeGui 0] {
802      Ite {
803        foreach obj $all_objs {
804          set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($obj $txtPars)"
805          #Tolcon_Trace "Ite.cmd=$cmd"
806          ::tol::console eval $cmd
807          ::TolConsole::SaveEval $cmd
808        }
809      }
810      Set {
811        set obj_args [join $all_objs ,]
812        set setCmd "SetOf[lindex $typeGui 1] ($obj_args)"
813        set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($setCmd $txtPars)"
814        #Tolcon_Trace "Set.cmd=$cmd"
815        ::tol::console eval $cmd
816        ::TolConsole::SaveEval $cmd
817      }
818      default {
819      }
820    }
821    ::TolInspector::UpdatePackageRoot
822    ::TolInspector::UpdateConsoleObj
823  }
824}
Note: See TracBrowser for help on using the repository browser.