107 proc create {type {save_as ""}} {
110 variable current_server
111 variable current_fname
118 wm title .ftp [
expr {($type eq "open") ? [msgcat::mc "Open Remote File"] : [msgcat::mc "Save File Remotely"]}]
120 wm geometry .ftp 600x400
123 set widgets(pw) [ttk::panedwindow .ftp.pw -orient horizontal]
129 $widgets(pw) add [ttk::frame .ftp.pw.lf]
131 ttk::frame .ftp.pw.lf.sf
132 set widgets(sb) [tablelist::tablelist .ftp.pw.lf.sf.tl \
133 -columns [list 0 [msgcat::mc "Connections"] 0 {} 0 {}] -treecolumn 0 -exportselection 0 -relief flat \
134 -selectmode single -movablerows 1 -labelrelief flat -highlightthickness 0 \
143 -acceptchildcommand [list remote::accept_child_command] \
145 -yscrollcommand [list utils::set_yscrollbar .ftp.pw.lf.sf.vb]]
146 scroller::scroller .ftp.pw.lf.sf.vb -orient vertical -command [list .ftp.pw.lf.sf.tl yview]
151 $widgets(sb) columnconfigure 0 -name name -editable 0 -resizable 1 -stretchable 1
152 $widgets(sb) columnconfigure 1 -name settings -hide 1
153 $widgets(sb) columnconfigure 2 -name passwd -hide 1
155 bind $widgets(sb) <<TablelistSelect>> [list remote::handle_sb_select]
156 bind [$widgets(sb) bodytag] <Double-Button-1> [list remote::handle_sb_double_click]
157 bind [$widgets(sb) bodytag] <Button-$::right_click> [list remote::show_sidebar_menu %W %x %y %X %Y]
158 bind $widgets(sb) <<TablelistRowMoved>> [list remote::handle_row_moved %d]
160 grid rowconfigure .ftp.pw.lf.sf 1 -weight 1
161 grid columnconfigure .ftp.pw.lf.sf 0 -weight 1
162 grid .ftp.pw.lf.sf.tl -row 0 -column 0 -sticky news -rowspan 2
163 grid [$widgets(sb) cornerpath] -row 0 -column 1 -sticky ew
164 grid .ftp.pw.lf.sf.vb -row 1 -column 1 -sticky ns
166 ttk::frame .ftp.pw.lf.bf
167 set widgets(new_b) [ttk::button .ftp.pw.lf.bf.edit -style BButton -text "+" -width 2 -command [list remote::show_new_menu]]
169 pack .ftp.pw.lf.bf.edit -side left -padx 2 -pady 2
171 pack .ftp.pw.lf.sf -fill both -expand yes
172 pack .ftp.pw.lf.bf -fill x
175 set widgets(new) [
menu .ftp.newPopup -tearoff 0]
176 $widgets(new) add command -label [msgcat::mc "New Group"] -command [list remote::new_group]
177 $widgets(new) add command -label [msgcat::mc "New Connection"] -command [list remote::new_connection]
179 set widgets(group) [
menu .ftp.groupPopup -tearoff 0 -postcommand [list remote::group_post]]
180 $widgets(group) add command -label [msgcat::mc "New Connection"] -command [list remote::new_connection]
181 $widgets(group) add separator
182 $widgets(group) add command -label [msgcat::mc "Rename Group"] -command [list remote::rename_group]
183 $widgets(group) add command -label [msgcat::mc "Delete Group"] -command [list remote::delete_group]
185 set widgets(connection) [
menu .ftp.connPopup -tearoff 0 -postcommand [list remote::connection_post]]
186 $widgets(connection) add command -label [msgcat::mc "Open Connection"] -command [list remote::open_connection]
187 $widgets(connection) add command -label [msgcat::mc "Close Connection"] -command [list remote::close_connection]
188 $widgets(connection) add separator
189 $widgets(connection) add command -label [msgcat::mc "Edit Connection"] -command [list remote::edit_connection]
190 $widgets(connection) add command -label [msgcat::mc "Test Connection"] -command [list remote::test_connection 0]
191 $widgets(connection) add separator
192 $widgets(connection) add command -label [msgcat::mc "Delete Connection"] -command [list remote::delete_connection]
198 $widgets(pw) add [ttk::frame .ftp.pw.rf] -weight 1
200 set widgets(viewer) [ttk::frame .ftp.pw.rf.vf]
202 ttk::frame .ftp.pw.rf.vf.ff
204 ttk::frame .ftp.pw.rf.vf.ff.mf
205 set widgets(dir_back) [ttk::button .ftp.pw.rf.vf.ff.mf.back -style BButton -image remote_back_disabled -command [list remote::handle_dir -1] -state disabled]
206 set widgets(dir_forward) [ttk::button .ftp.pw.rf.vf.ff.mf.forward -style BButton -image remote_next_disabled -command [list remote::handle_dir 1] -state disabled]
207 set widgets(dir_mb) [ttk::menubutton .ftp.pw.rf.vf.ff.mf.mb \
208 -menu [
set widgets(dir_menu) [
menu .ftp.dirPopup -tearoff 0 -postcommand [list remote::handle_dir_mb_post]]] \
211 pack $widgets(dir_back) -side left -padx 2 -pady 2
212 pack $widgets(dir_forward) -side left -padx 2 -pady 2
213 pack $widgets(dir_mb) -side left -padx 2 -pady 2 -fill x -expand yes
215 set widgets(tl) [tablelist::tablelist .ftp.pw.rf.vf.ff.tl \
216 -columns [list 0 [msgcat::mc "File System"] 0 {}] -exportselection 0 -borderwidth 0 -highlightthickness 0 -showlabels 0 \
217 -selectmode [
expr {($type eq "save") ? "browse" : "extended"}] \
218 -xscrollcommand [list utils::set_xscrollbar .ftp.pw.rf.vf.ff.hb] \
219 -yscrollcommand [list utils::set_yscrollbar .ftp.pw.rf.vf.ff.vb]]
220 scroller::scroller .ftp.pw.rf.vf.ff.vb -orient vertical -command [list .ftp.pw.rf.vf.ff.tl yview]
221 scroller::scroller .ftp.pw.rf.vf.ff.hb -orient horizontal -command [list .ftp.pw.rf.vf.ff.tl xview]
223 $widgets(tl) columnconfigure 0 -name fname -resizable 1 -stretchable 1 -editable 0 -formatcommand [list remote::format_name]
224 $widgets(tl) columnconfigure 1 -name dir -hide 1
226 bind $widgets(tl) <<TablelistSelect>> [list remote::handle_tl_select]
227 bind [$widgets(tl) bodytag] <Double-Button-1> [list remote::handle_tl_double_click]
229 grid rowconfigure .ftp.pw.rf.vf.ff 1 -weight 1
230 grid columnconfigure .ftp.pw.rf.vf.ff 0 -weight 1
231 grid .ftp.pw.rf.vf.ff.mf -row 0 -column 0 -sticky ew -columnspan 2
232 grid .ftp.pw.rf.vf.ff.tl -row 1 -column 0 -sticky news
233 grid .ftp.pw.rf.vf.ff.vb -row 1 -column 1 -sticky ns
234 grid .ftp.pw.rf.vf.ff.hb -row 2 -column 0 -sticky ew
236 ttk::frame .ftp.pw.rf.vf.sf
237 ttk::label .ftp.pw.rf.vf.sf.l -text [
format "%s: " [msgcat::mc "Name"]]
238 set widgets(save_entry) [ttk::entry .ftp.pw.rf.vf.sf.e -validate key -validatecommand [list remote::handle_save_entry %P]]
240 pack .ftp.pw.rf.vf.sf.l -side left -padx 2 -pady 2
241 pack .ftp.pw.rf.vf.sf.e -side left -padx 2 -pady 2 -fill x -expand yes
243 ttk::frame .ftp.pw.rf.vf.bf
244 set widgets(folder) [ttk::button .ftp.pw.rf.vf.bf.folder -style BButton -text [msgcat::mc "New Folder"] \
245 -command [list remote::handle_new_folder] -state disabled]
246 set widgets(open) [ttk::button .ftp.pw.rf.vf.bf.ok -style BButton -text [msgcat::mc "Open"] \
247 -width 6 -command [list remote::handle_open] -state disabled]
248 ttk::button .ftp.pw.rf.vf.bf.cancel -style BButton -text [msgcat::mc "Cancel"] \
249 -width 6 -command [list remote::handle_cancel]
251 pack .ftp.pw.rf.vf.bf.cancel -side right -padx 2 -pady 2
252 pack .ftp.pw.rf.vf.bf.ok -side right -padx 2 -pady 2
254 if {$type ne "open"} {
255 pack .ftp.pw.rf.vf.bf.folder -side left -padx 2 -pady 2
256 $widgets(open) configure -text [msgcat::mc "Save"]
259 pack .ftp.pw.rf.vf.ff -fill both -expand yes
260 if {$type ne "open"} {
261 pack .ftp.pw.rf.vf.sf -fill x
263 pack .ftp.pw.rf.vf.bf -fill x
265 pack .ftp.pw.rf.vf -fill both -expand yes
271 set widgets(editor) [ttk::frame .ftp.ef]
273 ttk::frame .ftp.ef.sf
274 ttk::label .ftp.ef.sf.l0 -text [
format "%s: " [msgcat::mc "Type"]]
275 set widgets(edit_type) [ttk::menubutton .ftp.ef.sf.mb0 -text "FTP" -menu [
menu .ftp.typePopup -tearoff 0]]
276 ttk::label .ftp.ef.sf.l1 -text [
format "%s: " [msgcat::mc "Group"]]
277 set widgets(edit_group) [ttk::menubutton .ftp.ef.sf.mb1 -text "" -menu [
menu .ftp.egroupPopup -tearoff 0 -postcommand [list remote::populate_group_menu]]]
278 ttk::label .ftp.ef.sf.l2 -text [
format "%s: " [msgcat::mc "Name"]]
279 set widgets(edit_name) [ttk::entry .ftp.ef.sf.ne -validate key -validatecommand [list remote::check_name %P]]
280 set widgets(edit_serverl) [ttk::label .ftp.ef.sf.l3 -text [
format "%s: " [msgcat::mc "Server"]]]
281 set widgets(edit_server) [ttk::entry .ftp.ef.sf.se -validate key -validatecommand [list remote::check_server %P]]
282 ttk::label .ftp.ef.sf.l4 -text [
format "%s: " [msgcat::mc "Username"]]
283 set widgets(edit_user) [ttk::entry .ftp.ef.sf.ue -validate key -validatecommand [list remote::check_username %P]]
284 ttk::label .ftp.ef.sf.l5 -text [
format "%s (%s): " [msgcat::mc "Password"] [msgcat::mc "Optional"]]
285 set widgets(edit_passwd) [ttk::entry .ftp.ef.sf.pe -show *]
286 set widgets(edit_portl) [ttk::label .ftp.ef.sf.l6 -text [
format "%s: " [msgcat::mc "Port"]]]
287 set widgets(edit_port) [ttk::entry .ftp.ef.sf.poe -validate key -validatecommand [list remote::check_port %P] -invalidcommand bell]
288 ttk::label .ftp.ef.sf.l7 -text [
format "%s (%s): " [msgcat::mc "Remote Directory"] [msgcat::mc "Optional"]]
289 set widgets(edit_dir) [ttk::entry .ftp.ef.sf.re -validate key -validatecommand [list remote::check_dir]]
291 bind $widgets(edit_name) <Return> [list .ftp.ef.bf.create invoke]
292 bind $widgets(edit_server) <Return> [list .ftp.ef.bf.create invoke]
293 bind $widgets(edit_user) <Return> [list .ftp.ef.bf.create invoke]
294 bind $widgets(edit_passwd) <Return> [list .ftp.ef.bf.create invoke]
295 bind $widgets(edit_port) <Return> [list .ftp.ef.bf.create invoke]
296 bind $widgets(edit_dir) <Return> [list .ftp.ef.bf.create invoke]
298 grid rowconfigure .ftp.ef.sf 8 -weight 1
299 grid columnconfigure .ftp.ef.sf 1 -weight 1
300 grid .ftp.ef.sf.l0 -row 0 -column 0 -sticky news -padx 2 -pady 2
301 grid .ftp.ef.sf.mb0 -row 0 -column 1 -sticky w -padx 2 -pady 2
302 grid .ftp.ef.sf.l1 -row 1 -column 0 -sticky news -padx 2 -pady 2
303 grid .ftp.ef.sf.mb1 -row 1 -column 1 -sticky w -padx 2 -pady 2
304 grid .ftp.ef.sf.l2 -row 2 -column 0 -sticky news -padx 2 -pady 2
305 grid .ftp.ef.sf.ne -row 2 -column 1 -sticky news -padx 2 -pady 2
306 grid .ftp.ef.sf.l3 -row 3 -column 0 -sticky news -padx 2 -pady 2
307 grid .ftp.ef.sf.se -row 3 -column 1 -sticky news -padx 2 -pady 2
308 grid .ftp.ef.sf.l4 -row 4 -column 0 -sticky news -padx 2 -pady 2
309 grid .ftp.ef.sf.ue -row 4 -column 1 -sticky news -padx 2 -pady 2
310 grid .ftp.ef.sf.l5 -row 5 -column 0 -sticky news -padx 2 -pady 2
311 grid .ftp.ef.sf.pe -row 5 -column 1 -sticky news -padx 2 -pady 2
312 grid .ftp.ef.sf.l6 -row 6 -column 0 -sticky news -padx 2 -pady 2
313 grid .ftp.ef.sf.poe -row 6 -column 1 -sticky news -padx 2 -pady 2
314 grid .ftp.ef.sf.l7 -row 7 -column 0 -sticky news -padx 2 -pady 2
315 grid .ftp.ef.sf.re -row 7 -column 1 -sticky news -padx 2 -pady 2
317 ttk::frame .ftp.ef.bf
318 set widgets(edit_test) [ttk::button .ftp.ef.bf.test -style BButton -text [msgcat::mc "Test"] \
319 -width 6 -command [list remote::test_connection 1] -state disabled]
320 set widgets(edit_create) [ttk::button .ftp.ef.bf.create -style BButton -text [msgcat::mc "Create"] \
321 -width 6 -command [list remote::update_connection] -state disabled]
322 ttk::button .ftp.ef.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width 6 -command {
324 pack .ftp.pw -fill both -expand yes
327 pack .ftp.ef.bf.test -side left -padx 2 -pady 2
328 pack .ftp.ef.bf.cancel -side right -padx 2 -pady 2
329 pack .ftp.ef.bf.create -side right -padx 2 -pady 2
331 pack .ftp.ef.sf -fill both -expand yes
332 pack .ftp.ef.bf -fill x
335 pack .ftp.pw -fill both -expand yes
344 if {$current_server ne ""} {
349 .ftp.typePopup add command -label "FTP" -command {
350 $remote::widgets(edit_type) configure -text "FTP"
351 $remote::widgets(edit_serverl) configure -text [format "%s: " [msgcat::mc "Server"]]
352 $remote::widgets(edit_port) delete 0 end
353 $remote::widgets(edit_port) insert end 21
354 grid $remote::widgets(edit_portl)
355 grid $remote::widgets(edit_port)
357 if {[
info procs ::sFTPopen] ne ""} {
358 .ftp.typePopup add command -label "SFTP" -command {
359 $remote::widgets(edit_type) configure -text "SFTP"
360 $remote::widgets(edit_serverl) configure -text [format "%s: " [msgcat::mc "Server"]]
361 $remote::widgets(edit_port) delete 0 end
362 $remote::widgets(edit_port) insert end 22
363 grid $remote::widgets(edit_portl)
364 grid $remote::widgets(edit_port)
367 .ftp.typePopup add command -label "WebDAV" -command {
368 $remote::widgets(edit_type) configure -text "WebDAV"
369 $remote::widgets(edit_serverl) configure -text "URL: "
370 $remote::widgets(edit_port) delete 0 end
371 grid remove $remote::widgets(edit_portl)
372 grid remove $remote::widgets(edit_port)
376 ::tk::PlaceWindow .ftp widget .
382 if {$current_server eq ""} {
384 set focus_widget $widgets(sb)
385 $widgets(sb) selection set 0
390 set server_name [
join [
lassign [
split $current_server ,] server_group] ,]
391 set group_row [$widgets(sb) searchcolumn name $server_group -parent root]
392 $widgets(sb) selection set [$widgets(sb) searchcolumn name $server_name -parent $group_row]
394 if {$type eq "open"} {
395 set focus_widget $widgets(tl)
397 set focus_widget $widgets(save_entry)
398 $widgets(save_entry) insert end $save_as
399 $widgets(save_entry) selection range 0 end
405 ::tk::SetFocusGrab .ftp $focus_widget
411 ::tk::RestoreFocusGrab .ftp $focus_widget
413 return [list $current_server $current_fname]