Project

General

Profile

Statistics
| Branch: | Revision:

root / src / tkenv / insplist.tcl @ e1750c09

History | View | Annotate | Download (6.34 KB)

1 01873262 Georg Kunz
#=================================================================
2
#  INSPLIST.TCL - part of
3
#
4
#                     OMNeT++/OMNEST
5
#            Discrete System Simulation in C++
6
#
7
#=================================================================
8
9
#----------------------------------------------------------------#
10
#  Copyright (C) 1992-2008 Andras Varga
11
#
12
#  This file is distributed WITHOUT ANY WARRANTY. See the file
13
#  `license' for details on this and other legal matters.
14
#----------------------------------------------------------------#
15
16
#
17
# Inspector list handling
18
#
19
20
# PIL stands for Pending Inspector List
21
#set pil_name() {}
22
#set pil_class() {}
23
#set pil_type() {}
24
#set pil_geom() {}
25
26
# must store a copy if object names and class names because this info
27
# is no longer available when we get called from cObject dtor:
28
#set insp_w2name() {}
29
#set insp_w2class() {}
30
31
32
#
33
# THIS PROC IS CALLED FROM C++ CODE, at each inspector display update.
34
#
35
proc inspectorupdate_callback {} {
36
    global priv
37
38
    set priv(animspeed) [opp_getsimoption animation_speed]
39
40
    inspectorlist_openinspectors
41
    notifyPlugins inspectorUpdate
42
    filteredobjectlist_inspectorupdate
43
}
44
45
46
#
47
# try to open inspectors in 'pending inspectors' list
48
#
49
proc inspectorlist_openinspectors {} {
50
    global pil_name pil_class pil_type pil_geom
51
52
    foreach key [array names pil_name] {
53
        # check if element is still in the array: if an inspector was several times
54
        # on the list (ie. both w/ type=0 and type!=0), opening it removes both elements...
55
        if [info exists pil_name($key)] {
56
            #DBG: puts [list opp_inspectbyname $pil_name($key) $pil_class($key) $pil_type($key) $pil_geom($key)]
57
            if [catch {opp_inspectbyname $pil_name($key) $pil_class($key) $pil_type($key) $pil_geom($key)}] {
58
                tk_messageBox -title Error -message "Error opening inspector for ($pil_class($key))$pil_name($key), ignoring."
59
                unset pil_name($key)
60
                unset pil_class($key)
61
                unset pil_type($key)
62
                unset pil_geom($key)
63
            }
64
        }
65
    }
66
}
67
68
69
proc inspectorlist_storename {w} {
70
    global insp_w2name insp_w2class
71
72
    if {![regexp {\.(ptr.*)-([0-9]+)} $w match object type]} {
73
        error "window name $w doesn't look like an inspector window"
74
    }
75
76
    set insp_w2name($w) [opp_getobjectfullpath $object]
77
    set insp_w2class($w) [opp_getobjectshorttypename $object]
78
    #debug "object and class name for $w stored"
79
}
80
81
82
#
83
# add an inspector to the list
84
#
85
# called when an inspector window gets closed because the underlying object
86
# was destroyed -- in this case remember it on the 'pending inspectors' list
87
# so that we can reopen the inspector when (if) the object reappears.
88
#
89
proc inspectorlist_add {w} {
90
    global pil_name pil_class pil_type pil_geom pil_nextindex
91
    global insp_w2name insp_w2class
92
93
    if {![regexp {\.(ptr.*)-([0-9]+)} $w match object type]} {
94
        error "window name $w doesn't look like an inspector window"
95
    }
96
97
    # we cannot use here the opp_getobjectfullpath, opp_getclass methods because
98
    # we're called from the cObject destructor, name and class are long gone!
99
    set objname $insp_w2name($w)
100
    set classname $insp_w2class($w)
101
    set key "$objname:$classname:$type"
102
103
    set pil_name($key)   $objname
104
    set pil_class($key)  $classname
105
    set pil_type($key)   $type
106
    set pil_geom($key)   [inspectorlist_get_geom $w 1]
107
108
    #debug "$key added to insp list"
109
}
110
111
#
112
# remove an inspector from the 'pending inspectors' list (if it was in the list)
113
#
114
# called when an inspector window is opened.
115
#
116
proc inspectorlist_remove {w} {
117
    global pil_name pil_class pil_type pil_geom
118
119
    if {![regexp {\.(ptr.*)-([0-9]+)} $w match object type]} {
120
        error "window name $w doesn't look like an inspector window"
121
    }
122
123
    set key "[opp_getobjectfullpath $object]:[opp_getobjectshorttypename $object]:$type"
124
125
    catch {
126
        unset pil_name($key)
127
        unset pil_class($key)
128
        unset pil_type($key)
129
        unset pil_geom($key)
130
        #debug "$key removed from insp list"
131
    }
132
}
133
134
proc inspectorlist_tkenvrc_get_contents {allowdestructive} {
135
    global pil_name pil_class pil_type pil_geom
136
137
    set res ""
138
    foreach w [winfo children .] {
139
       if [regexp {\.(ptr.*)-([0-9]+)} $w match object type] {
140
           set objname [opp_getobjectfullpath $object]
141
           set class [opp_getobjectshorttypename $object]
142
           set geom [inspectorlist_get_geom $w $allowdestructive]
143
144
           append res "inspector \"$objname\" \"$class\" \"$type\" \"$geom\"\n"
145
       }
146
    }
147
148
    foreach key [array names pil_name] {
149
       append res "inspector \"$pil_name($key)\" \"$pil_class($key)\" \"$pil_type($key)\" \"$pil_geom($key)\"\n"
150
    }
151
152
    return $res
153
}
154
155
156
proc inspectorlist_tkenvrc_reset {} {
157
    global pil_name pil_class pil_type pil_geom
158
159
    # delete old array
160
    catch {
161
       unset pil_name
162
       unset pil_class
163
       unset pil_type
164
       unset pil_geom
165
    }
166
}
167
168
169
proc inspectorlist_tkenvrc_process_line {line} {
170
    global pil_name pil_class pil_type pil_geom
171
172
    if {[llength $line]!=5} {error "wrong number of columns"}
173
174
    set objname [lindex $line 1]
175
    set class [lindex $line 2]
176
    set type [lindex $line 3]
177
    set geom [lindex $line 4]
178
179
    if [catch {opp_inspectortype $type}] {return}  ;# ignore obsolete inspector types
180
181
    set key "$objname:$class:$type"
182
183
    set pil_name($key)   $objname
184
    set pil_class($key)  $class
185
    set pil_type($key)   $type
186
    set pil_geom($key)   $geom
187
}
188
189
#
190
# Utility function: returns a "geometry:state" string for the given window.
191
# The geometry corresponds to the "normal" (non-zoomed) state of the
192
# window, so that can be restored from .tkenvrc as well.
193
#
194
proc inspectorlist_get_geom {w allowdestructive} {
195
    set state [wm state $w]
196
    if {$state == "normal"} {
197
        return "[wm geometry $w]:$state"
198
    } else {
199
        # Return the "restored" pos and size, not the zoomed or iconized one.
200
        # For this, we have to temporarily restore the window from the current
201
        # state (zoomed, iconic, etc.) If Tkenv is exiting or $w is being closed,
202
        # we don't bother to restore the original state afterwards, as it would
203
        # only cause more screen flicker.
204
        wm state $w normal
205
        set result "[wm geometry $w]:$state"
206
        if {!$allowdestructive} {
207
            wm state $w $state ;# restore original state
208
        }
209
        return $result
210
    }
211
}