1 # ui-filedlg.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/applications/player/ui-filedlg.tcl,v 1.4 2002/02/03 04:22:14 lim Exp $
32
33
34 import WidgetClass FileDialog
35
36 WidgetClass FileDialog/Archive -superclass FileDialog -default {
37 { .preview.Checkbutton.borderWidth 1 }
38 { .preview.Checkbutton.highlightThickness 1 }
39 { .preview.info.text.borderWidth 1 }
40 { .preview.info.text.highlightThickness 0 }
41 { .preview.info.text.width 25 }
42 { .preview.info.text.height 6 }
43 { .preview.info.scrollbar both }
44 { .preview.info*Scrollbar.width 10 }
45 { .preview.info*Scrollbar.borderWidth 1 }
46 { .preview.info*Scrollbar.highlightThickness 1 }
47 { *MultiColumnListbox*bbox.width 300 }
48 }
49
50
51 FileDialog/Archive instproc build_widget { path } {
52 $self next $path
53 $self subwidget filebox configure \
54 -browsecmd "$self browse_preview; $self ignore_args"
55
56 frame $path.preview
57 checkbutton $path.preview.button -text "Preview" -anchor w \
58 -variable [$self tkvarname preview_] \
59 -command "$self browse_preview"
60 #text $path.preview.info -state disabled -wrap none
61 ScrolledText $path.preview.info -options {
62 { text.state disabled }
63 { text.wrap none }
64 }
65
66 $self tkvar preview_
67 set preview_ 1
68
69 pack $path.preview.button -side top -fill x -anchor w
70 pack $path.preview.info -fill both -expand 1 -padx 5 -pady 5
71 pack $path.preview -fill both -side right
72 }
73
74
75 FileDialog/Archive instproc browse_preview { } {
76 set filetypes [$self subwidget filebox cget -filetypes]
77 set ext [string trim [lindex [lindex $filetypes 0] 1]]
78 switch -exact -- $ext {
79 .dat {
80 $self browse_preview_ browse_data_index DAT
81 }
82 .idx {
83 $self browse_preview_ browse_data_index IDX
84 }
85 .ctg {
86 $self browse_preview_ browse_catalog
87 }
88 }
89 }
90
91
92 FileDialog/Archive instproc browse_preview_ { method args } {
93 $self tkvar preview_
94
95 if { $preview_ } {
96 set text [[$self subwidget preview].info subwidget text]
97 $text configure -state normal
98 $text delete 1.0 end
99 set path [file join \
100 [$self subwidget filebox cget -directory] \
101 [$self subwidget filebox cget -filename]]
102 eval [list $self] [list $method] [list $path] $args
103 $text configure -state disabled
104 }
105 }
106
107
108 FileDialog/Archive instproc browse_data_index { filename filetype } {
109 set afile [new ArchiveFile]
110 if ![catch {$afile open $filename; $afile header hdr} ] {
111 if { [string match "M${filetype}*" $hdr(version)] } {
112 set duration [expr $hdr(end) - $hdr(start)]
113 if { $duration < 0.0 } {
114 set duration 0.0
115 }
116
117 set string "Version: $hdr(version)\n"
118 append string "Protocol: $hdr(protocol)\n"
119 append string "Media: $hdr(media)\n"
120 append string "CName: $hdr(cname)\n"
121 append string "Name: $hdr(name)\n"
122 append string "Start: [ArchiveFile ts2string \
123 $hdr(start)]\n"
124 append string "End: [ArchiveFile ts2string \
125 $hdr(end)]\n"
126 append string "Duration: $duration seconds\n"
127 } else {
128 set string "Cannot preview file"
129 }
130 } else {
131 set string "Cannot preview file"
132 }
133 [$self subwidget preview].info subwidget text insert end $string
134 delete $afile
135 }
136
137
138 FileDialog/Archive instproc browse_catalog { filename } {
139 set catalog [new SessionCatalog]
140 set text [[$self subwidget preview].info subwidget text]
141
142 if [catch {$catalog open $filename}] {
143 $text insert end "Cannot open file"
144 delete $catalog
145 return
146 }
147
148 if [catch {$catalog read}] {
149 global errorInfo
150 $text insert end "Cannot preview session catalog"
151 delete $catalog
152 return
153 }
154
155 foreach id [$catalog info streams] {
156 lappend session([$catalog info session $id]) $id
157 }
158
159 foreach s [array names session] {
160 $text insert end "$s:\n"
161 foreach id $session($s) {
162 $text insert end " Data file: [file tail \
163 [$catalog info datafile $id]]\n"
164 $text insert end " Index file: [file tail \
165 [$catalog info indexfile $id]]\n"
166 }
167 }
168
169 delete $catalog
170 }
171
172
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.