1 # mtrace.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/common/mtrace.tcl,v 1.19 2002/02/03 04:25:43 lim Exp $
32
33
34 #Class MTrace - need this comment for import
35
36 #
37 # How to use mtrace?
38 # -------------------
39 #
40 # - Use "set mtrace [MTrace init {trace flags}]" to create the mtrace object
41 # (See tcl/archive/player.tcl for an example)
42 # - Use "$mtrace toggle_window" to display/hide a window that is used to
43 # set/reset individual trace flags dynamicalLy
44 # - In your .cc files, use the MTrace macro to output a trace message
45 # - In your .tcl files, use the mtrace procedure to output a trace message.
46 # (This still needs some more work)
47 #
48
49
50 #
51 # IMPORTANT: If you change any of the #defines below, or add a new flag,
52 # also update the misc/mtrace.h file correspondingly
53 #
54 set MTrace(trcNone) {0x00000000 {none}}
55 set MTrace(trcNet) {0x00000001 {Network}}
56 set MTrace(trcSRM) {0x00000002 {SRM}}
57 set MTrace(trcArchive) {0x00000004 {Archive}}
58 set MTrace(trcMB) {0x00000008 {Mediaboard}}
59 set MTrace(trcFCA) {0x00000010 {Floor control}}
60 set MTrace(trcLTS) {0x00000020 {Logical Time System}}
61 set MTrace(trcTGMB) {0x00000040 {TopGun MediaBoard}}
62 set MTrace(trcCB) {0x00000080 {Coordination Bus}}
63 set MTrace(trcWC) {0x00000100 {Web Cache}}
64 set MTrace(trcVerbose) {0x20000000 {Verbose}}
65 set MTrace(trcExcessive) {0x40000000 {Excessive}}
66 set MTrace(trcTmp) {0x80000000 {Temp}}
67 set MTrace(trcAll) {0xFFFFFFFF {All}}
68
69
70
71
72 # check if the MTrace object exists, if it doesn't, then just create a NULL
73 # MTrace method
74
75 if { [Class info instances MTrace]=="" } {
76 proc MTrace { args } {
77 # do nothing
78 return MTrace
79 }
80 }
81
82
83 MTrace proc init { flags } {
84 global MTrace
85 MTrace instvar mtrace
86 set mtrace [new MTrace]
87 $mtrace create_window
88 foreach flag $flags {
89 if { [info exists MTrace($flag)] } {
90 set bits [lindex $MTrace($flag) 0]
91 set msg [lindex $MTrace($flag) 1]
92 $mtrace tkvar flag_$flag
93 set flag_$flag 1
94 $mtrace set_flag $bits
95 }
96 }
97 return $mtrace
98 }
99
100
101 MTrace instproc create_window { } {
102 global mash
103 if { $mash(environ) == "smash" } return
104
105 $self instvar path_
106 global MTrace
107 set count 0
108 while { [winfo exists ".mtrace_$count"] } { incr count }
109
110 set path_ ".mtrace_$count"
111 toplevel $path_
112 wm title $path_ "MASH Trace"
113 wm withdraw $path_
114
115 set main [frame $path_.main -bd 1 -relief sunken]
116 pack $main -side top -fill both -expand 1 -padx 5 -pady 3
117
118 foreach flag [array names MTrace] {
119 $self tkvar flag_$flag
120 set flag_$flag 0
121 checkbutton $main.$flag -text [lindex $MTrace($flag) 1] \
122 -variable [$self tkvarname flag_$flag] \
123 -command "$self toggle_flag $flag" \
124 -bd 1 -pady 0 -anchor w
125 pack $main.$flag -pady 0 -padx 5 -fill x -expand 1
126 }
127
128 button $path_.button -text "Dismiss" -command "$self toggle_window" \
129 -pady 0
130 pack $path_.button -anchor e -padx 5 -pady 2
131
132 wm protocol $path_ WM_DELETE_WINDOW "$self toggle_window"
133
134 return $path_
135 }
136
137
138 MTrace instproc toggle_window { } {
139 global mash
140 if { $mash(environ) == "smash" } return
141
142 $self instvar path_
143 if { [winfo ismapped $path_] } {
144 wm withdraw $path_
145 } else {
146 wm deiconify $path_
147 }
148 }
149
150
151 MTrace instproc toggle_flag { flag } {
152 global MTrace
153 $self tkvar flag_$flag
154 if { [set flag_$flag] } {
155 $self set_flag [lindex $MTrace($flag) 0]
156 } else {
157 $self reset_flag [lindex $MTrace($flag) 0]
158 }
159 }
160
161
162 proc mtrace { flags args } {
163 global MTrace
164 set bits 0
165 foreach flag [split $flags "|"] {
166 set bits [expr $bits | [lindex $MTrace($flag) 0]]
167 }
168 MTrace instvar mtrace
169 if [info exists mtrace] {
170 $mtrace trace $bits $args
171 }
172 }
173
174
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.