source: tol/tolbase/lib/toltk/tolinspe__main.tcl @ 7a3f24e

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

Refs #1933
Se separa el archivo tolinspe.tcl en 5 partes:

+ main: parte principal y algunas funciones generales)
+ wtree1: funciones dependientes de los widgets de árbol (parte 1)
+ wtree2: funciones dependientes de los widgets de árbol (parte 2)
+ draw: funciones para representar objetos TOL (tabular, graficar, etc.)
+ tolgui: otras funciones fuera del namespace ::TolInpector

Se actualizan las nuevas ubicaciones en tclIndex.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7332 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 37.0 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
11
12if { 0 && ![info exists toltk_script_path] } {
13  set toltk_script_path [file dirname [info script]]
14  source [file join $toltk_script_path init_toltk.tcl]
15}
16
17if {"unix" eq $::tcl_platform(platform)} {
18  foreach "but units" [list 4 -5 5 5] {
19    set comm [string map "%d $units" {
20      %W yview scroll %d units
21    }]
22    bind TreeView <$but> $comm
23  }
24} else {
25  bind TreeView <MouseWheel> {
26    %W yview scroll [expr int(-1*%D/36)] units
27  }
28}
29#
30##/////////////////////////////////////////////////////////////////////////////
31#proc dump { args } {
32##
33## PURPOSE: Auxiliary procedure to show a string
34##
35##/////////////////////////////////////////////////////////////////////////////
36#puts $args
37#}
38
39#/////////////////////////////////////////////////////////////////////////////
40proc startupResources { } {
41#
42# PURPOSE: Establishes the preferences of the inspector
43#
44#/////////////////////////////////////////////////////////////////////////////   
45  global tcl_platform
46  global toltk_options
47  DynamicHelp::configure -background #FFFFC0
48  if {[string equal $tcl_platform(platform) "windows"]} {
49    set toltk_options(colors,SystemButtonFace) SystemButtonFace
50    set toltk_options(fonts,MenuNor)           {Tahoma 8}
51    set toltk_options(fonts,Fixed)             {{Courier New} 9}
52    set toltk_options(fonts,FixSmall)          {{Courier New} 8}
53    set toltk_options(fonts,Title1)            {Arial 9 bold}
54    set toltk_options(fonts,Label)             {Arial 9}
55    set toltk_options(fonts,TxtSmall)          {Arial 8}
56    set toltk_options(relief,ridge)            ridge
57  } else {
58    set toltk_options(colors,SystemButtonFace) #d4d4d4
59    set toltk_options(fonts,MenuNor)           {-*-helvetica-medium-r}
60    set toltk_options(fonts,Fixed)             {Courier 9}
61    set toltk_options(fonts,FixSmall)          {-*-courier-small-r}
62    set toltk_options(fonts,Title1)            {-*-helvetica-bold-r}
63    set toltk_options(fonts,Label)             {-*-helvetica-medium-r}
64    set toltk_options(fonts,TxtSmall)          {-*-helvetica-small-r}
65    set toltk_options(relief,ridge)            raised
66  }
67  option add *background         $toltk_options(colors,SystemButtonFace) user
68  option add *Label.font         $toltk_options(fonts,Label) user
69  option add *Radiobutton.font   $toltk_options(fonts,Label) user
70  option add *Checkbutton.font   $toltk_options(fonts,Label) user
71  option add *Button.font        $toltk_options(fonts,Label) user
72  option add *Menu.font          $toltk_options(fonts,MenuNor) user
73  option add *TitleFrame.l.font  $toltk_options(fonts,Title1) user
74  option add *Tabset.selectForeground black user
75
76  option readfile [file join $::toltk_script_path toltk.rc] user
77}
78
79#/////////////////////////////////////////////////////////////////////////////
80namespace eval ::TolInspector {
81#
82# PURPOSE: The purpose of this namespace is creating a the TOL object
83#          inspector and managing its events.
84# VARIABLES:
85#   data:
86#   regFunLst:    List array with functions defined by user
87#   tolset:       Name of the current TOL set variable
88#   tolindex:
89#   at_set:
90#   node_prefix:
91#   ht_tree:      Tree widget containing the TOL objects (:blt::treeview)
92#   blt_tree:     Tree widget containing the TOL objects (:blt::tree)
93#   w_tabset:     Tabset widget containing trees of variables and functions
94#   ht_vars:      Tree widget containing the tree of Variables
95#                 (:blt::treeview)
96#   blt_vartree:  Tree widget containing the tree of Variables (:blt::tree)
97#   data_menu:    Array with data of menus
98#   group_id:
99#   ht_funcs:     Tree widget containing the tree of Functions
100#                 (:blt::treeview)
101#   blt_functree: Tree widget containing the tree of Functions (:blt::tree)
102#   item_data:    Array to hold the full content & description of items
103#   item_id:      Current index of item to insert in ht_* starting from 1
104#   OnSelectItem: Command to invoke on SelectItem in ht_*
105#   OnBusyCmd:    Command to invoke when busy
106#   SubTypeImgs:  Images associated to types of set
107#
108#/////////////////////////////////////////////////////////////////////////////
109  variable data
110 
111  # List array with functions defined by user
112  variable regFunLst
113 
114  # name of the current TOL set variable.
115  variable tolset ""
116  variable tolindex ""
117  # estas variables desapareceran cuando ::tol::forallchild admita scripts
118  # completos y no solo nombres de proc
119  variable at_set
120  variable node_prefix
121
122  variable iterSet ""
123  variable knownReference ""
124
125  variable gra_parent ""
126  # tree widget containing the TOL objects.
127  variable ht_tree   ;# is a ::blt::treeview
128  variable blt_tree  ;# is a ::blt::tree
129
130  # tabset widget containing trees of variables and functions
131  variable w_tabset
132
133  # list widget containing the variables. It's the window of
134  # the tab Variable
135  variable ht_vars      ;# is a ::blt::treeview
136  variable blt_vartree  ;# is a ::blt::tree
137 
138  variable data_menu
139  variable group_id -1
140
141  # list widget containing the functions. It's the window of
142  # the tab Functions
143  variable ht_funcs     ;# is a ::blt::treeview
144  variable blt_functree ;# is a ::blt::tree
145
146  # array to hold the full content & description of items
147  variable item_data
148
149  # current index of item to insert in ht_* starting from 1
150  variable item_id
151 
152  # tell if we are processing a SelectSet event
153
154  #variable selecting_set
155  #variable closing
156
157  # command to invoke on SelectItem in ht_*
158  variable OnSelectItem
159
160  # command to invoke when busy
161  variable OnBusyCmd ""
162
163  # images associated to types of set.
164  variable SubTypeImgs {
165    GenericSet MODFile PRJFile DIRFile TOLFile
166    BDCFile BDTFile BSTFile BMTFile BSIFile TSIFile BMIFile
167    StructuredSet TableSet}
168
169}
170
171#/////////////////////////////////////////////////////////////////////////////
172proc ::TolInspector::SubTypeImage { idx } {
173#/////////////////////////////////////////////////////////////////////////////
174  variable SubTypeImgs
175
176  #Tolcon_Trace "SubTypeImage $idx = [lindex $SubTypeImgs $idx]"
177  ::Bitmap::get [lindex $SubTypeImgs $idx]
178}
179
180#/////////////////////////////////////////////////////////////////////////////
181proc ::TolInspector::CreateColumns { ht } {
182#
183# PURPOSE: Creates the columns (index, name, content, path, description )
184#          of the tree of variables or functions
185#
186# PARAMETERS:
187#   ht: path of ::blt::treeview of variables or ::blt::treeview of functions
188#
189#/////////////////////////////////////////////////////////////////////////////
190  # main column ==> Name
191  $ht column configure treeView -text [mc "Name"] -justify left \
192      -bg white -activetitlebackground gray90 -pad 3
193  # index column
194  $ht column insert 0 Index \
195      -bg white -justify left -activetitlebackground gray90
196  # columns Content Path & Description
197  #(pgea) se oculta la columna correspondiente a la referencia
198  $ht column insert end Content Description Path\
199      -bg white -justify left -activetitlebackground gray90 -pad 3
200  $ht column insert end Reference -hide yes
201  foreach c {Index Content Description Path} {
202    $ht column configure $c -text [mc "$c"]
203  }
204  # associates the command of order to each one of the titles of the
205  # columns of the trees
206  foreach column [$ht column names] {
207    $ht column configure $column \
208      -command [list ::TolInspector::SortColumn $ht $column]
209  }
210}
211
212#/////////////////////////////////////////////////////////////////////////////
213proc ::TolInspector::SortColumn {ht column} {
214#
215# PURPOSE: Associates the command of order to the title of a column of the
216#          tree of variables or the tree of functions
217#
218# PARAMETERS:
219#   ht:     path of ::blt::treeview of variables or ::blt::treeview of
220#           functions
221#   column: name of the column of this tree
222#
223#///////////////////////////////////////////////////////////////////////////// 
224  set old [$ht sort cget -column]
225  set decreasing 0
226  if { "$old" == "$column" } {
227    set decreasing [$ht sort cget -decreasing]
228    set decreasing [expr !$decreasing]
229  }
230  $ht sort configure -decreasing $decreasing -column $column -mode integer
231  $ht configure -flat no
232  $ht sort auto yes
233
234  blt::busy hold $ht
235  update
236  blt::busy release $ht
237}
238
239#/////////////////////////////////////////////////////////////////////////////
240proc ::TolInspector::Create { w args } {
241#
242# PURPOSE: Creates the object inspector, that contains two panels with three
243#          treeviews and three trees.
244#           - One for the left side of the inspector (with grammars,
245#             included files, console objects and object's spool)
246#           - And two for the right one (one for variables tab and one for
247#             functions tab)
248#
249# PARAMETERS:
250#   w:    path where tol inspector must be created
251#   args: list of pairs {-option value} with options for the inspector.
252#      -onselcmd  Comand to execute when a node is selected
253#      -wleft     relative weight of left pane
254#      -wrigth    relative weight of rigth pane
255#
256#/////////////////////////////////////////////////////////////////////////////
257  global toltk_options
258  variable ht_tree
259  variable blt_tree
260  variable ht_vars
261  variable blt_vartree
262  variable data_menu
263  variable ht_funcs
264  variable blt_functree
265  variable w_tabset
266  variable OnSelectItem
267  variable OnBusyCmd ""
268
269  # this should be used insted of a lot of scalar variables.
270  # but, what can we do now?
271
272  variable widgets
273  variable data
274
275  array set data {
276    pool,objects ""
277  }
278
279  array set options {
280    -onselcmd ""
281    -wleft    3
282    -wright   7
283  }
284  array set options $args
285 
286  # initializes the command OnSelectItem to ""
287  set OnSelectItem $options(-onselcmd)
288
289  #variable selecting_set 0
290  #variable closing 0
291
292  #upvar \#0 ::TolTk::Images Images
293
294  # creation of PANED WINDOW MAIN
295  set pwMain [PanedWindow $w -side bottom -pad 0 -width 4]
296  # creation of pane left and pane right
297  set paneLeft  [$pwMain add -weight $options(-wleft)]
298  set paneRight [$pwMain add -weight $options(-wright)]
299  set widgets(panes,left)  $paneLeft
300  set widgets(panes,right) $paneRight
301 
302  # when a panel is destroyed, the item 'geometry,side' of the array variable
303  # data gives the value of the width of panel 'side' (left or right)
304  bind $paneLeft <Destroy> {
305    namespace eval  ::TolInspector {
306      variable data
307      variable widgets
308      set data(geometry,left)  [winfo width $widgets(panes,left)]
309    }
310  } 
311  bind $paneRight <Destroy> {
312    namespace eval  ::TolInspector {
313      variable data
314      variable widgets
315      set data(geometry,right)  [winfo width $widgets(panes,right)]
316    }
317  }
318  # bind for destruction of paned window main
319  bind $pwMain <Destroy> ::TolInspector::Destroy
320
321  # creation of pane left with tree with the TOL OBJECTS
322  CreatePaneLeft  $paneLeft
323  # creation of the right panel with TABSET of VARIABLES and FUNCTIONS
324  CreatePaneRight $paneRight
325  # creation of the menus
326  CreateMenus
327  # packing the panedwindowmain
328  pack $pwMain -fill both -expand yes
329
330  # esto es para evitar que aparezca el icono open cuando
331  # relleno estando el mouse sobre ht_*
332  $ht_vars  bind Entry <Enter>  ""
333  $ht_vars  bind Entry <Leave>  ""
334  $ht_funcs bind Entry <Enter>  ""
335  $ht_funcs bind Entry <Leave>  ""
336}
337
338#/////////////////////////////////////////////////////////////////////////////
339proc ::TolInspector::CreatePaneLeft { paneLeft } {
340#
341# PURPOSE: Creation of TREE LEFT with the TOL OBJECTS
342#
343# PARAMETERS:
344#   paneLeft:  path of the pane of the left in TolInspector
345#
346#/////////////////////////////////////////////////////////////////////////////
347  global toltk_options
348  variable blt_tree
349  variable ht_tree
350 
351  # creation of the ScrolledWindow of the left side
352  set sw1 [ScrolledWindow $paneLeft.sw -ipad 0 -borderwidth 0 -scrollbar both ]
353  # creation of the left tree
354  set blt_tree [::blt::tree create tree$sw1.ht]
355  set ht_tree [::blt::treeview $sw1.ht -tree $blt_tree -bg white \
356           -hideroot no -activeicons "" \
357           -selectbackground gray75 -selectforeground black \
358           -selectcommand ::TolInspector::SelectObject \
359           -highlightthickness 0 -font $toltk_options(fonts,Label)]
360  # configuration of the left tree
361  $ht_tree configure \
362           -closecommand  "::TolInspector::CloseObject %#" \
363           -opencommand   "::TolInspector::OpenObject %#"
364  $ht_tree style configure text -bg white     
365  $ht_tree column configure treeView -bg white
366  $ht_tree column insert end FileName -hide true 
367  # creation of the root node "Tol Objects"
368  set img [::Bitmap::get Objects]
369  $ht_tree entry configure root -label [mc "Tol Objects"]\
370           -icons [list $img $img]
371
372  # creation of the node father "Grammars"
373  set img [::Bitmap::get Grammars] 
374  set blt_idx [$blt_tree insert root -label "root-grammars"\
375           -tags "root-grammars"]
376  $ht_tree entry configure $blt_idx -label [mc "Grammars"]\
377           -icons [list $img $img]
378  # Inserts in the node of grammars a node by each grammar that exists in Tol
379  InsertGrammars
380
381  # creation of the node father "Packages"
382  set img [::Bitmap::get "package"] 
383  set blt_idx [$blt_tree insert root -label "root-packages"\
384           -tags "root-packages"]
385  $ht_tree entry configure $blt_idx -label [mc "Packages"]\
386           -icons [list $img $img] -button yes
387
388  # creation of the node father "Included Files"
389  set img [::Bitmap::get "Files"]
390  set blt_idx [$blt_tree insert root -label "root-files" -tags "root-files"]
391  $ht_tree entry configure $blt_idx -label [mc "Included Files"] \
392      -icons [list $img $img] -button yes
393  # creation of the node father "Console Objects" 
394  set img [::Bitmap::get "Console"]
395  set blt_idx [$blt_tree insert root -label "root-console"\
396          -tags "root-console"]
397  $ht_tree entry configure $blt_idx -label [mc "Console Objects"] \
398      -icons [list $img $img] -button yes
399  # creation of the node father "Objects' Spool"
400  set img [::Bitmap::get "pool"]
401  set blt_idx [$blt_tree insert root -label "root-pool" -tags "root-pool"]
402  $ht_tree entry configure $blt_idx -label [mc "Objects' Spool"] \
403      -icons [list $img $img] -button yes
404  # associates the tree to scrolled window
405  $sw1 setwidget $ht_tree
406  # packing
407  pack $sw1 -fill both -expand yes
408  # bind the focus on tree
409  bind $ht_tree  <Button-1> "::focus $ht_tree"
410}
411
412#/////////////////////////////////////////////////////////////////////////////
413proc ::TolInspector::CreatePaneRight { paneRight } {
414#
415# PURPOSE: Creation of the right pane with TABSET with VARIABLES and FUNCTIONS
416#
417# PARAMETERS:
418#   paneLeft:  path of the pane of the right in TolInspector
419#
420#/////////////////////////////////////////////////////////////////////////////
421  global toltk_options
422  variable w_tabset
423  variable blt_vartree
424  variable ht_vars
425  variable blt_functree
426  variable ht_funcs
427 
428  # creates the tabset to display the variables & functions   
429  #set w_tabset [::blt::tabset $paneRight.ts -relief flat\
430            -bd 0 -outerpad 0 -tier 2 -slant none -textside top \
431            -highlightthickness 0 -side left -rotate 90]
432  set w_tabset [::blt::tabset $paneRight.ts -relief flat\
433            -bd 0 -outerpad 0 -tier 2 -slant right -textside right \
434            -highlightthickness 0]
435  # creates the scrolled windows for each one of the tabs
436  set sw21 [ScrolledWindow $w_tabset.sw1]
437  set sw22 [ScrolledWindow $w_tabset.sw2]
438  # inserts in the tabset the tabs of functions and variables
439  $w_tabset insert end \
440      Variables -text [mc Variables] -selectbackground \#d9d9d9 -bg gray75 \
441      -image [::Bitmap::get Variables] -pady 0\
442      Functions -text [mc Functions] -selectbackground \#d9d9d9 -bg gray75 \
443      -image [::Bitmap::get Functions] -pady 0
444
445  # Creation of the right TREE RIGHT with VARIABLES
446  set blt_vartree [::blt::tree create tree$sw21.vars]
447  set ht_vars [::blt::treeview $sw21.vars -tree $blt_vartree -flat no\
448           -bg white -hideroot yes -linewidth 0 -activeicons {}\
449           -selectmode multiple\
450           -selectbackground gray75 -selectforeground black \
451           -highlightthickness 0 -font $toltk_options(fonts,Label)]
452  #tv_ordered_selection tvsel -tv $ht_vars
453  # configuration of the tree of variables
454  $ht_vars configure \
455    -opencommand   "::TolInspector::OpenVariable %#" \
456    -selectcommand "::TolInspector::SelectItem $ht_vars"
457  $ht_vars style configure text -bg white
458  bind $ht_vars  <Button-1> "::focus $ht_vars"
459   
460  # Creation of the right TREE RIGHT with FUNCTIONS
461  set blt_functree [::blt::tree create tree$sw22.funcs]
462  set ht_funcs [::blt::treeview $sw22.funcs -tree $blt_functree -flat no\
463          -bg white -hideroot yes -linewidth 0 -activeicons {} \
464          -selectmode multiple\
465          -selectbackground gray75 -selectforeground black \
466          -highlightthickness 0 -font $toltk_options(fonts,Label)]
467  # configuration of the tree of functions
468  $ht_funcs configure  -selectcommand "::TolInspector::SelectItem $ht_funcs"
469  $ht_funcs style configure text -bg white
470  bind $ht_funcs <Button-1> "::focus $ht_funcs"
471 
472  # associates the trees to scrolled windows
473  $sw21 setwidget $ht_vars
474  $sw22 setwidget $ht_funcs
475  # configure the tabs
476  $w_tabset tab configure Variables -window $sw21 -fill both -padx 0
477  $w_tabset tab configure Functions -window $sw22 -fill both -padx 0
478  # create the columns of the trees of variables and functions
479  CreateColumns $ht_vars
480  CreateColumns $ht_funcs
481  # packing the tabset
482  pack $w_tabset -fill both -expand yes
483  $w_tabset tab configure Variables\
484         -command "::TolInspector::SelectItem $ht_vars"
485  $w_tabset tab configure Functions\
486         -command "::TolInspector::SelectItem $ht_funcs"
487}
488
489#/////////////////////////////////////////////////////////////////////////////
490proc ::TolInspector::CreateMenus {} {
491#
492# PURPOSE: Create the menus of the trees
493#
494#/////////////////////////////////////////////////////////////////////////////
495  variable data_menu
496  variable ht_vars
497  variable ht_funcs
498  variable ht_tree
499
500  set data_menu(main)          [menu $ht_vars.m -tearoff 0]
501  set data_menu(Code,File)     [menu $data_menu(main).mcof -tearoff 0]
502  set data_menu(Complex,File)  [menu $data_menu(main).mcxf -tearoff 0]
503  set data_menu(Date,File)     [menu $data_menu(main).mdaf -tearoff 0]
504  set data_menu(Matrix,File)   [menu $data_menu(main).mmaf -tearoff 0]
505  set data_menu(VMatrix,File)  [menu $data_menu(main).mvmf -tearoff 0]
506  set data_menu(Polyn,File)    [menu $data_menu(main).mpof -tearoff 0]
507  set data_menu(Ratio,File)    [menu $data_menu(main).mraf -tearoff 0]
508  set data_menu(Real,File)     [menu $data_menu(main).mref -tearoff 0]
509  set data_menu(Serie,File)    [menu $data_menu(main).msef -tearoff 0]
510  set data_menu(Set,File)      [menu $data_menu(main).mstf -tearoff 0]
511  set data_menu(File,File)     [menu $data_menu(main).mfif -tearoff 0]
512  set data_menu(Anything,File) [menu $data_menu(main).mspf -tearoff 0]
513  set data_menu(Text,File)     [menu $data_menu(main).mtef -tearoff 0]
514  set data_menu(TimeSet,File)  [menu $data_menu(main).mtif -tearoff 0]
515  set data_menu(NameBlock,File)  [menu $data_menu(main).mnbf -tearoff 0]
516
517  set data_menu(Code,Functions)     [menu $data_menu(main).mcofu -tearoff 0]
518  set data_menu(Complex,Functions)  [menu $data_menu(main).mcxfu -tearoff 0]
519  set data_menu(Date,Functions)     [menu $data_menu(main).mdafu -tearoff 0]
520  set data_menu(Matrix,Functions)   [menu $data_menu(main).mmafu -tearoff 0]
521  set data_menu(VMatrix,Functions)  [menu $data_menu(main).mvmfu -tearoff 0]
522  set data_menu(Polyn,Functions)    [menu $data_menu(main).mpofu -tearoff 0]
523  set data_menu(Ratio,Functions)    [menu $data_menu(main).mrafu -tearoff 0]
524  set data_menu(Real,Functions)     [menu $data_menu(main).mrefu -tearoff 0]
525  set data_menu(Serie,Functions)    [menu $data_menu(main).msefu -tearoff 0]
526  set data_menu(Set,Functions)      [menu $data_menu(main).mstfu -tearoff 0]
527  set data_menu(File,Functions)     [menu $data_menu(main).mfifu -tearoff 0]
528  set data_menu(Anything,Functions) [menu $data_menu(main).mspfu -tearoff 0]
529  set data_menu(Text,Functions)     [menu $data_menu(main).mtefu -tearoff 0]
530  set data_menu(TimeSet,Functions)  [menu $data_menu(main).mtifu -tearoff 0]
531  set data_menu(NameBlock,Functions)  [menu $data_menu(main).mnbfu -tearoff 0]
532
533  set data_menu(Matrix,Table)       [menu $data_menu(main).mmat   -tearoff 0]
534  set data_menu(Matrix,Export)      [menu $data_menu(main).mmae   -tearoff 0]
535  set data_menu(Matrix,Draw)        [menu $data_menu(main).mmac   -tearoff 0]
536  set data_menu(Matrix,Export,BDT)  [menu $data_menu(main).mmaebdt -tearoff 0]
537  set data_menu(Serie,DrawAutocor)  [menu $data_menu(main).mseda  -tearoff 0]
538  set data_menu(Serie,TableAutocor) [menu $data_menu(main).mseta  -tearoff 0]
539  set data_menu(Set,Table)          [menu $data_menu(main).mstt   -tearoff 0]
540  set data_menu(Set,Table2)         [menu $data_menu(main).mstt2  -tearoff 0]
541  set data_menu(Set,Draw)           [menu $data_menu(main).mstd   -tearoff 0]
542  set data_menu(Set,Draw,Special)   [menu $data_menu(main).mstds  -tearoff 0]
543  set data_menu(Set,Draw,Special,M) [menu $data_menu(main).mstdsm -tearoff 0] 
544  set data_menu(File,View)          [menu $data_menu(main).mfiv   -tearoff 0]
545  set data_menu(File,Decompile)     [menu $data_menu(main).mfid   -tearoff 0]
546  set data_menu(TimeSet,View)       [menu $data_menu(main).mtiv   -tearoff 0]
547  #$ht_vars  bind Entry <Button-3> +[$ht_vars bind Entry <Button-1>]
548 
549  # composes the  menus for each one of the trees, depending the node
550  # that is selected
551  $ht_vars  bind all <Button-3> +[list ::TolInspector::PostVariable %X %Y]
552  $ht_funcs bind all <Button-3> +[list ::TolInspector::PostFunction %X %Y]
553  $ht_tree  bind all <Button-3> +[list ::TolInspector::PostTree     %X %Y]
554}
555
556#/////////////////////////////////////////////////////////////////////////////
557proc ::TolInspector::GetWeight { pane } {
558#
559# PURPOSE: Set data(geometry,$pane) to the value of the current geometry
560#          of the pane
561#
562# PARAMETERS:
563#   pane -> string with a value "left" or "right" for each one of panels
564#
565#/////////////////////////////////////////////////////////////////////////////
566  variable widgets
567  variable data
568
569  if {[winfo exists $widgets(panes,$pane)]} {
570    set data(geometry,$pane) [winfo width $widgets(panes,$pane)]
571  }
572  set data(geometry,$pane)
573}
574
575#/////////////////////////////////////////////////////////////////////////////
576proc ::TolInspector::Destroy { } {
577#
578# PURPOSE: Destroys the three trees of TolInspector and array with full
579#          content & description of items
580#
581#///////////////////////////////////////////////////////////////////////////// 
582  variable blt_tree
583  variable blt_vartree
584  variable blt_functree
585  variable item_data
586
587  ::blt::tree destroy $blt_tree
588  ::blt::tree destroy $blt_vartree
589  ::blt::tree destroy $blt_functree
590  unset item_data
591}
592
593#/////////////////////////////////////////////////////////////////////////////
594proc ::TolInspector::OneLine { str } {
595#
596# PURPOSE: Gives a string with carriage returns \n and return this string
597#          until the first carriage return that appears after a word,
598#          replacing the rest by ... if some word existed after that carriage
599#          return
600#          Examples: the str "a\n b c"     returns "a..."
601#                            "\n \n a\n b" returns "a..."
602#                            "\n \n a\n"   returns "a"
603# PARAMETERS:
604#   str -> string with \n
605#
606#/////////////////////////////////////////////////////////////////////////////
607  set str [string trim $str]
608  set lnidx [string first "\n" $str]
609  if { $lnidx != -1 } {
610    if { [incr lnidx -1] > 0 } {
611      return "[string range $str 0 $lnidx]..."
612    } else {
613      return "..."
614    }
615  }
616  set str
617}
618
619#/////////////////////////////////////////////////////////////////////////////
620proc ::TolInspector::TrimContent { grammar content } {
621#///////////////////////////////////////////////////////////////////////////// 
622  if { [string equal "Real" $grammar] } {
623     return [::TolConsole::Format $content]
624  } else {
625    if { [string equal \"\n\" $content] } {
626      set content {"\n"}
627    }
628    return [OneLine $content]
629    set content [string trim $content]
630    set lnidx [string first "\n" $content]
631    if { $lnidx != -1 } {
632      if { [incr lnidx -1] > 0 } {
633        return "[string range $content 0 $lnidx]..."
634      } else {
635        return "..."
636      }
637    }
638    set content
639  }
640}
641
642#>> [tolinspe_wtree1.tcl]
643#>> proc ::TolInspector::_InsertChild
644#>> proc ::TolInspector::InsertChild
645#>> proc ::TolInspector::Insert_HTItem
646#>> proc ::TolInspector::ClearHiertables
647#>> proc ::TolInspector::getPackageReference
648#>> proc ::TolInspector::OpenObject
649#>> proc ::TolInspector::InsertPackages
650#>> proc ::TolInspector::InsertGrammars
651#>> proc ::TolInspector::InsertFiles
652#>> proc ::TolInspector::InsertConsoleObj
653#>> proc ::TolInspector::InsertPoolObj
654#>> proc ::TolInspector::InsertSubset
655
656proc ::TolInspector::FilterNameBlockMember { name } {
657  set st_reg [ regexp {(.+::)?(_)?(\.)?(.*)} $name => p1 p2 p3 p4]
658  if { !$st_reg } {
659    list -show 1 -fcolor "black" -name $name
660  } elseif { $p2 eq "_" } {
661    if { $p3 eq "." } {
662      if { [string match {autodoc.member.*} $p4] } {
663        # es un elemento de autodocumentacion y no se muestra
664        list -show 0
665      } {
666        # es un miembro de solo lectura
667        list -show 1 -fcolor "gray50" -name "_.$p4"
668      }
669    } else {
670      # es un miembro oculto,
671      set showPrivate [ Tol_GetViewPrivateMembers ]
672      list -show $showPrivate -fcolor "gray75" -name "_$p4"
673    }
674  } else {
675    list -show 1 -fcolor "black" -name $p4
676  }
677}
678
679#>> [tolinspe__wtree2.tcl]
680#>> proc ::TolInspector::ClearConsoleObj
681#>> proc ::TolInspector::ClearConsoleObjSel
682#>> proc ::TolInspector::UpdateFileRoot
683#>> proc ::TolInspector::UpdateConsoleObj
684#>> proc ::TolInspector::UpdatePoolObj
685
686#>> [tolinspe_wtree1.tcl]
687#>> proc ::TolInspector::SelectObject
688#>> proc ::TolInspector::SelectFileRoot
689#>> proc ::TolInspector::SelectConsoleRoot
690#>> proc ::TolInspector::SelectPoolRoot
691#>> proc ::TolInspector::SelectGrammar
692#>> proc ::TolInspector::SelectSet
693
694proc ::TolInspector::GetParentGrammar { set_ref } {
695  set root [ lindex $set_ref 0 ]
696  set L [ llength $set_ref ]
697  if { ( $root eq "File" && $L <= 2 ) } {
698    set root
699  } else {
700    lindex [ tol::info var $set_ref ] 0
701  }
702}
703
704#/////////////////////////////////////////////////////////////////////////////
705proc ::TolInspector::HasSubset { args } {
706#///////////////////////////////////////////////////////////////////////////// 
707  if { [string equal [lindex $args 0] "Set"] } {
708    variable has_button 1
709    return 0
710  }
711  return 1
712}
713
714#>> [tolinspe_wtree1.tcl]
715#>> proc ::TolInspector::CloseObject
716#>> proc ::TolInspector::OpenVariable
717#>> proc ::TolInspector::SelectItem
718#>> proc ::TolInspector::FillText
719
720#/////////////////////////////////////////////////////////////////////////////
721proc ::TolInspector::GetItemName { prefix idx_list } {
722#///////////////////////////////////////////////////////////////////////////// 
723  set node_id $prefix
724  foreach id $idx_list {
725    append node_id "-$id"
726  }
727  set node_id
728}
729
730#/////////////////////////////////////////////////////////////////////////////
731proc ::TolInspector::OnBusy { cmd } {
732#///////////////////////////////////////////////////////////////////////////// 
733  variable OnBusyCmd $cmd
734}
735
736#/////////////////////////////////////////////////////////////////////////////
737proc ::TolInspector::Busy { } {
738#///////////////////////////////////////////////////////////////////////////// 
739  variable OnBusyCmd
740  variable ht_tree
741  variable ht_vars
742
743  $ht_tree configure -cursor watch
744  $ht_vars configure -cursor watch
745  if { [string length $OnBusyCmd] } {
746    eval $OnBusyCmd 1
747  }
748}
749
750#/////////////////////////////////////////////////////////////////////////////
751proc ::TolInspector::NotBusy { } {
752#///////////////////////////////////////////////////////////////////////////// 
753  variable OnBusyCmd
754  variable ht_tree
755  variable ht_vars
756
757  $ht_tree configure -cursor ""
758  $ht_vars configure -cursor ""
759
760  if { [string length $OnBusyCmd] } {
761    eval $OnBusyCmd 0
762  }
763}
764
765#>> [tolinspe__tolgui.tcl]
766#>> proc TclList2SetOfText
767#>> proc Tol_*
768#>> proc TolGui_*
769
770#>> [tolinspe__wtree2.tcl]
771#>> proc ::TolInspector::PostVariable
772#>> proc ::TolInspector::PostFunction
773#>> proc ::TolInspector::PostTree
774#>> proc ::TolInspector::RemoveFromSpool
775#>> proc ::TolInspector::AddToSpool
776#>> proc ::TolInspector::AddToEvalWindow
777#>> proc ::TolInspector::SelectAll
778#>> proc ::TolInspector::ToggleSelection
779
780#>> [tolinspe__draw.tcl]
781#>> proc ::TolInspector::ExportBDTMatrix
782#>> proc ::TolInspector::Draw*
783#>> proc ::TolInspector::Table*
784#>> proc ::TolInspector::View*
785
786#/////////////////////////////////////////////////////////////////////////////
787proc ::TolInspector::DecompileFile {name} {
788#
789# PURPOSE:
790#
791# PARAMETERS:
792#   name -> cadena con el nombre de un archivo o el de una variable
793#           que hace referencia a un archivo
794#
795# TODO: Actualmente en name solo puede llegar el nombre de un archivo
796#
797#/////////////////////////////////////////////////////////////////////////////
798  variable data
799  #puts "DECOMPILE 1.1, name=$name"
800  if {[file isfile $name]} {
801    set path $name
802  } else  {
803    set path [::tol::info path $name]
804  }
805  #puts "DECOMPILE 1.2"
806  #Comprobar si el archivo ya está abierto y si es así poner que no está compilado
807  if [namespace exists ::Editor] {
808    foreach ins [namespace children ::Editor] {
809      upvar \#0 ${ins}::data dataEd
810      if [string equal $dataEd(nameFile) $path] {
811        set dataEd(isCompiled) 0
812      }
813    }
814  }
815  #puts "DECOMPILE 1.3"
816  #Quitar del spool todos los objetos provenientes de este archivo
817 
818  foreach _obj $data(pool,objects) {
819    array set obj $_obj
820    #Tolcon_Trace "REFERENCIA: $obj(reference)"
821    if {[string equal [lindex $obj(reference) 0] $path]} {
822      set idx [lsearch $data(pool,objects) $_obj]
823      set data(pool,objects) [lreplace $data(pool,objects) $idx $idx]
824    }
825  }
826  # https://www.tol-project.org/ticket/1483
827  catch {
828    ::tol::decompile $path
829  }
830  ::TolInspector::UpdateFileRoot
831}
832
833#/////////////////////////////////////////////////////////////////////////////
834proc ::TolInspector::ReadUserFunctions {} {
835#
836# PURPOSE: Recorre el set global que tiene la definicion de funciones y va
837#          guardando esa informacion en arrays para almacenarla finalmente en
838#          regFunLst
839#
840#/////////////////////////////////////////////////////////////////////////////
841  variable regFunLst
842 
843  #Set global que tiene la definicion de funciones
844  set obj GuiFunction
845
846  if { [llength [set infAry [TclInfoVar Set $obj]] ] } {
847    #Tolcon_Trace "ReadUserFunctions: infAry = $infAry"
848    array set info $infAry
849    set nFun [lindex $info(CONTENT) 0]
850    #Tolcon_Trace "Numero de funciones =$nFun"
851    for  {set idf 1} {$idf <= $nFun} {incr idf} {
852      array set ifNameFun [TclInfoRef [list Set $obj $idf 1]]
853      array set ifNameGui [TclInfoRef [list Set $obj $idf 2]]
854      array set ifTypeGui [TclInfoRef [list Set $obj $idf 3]]
855      array set ifTypeOut [TclInfoRef [list Set $obj $idf 4]]
856      array set ifParams  [TclInfoRef [list Set $obj $idf 5]]
857      #Hago lindex $a(CONTENT) 0 para quitar las comillas
858      set regFun($idf,nameFun) [lindex $ifNameFun(CONTENT) 0]
859      set regFun($idf,nameGui) [lindex $ifNameGui(CONTENT) 0]
860      set regFun($idf,typeGui) [lindex $ifTypeGui(CONTENT) 0]
861      set regFun($idf,typeOut) [lindex $ifTypeOut(CONTENT) 0]
862      set nPar [lindex $ifParams(CONTENT) 0]
863      #Tolcon_Trace "Numero de parametros =$nPar"
864      for  {set idp 1} {$idp <= $nPar} {incr idp} {
865        array set ipNameGui [TclInfoRef [list Set $obj $idf 5 $idp 1]]
866        array set ipTypePar [TclInfoRef [list Set $obj $idf 5 $idp 2]]
867        array set ipTypeSel [TclInfoRef [list Set $obj $idf 5 $idp 3]]
868        array set ipListVal [TclInfoRef [list Set $obj $idf 5 $idp 4]]
869        set regPar($idp,nameGui) [lindex $ipNameGui(CONTENT) 0]
870        set regPar($idp,typePar) [lindex $ipTypePar(CONTENT) 0]
871        set regPar($idp,typeSel)         $ipTypeSel(CONTENT)
872        set nVal [lindex $ipListVal(CONTENT) 0]
873        #Tolcon_Trace "nVal=$nVal"
874        set lstVal ""
875        for  {set idv 1} {$idv <= $nVal} {incr idv} {
876           array set iVal [TclInfoRef [list Set $obj $idf 5 $idp 4 $idv]]
877           lappend lstVal [lindex $iVal(CONTENT) 0]
878        }
879        set regPar($idp,lstVal) $lstVal
880      }
881      set regFun($idf,parameters) [array get regPar]
882      array unset regPar
883      #parray regFun
884    }
885    set regFunLst [array get regFun]
886  } else {
887    set regFunLst ""
888  }
889}
890
891#/////////////////////////////////////////////////////////////////////////////
892proc ::TolInspector::ShowMenuUserFunc {gra} {
893#
894# PURPOSE: Muestra un menu contextual que...
895#
896#/////////////////////////////////////////////////////////////////////////////
897  variable data_menu
898  variable regFunLst
899 
900  #puts "ShowMenuUserFunc: gra=$gra"
901  if {[expr [info exist ::TolInspector::regFunLst] && [llength $regFunLst] ]} {
902    array set regFun $regFunLst
903    regsub -all ,nameGui \
904       [array names regFun *,nameGui] "" lstFun
905    foreach idf [lsort -integer $lstFun] {
906      set typeGui [split $regFun($idf,typeGui) .]
907      switch  [lindex $typeGui 0] {
908        Ite - Set {
909          if {[lindex $typeGui 1] eq $gra} {
910            $data_menu($gra,Functions) add command -label [mc $regFun($idf,nameGui)]\
911              -command [list ::TolInspector::CallUserFunction $gra $idf]
912          }
913        }
914        default {
915        }
916      }
917    }
918  }
919}
920
921#/////////////////////////////////////////////////////////////////////////////
922proc ::TolInspector::CallUserFunction {grammar idx} {
923#
924# PURPOSE: Para los tipos de funciones Ite y Set, muestra un dialogo que
925#          pide los
926#
927#/////////////////////////////////////////////////////////////////////////////
928  variable regFunLst
929  variable group_id
930  variable data
931  variable options_selected
932
933  upvar \#0 ::TolInspector::options_selected($grammar) items_selected
934  #puts "CallUserFunction. grammar=$grammar, idx=$idx, items_selected=$items_selected"
935 
936  set all_objs [ list ]
937  foreach it $items_selected {
938    set tcl_ref [ lindex $it 0 ]
939    set obj_addr [ ::tol::info address $tcl_ref ]
940    lappend all_objs "GetObjectFromAddress(\"$obj_addr\")"
941  }
942
943  if { [ llength $all_objs ] } {
944    incr group_id
945    array set regFun $regFunLst
946    set gui [bguifunction .t$group_id \
947                 -title $regFun($idx,nameGui) \
948                 -regpars $regFun($idx,parameters)]
949    set txtPars [join [$gui get values] ,]
950    if {$txtPars ne ""} {
951      set txtPars ",$txtPars"
952    }
953    destroy $gui
954    set typeGui [split $regFun($idx,typeGui) .]
955    switch [lindex $typeGui 0] {
956      Ite {
957        foreach obj $all_objs {
958          set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($obj $txtPars)"
959          #Tolcon_Trace "Ite.cmd=$cmd"
960          ::tol::console eval $cmd
961          ::TolConsole::SaveEval $cmd
962        }
963      }
964      Set {
965        set obj_args [join $all_objs ,]
966        set setCmd "SetOf[lindex $typeGui 1] ($obj_args)"
967        set cmd "$regFun($idx,typeOut) $regFun($idx,nameFun) ($setCmd $txtPars)"
968        #Tolcon_Trace "Set.cmd=$cmd"
969        ::tol::console eval $cmd
970        ::TolConsole::SaveEval $cmd
971      }
972      default {
973      }
974    }
975    ::TolInspector::UpdateConsoleObj
976  }
977}
978
979namespace eval ::LoadStatus {
980  variable data
981}
982
983#proc ::LoadStatus::Show {file} {
984#   
985#  set f [toplevel .topStatus]
986#  #wm protocol $path WM_DELETE_WINDOW [list ::Editor::OnDelete $this]
987#  # bind Destroy más abajo
988# 
989#  label $f.lfile -text $file
990#  # frame y label para barra de estado
991#  set data(sb,frame) [frame $f.fop -relief groove -bd 1 -height 7]
992#  set data(sb,objs)  [label $f.fop.objs -relief groove -bd 1 -width 16]
993#  set data(sb,files) [label $f.fop.files -text [mc "Not Compiled"] \
994#          -relief raised -bd 1 -width 16]
995#  set data(sb,time)  [label $f.fop.time -bd 1 -width 14]
996#  set data(sb,rell)  [label $f.fop.rell -relief groove -bd 1]
997# 
998# 
999#  # empaquetamos los label de estado
1000#  pack $f.fop.objs $f.fop.files $f.fop.time -side left
1001#  pack $f.fop.rell -expand true -fill x
1002# 
1003#  grid $f.lfile -sticky news
1004#  grid $f.fop   -sticky ews
1005# 
1006#  grid rowconfigure    $f 1 -weight 1
1007#  grid columnconfigure $f 0 -weight 1
1008#   
1009#}
1010#
1011#
1012#proc ::LoadStatus::Hide {w} {
1013#   
1014#
Note: See TracBrowser for help on using the repository browser.