source: tol/tolbase/lib/toltk/tolinspe__main.tcl

devel
Last change on this file was 97db5a0, checked in by Pedro Gea <pgea@…>, 10 years ago

Refs #1933
Se incorpora un parámetro en init_toltk.tcl para provisionalmente mostrar o no filtros en el inspector.
Se traducen los nombres de columna del inspector.
Se incorporan el contenido y la descripción completa (sin TrimContent) de las variables TOL.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7361 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  global show_filters
307  variable w_tabset
308  variable wt_vars
309  variable wt_funcs
310 
311  # creates the tabset to display the variables & functions
312  set w_tabset [NoteBook $paneRight.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]           
313 
314  # inserts in the tabset the tabs of functions and variables       
315  $w_tabset insert 0 Variables -text [mc Variables] -image [::Bitmap::get Variables] -background \#d9d9d9
316  $w_tabset insert 1 Functions -text [mc Functions] -image [::Bitmap::get Functions] -background \#d9d9d9
317  $w_tabset raise Variables
318 
319  # creates the scrolled windows for each one of the tabs
320  set tab1 [$w_tabset getframe Variables]
321  set tab2 [$w_tabset getframe Functions]
322  set sw21 [ScrolledWindow $tab1.sw12 -scrollbar none] 
323  set sw22 [ScrolledWindow $tab2.sw22 -scrollbar none]
324
325  # Creation of the right TREE RIGHT with VARIABLES
326  set wt_vars [::wtree $sw21.vars -table 1 -filter $show_filters \
327    -background white -showroot 0 -selectmode extended -showheader 1 \
328    -highlightbackground gray75 -highlightcolor black \
329    -highlightthickness 0 -font $toltk_options(fonts,Label) \
330    -columns [list \
331    [list text -label [mc Index] -tags Index] \
332    [list text -label [mc Grammar] -tags Grammar] \
333    [list {image text} -label [mc Name] -tags Name] \
334    [list text -label [mc Content] -tags Content] \
335    [list text -label [mc Description] -tags Description] \
336    [list text -label [mc Path] -tags Path] \
337    [list text -label [mc Reference] -tags Reference] \
338  ]]
339  #@ filtro: 0(Index) 0(no) 2(Name) 1(yes)
340  $wt_vars configure -columnfilter [list 0 0 2 1]
341  # configuration of the tree of variables
342  $wt_vars column configure Grammar -visible no
343  $wt_vars column configure Reference -visible no
344  $wt_vars column configure all -itembackground ""
345  $wt_vars notify bind $wt_vars <Expand-before> "::TolInspector::OpenVariable %I"
346  $wt_vars notify bind $wt_vars <Selection> "::TolInspector::SelectItem $wt_vars"
347  bind $wt_vars <Button-1> "::focus $wt_vars"   
348  bind $wt_vars <Double-1> "::TolInspector::SelectionExpand"
349 
350  # Creation of the right TREE RIGHT with FUNCTIONS
351  set wt_funcs [::wtree $sw22.vars -table 1 -filter $show_filters \
352    -background white -showroot 0 -selectmode extended -showheader 1 \
353    -highlightbackground gray75 -highlightcolor black \
354    -highlightthickness 0 -font $toltk_options(fonts,Label) \
355    -columns [list \
356    [list text -label [mc Index] -tags Index] \
357    [list text -label [mc Grammar] -tags Grammar] \
358    [list {image text} -label [mc Name] -tags Name] \
359    [list text -label [mc Content] -tags Content] \
360    [list text -label [mc Description] -tags Description] \
361    [list text -label [mc Path] -tags Path] \
362    [list text -label [mc Reference] -tags Reference] \
363  ]]
364  #@ filtro: 0(Index) 0(no) 2(Name) 1(yes)
365  $wt_funcs configure -columnfilter [list 0 0 2 1]
366  # configuration of the tree of functions
367  $wt_funcs column configure Grammar -visible no
368  $wt_funcs column configure Reference -visible no
369  $wt_funcs column configure all -itembackground ""     
370  $wt_funcs notify bind $wt_funcs <Selection> "::TolInspector::SelectItem $wt_funcs"     
371  bind $wt_funcs <Button-1> "::focus $wt_funcs"     
372 
373  # associates the trees to scrolled windows
374  $sw21 setwidget $wt_vars
375  $sw22 setwidget $wt_funcs 
376  # configure the tabs
377  $tab1 configure -borderwidth 2 -background \#d9d9d9
378  $tab2 configure -borderwidth 2 -background \#d9d9d9
379
380  # packing the tabset
381  pack $tab1.sw12 -fill both -expand yes
382  pack $tab2.sw22 -fill both -expand yes   
383  pack $w_tabset -fill both -expand yes 
384}
385
386#/////////////////////////////////////////////////////////////////////////////
387proc ::TolInspector::CreateMenus {} {
388#
389# PURPOSE: Create the menus of the trees
390#
391#/////////////////////////////////////////////////////////////////////////////
392  variable data_menu
393  variable wt_vars
394  variable wt_funcs
395  variable wt_tree 
396
397  set data_menu(main)          [menu $wt_tree.m -tearoff 0]
398  set data_menu(Code,File)     [menu $data_menu(main).mcof -tearoff 0]
399  set data_menu(Complex,File)  [menu $data_menu(main).mcxf -tearoff 0]
400  set data_menu(Date,File)     [menu $data_menu(main).mdaf -tearoff 0]
401  set data_menu(Matrix,File)   [menu $data_menu(main).mmaf -tearoff 0]
402  set data_menu(VMatrix,File)  [menu $data_menu(main).mvmf -tearoff 0]
403  set data_menu(Polyn,File)    [menu $data_menu(main).mpof -tearoff 0]
404  set data_menu(Ratio,File)    [menu $data_menu(main).mraf -tearoff 0]
405  set data_menu(Real,File)     [menu $data_menu(main).mref -tearoff 0]
406  set data_menu(Serie,File)    [menu $data_menu(main).msef -tearoff 0]
407  set data_menu(Set,File)      [menu $data_menu(main).mstf -tearoff 0]
408  set data_menu(File,File)     [menu $data_menu(main).mfif -tearoff 0]
409  set data_menu(Anything,File) [menu $data_menu(main).mspf -tearoff 0]
410  set data_menu(Text,File)     [menu $data_menu(main).mtef -tearoff 0]
411  set data_menu(TimeSet,File)  [menu $data_menu(main).mtif -tearoff 0]
412  set data_menu(NameBlock,File)  [menu $data_menu(main).mnbf -tearoff 0]
413
414  set data_menu(Code,Functions)     [menu $data_menu(main).mcofu -tearoff 0]
415  set data_menu(Complex,Functions)  [menu $data_menu(main).mcxfu -tearoff 0]
416  set data_menu(Date,Functions)     [menu $data_menu(main).mdafu -tearoff 0]
417  set data_menu(Matrix,Functions)   [menu $data_menu(main).mmafu -tearoff 0]
418  set data_menu(VMatrix,Functions)  [menu $data_menu(main).mvmfu -tearoff 0]
419  set data_menu(Polyn,Functions)    [menu $data_menu(main).mpofu -tearoff 0]
420  set data_menu(Ratio,Functions)    [menu $data_menu(main).mrafu -tearoff 0]
421  set data_menu(Real,Functions)     [menu $data_menu(main).mrefu -tearoff 0]
422  set data_menu(Serie,Functions)    [menu $data_menu(main).msefu -tearoff 0]
423  set data_menu(Set,Functions)      [menu $data_menu(main).mstfu -tearoff 0]
424  set data_menu(File,Functions)     [menu $data_menu(main).mfifu -tearoff 0]
425  set data_menu(Anything,Functions) [menu $data_menu(main).mspfu -tearoff 0]
426  set data_menu(Text,Functions)     [menu $data_menu(main).mtefu -tearoff 0]
427  set data_menu(TimeSet,Functions)  [menu $data_menu(main).mtifu -tearoff 0]
428  set data_menu(NameBlock,Functions)  [menu $data_menu(main).mnbfu -tearoff 0]
429
430  set data_menu(Matrix,Table)       [menu $data_menu(main).mmat   -tearoff 0]
431  set data_menu(Matrix,Export)      [menu $data_menu(main).mmae   -tearoff 0]
432  set data_menu(Matrix,Draw)        [menu $data_menu(main).mmac   -tearoff 0]
433  set data_menu(Matrix,Export,BDT)  [menu $data_menu(main).mmaebdt -tearoff 0]
434  set data_menu(Serie,DrawAutocor)  [menu $data_menu(main).mseda  -tearoff 0]
435  set data_menu(Serie,TableAutocor) [menu $data_menu(main).mseta  -tearoff 0]
436  set data_menu(Set,Table)          [menu $data_menu(main).mstt   -tearoff 0]
437  set data_menu(Set,Table2)         [menu $data_menu(main).mstt2  -tearoff 0]
438  set data_menu(Set,Draw)           [menu $data_menu(main).mstd   -tearoff 0]
439  set data_menu(Set,Draw,Special)   [menu $data_menu(main).mstds  -tearoff 0]
440  set data_menu(Set,Draw,Special,M) [menu $data_menu(main).mstdsm -tearoff 0] 
441  set data_menu(File,View)          [menu $data_menu(main).mfiv   -tearoff 0]
442  set data_menu(File,Decompile)     [menu $data_menu(main).mfid   -tearoff 0]
443  set data_menu(TimeSet,View)       [menu $data_menu(main).mtiv   -tearoff 0]
444  #$ht_vars  bind Entry <Button-3> +[$ht_vars bind Entry <Button-1>]
445 
446  # composes the  menus for each one of the trees, depending the node that is selected
447  bind $wt_tree <Button-3> "::TolInspector::PostTree %x %y %X %Y"
448  bind $wt_vars <Button-3> "::TolInspector::PostVariable %x %y %X %Y"
449  bind $wt_funcs <Button-3> "::TolInspector::PostFunction %x %y %X %Y"
450}
451
452#/////////////////////////////////////////////////////////////////////////////
453proc ::TolInspector::GetWeight { pane } {
454#
455# PURPOSE: Set data(geometry,$pane) to the value of the current geometry
456#          of the pane
457#
458# PARAMETERS:
459#   pane -> string with a value "left" or "right" for each one of panels
460#
461#/////////////////////////////////////////////////////////////////////////////
462  variable widgets
463  variable data
464
465  if {[winfo exists $widgets(panes,$pane)]} {
466    set data(geometry,$pane) [winfo width $widgets(panes,$pane)]
467  }
468  set data(geometry,$pane)
469}
470
471#/////////////////////////////////////////////////////////////////////////////
472proc ::TolInspector::Destroy { } {
473#
474# PURPOSE: Destroys the three trees of TolInspector and array with full
475#          content & description of items
476#
477#///////////////////////////////////////////////////////////////////////////// 
478  #@ Hay algo que destruir?
479  return
480}
481
482#/////////////////////////////////////////////////////////////////////////////
483proc ::TolInspector::OneLine { str } {
484#
485# PURPOSE: Gives a string with carriage returns \n and return this string
486#          until the first carriage return that appears after a word,
487#          replacing the rest by ... if some word existed after that carriage
488#          return
489#          Examples: the str "a\n b c"     returns "a..."
490#                            "\n \n a\n b" returns "a..."
491#                            "\n \n a\n"   returns "a"
492# PARAMETERS:
493#   str -> string with \n
494#
495#/////////////////////////////////////////////////////////////////////////////
496  set str [string trim $str]
497  set lnidx [string first "\n" $str]
498  if { $lnidx != -1 } {
499    if { [incr lnidx -1] > 0 } {
500      return "[string range $str 0 $lnidx]..."
501    } else {
502      return "..."
503    }
504  }
505  set str
506}
507
508#/////////////////////////////////////////////////////////////////////////////
509proc ::TolInspector::TrimContent { grammar content } {
510#///////////////////////////////////////////////////////////////////////////// 
511  if { [string equal "Real" $grammar] } {
512     return [::TolConsole::Format $content]
513  } else {
514    if { [string equal \"\n\" $content] } {
515      set content {"\n"}
516    }
517    return [OneLine $content]
518  }
519}
520
521#>> [tolinspe_wtree1.tcl]
522#>> proc ::TolInspector::InsertChild
523#>> proc ::TolInspector::InsertItem
524#>> proc ::TolInspector::ClearHiertables
525#>> proc ::TolInspector::OpenObject
526#>> proc ::TolInspector::InsertPackages
527#>> proc ::TolInspector::InsertGrammars
528#>> proc ::TolInspector::InsertFiles
529#>> proc ::TolInspector::InsertConsoleObj
530#>> proc ::TolInspector::InsertSubset
531
532#/////////////////////////////////////////////////////////////////////////////
533proc ::TolInspector::FilterNameBlockMember { name } {
534#/////////////////////////////////////////////////////////////////////////////
535  set st_reg [ regexp {(.+::)?(_)?(\.)?(.*)} $name => p1 p2 p3 p4]
536  if { !$st_reg } {
537    list -show 1 -fcolor "black" -name $name
538  } elseif { $p2 eq "_" } {
539    if { $p3 eq "." } {
540      if { [string match {autodoc.member.*} $p4] } {
541        # es un elemento de autodocumentacion y no se muestra
542        list -show 0
543      } {
544        # es un miembro de solo lectura
545        list -show 1 -fcolor "gray50" -name "_.$p4"
546      }
547    } else {
548      # es un miembro oculto,
549      set showPrivate [ Tol_GetViewPrivateMembers ]
550      list -show $showPrivate -fcolor "gray75" -name "_$p4"
551    }
552  } else {
553    list -show 1 -fcolor "black" -name $p4
554  }
555}
556
557#>> [tolinspe__wtree2.tcl]
558#>> proc ::TolInspector::ClearConsoleObj
559#>> proc ::TolInspector::ClearConsoleObjSel
560#>> proc ::TolInspector::UpdateFileRoot
561#>> proc ::TolInspector::UpdateConsoleObj
562
563#>> [tolinspe_wtree1.tcl]
564#>> proc ::TolInspector::SelectObject
565#>> proc ::TolInspector::SelectFileRoot
566#>> proc ::TolInspector::SelectConsoleRoot
567#>> proc ::TolInspector::SelectGrammar
568#>> proc ::TolInspector::SelectSet
569
570#>> [tolinspe_wtree1.tcl]
571#>> proc ::TolInspector::CloseObject
572#>> proc ::TolInspector::OpenVariable
573#>> proc ::TolInspector::SelectItem
574
575#/////////////////////////////////////////////////////////////////////////////
576proc ::TolInspector::GetItemName { prefix idx_list } {
577#///////////////////////////////////////////////////////////////////////////// 
578  set node_id $prefix
579  foreach id $idx_list {
580    append node_id "-$id"
581  }
582  set node_id
583}
584
585#/////////////////////////////////////////////////////////////////////////////
586proc ::TolInspector::OnBusy { cmd } {
587#///////////////////////////////////////////////////////////////////////////// 
588  variable OnBusyCmd $cmd
589}
590
591#/////////////////////////////////////////////////////////////////////////////
592proc ::TolInspector::Busy { } {
593#///////////////////////////////////////////////////////////////////////////// 
594  variable OnBusyCmd
595  variable wt_tree 
596  variable wt_vars
597
598  $wt_tree configure -cursor watch
599  $wt_vars configure -cursor watch
600  if { [string length $OnBusyCmd] } {
601    eval $OnBusyCmd 1
602  }
603}
604
605#/////////////////////////////////////////////////////////////////////////////
606proc ::TolInspector::NotBusy { } {
607#///////////////////////////////////////////////////////////////////////////// 
608  variable OnBusyCmd
609  variable wt_tree   
610  variable wt_vars
611
612  $wt_tree configure -cursor ""
613  $wt_vars configure -cursor ""
614
615  if { [string length $OnBusyCmd] } {
616    eval $OnBusyCmd 0
617  }
618}
619
620#>> [tolinspe__tolgui.tcl]
621#>> proc TclList2SetOfText
622#>> proc Tol_*
623#>> proc TolGui_*
624
625
626#>> [tolinspe__wtree2.tcl]
627#>> proc ::TolInspector::PostVariable
628#>> proc ::TolInspector::PostFunction
629#>> proc ::TolInspector::PostTree
630#>> proc ::TolInspector::AddToEvalWindow
631#>> proc ::TolInspector::SelectAll
632#>> proc ::TolInspector::ToggleSelection
633
634#>> [__draw.tcl]
635#>> proc ::TolInspector::ExportBDTMatrix
636#>> proc ::TolInspector::Draw*
637#>> proc ::TolInspector::Table*
638#>> proc ::TolInspector::View*
639
640#/////////////////////////////////////////////////////////////////////////////
641proc ::TolInspector::DecompileFile {name} {
642#
643# PURPOSE:
644#
645# PARAMETERS:
646#   name -> cadena con el nombre de un archivo o el de una variable
647#           que hace referencia a un archivo
648#
649# TODO: Actualmente en name solo puede llegar el nombre de un archivo
650#
651#/////////////////////////////////////////////////////////////////////////////
652  #puts "DECOMPILE 1.1, name=$name"
653  if {[file isfile $name]} {
654    set path $name
655  } else  {
656    set path [::tol::info path $name]
657  }
658  #puts "DECOMPILE 1.2"
659  #Comprobar si el archivo ya está abierto y si es así poner que no está compilado
660  if [namespace exists ::Editor] {
661    foreach ins [namespace children ::Editor] {
662      upvar \#0 ${ins}::data dataEd
663      if [string equal $dataEd(nameFile) $path] {
664        set dataEd(isCompiled) 0
665      }
666    }
667  }
668  # https://www.tol-project.org/ticket/1483
669  catch {
670    ::tol::decompile $path
671  }
672  ::TolInspector::UpdateFileRoot
673}
674
675#/////////////////////////////////////////////////////////////////////////////
676proc ::TolInspector::ReadUserFunctions {} {
677#
678# PURPOSE: Recorre el set global que tiene la definicion de funciones y va
679#          guardando esa informacion en arrays para almacenarla finalmente en
680#          regFunLst
681#
682#/////////////////////////////////////////////////////////////////////////////
683  variable regFunLst
684 
685  #Set global que tiene la definicion de funciones
686  set obj GuiFunction
687
688  if { [llength [set infAry [TclInfoVar Set $obj]] ] } {
689    #Tolcon_Trace "ReadUserFunctions: infAry = $infAry"
690    array set info $infAry
691    set nFun [lindex $info(CONTENT) 0]
692    #Tolcon_Trace "Numero de funciones =$nFun"
693    for  {set idf 1} {$idf <= $nFun} {incr idf} {
694      array set ifNameFun [TclInfoRef [list Set $obj $idf 1]]
695      array set ifNameGui [TclInfoRef [list Set $obj $idf 2]]
696      array set ifTypeGui [TclInfoRef [list Set $obj $idf 3]]
697      array set ifTypeOut [TclInfoRef [list Set $obj $idf 4]]
698      array set ifParams  [TclInfoRef [list Set $obj $idf 5]]
699      #Hago lindex $a(CONTENT) 0 para quitar las comillas
700      set regFun($idf,nameFun) [lindex $ifNameFun(CONTENT) 0]
701      set regFun($idf,nameGui) [lindex $ifNameGui(CONTENT) 0]
702      set regFun($idf,typeGui) [lindex $ifTypeGui(CONTENT) 0]
703      set regFun($idf,typeOut) [lindex $ifTypeOut(CONTENT) 0]
704      set nPar [lindex $ifParams(CONTENT) 0]
705      #Tolcon_Trace "Numero de parametros =$nPar"
706      for  {set idp 1} {$idp <= $nPar} {incr idp} {
707        array set ipNameGui [TclInfoRef [list Set $obj $idf 5 $idp 1]]
708        array set ipTypePar [TclInfoRef [list Set $obj $idf 5 $idp 2]]
709        array set ipTypeSel [TclInfoRef [list Set $obj $idf 5 $idp 3]]
710        array set ipListVal [TclInfoRef [list Set $obj $idf 5 $idp 4]]
711        set regPar($idp,nameGui) [lindex $ipNameGui(CONTENT) 0]
712        set regPar($idp,typePar) [lindex $ipTypePar(CONTENT) 0]
713        set regPar($idp,typeSel)         $ipTypeSel(CONTENT)
714        set nVal [lindex $ipListVal(CONTENT) 0]
715        #Tolcon_Trace "nVal=$nVal"
716        set lstVal ""
717        for  {set idv 1} {$idv <= $nVal} {incr idv} {
718           array set iVal [TclInfoRef [list Set $obj $idf 5 $idp 4 $idv]]
719           lappend lstVal [lindex $iVal(CONTENT) 0]
720        }
721        set regPar($idp,lstVal) $lstVal
722      }
723      set regFun($idf,parameters) [array get regPar]
724      array unset regPar
725      #parray regFun
726    }
727    set regFunLst [array get regFun]
728  } else {
729    set regFunLst ""
730  }
731}
732
733#/////////////////////////////////////////////////////////////////////////////
734proc ::TolInspector::ShowMenuUserFunc {gra} {
735#
736# PURPOSE: Muestra un menu contextual que...
737#
738#/////////////////////////////////////////////////////////////////////////////
739  variable data_menu
740  variable regFunLst
741 
742  #puts "ShowMenuUserFunc: gra=$gra"
743  if {[expr [info exist ::TolInspector::regFunLst] && [llength $regFunLst] ]} {
744    array set regFun $regFunLst
745    regsub -all ,nameGui \
746       [array names regFun *,nameGui] "" lstFun
747    foreach idf [lsort -integer $lstFun] {
748      set typeGui [split $regFun($idf,typeGui) .]
749      switch  [lindex $typeGui 0] {
750        Ite - Set {
751          if {[lindex $typeGui 1] eq $gra} {
752            $data_menu($gra,Functions) add command -label [mc $regFun($idf,nameGui)]\
753              -command [list ::TolInspector::CallUserFunction $gra $idf]
754          }
755        }
756        default {
757        }
758      }
759    }
760  }
761}
762
763#/////////////////////////////////////////////////////////////////////////////
764proc ::TolInspector::CallUserFunction {grammar idx} {
765#
766# PURPOSE: Para los tipos de funciones Ite y Set, muestra un dialogo que
767#          pide los
768#
769#/////////////////////////////////////////////////////////////////////////////
770  variable regFunLst
771  variable group_id
772  variable options_selected
773
774  upvar \#0 ::TolInspector::options_selected($grammar) items_selected
775  #puts "CallUserFunction. grammar=$grammar, idx=$idx, items_selected=$items_selected"
776 
777  set all_objs [ list ]
778  foreach it $items_selected {
779    set tcl_ref [ lindex $it 0 ]
780    set obj_addr [ ::tol::info address $tcl_ref ]
781    lappend all_objs "GetObjectFromAddress(\"$obj_addr\")"
782  }
783
784  if { [ llength $all_objs ] } {
785    incr group_id
786    array set regFun $regFunLst
787    set gui [bguifunction .t$group_id \
788                 -title $regFun($idx,nameGui) \
789                 -regpars $regFun($idx,parameters)]
790    set txtPars [join [$gui get values] ,]
791    if {$txtPars ne ""} {
792      set txtPars ",$txtPars"
793    }
794    destroy $gui
795    set typeGui [split $regFun($idx,typeGui) .]
796    switch [lindex $typeGui 0] {
797      Ite {
798        foreach obj $all_objs {
799          set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($obj $txtPars)"
800          #Tolcon_Trace "Ite.cmd=$cmd"
801          ::tol::console eval $cmd
802          ::TolConsole::SaveEval $cmd
803        }
804      }
805      Set {
806        set obj_args [join $all_objs ,]
807        set setCmd "SetOf[lindex $typeGui 1] ($obj_args)"
808        set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($setCmd $txtPars)"
809        #Tolcon_Trace "Set.cmd=$cmd"
810        ::tol::console eval $cmd
811        ::TolConsole::SaveEval $cmd
812      }
813      default {
814      }
815    }
816    ::TolInspector::UpdatePackageRoot
817    ::TolInspector::UpdateConsoleObj
818  }
819}
Note: See TracBrowser for help on using the repository browser.