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

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

Refs #1933
Se prescinden de algunos métodos auxiliares creados en tolinspe para usar wtree/treectrl.
Quedan algunos por revisar.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7345 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 31.0 KB
RevLine 
[7a3f24e]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
[6207115]11package require wtree
[7a3f24e]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    }]
[6207115]23    #@! REVISAR
[7a3f24e]24    bind TreeView <$but> $comm
25  }
26} else {
[6207115]27  #@! REVISAR
[7a3f24e]28  bind TreeView <MouseWheel> {
29    %W yview scroll [expr int(-1*%D/36)] units
30  }
31}
32
33#/////////////////////////////////////////////////////////////////////////////
34proc startupResources { } {
35#
36# PURPOSE: Establishes the preferences of the inspector
37#
38#/////////////////////////////////////////////////////////////////////////////   
39  global tcl_platform
40  global toltk_options
41  DynamicHelp::configure -background #FFFFC0
42  if {[string equal $tcl_platform(platform) "windows"]} {
43    set toltk_options(colors,SystemButtonFace) SystemButtonFace
44    set toltk_options(fonts,MenuNor)           {Tahoma 8}
45    set toltk_options(fonts,Fixed)             {{Courier New} 9}
46    set toltk_options(fonts,FixSmall)          {{Courier New} 8}
47    set toltk_options(fonts,Title1)            {Arial 9 bold}
48    set toltk_options(fonts,Label)             {Arial 9}
49    set toltk_options(fonts,TxtSmall)          {Arial 8}
50    set toltk_options(relief,ridge)            ridge
51  } else {
52    set toltk_options(colors,SystemButtonFace) #d4d4d4
53    set toltk_options(fonts,MenuNor)           {-*-helvetica-medium-r}
54    set toltk_options(fonts,Fixed)             {Courier 9}
55    set toltk_options(fonts,FixSmall)          {-*-courier-small-r}
56    set toltk_options(fonts,Title1)            {-*-helvetica-bold-r}
57    set toltk_options(fonts,Label)             {-*-helvetica-medium-r}
58    set toltk_options(fonts,TxtSmall)          {-*-helvetica-small-r}
59    set toltk_options(relief,ridge)            raised
60  }
61  option add *background         $toltk_options(colors,SystemButtonFace) user
62  option add *Label.font         $toltk_options(fonts,Label) user
63  option add *Radiobutton.font   $toltk_options(fonts,Label) user
64  option add *Checkbutton.font   $toltk_options(fonts,Label) user
65  option add *Button.font        $toltk_options(fonts,Label) user
66  option add *Menu.font          $toltk_options(fonts,MenuNor) user
67  option add *TitleFrame.l.font  $toltk_options(fonts,Title1) user
68  option add *Tabset.selectForeground black user
69
70  option readfile [file join $::toltk_script_path toltk.rc] user
71}
72
73#/////////////////////////////////////////////////////////////////////////////
74namespace eval ::TolInspector {
75#
76# PURPOSE: The purpose of this namespace is creating a the TOL object
77#          inspector and managing its events.
78# VARIABLES:
79#   data:
80#   regFunLst:    List array with functions defined by user
[6207115]81#   wt_tree:      Tree widget containing the TOL objects (::wtree)
[7a3f24e]82#   w_tabset:     Tabset widget containing trees of variables and functions
[6207115]83#   wt_vars:      Tree widget containing the tree of Variables (::wtree)
[7a3f24e]84#   data_menu:    Array with data of menus
85#   group_id:
[6207115]86#   wt_funcs:     Tree widget containing the tree of Functions (::wtree)
87#   OnSelectItem: Command to invoke on SelectItem in wt_*
[7a3f24e]88#   OnBusyCmd:    Command to invoke when busy
89#   SubTypeImgs:  Images associated to types of set
90#
91#/////////////////////////////////////////////////////////////////////////////
92  variable data
[6207115]93  variable arguments
[7a3f24e]94 
95  # List array with functions defined by user
96  variable regFunLst
97 
98  # tree widget containing the TOL objects.
[6207115]99  variable wt_tree   ;# is a ::wtree
100 
[7a3f24e]101  # tabset widget containing trees of variables and functions
102  variable w_tabset
103
[6207115]104  # list widget containing the variables. It's the window of the tab Variable
105  variable wt_vars      ;# is a ::wtree
[7a3f24e]106 
107  variable data_menu
108  variable group_id -1
109
[6207115]110  # list widget containing the functions. It's the window of the tab Functions
111  variable wt_funcs     ;# is a ::wtree
[7a3f24e]112
[6207115]113  # command to invoke on SelectItem in wt_*
[7a3f24e]114  variable OnSelectItem
115
116  # command to invoke when busy
117  variable OnBusyCmd ""
118
119  # images associated to types of set.
120  variable SubTypeImgs {
121    GenericSet MODFile PRJFile DIRFile TOLFile
122    BDCFile BDTFile BSTFile BMTFile BSIFile TSIFile BMIFile
123    StructuredSet TableSet}
124
125}
126
127#/////////////////////////////////////////////////////////////////////////////
128proc ::TolInspector::SubTypeImage { idx } {
129#/////////////////////////////////////////////////////////////////////////////
130  variable SubTypeImgs
131
132  #Tolcon_Trace "SubTypeImage $idx = [lindex $SubTypeImgs $idx]"
133  ::Bitmap::get [lindex $SubTypeImgs $idx]
134}
135
136#/////////////////////////////////////////////////////////////////////////////
137proc ::TolInspector::Create { w args } {
138#
139# PURPOSE: Creates the object inspector, that contains two panels with three
140#          treeviews and three trees.
141#           - One for the left side of the inspector (with grammars,
[6207115]142#             included files and console objects)
[7a3f24e]143#           - And two for the right one (one for variables tab and one for
144#             functions tab)
145#
146# PARAMETERS:
147#   w:    path where tol inspector must be created
148#   args: list of pairs {-option value} with options for the inspector.
149#      -onselcmd  Comand to execute when a node is selected
150#      -wleft     relative weight of left pane
151#      -wrigth    relative weight of rigth pane
152#
153#/////////////////////////////////////////////////////////////////////////////
154  global toltk_options
[6207115]155  variable wt_tree 
156  variable wt_vars 
[7a3f24e]157  variable data_menu
[6207115]158  variable wt_funcs 
[7a3f24e]159  variable w_tabset
160  variable OnSelectItem
161  variable OnBusyCmd ""
162
163  # this should be used insted of a lot of scalar variables.
164  # but, what can we do now?
165
166  variable widgets
167  variable data
168
169  array set options {
170    -onselcmd ""
171    -wleft    3
172    -wright   7
173  }
174  array set options $args
175 
176  # initializes the command OnSelectItem to ""
177  set OnSelectItem $options(-onselcmd)
178
179  #upvar \#0 ::TolTk::Images Images
[6207115]180 
181  bind TreeCtrl <Button1-Motion> {
182    TreeCtrl::Motion1 %W %x %y
183  }
[7a3f24e]184
185  # creation of PANED WINDOW MAIN
186  set pwMain [PanedWindow $w -side bottom -pad 0 -width 4]
187  # creation of pane left and pane right
188  set paneLeft  [$pwMain add -weight $options(-wleft)]
189  set paneRight [$pwMain add -weight $options(-wright)]
190  set widgets(panes,left)  $paneLeft
191  set widgets(panes,right) $paneRight
192 
193  # when a panel is destroyed, the item 'geometry,side' of the array variable
194  # data gives the value of the width of panel 'side' (left or right)
195  bind $paneLeft <Destroy> {
196    namespace eval  ::TolInspector {
197      variable data
198      variable widgets
199      set data(geometry,left)  [winfo width $widgets(panes,left)]
200    }
201  } 
202  bind $paneRight <Destroy> {
203    namespace eval  ::TolInspector {
204      variable data
205      variable widgets
206      set data(geometry,right)  [winfo width $widgets(panes,right)]
207    }
208  }
209  # bind for destruction of paned window main
210  bind $pwMain <Destroy> ::TolInspector::Destroy
211
212  # creation of pane left with tree with the TOL OBJECTS
213  CreatePaneLeft  $paneLeft
214  # creation of the right panel with TABSET of VARIABLES and FUNCTIONS
215  CreatePaneRight $paneRight
216  # creation of the menus
217  CreateMenus
218  # packing the panedwindowmain
219  pack $pwMain -fill both -expand yes
220
221  # esto es para evitar que aparezca el icono open cuando
222  # relleno estando el mouse sobre ht_*
[6207115]223  #@! Por revisar
224  #@! $ht_vars  bind Entry <Enter>  ""
225  #@! $ht_vars  bind Entry <Leave>  ""
226  #@! $ht_funcs bind Entry <Enter>  ""
227  #@! $ht_funcs bind Entry <Leave>  ""
[7a3f24e]228}
229
230#/////////////////////////////////////////////////////////////////////////////
231proc ::TolInspector::CreatePaneLeft { paneLeft } {
232#
233# PURPOSE: Creation of TREE LEFT with the TOL OBJECTS
234#
235# PARAMETERS:
236#   paneLeft:  path of the pane of the left in TolInspector
237#
238#/////////////////////////////////////////////////////////////////////////////
239  global toltk_options
[6207115]240  variable wt_tree
[7a3f24e]241 
242  # creation of the ScrolledWindow of the left side
[6207115]243  set sw1 [ScrolledWindow $paneLeft.sw -ipad 0 -borderwidth 0 -scrollbar none]
244
[7a3f24e]245  # creation of the left tree
[6207115]246  set wt_tree [::wtree $sw1.wt -table 0 -filter no \
[e0578ae]247    -background white -showroot 1 -selectmode single -showheader 0 \
[6207115]248    -highlightbackground gray75 -highlightcolor black \
249    -highlightthickness 0 -font $toltk_options(fonts,Label) \
[e0578ae]250    -columns [::TolInspector::LNodeDef] ]
[6207115]251   
[7a3f24e]252  # configuration of the left tree
[e0578ae]253  $wt_tree column configure "range 1 end" -visible no
[6207115]254  $wt_tree column configure first -expand yes -weight 1
255  $wt_tree column configure all -itembackground ""       
256  $wt_tree notify bind $wt_tree <Selection> "::TolInspector::SelectObject"   
257  $wt_tree notify bind $wt_tree <Expand-before> "::TolInspector::OpenObject %I"
258  $wt_tree notify bind $wt_tree <Collapse-before> "::TolInspector::CloseObject %I" 
259           
[7a3f24e]260  # creation of the root node "Tol Objects"
261  set img [::Bitmap::get Objects]
[6207115]262  #@ Se pone el style a mano, no sé la manera natural de hacer esto con wtree
[ceea866]263  $wt_tree item style set root Name [$wt_tree column cget Name -itemstyle]
264  $wt_tree item text root Name [mc "Tol Objects"]
265  $wt_tree item image root Name $img
[7a3f24e]266
267  # creation of the node father "Grammars"
268  set img [::Bitmap::get Grammars] 
[e0578ae]269  set wt_row [::TolInspector::LNode "" Root $img [mc "Grammars"] "Grammar"]
[6207115]270  $wt_tree insert $wt_row -at child -relative root -tags "root-grammars"
[7a3f24e]271  # Inserts in the node of grammars a node by each grammar that exists in Tol
272  InsertGrammars
273
274  # creation of the node father "Packages"
275  set img [::Bitmap::get "package"] 
[e0578ae]276  set wt_row [::TolInspector::LNode "" Root $img [mc "Packages"] "Package"]   
[6207115]277  $wt_tree insert $wt_row -at child -relative root -tags "root-packages" -button yes
[7a3f24e]278
279  # creation of the node father "Included Files"
280  set img [::Bitmap::get "Files"]
[e0578ae]281  set wt_row [::TolInspector::LNode "" Root $img [mc "Included Files"] "File"]   
[6207115]282  $wt_tree insert $wt_row -at child -relative root -tags "root-files" -button yes
283     
[7a3f24e]284  # creation of the node father "Console Objects" 
285  set img [::Bitmap::get "Console"]
[e0578ae]286  set wt_row [::TolInspector::LNode "" Root $img [mc "Console Objects"] "Console"] 
[6207115]287  $wt_tree insert $wt_row -at child -relative root -tags "root-console" -button yes
288     
289  # associates the tree to scrolled window
290  $sw1 setwidget $wt_tree
291
[7a3f24e]292  # packing
293  pack $sw1 -fill both -expand yes
[6207115]294 
[7a3f24e]295  # bind the focus on tree
[6207115]296  bind ${wt_tree}.frameTree.t <Button-1> "::focus $wt_tree"
297 
298  # expand/collapse (and fill/unfill) a node with a double clic
[0731938]299  bind ${wt_tree}.frameTree.t <Double-1> "::TolInspector::ToggleItem %x %y"
[7a3f24e]300}
301
302#/////////////////////////////////////////////////////////////////////////////
303proc ::TolInspector::CreatePaneRight { paneRight } {
304#
305# PURPOSE: Creation of the right pane with TABSET with VARIABLES and FUNCTIONS
306#
307# PARAMETERS:
308#   paneLeft:  path of the pane of the right in TolInspector
309#
310#/////////////////////////////////////////////////////////////////////////////
311  global toltk_options
312  variable w_tabset
[6207115]313  variable wt_vars
314  variable wt_funcs
[7a3f24e]315 
[0731938]316  # creates the tabset to display the variables & functions
[e933fd6]317  set w_tabset [NoteBook $paneRight.nb -tabbevelsize 8 -tabpady {2 6} -font {Arial 8}]           
[0731938]318 
319  # inserts in the tabset the tabs of functions and variables       
320  $w_tabset insert 0 Variables -text [mc Variables] -image [::Bitmap::get Variables] -background \#d9d9d9
321  $w_tabset insert 1 Functions -text [mc Functions] -image [::Bitmap::get Functions] -background \#d9d9d9
322  $w_tabset raise Variables
[6207115]323 
[0731938]324  # creates the scrolled windows for each one of the tabs
325  set tab1 [$w_tabset getframe Variables]
326  set tab2 [$w_tabset getframe Functions]
327  set sw21 [ScrolledWindow $tab1.sw12 -scrollbar none] 
328  set sw22 [ScrolledWindow $tab2.sw22 -scrollbar none]
[7a3f24e]329
330  # Creation of the right TREE RIGHT with VARIABLES
[6207115]331  set wt_vars [::wtree $sw21.vars -table 1 -filter no \
332    -background white -showroot 0 -selectmode extended -showheader 1 \
333    -highlightbackground gray75 -highlightcolor black \
334    -highlightthickness 0 -font $toltk_options(fonts,Label) \
[e0578ae]335    -columns [::TolInspector::RNodeDef] ]
[7a3f24e]336  # configuration of the tree of variables
[ceea866]337  $wt_vars column configure Grammar -visible no
338  $wt_vars column configure Reference -visible no
[e0578ae]339  $wt_vars column configure all -itembackground ""
[6207115]340  $wt_vars notify bind $wt_vars <Expand-before> "::TolInspector::OpenVariable %I"
341  $wt_vars notify bind $wt_vars <Selection> "::TolInspector::SelectItem $wt_vars"
342  #@! el bind debería poder hacerse directamente sobre el wtree
[0731938]343  bind ${wt_vars}.frameTree.t <Button-1> "::focus $wt_vars"   
[6207115]344  bind ${wt_vars}.frameTree.t <Double-1> "::TolInspector::SelectionExpand"
345 
[7a3f24e]346  # Creation of the right TREE RIGHT with FUNCTIONS
[6207115]347  set wt_funcs [::wtree $sw22.vars -table 1 -filter no \
348    -background white -showroot 0 -selectmode extended -showheader 1 \
349    -highlightbackground gray75 -highlightcolor black \
350    -highlightthickness 0 -font $toltk_options(fonts,Label) \
[e0578ae]351    -columns [::TolInspector::RNodeDef] ]
[7a3f24e]352  # configuration of the tree of functions
[ceea866]353  $wt_funcs column configure Grammar -visible no
354  $wt_funcs column configure Reference -visible no
[6207115]355  $wt_funcs column configure all -itembackground ""     
356  $wt_funcs notify bind $wt_funcs <Selection> "::TolInspector::SelectItem $wt_funcs"     
357  bind ${wt_funcs}.frameTree.t <Button-1> "::focus $wt_funcs"     
[7a3f24e]358 
359  # associates the trees to scrolled windows
[6207115]360  $sw21 setwidget $wt_vars
361  $sw22 setwidget $wt_funcs 
[7a3f24e]362  # configure the tabs
[0731938]363  $tab1 configure -borderwidth 2 -background \#d9d9d9
364  $tab2 configure -borderwidth 2 -background \#d9d9d9
[6207115]365
[7a3f24e]366  # packing the tabset
[0731938]367  pack $tab1.sw12 -fill both -expand yes
368  pack $tab2.sw22 -fill both -expand yes   
369  pack $w_tabset -fill both -expand yes 
370  #@! $w_tabset tab configure Variables\
371  #@!        -command "::TolInspector::SelectItem $wt_vars"
372  #@! $w_tabset tab configure Functions\
373  #@!        -command "::TolInspector::SelectItem $wt_funcs"
[7a3f24e]374}
375
376#/////////////////////////////////////////////////////////////////////////////
377proc ::TolInspector::CreateMenus {} {
378#
379# PURPOSE: Create the menus of the trees
380#
381#/////////////////////////////////////////////////////////////////////////////
382  variable data_menu
[6207115]383  variable wt_vars
384  variable wt_funcs
385  variable wt_tree 
[7a3f24e]386
[6207115]387  set data_menu(main)          [menu $wt_tree.m -tearoff 0]
[7a3f24e]388  set data_menu(Code,File)     [menu $data_menu(main).mcof -tearoff 0]
389  set data_menu(Complex,File)  [menu $data_menu(main).mcxf -tearoff 0]
390  set data_menu(Date,File)     [menu $data_menu(main).mdaf -tearoff 0]
391  set data_menu(Matrix,File)   [menu $data_menu(main).mmaf -tearoff 0]
392  set data_menu(VMatrix,File)  [menu $data_menu(main).mvmf -tearoff 0]
393  set data_menu(Polyn,File)    [menu $data_menu(main).mpof -tearoff 0]
394  set data_menu(Ratio,File)    [menu $data_menu(main).mraf -tearoff 0]
395  set data_menu(Real,File)     [menu $data_menu(main).mref -tearoff 0]
396  set data_menu(Serie,File)    [menu $data_menu(main).msef -tearoff 0]
397  set data_menu(Set,File)      [menu $data_menu(main).mstf -tearoff 0]
398  set data_menu(File,File)     [menu $data_menu(main).mfif -tearoff 0]
399  set data_menu(Anything,File) [menu $data_menu(main).mspf -tearoff 0]
400  set data_menu(Text,File)     [menu $data_menu(main).mtef -tearoff 0]
401  set data_menu(TimeSet,File)  [menu $data_menu(main).mtif -tearoff 0]
402  set data_menu(NameBlock,File)  [menu $data_menu(main).mnbf -tearoff 0]
403
404  set data_menu(Code,Functions)     [menu $data_menu(main).mcofu -tearoff 0]
405  set data_menu(Complex,Functions)  [menu $data_menu(main).mcxfu -tearoff 0]
406  set data_menu(Date,Functions)     [menu $data_menu(main).mdafu -tearoff 0]
407  set data_menu(Matrix,Functions)   [menu $data_menu(main).mmafu -tearoff 0]
408  set data_menu(VMatrix,Functions)  [menu $data_menu(main).mvmfu -tearoff 0]
409  set data_menu(Polyn,Functions)    [menu $data_menu(main).mpofu -tearoff 0]
410  set data_menu(Ratio,Functions)    [menu $data_menu(main).mrafu -tearoff 0]
411  set data_menu(Real,Functions)     [menu $data_menu(main).mrefu -tearoff 0]
412  set data_menu(Serie,Functions)    [menu $data_menu(main).msefu -tearoff 0]
413  set data_menu(Set,Functions)      [menu $data_menu(main).mstfu -tearoff 0]
414  set data_menu(File,Functions)     [menu $data_menu(main).mfifu -tearoff 0]
415  set data_menu(Anything,Functions) [menu $data_menu(main).mspfu -tearoff 0]
416  set data_menu(Text,Functions)     [menu $data_menu(main).mtefu -tearoff 0]
417  set data_menu(TimeSet,Functions)  [menu $data_menu(main).mtifu -tearoff 0]
418  set data_menu(NameBlock,Functions)  [menu $data_menu(main).mnbfu -tearoff 0]
419
420  set data_menu(Matrix,Table)       [menu $data_menu(main).mmat   -tearoff 0]
421  set data_menu(Matrix,Export)      [menu $data_menu(main).mmae   -tearoff 0]
422  set data_menu(Matrix,Draw)        [menu $data_menu(main).mmac   -tearoff 0]
423  set data_menu(Matrix,Export,BDT)  [menu $data_menu(main).mmaebdt -tearoff 0]
424  set data_menu(Serie,DrawAutocor)  [menu $data_menu(main).mseda  -tearoff 0]
425  set data_menu(Serie,TableAutocor) [menu $data_menu(main).mseta  -tearoff 0]
426  set data_menu(Set,Table)          [menu $data_menu(main).mstt   -tearoff 0]
427  set data_menu(Set,Table2)         [menu $data_menu(main).mstt2  -tearoff 0]
428  set data_menu(Set,Draw)           [menu $data_menu(main).mstd   -tearoff 0]
429  set data_menu(Set,Draw,Special)   [menu $data_menu(main).mstds  -tearoff 0]
430  set data_menu(Set,Draw,Special,M) [menu $data_menu(main).mstdsm -tearoff 0] 
431  set data_menu(File,View)          [menu $data_menu(main).mfiv   -tearoff 0]
432  set data_menu(File,Decompile)     [menu $data_menu(main).mfid   -tearoff 0]
433  set data_menu(TimeSet,View)       [menu $data_menu(main).mtiv   -tearoff 0]
434  #$ht_vars  bind Entry <Button-3> +[$ht_vars bind Entry <Button-1>]
435 
[6207115]436  # composes the  menus for each one of the trees, depending the node that is selected
437  bind ${wt_tree}.frameTree.t <Button-3> "::TolInspector::PostTree %X %Y"
438  bind ${wt_vars}.frameTree.t <Button-3> "::TolInspector::PostVariable %X %Y"
439  bind ${wt_funcs}.frameTree.t <Button-3> "::TolInspector::PostFunction %X %Y"
[7a3f24e]440}
441
442#/////////////////////////////////////////////////////////////////////////////
443proc ::TolInspector::GetWeight { pane } {
444#
445# PURPOSE: Set data(geometry,$pane) to the value of the current geometry
446#          of the pane
447#
448# PARAMETERS:
449#   pane -> string with a value "left" or "right" for each one of panels
450#
451#/////////////////////////////////////////////////////////////////////////////
452  variable widgets
453  variable data
454
455  if {[winfo exists $widgets(panes,$pane)]} {
456    set data(geometry,$pane) [winfo width $widgets(panes,$pane)]
457  }
458  set data(geometry,$pane)
459}
460
461#/////////////////////////////////////////////////////////////////////////////
462proc ::TolInspector::Destroy { } {
463#
464# PURPOSE: Destroys the three trees of TolInspector and array with full
465#          content & description of items
466#
467#///////////////////////////////////////////////////////////////////////////// 
[6207115]468  #@! wtree destroy ??
469  return
[7a3f24e]470}
471
472#/////////////////////////////////////////////////////////////////////////////
473proc ::TolInspector::OneLine { str } {
474#
475# PURPOSE: Gives a string with carriage returns \n and return this string
476#          until the first carriage return that appears after a word,
477#          replacing the rest by ... if some word existed after that carriage
478#          return
479#          Examples: the str "a\n b c"     returns "a..."
480#                            "\n \n a\n b" returns "a..."
481#                            "\n \n a\n"   returns "a"
482# PARAMETERS:
483#   str -> string with \n
484#
485#/////////////////////////////////////////////////////////////////////////////
486  set str [string trim $str]
487  set lnidx [string first "\n" $str]
488  if { $lnidx != -1 } {
489    if { [incr lnidx -1] > 0 } {
490      return "[string range $str 0 $lnidx]..."
491    } else {
492      return "..."
493    }
494  }
495  set str
496}
497
498#/////////////////////////////////////////////////////////////////////////////
499proc ::TolInspector::TrimContent { grammar content } {
500#///////////////////////////////////////////////////////////////////////////// 
501  if { [string equal "Real" $grammar] } {
502     return [::TolConsole::Format $content]
503  } else {
504    if { [string equal \"\n\" $content] } {
505      set content {"\n"}
506    }
507    return [OneLine $content]
508    set content [string trim $content]
509    set lnidx [string first "\n" $content]
510    if { $lnidx != -1 } {
511      if { [incr lnidx -1] > 0 } {
512        return "[string range $content 0 $lnidx]..."
513      } else {
514        return "..."
515      }
516    }
517    set content
518  }
519}
520
521#>> [tolinspe_wtree1.tcl]
522#>> proc ::TolInspector::InsertChild
[6207115]523#>> proc ::TolInspector::InsertItem
[7a3f24e]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
[6207115]532#/////////////////////////////////////////////////////////////////////////////
[7a3f24e]533proc ::TolInspector::FilterNameBlockMember { name } {
[6207115]534#/////////////////////////////////////////////////////////////////////////////
[7a3f24e]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
[6207115]595  variable wt_tree 
596  variable wt_vars
[7a3f24e]597
[6207115]598  $wt_tree configure -cursor watch
599  $wt_vars configure -cursor watch
[7a3f24e]600  if { [string length $OnBusyCmd] } {
601    eval $OnBusyCmd 1
602  }
603}
604
605#/////////////////////////////////////////////////////////////////////////////
606proc ::TolInspector::NotBusy { } {
607#///////////////////////////////////////////////////////////////////////////// 
608  variable OnBusyCmd
[6207115]609  variable wt_tree   
610  variable wt_vars
[7a3f24e]611
[6207115]612  $wt_tree configure -cursor ""
613  $wt_vars configure -cursor ""
[7a3f24e]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
[6207115]625
[7a3f24e]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
[6207115]634#>> [__draw.tcl]
[7a3f24e]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::UpdateConsoleObj
817  }
818}
Note: See TracBrowser for help on using the repository browser.