1 # ui-import.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1998-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/mbv2/ui-import.tcl,v 1.4 2002/02/03 04:21:59 lim Exp $
32
33
34 import Dialog FileBox
35
36
37 # --
38 # FileDialog combo for selecting files to import
39 # result values are:
40 # 1) "" if cancel pressed
41 # 2) a list of files selected if "import all" pressed
42 # 3) a list of one file if "import" pressed or double click
43 # --
44
45 WidgetClass Dialog/MBv2Import -superclass Dialog -configspec {
46 {-directory directory Directory "" config_directory cget_directory }
47 } -default {
48 { *background WidgetDefault }
49 { *Button.borderWidth 1 }
50 { *Menubutton.borderWidth 1 }
51 { *Menubutton.highlightThickness 1 }
52 { *Menubutton.anchor w }
53 { *Menubutton.padX 5 }
54 { *Menubutton*font WidgetDefault }
55 { *Label*font WidgetDefault }
56 }
57
58
59 Dialog/MBv2Import private config_filetypes { args } {
60 return [eval [$self subwidget filebox] config_filetypes $args]
61 }
62
63
64 Dialog/MBv2Import private cget_filetypes { args } {
65 return [eval [$self subwidget filebox] cget_filetypes $args]
66 }
67
68
69 Dialog/MBv2Import private config_directory { args } {
70 return [eval [$self subwidget filebox] config_directory $args]
71 }
72
73
74 Dialog/MBv2Import private cget_directory { args } {
75 return [eval [$self subwidget filebox] cget_directory $args]
76 }
77
78
79 Dialog/MBv2Import private build_widget { path } {
80 $self next $path
81
82 $self instvar filetypes_
83 set filetypes_(image) { {Image Files} {.gif .GIF} }
84 set filetypes_(text) { {Text Files} {.txt} }
85 set filetypes_(all) { {All Files} {*} }
86
87 set filetypes ""
88 foreach n [list image text all] {
89 lappend filetypes $filetypes_($n)
90 }
91
92 set filebox [FileBox $path.filebox -filetypes $filetypes \
93 -command "$self import; $self ignore_args" \
94 -browsecmd "$self ignore_args"]
95
96 frame $path.import_as_frame
97 label $path.import_as_label -text "Import as:" -anchor e -width 14
98 DropDown $path.import_as -variable [$self tkvarname import_as_]
99 $path.import_as insert end "Image" "Text"
100 $self tkvar import_as_
101 trace variable import_as_ w "$self import_as_changed"
102 set import_as_ Image
103
104 pack $path.import_as_label -side left -padx 4 -in $path.import_as_frame
105 pack $path.import_as -expand yes -fill x -side right \
106 -in $path.import_as_frame
107
108 frame $path.buttons
109 button $path.import -underline 0 -text "Import" \
110 -command "$self import"
111 button $path.all -underline 8 -text "Import all" \
112 -command "$self import_all"
113 button $path.cancel -underline 0 -text "Cancel" \
114 -command "$self cancel"
115
116 bind $path <KeyPress-Escape> "$self cancel"
117 pack $path.import $path.all $path.cancel -side left -padx 5 -pady 2 \
118 -in $path.buttons
119 pack $path.buttons -side bottom -anchor e -pady 3
120 pack $path.filebox -side top -fill both -expand 1
121 pack $path.import_as_frame -side top -fill x
122 }
123
124
125 Dialog/MBv2Import private import_as_changed {args} {
126 $self tkvar import_as_
127 $self instvar filetypes_
128 $self subwidget filebox configure -current_filetype \
129 $filetypes_([string tolower $import_as_])
130 }
131
132
133 Dialog/MBv2Import public import_as { what } {
134 $self tkvar import_as_
135 set import_as_ [string toupper [string index $what 0]][string tolower\
136 [string range $what 1 end]]
137 }
138
139
140 Dialog/MBv2Import private import {} {
141 set filebox [$self subwidget filebox]
142 set file [$filebox cget -filename]
143 if { $file=="" } return
144 set path [file join [$filebox cget -directory] $file]
145 if {![file exists $path]} {
146 Dialog transient MessageBox -image Icons(warning) -type ok \
147 -text "File \"$path\" does not exist."
148 return
149 }
150 $self tkvar import_as_
151 $self config -result [list [string tolower $import_as_] [list $path]]
152 }
153
154
155 # used to compare strings that have a number at the end
156 # this is dead slow, but presumably we don't do this often
157 Dialog/MBv2Import private alphanumeric_cmp {str1 str2} {
158 if {$str1==$str2} { return 0 }
159 if {$str1> $str2} { return 1 }
160 return -1
161
162 # if {[ regexp {[a-zA-Z]*0*([0-9]*)\.[a-zA-Z0-9]*} $str1 {} n1 ] && \
163 # [ regexp {[a-zA-Z]*0*([0-9]*)\.[a-zA-Z0-9]*} $str2 \
164 # {} n2]} {
165 # return [expr {$n1 - $n2}]
166 # }
167 }
168
169
170 Dialog/MBv2Import private import_all {} {
171 set filebox [$self subwidget filebox]
172 set dir [$filebox cget -directory]
173 set filter [$filebox current_filter]
174 set files [lsort -command "$self alphanumeric_cmp" \
175 [eval glob -nocomplain [file join $dir $filter]]]
176 if {0==[llength $files]} {
177 # there are no satisfactory files
178 Dialog transient MessageBox -type ok -text \
179 "Could not find any appropriate files in\
180 \n\"$dir\"" -image Icons(warning)
181 return
182 }
183 # The glob pattern might result in multiple matches, esp. if the
184 # file system is case insensitive, like win95
185 # make sure each file is listed only once
186
187 set prevFile ""
188 set tmplist ""
189 foreach f $files {
190 if {$f!=$prevFile} {
191 lappend tmplist $f
192 }
193 set prevFile $f
194 }
195 $self tkvar import_as_
196 $self config -result [list [string tolower $import_as_] \
197 $tmplist]
198 }
199
200
201 Dialog/MBv2Import instproc cancel { } {
202 $self tkvar result_
203 $self config -result ""
204 }
205
206
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.